import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
-import Control.Monad (forever)
+import Control.Monad (forever, void)
import qualified Data.ByteString.Base16 as B16 (encode)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
import FuncTorrent.Bencode (BVal(..))
import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
import FuncTorrent.Network (sendGetRequest)
-import FuncTorrent.Peer (Peer(..))
-import FuncTorrent.Utils (splitN)
-import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..), Port, IP)
+import FuncTorrent.PeerMsgs (Peer(..), makePeer)
+import FuncTorrent.Utils (splitN, IP, Port)
+import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..))
--- | URL encode hash as per RFC1738
("event", "started")]
trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
-trackerLoop url port peerId infohash fschan tstate = forever $ do
+trackerLoop url sport peerId infohash fschan tstate = forever $ do
st' <- FS.getStats fschan
st <- readMVar st'
let up = FS.bytesRead st
down = FS.bytesWritten st
- resp <- sendGetRequest url $ mkArgs port peerId up down (left tstate) infohash
+ resp <- sendGetRequest url $ mkArgs sport peerId up down (left tstate) infohash
case Benc.decode resp of
- Left e -> do
+ Left e ->
return () -- $ pack (show e)
Right trackerInfo ->
case parseTrackerResponse trackerInfo of
- Left e -> return () -- e
+ Left e -> return ()
Right tresp -> do
- _ <- threadDelay $ fromIntegral (interval tresp)
ps <- isEmptyMVar $ connectedPeers tstate
if ps
- then do
- _ <- putMVar (connectedPeers tstate) (peers tresp)
- return ()
- else do
- _ <- swapMVar (connectedPeers tstate) (peers tresp)
- return ()
+ then
+ putMVar (connectedPeers tstate) (peers tresp)
+ else
+ void $ swapMVar (connectedPeers tstate) (peers tresp)
+ threadDelay $ fromIntegral (interval tresp)
parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
parseTrackerResponse resp =
where
(Bdict body) = resp
-makePeer :: ByteString -> Peer
-makePeer peer = Peer "" (toIP ip') (toPort port')
- where (ip', port') = splitAt 4 peer
-
-toPort :: ByteString -> Port
-toPort = read . ("0x" ++) . unpack . B16.encode
-
-toIP :: ByteString -> IP
-toIP = Data.List.intercalate "." .
- map (show . toInt . ("0x" ++) . unpack) .
- splitN 2 . B16.encode
-
-toInt :: String -> Integer
-toInt = read