X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FTracker%2FHttp.hs;h=13395cc72dfc789940646eb3fb5c8f2aae3e6c7f;hb=272216c101f5f411726898f90355956ab9a105b7;hp=5caefd663acbce46cc91dc6243623790724ea79a;hpb=f669c4670f61f71b7ba19368324a2a8a70c09723;p=functorrent.git diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs index 5caefd6..13395cc 100644 --- a/src/FuncTorrent/Tracker/Http.hs +++ b/src/FuncTorrent/Tracker/Http.hs @@ -23,16 +23,15 @@ module FuncTorrent.Tracker.Http (trackerLoop ) where -import Prelude hiding (lookup, splitAt) +import Prelude hiding (lookup) 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 Data.ByteString.Char8 as BC (pack, unpack) import Data.Char (chr) -import Data.List (intercalate) import Data.Map as M (lookup) import Network (PortNumber) import Network.HTTP.Base (urlEncode) @@ -41,9 +40,9 @@ import qualified FuncTorrent.Bencode as Benc 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 (makePeer) +import FuncTorrent.Utils (splitN, IP, Port) +import FuncTorrent.Tracker.Types(TState(..), HttpTrackerResponse(..)) --- | URL encode hash as per RFC1738 @@ -74,30 +73,27 @@ mkArgs port peer_id up down left' infoHash = ("event", "started")] trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO () -trackerLoop url port 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 +trackerLoop url sport peerId infohash fschan tstate = forever $ do + st <- readMVar <$> FS.getStats fschan + up <- fmap FS.bytesRead st + down <- fmap FS.bytesWritten st + 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 :: BVal -> Either ByteString HttpTrackerResponse parseTrackerResponse resp = case lookup "failure reason" body of Just (Bstr err) -> Left err @@ -106,7 +102,7 @@ parseTrackerResponse resp = let (Just (Bint i)) = lookup "interval" body (Just (Bstr peersBS)) = lookup "peers" body pl = map makePeer (splitN 6 peersBS) - in Right TrackerResponse { + in Right HttpTrackerResponse { interval = i , peers = pl , complete = Nothing @@ -115,17 +111,3 @@ 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