From: Ramakrishnan Muthukrishnan Date: Sun, 19 Jun 2016 15:20:27 +0000 (+0530) Subject: refactoring: return type of tracker X-Git-Url: https://git.rkrishnan.org/components/com_hotproperty/flags/%22doc.html/provisioning?a=commitdiff_plain;h=272216c101f5f411726898f90355956ab9a105b7;p=functorrent.git refactoring: return type of tracker Needs DuplicateRecordFields from GHC 8.0.x to compile --- diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs index 9edf3fc..13395cc 100644 --- a/src/FuncTorrent/Tracker/Http.hs +++ b/src/FuncTorrent/Tracker/Http.hs @@ -42,7 +42,7 @@ import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats) import FuncTorrent.Network (sendGetRequest) import FuncTorrent.PeerMsgs (makePeer) import FuncTorrent.Utils (splitN, IP, Port) -import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..)) +import FuncTorrent.Tracker.Types(TState(..), HttpTrackerResponse(..)) --- | URL encode hash as per RFC1738 @@ -93,7 +93,7 @@ trackerLoop url sport peerId infohash fschan tstate = forever $ do 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 @@ -102,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 diff --git a/src/FuncTorrent/Tracker/Types.hs b/src/FuncTorrent/Tracker/Types.hs index 3adcacc..1c47d31 100644 --- a/src/FuncTorrent/Tracker/Types.hs +++ b/src/FuncTorrent/Tracker/Types.hs @@ -18,15 +18,18 @@ -} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} module FuncTorrent.Tracker.Types ( TrackerProtocol(..) - , TrackerResponse(..) + , HttpTrackerResponse(..) + , UdpTrackerResponse(..) , TrackerEventState(..) , TState(..) , TrackerMsg(..) ) where import Data.ByteString (ByteString) +import Data.Word (Word32) import Control.Concurrent.MVar (MVar) import FuncTorrent.PeerMsgs (Peer) @@ -51,9 +54,16 @@ data TState = TState { left :: Integer } -- | Tracker response -data TrackerResponse = TrackerResponse { +data HttpTrackerResponse = HttpTrackerResponse { interval :: Integer , peers :: [Peer] , complete :: Maybe Integer , incomplete :: Maybe Integer } deriving (Show, Eq) + +data UdpTrackerResponse = UdpTrackerResponse { + leechers :: Word32 + , seeders :: Word32 + , interval :: Word32 + , peers :: [Peer] + } deriving (Show) diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs index 5e98879..aaa9947 100644 --- a/src/FuncTorrent/Tracker/Udp.hs +++ b/src/FuncTorrent/Tracker/Udp.hs @@ -40,7 +40,7 @@ import System.Random (randomIO) import System.Timeout (timeout) import FuncTorrent.PeerMsgs (Peer(..)) -import FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..)) +import FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..), UdpTrackerResponse(..)) import FuncTorrent.Utils (IP, Port, toIP, toPort, getHostname, getPort) import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats) @@ -171,13 +171,7 @@ announceRequest cid infohash peerId up down left port = do liftIO $ sendRequest h (toStrict pkt) return tidi -data PeerStats = PeerStats { leechers :: Word32 - , seeders :: Word32 - , interval :: Word32 - , peers :: [Peer] - } deriving (Show) - -announceResponse :: Word32 -> ReaderT UDPTrackerHandle IO PeerStats +announceResponse :: Word32 -> ReaderT UDPTrackerHandle IO UdpTrackerResponse announceResponse tid = do h <- ask resp <- liftIO $ recvResponse h @@ -186,10 +180,10 @@ announceResponse tid = do if tidr == tid then do liftIO $ putStrLn "announce succeeded" - return $ PeerStats ls ss interval xs + return $ UdpTrackerResponse ls ss interval xs else - return $ PeerStats 0 0 0 [] - _ -> return $ PeerStats 0 0 0 [] + return $ UdpTrackerResponse 0 0 0 [] + _ -> return $ UdpTrackerResponse 0 0 0 [] getIPPortPairs :: Get [Peer] getIPPortPairs = do diff --git a/stack.yaml b/stack.yaml index d652a8c..5b69a9a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -13,7 +13,7 @@ packages: extra-deps: [] # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-5.2 +resolver: nightly-2016-06-19 rebuild-ghc-options: true ghc-options: