From 08d1d4674ef38542e5db24fc398efefbc7bb35af Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Thu, 21 Nov 2013 21:41:06 +0400 Subject: Rename protocol module --- src/Network/BitTorrent/Tracker/Message.hs | 406 +++++++++++++++++++++++++++++ src/Network/BitTorrent/Tracker/Protocol.hs | 406 ----------------------------- 2 files changed, 406 insertions(+), 406 deletions(-) create mode 100644 src/Network/BitTorrent/Tracker/Message.hs delete mode 100644 src/Network/BitTorrent/Tracker/Protocol.hs (limited to 'src/Network/BitTorrent') diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs new file mode 100644 index 00000000..8f4c9228 --- /dev/null +++ b/src/Network/BitTorrent/Tracker/Message.hs @@ -0,0 +1,406 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- Every tracker should support announce query. This query is used +-- to discover peers within swarm and have two-fold effect: +-- +-- * peer doing announce discover other peers using peer list from +-- the response to the announce query. +-- +-- * tracker store peer information and use it in the succeeding +-- requests made by other peers, until the peer info expires. +-- +-- By convention most trackers support another form of request -- +-- scrape query -- which queries the state of a given torrent (or +-- a list of torrents) that the tracker is managing. +-- +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# OPTIONS -fno-warn-orphans #-} +module Network.BitTorrent.Tracker.Protocol + ( -- * Announce + Event(..) + , AnnounceQuery(..) + , AnnounceInfo(..) + + -- ** Defaults + , defaultNumWant + , defaultPorts + + -- * Scrape + , ScrapeQuery + , ScrapeInfo(..) + , Scrape + + -- * TODO + , Tracker(..) + , scrapeOne + ) + where + +import Control.Applicative +import Control.Exception +import Control.Monad +import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson.TH +import Data.BEncode as BE +import Data.BEncode.BDict as BE +import Data.Char as Char +import Data.List as L +import Data.Map as M +import Data.Maybe +import Data.Monoid +import Data.Serialize as S hiding (Result) +import Data.Text (Text) +import Data.Text.Encoding +import Data.Typeable +import Data.URLEncoded as URL +import Data.Word +import Network +import Network.URI +import Network.Socket + +import Data.Torrent.InfoHash +import Data.Torrent.Progress +import Network.BitTorrent.Core.PeerId +import Network.BitTorrent.Core.PeerAddr + +{----------------------------------------------------------------------- + Announce messages +-----------------------------------------------------------------------} + +-- | Events used to specify which kind of tracker request is performed. +data Event = Started + -- ^ For the first request: when a peer join the swarm. + | Stopped + -- ^ Sent when the peer is shutting down. + | Completed + -- ^ To be sent when the peer completes a download. + deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) + +$(deriveJSON (L.map toLower . L.dropWhile isLower) ''Event) + +-- | A tracker request is HTTP GET request; used to include metrics +-- from clients that help the tracker keep overall statistics about +-- the torrent. The most important, requests are used by the tracker +-- to keep track lists of active peer for a particular torrent. +-- +data AnnounceQuery = AnnounceQuery { + reqInfoHash :: !InfoHash + -- ^ Hash of info part of the torrent usually obtained from + -- 'Torrent'. + + , reqPeerId :: !PeerId + -- ^ ID of the peer doing request. + + , reqPort :: !PortNumber + -- ^ Port to listen to for connections from other + -- peers. Normally, tracker should respond with this port when + -- some peer request the tracker with the same info hash. + + , reqProgress :: !Progress + -- ^ Current progress of peer doing request. + + , reqIP :: Maybe HostAddress + -- ^ The peer IP. Needed only when client communicated with + -- tracker throught a proxy. + + , reqNumWant :: Maybe Int + -- ^ Number of peers that the peers wants to receive from. See + -- note for 'defaultNumWant'. + + , reqEvent :: Maybe Event + -- ^ If not specified, the request is regular periodic request. + } deriving (Show, Typeable) + +$(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceQuery) + +newtype PeerList = PeerList { getPeerList :: [PeerAddr] } + deriving (Show, Eq, ToJSON, FromJSON, Typeable) + +-- | The tracker response includes a peer list that helps the client +-- participate in the torrent. The most important is 'respPeer' list +-- used to join the swarm. +-- +data AnnounceInfo = + Failure !Text -- ^ Failure reason in human readable form. + | AnnounceInfo { + -- | Number of peers completed the torrent. (seeders) + respComplete :: !(Maybe Int) + + -- | Number of peers downloading the torrent. (leechers) + , respIncomplete :: !(Maybe Int) + + -- | Recommended interval to wait between requests. + , respInterval :: !Int + + -- | Minimal amount of time between requests. A peer /should/ + -- make timeout with at least 'respMinInterval' value, + -- otherwise tracker might not respond. If not specified the + -- same applies to 'respInterval'. + , respMinInterval :: !(Maybe Int) + + -- | Peers that must be contacted. + , respPeers :: !PeerList + + -- | Human readable warning. + , respWarning :: !(Maybe Text) + } deriving (Show, Typeable) + +$(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceInfo) + +-- | Ports typically reserved for bittorrent P2P listener. +defaultPorts :: [PortNumber] +defaultPorts = [6881..6889] + +-- | Above 25, new peers are highly unlikely to increase download +-- speed. Even 30 peers is /plenty/, the official client version 3 +-- in fact only actively forms new connections if it has less than +-- 30 peers and will refuse connections if it has 55. +-- +-- So the default value is set to 50 because usually 30-50% of peers +-- are not responding. +-- +defaultNumWant :: Int +defaultNumWant = 50 + +{----------------------------------------------------------------------- + Bencode announce encoding +-----------------------------------------------------------------------} + +instance BEncode PeerList where + toBEncode (PeerList xs) = toBEncode xs + fromBEncode (BList l ) = PeerList <$> fromBEncode (BList l) + fromBEncode (BString s ) = PeerList <$> runGet getCompactPeerList s + fromBEncode _ = decodingError "Peer list" + +-- | HTTP tracker protocol compatible encoding. +instance BEncode AnnounceInfo where + toBEncode (Failure t) = toDict $ + "failure reason" .=! t + .: endDict + + toBEncode AnnounceInfo {..} = toDict $ + "complete" .=? respComplete + .: "incomplete" .=? respIncomplete + .: "interval" .=! respInterval + .: "min interval" .=? respMinInterval + .: "peers" .=! respPeers + .: "warning message" .=? respWarning + .: endDict + + fromBEncode (BDict d) + | Just t <- BE.lookup "failure reason" d = Failure <$> fromBEncode t + | otherwise = (`fromDict` (BDict d)) $ do + AnnounceInfo + <$>? "complete" + <*>? "incomplete" + <*>! "interval" + <*>? "min interval" + <*>! "peers" + <*>? "warning message" + fromBEncode _ = decodingError "Announce info" + +instance URLShow PortNumber where + urlShow = urlShow . fromEnum + +instance URLShow Word32 where + urlShow = show + +instance URLShow Event where + urlShow e = urlShow (Char.toLower x : xs) + where + -- INVARIANT: this is always nonempty list + (x : xs) = show e + +instance URLShow Word64 where + urlShow = show + +instance URLEncode Progress where + urlEncode Progress {..} = mconcat + [ s "uploaded" %= _uploaded + , s "left" %= _left + , s "downloaded" %= _downloaded + ] + where s :: String -> String; s = id; {-# INLINE s #-} + +-- | HTTP tracker protocol compatible encoding. +instance URLEncode AnnounceQuery where + urlEncode AnnounceQuery {..} = mconcat + [ s "peer_id" %= reqPeerId + , s "port" %= reqPort + , urlEncode reqProgress + + + , s "ip" %=? reqIP + , s "numwant" %=? reqNumWant + , s "event" %=? reqEvent + ] + where s :: String -> String; s = id; {-# INLINE s #-} + +{----------------------------------------------------------------------- + Binary announce encoding +-----------------------------------------------------------------------} + +type EventId = Word32 + +eventId :: Event -> EventId +eventId Completed = 1 +eventId Started = 2 +eventId Stopped = 3 + +-- TODO add Regular event +putEvent :: Putter (Maybe Event) +putEvent Nothing = putWord32be 0 +putEvent (Just e) = putWord32be (eventId e) + +getEvent :: S.Get (Maybe Event) +getEvent = do + eid <- getWord32be + case eid of + 0 -> return Nothing + 1 -> return $ Just Completed + 2 -> return $ Just Started + 3 -> return $ Just Stopped + _ -> fail "unknown event id" + +-- | UDP tracker protocol compatible encoding. +instance Serialize AnnounceQuery where + put AnnounceQuery {..} = do + put reqInfoHash + put reqPeerId + put reqProgress + putEvent reqEvent + putWord32be $ fromMaybe 0 reqIP + putWord32be $ 0 -- TODO what the fuck is "key"? + putWord32be $ fromIntegral $ fromMaybe (-1) reqNumWant + + put reqPort + + get = do + ih <- get + pid <- get + + progress <- get + + ev <- getEvent + ip <- getWord32be +-- key <- getWord32be -- TODO + want <- getWord32be + + port <- get + + return $ AnnounceQuery { + reqInfoHash = ih + , reqPeerId = pid + , reqPort = port + , reqProgress = progress + , reqIP = if ip == 0 then Nothing else Just ip + , reqNumWant = if want == -1 then Nothing else Just (fromIntegral want) + , reqEvent = ev + } + +-- | UDP tracker protocol compatible encoding. +instance Serialize AnnounceInfo where + put (Failure msg) = put $ encodeUtf8 msg + put AnnounceInfo {..} = do + putWord32be $ fromIntegral respInterval + putWord32be $ fromIntegral $ fromMaybe 0 respIncomplete + putWord32be $ fromIntegral $ fromMaybe 0 respComplete + forM_ (getPeerList respPeers) put + + get = do + interval <- getWord32be + leechers <- getWord32be + seeders <- getWord32be + peers <- many get + + return $ AnnounceInfo { + respWarning = Nothing + , respInterval = fromIntegral interval + , respMinInterval = Nothing + , respIncomplete = Just $ fromIntegral leechers + , respComplete = Just $ fromIntegral seeders + , respPeers = PeerList peers + } + +{----------------------------------------------------------------------- + Scrape messages +-----------------------------------------------------------------------} + +type ScrapeQuery = [InfoHash] + +-- | Overall information about particular torrent. +data ScrapeInfo = ScrapeInfo { + -- | Number of seeders - peers with the entire file. + siComplete :: {-# UNPACK #-} !Int + + -- | Total number of times the tracker has registered a completion. + , siDownloaded :: {-# UNPACK #-} !Int + + -- | Number of leechers. + , siIncomplete :: {-# UNPACK #-} !Int + + -- | Name of the torrent file, as specified by the "name" + -- file in the info section of the .torrent file. + , siName :: !(Maybe Text) + } deriving (Show, Eq, Typeable) + +$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) + +-- TODO hash map +-- | Scrape info about a set of torrents. +type Scrape = Map InfoHash ScrapeInfo + +-- | HTTP tracker protocol compatible encoding. +instance BEncode ScrapeInfo where + toBEncode ScrapeInfo {..} = toDict $ + "complete" .=! siComplete + .: "downloaded" .=! siDownloaded + .: "incomplete" .=! siIncomplete + .: "name" .=? siName + .: endDict + + fromBEncode = fromDict $ do + ScrapeInfo <$>! "complete" + <*>! "downloaded" + <*>! "incomplete" + <*>? "name" + +-- | UDP tracker protocol complatble encoding. +instance Serialize ScrapeInfo where + put ScrapeInfo {..} = do + putWord32be $ fromIntegral siComplete + putWord32be $ fromIntegral siDownloaded + putWord32be $ fromIntegral siIncomplete + + get = do + seeders <- getWord32be + downTimes <- getWord32be + leechers <- getWord32be + + return $ ScrapeInfo { + siComplete = fromIntegral seeders + , siDownloaded = fromIntegral downTimes + , siIncomplete = fromIntegral leechers + , siName = Nothing + } + +-- | Set of tracker RPCs. +class Tracker s where + connect :: URI -> IO s + announce :: s -> AnnounceQuery -> IO AnnounceInfo + scrape :: s -> ScrapeQuery -> IO Scrape + +-- | More particular version of 'scrape', just for one torrent. +-- +scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo +scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih + where + err = throwIO $ userError "unable to find info hash in response dict" diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs deleted file mode 100644 index 8f4c9228..00000000 --- a/src/Network/BitTorrent/Tracker/Protocol.hs +++ /dev/null @@ -1,406 +0,0 @@ --- | --- Copyright : (c) Sam Truzjan 2013 --- License : BSD3 --- Maintainer : pxqr.sta@gmail.com --- Stability : experimental --- Portability : portable --- --- Every tracker should support announce query. This query is used --- to discover peers within swarm and have two-fold effect: --- --- * peer doing announce discover other peers using peer list from --- the response to the announce query. --- --- * tracker store peer information and use it in the succeeding --- requests made by other peers, until the peer info expires. --- --- By convention most trackers support another form of request -- --- scrape query -- which queries the state of a given torrent (or --- a list of torrents) that the tracker is managing. --- -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# OPTIONS -fno-warn-orphans #-} -module Network.BitTorrent.Tracker.Protocol - ( -- * Announce - Event(..) - , AnnounceQuery(..) - , AnnounceInfo(..) - - -- ** Defaults - , defaultNumWant - , defaultPorts - - -- * Scrape - , ScrapeQuery - , ScrapeInfo(..) - , Scrape - - -- * TODO - , Tracker(..) - , scrapeOne - ) - where - -import Control.Applicative -import Control.Exception -import Control.Monad -import Data.Aeson (ToJSON, FromJSON) -import Data.Aeson.TH -import Data.BEncode as BE -import Data.BEncode.BDict as BE -import Data.Char as Char -import Data.List as L -import Data.Map as M -import Data.Maybe -import Data.Monoid -import Data.Serialize as S hiding (Result) -import Data.Text (Text) -import Data.Text.Encoding -import Data.Typeable -import Data.URLEncoded as URL -import Data.Word -import Network -import Network.URI -import Network.Socket - -import Data.Torrent.InfoHash -import Data.Torrent.Progress -import Network.BitTorrent.Core.PeerId -import Network.BitTorrent.Core.PeerAddr - -{----------------------------------------------------------------------- - Announce messages ------------------------------------------------------------------------} - --- | Events used to specify which kind of tracker request is performed. -data Event = Started - -- ^ For the first request: when a peer join the swarm. - | Stopped - -- ^ Sent when the peer is shutting down. - | Completed - -- ^ To be sent when the peer completes a download. - deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) - -$(deriveJSON (L.map toLower . L.dropWhile isLower) ''Event) - --- | A tracker request is HTTP GET request; used to include metrics --- from clients that help the tracker keep overall statistics about --- the torrent. The most important, requests are used by the tracker --- to keep track lists of active peer for a particular torrent. --- -data AnnounceQuery = AnnounceQuery { - reqInfoHash :: !InfoHash - -- ^ Hash of info part of the torrent usually obtained from - -- 'Torrent'. - - , reqPeerId :: !PeerId - -- ^ ID of the peer doing request. - - , reqPort :: !PortNumber - -- ^ Port to listen to for connections from other - -- peers. Normally, tracker should respond with this port when - -- some peer request the tracker with the same info hash. - - , reqProgress :: !Progress - -- ^ Current progress of peer doing request. - - , reqIP :: Maybe HostAddress - -- ^ The peer IP. Needed only when client communicated with - -- tracker throught a proxy. - - , reqNumWant :: Maybe Int - -- ^ Number of peers that the peers wants to receive from. See - -- note for 'defaultNumWant'. - - , reqEvent :: Maybe Event - -- ^ If not specified, the request is regular periodic request. - } deriving (Show, Typeable) - -$(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceQuery) - -newtype PeerList = PeerList { getPeerList :: [PeerAddr] } - deriving (Show, Eq, ToJSON, FromJSON, Typeable) - --- | The tracker response includes a peer list that helps the client --- participate in the torrent. The most important is 'respPeer' list --- used to join the swarm. --- -data AnnounceInfo = - Failure !Text -- ^ Failure reason in human readable form. - | AnnounceInfo { - -- | Number of peers completed the torrent. (seeders) - respComplete :: !(Maybe Int) - - -- | Number of peers downloading the torrent. (leechers) - , respIncomplete :: !(Maybe Int) - - -- | Recommended interval to wait between requests. - , respInterval :: !Int - - -- | Minimal amount of time between requests. A peer /should/ - -- make timeout with at least 'respMinInterval' value, - -- otherwise tracker might not respond. If not specified the - -- same applies to 'respInterval'. - , respMinInterval :: !(Maybe Int) - - -- | Peers that must be contacted. - , respPeers :: !PeerList - - -- | Human readable warning. - , respWarning :: !(Maybe Text) - } deriving (Show, Typeable) - -$(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceInfo) - --- | Ports typically reserved for bittorrent P2P listener. -defaultPorts :: [PortNumber] -defaultPorts = [6881..6889] - --- | Above 25, new peers are highly unlikely to increase download --- speed. Even 30 peers is /plenty/, the official client version 3 --- in fact only actively forms new connections if it has less than --- 30 peers and will refuse connections if it has 55. --- --- So the default value is set to 50 because usually 30-50% of peers --- are not responding. --- -defaultNumWant :: Int -defaultNumWant = 50 - -{----------------------------------------------------------------------- - Bencode announce encoding ------------------------------------------------------------------------} - -instance BEncode PeerList where - toBEncode (PeerList xs) = toBEncode xs - fromBEncode (BList l ) = PeerList <$> fromBEncode (BList l) - fromBEncode (BString s ) = PeerList <$> runGet getCompactPeerList s - fromBEncode _ = decodingError "Peer list" - --- | HTTP tracker protocol compatible encoding. -instance BEncode AnnounceInfo where - toBEncode (Failure t) = toDict $ - "failure reason" .=! t - .: endDict - - toBEncode AnnounceInfo {..} = toDict $ - "complete" .=? respComplete - .: "incomplete" .=? respIncomplete - .: "interval" .=! respInterval - .: "min interval" .=? respMinInterval - .: "peers" .=! respPeers - .: "warning message" .=? respWarning - .: endDict - - fromBEncode (BDict d) - | Just t <- BE.lookup "failure reason" d = Failure <$> fromBEncode t - | otherwise = (`fromDict` (BDict d)) $ do - AnnounceInfo - <$>? "complete" - <*>? "incomplete" - <*>! "interval" - <*>? "min interval" - <*>! "peers" - <*>? "warning message" - fromBEncode _ = decodingError "Announce info" - -instance URLShow PortNumber where - urlShow = urlShow . fromEnum - -instance URLShow Word32 where - urlShow = show - -instance URLShow Event where - urlShow e = urlShow (Char.toLower x : xs) - where - -- INVARIANT: this is always nonempty list - (x : xs) = show e - -instance URLShow Word64 where - urlShow = show - -instance URLEncode Progress where - urlEncode Progress {..} = mconcat - [ s "uploaded" %= _uploaded - , s "left" %= _left - , s "downloaded" %= _downloaded - ] - where s :: String -> String; s = id; {-# INLINE s #-} - --- | HTTP tracker protocol compatible encoding. -instance URLEncode AnnounceQuery where - urlEncode AnnounceQuery {..} = mconcat - [ s "peer_id" %= reqPeerId - , s "port" %= reqPort - , urlEncode reqProgress - - - , s "ip" %=? reqIP - , s "numwant" %=? reqNumWant - , s "event" %=? reqEvent - ] - where s :: String -> String; s = id; {-# INLINE s #-} - -{----------------------------------------------------------------------- - Binary announce encoding ------------------------------------------------------------------------} - -type EventId = Word32 - -eventId :: Event -> EventId -eventId Completed = 1 -eventId Started = 2 -eventId Stopped = 3 - --- TODO add Regular event -putEvent :: Putter (Maybe Event) -putEvent Nothing = putWord32be 0 -putEvent (Just e) = putWord32be (eventId e) - -getEvent :: S.Get (Maybe Event) -getEvent = do - eid <- getWord32be - case eid of - 0 -> return Nothing - 1 -> return $ Just Completed - 2 -> return $ Just Started - 3 -> return $ Just Stopped - _ -> fail "unknown event id" - --- | UDP tracker protocol compatible encoding. -instance Serialize AnnounceQuery where - put AnnounceQuery {..} = do - put reqInfoHash - put reqPeerId - put reqProgress - putEvent reqEvent - putWord32be $ fromMaybe 0 reqIP - putWord32be $ 0 -- TODO what the fuck is "key"? - putWord32be $ fromIntegral $ fromMaybe (-1) reqNumWant - - put reqPort - - get = do - ih <- get - pid <- get - - progress <- get - - ev <- getEvent - ip <- getWord32be --- key <- getWord32be -- TODO - want <- getWord32be - - port <- get - - return $ AnnounceQuery { - reqInfoHash = ih - , reqPeerId = pid - , reqPort = port - , reqProgress = progress - , reqIP = if ip == 0 then Nothing else Just ip - , reqNumWant = if want == -1 then Nothing else Just (fromIntegral want) - , reqEvent = ev - } - --- | UDP tracker protocol compatible encoding. -instance Serialize AnnounceInfo where - put (Failure msg) = put $ encodeUtf8 msg - put AnnounceInfo {..} = do - putWord32be $ fromIntegral respInterval - putWord32be $ fromIntegral $ fromMaybe 0 respIncomplete - putWord32be $ fromIntegral $ fromMaybe 0 respComplete - forM_ (getPeerList respPeers) put - - get = do - interval <- getWord32be - leechers <- getWord32be - seeders <- getWord32be - peers <- many get - - return $ AnnounceInfo { - respWarning = Nothing - , respInterval = fromIntegral interval - , respMinInterval = Nothing - , respIncomplete = Just $ fromIntegral leechers - , respComplete = Just $ fromIntegral seeders - , respPeers = PeerList peers - } - -{----------------------------------------------------------------------- - Scrape messages ------------------------------------------------------------------------} - -type ScrapeQuery = [InfoHash] - --- | Overall information about particular torrent. -data ScrapeInfo = ScrapeInfo { - -- | Number of seeders - peers with the entire file. - siComplete :: {-# UNPACK #-} !Int - - -- | Total number of times the tracker has registered a completion. - , siDownloaded :: {-# UNPACK #-} !Int - - -- | Number of leechers. - , siIncomplete :: {-# UNPACK #-} !Int - - -- | Name of the torrent file, as specified by the "name" - -- file in the info section of the .torrent file. - , siName :: !(Maybe Text) - } deriving (Show, Eq, Typeable) - -$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) - --- TODO hash map --- | Scrape info about a set of torrents. -type Scrape = Map InfoHash ScrapeInfo - --- | HTTP tracker protocol compatible encoding. -instance BEncode ScrapeInfo where - toBEncode ScrapeInfo {..} = toDict $ - "complete" .=! siComplete - .: "downloaded" .=! siDownloaded - .: "incomplete" .=! siIncomplete - .: "name" .=? siName - .: endDict - - fromBEncode = fromDict $ do - ScrapeInfo <$>! "complete" - <*>! "downloaded" - <*>! "incomplete" - <*>? "name" - --- | UDP tracker protocol complatble encoding. -instance Serialize ScrapeInfo where - put ScrapeInfo {..} = do - putWord32be $ fromIntegral siComplete - putWord32be $ fromIntegral siDownloaded - putWord32be $ fromIntegral siIncomplete - - get = do - seeders <- getWord32be - downTimes <- getWord32be - leechers <- getWord32be - - return $ ScrapeInfo { - siComplete = fromIntegral seeders - , siDownloaded = fromIntegral downTimes - , siIncomplete = fromIntegral leechers - , siName = Nothing - } - --- | Set of tracker RPCs. -class Tracker s where - connect :: URI -> IO s - announce :: s -> AnnounceQuery -> IO AnnounceInfo - scrape :: s -> ScrapeQuery -> IO Scrape - --- | More particular version of 'scrape', just for one torrent. --- -scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo -scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih - where - err = throwIO $ userError "unable to find info hash in response dict" -- cgit v1.2.3