Rename scrape datatypes

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)