From 915dab01a9aefd59497ea97e76b45db3a865635f Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Sat, 30 Nov 2013 13:30:19 +0400 Subject: Rename scrape datatypes --- src/Network/BitTorrent/Tracker/RPC/Message.hs | 52 ++++++++++--------------- src/Network/BitTorrent/Tracker/RPC/UDP.hs | 9 ++--- tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | 10 ++--- 3 files changed, 30 insertions(+), 41 deletions(-) diff --git a/src/Network/BitTorrent/Tracker/RPC/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs index a0691f37..74a3842f 100644 --- a/src/Network/BitTorrent/Tracker/RPC/Message.hs +++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs @@ -40,8 +40,8 @@ module Network.BitTorrent.Tracker.RPC.Message -- * Scrape , ScrapeQuery - , ScrapeInfo(..) - , Scrape + , ScrapeEntry (..) + , ScrapeInfo ) where @@ -56,7 +56,6 @@ import Data.ByteString.Char8 as BC import Data.Char as Char import Data.Convertible import Data.List as L -import Data.Map as M import Data.Maybe import Data.Serialize as S hiding (Result) import Data.Text (Text) @@ -482,9 +481,8 @@ parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage type ScrapeQuery = [InfoHash] --- TODO rename to ScrapeEntry -- | Overall information about particular torrent. -data ScrapeInfo = ScrapeInfo { +data ScrapeEntry = ScrapeEntry { -- | Number of seeders - peers with the entire file. siComplete :: {-# UNPACK #-} !Int @@ -499,43 +497,35 @@ data ScrapeInfo = ScrapeInfo { , siName :: !(Maybe Text) } deriving (Show, Eq, Typeable) -$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) - --- TODO hash map --- TODO rename to ScrapeInfo --- | Scrape info about a set of torrents. -type Scrape = Map InfoHash ScrapeInfo +$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeEntry) -- | HTTP tracker protocol compatible encoding. -instance BEncode ScrapeInfo where - toBEncode ScrapeInfo {..} = toDict $ +instance BEncode ScrapeEntry where + toBEncode ScrapeEntry {..} = toDict $ "complete" .=! siComplete .: "downloaded" .=! siDownloaded .: "incomplete" .=! siIncomplete .: "name" .=? siName .: endDict - fromBEncode = fromDict $ do - ScrapeInfo <$>! "complete" - <*>! "downloaded" - <*>! "incomplete" - <*>? "name" + fromBEncode = fromDict $ ScrapeEntry + <$>! "complete" + <*>! "downloaded" + <*>! "incomplete" + <*>? "name" -- | UDP tracker protocol compatible encoding. -instance Serialize ScrapeInfo where - put ScrapeInfo {..} = do +instance Serialize ScrapeEntry where + put ScrapeEntry {..} = 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 - } + get = ScrapeEntry + <$> (fromIntegral <$> getWord32be) + <*> (fromIntegral <$> getWord32be) + <*> (fromIntegral <$> getWord32be) + <*> pure Nothing + +-- | Scrape info about a set of torrents. +type ScrapeInfo = [(InfoHash, ScrapeEntry)] diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs index 0336db8d..bb5fe7e3 100644 --- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs +++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs @@ -30,7 +30,6 @@ import Control.Monad import Data.ByteString (ByteString) import Data.IORef import Data.List as L -import Data.Map as M import Data.Maybe import Data.Monoid import Data.Serialize @@ -94,7 +93,7 @@ data Request = Connect data Response = Connected ConnectionId | Announced AnnounceInfo - | Scraped [ScrapeInfo] + | Scraped [ScrapeEntry] | Failed Text deriving Show @@ -288,7 +287,7 @@ connectUDP tracker = do case resp of Connected cid -> return cid Failed msg -> throwIO $ userError $ T.unpack msg - _ -> throwIO $ userError "message type mismatch" + _ -> throwIO $ userError "connect: response type mismatch" connect :: URI -> IO UDPTracker connect uri = do @@ -313,12 +312,12 @@ announce ann tracker = do Announced info -> return info _ -> fail "announce: response type mismatch" -scrape :: ScrapeQuery -> UDPTracker -> IO Scrape +scrape :: ScrapeQuery -> UDPTracker -> IO ScrapeInfo scrape ihs tracker = do freshConnection tracker resp <- transaction tracker (Scrape ihs) case resp of - Scraped info -> return $ M.fromList $ L.zip ihs info + Scraped info -> return $ L.zip ihs info _ -> fail "scrape: response type mismatch" {----------------------------------------------------------------------- diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs index 1a893011..73cf07f3 100644 --- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs +++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs @@ -11,7 +11,7 @@ import Test.Hspec import Test.QuickCheck import Network.BitTorrent.Core.PeerAddr -import Network.BitTorrent.Tracker.RPC.Message +import Network.BitTorrent.Tracker.RPC.Message as Message import Network.BitTorrent.Tracker.RPC.UDP import Network.BitTorrent.Tracker.RPC.MessageSpec () @@ -27,6 +27,7 @@ trackerURIs = -- relation with query: peer id, numwant validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation +validateInfo _ Message.Failure {..} = error "validateInfo: failure" validateInfo AnnounceQuery {..} AnnounceInfo {..} = do respComplete `shouldSatisfy` isJust respIncomplete `shouldSatisfy` isJust @@ -44,11 +45,10 @@ spec = do context (show uri) $ do describe "announce" $ do it "have valid response" $ do - query <- arbitrarySample - connect uri >>= announce query >>= validateInfo query + q <- arbitrarySample + connect uri >>= announce q >>= validateInfo q describe "scrape" $ do it "have valid response" $ do xs <- connect uri >>= scrape [def] - return () --- L.length xs `shouldSatisfy` (>= 1) + L.length xs `shouldSatisfy` (>= 1) -- cgit v1.2.3