From 5573c240b4c2e87cf2deb55939591edd0851f8b8 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Sat, 30 Nov 2013 13:06:09 +0400
Subject: Add basic spec for UDP tracker RPC

---
 bittorrent.cabal                                |  1 +
 src/Network/BitTorrent/Tracker/RPC/Message.hs   |  2 +
 src/Network/BitTorrent/Tracker/RPC/UDP.hs       | 18 ++++-----
 tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | 53 +++++++++++++++++++++++--
 4 files changed, 62 insertions(+), 12 deletions(-)

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 4d11b346..ebecaa26 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -162,6 +162,7 @@ test-suite spec
                      , filepath
                      , time
                      , convertible
+                     , data-default
 
                      , aeson
                      , cereal
diff --git a/src/Network/BitTorrent/Tracker/RPC/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs
index 18c1a4c7..a0691f37 100644
--- a/src/Network/BitTorrent/Tracker/RPC/Message.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs
@@ -482,6 +482,7 @@ parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage
 
 type ScrapeQuery = [InfoHash]
 
+-- TODO rename to ScrapeEntry
 -- | Overall information about particular torrent.
 data ScrapeInfo = ScrapeInfo {
     -- | Number of seeders - peers with the entire file.
@@ -501,6 +502,7 @@ data ScrapeInfo = ScrapeInfo {
 $(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
 
diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
index beff6b4f..0336db8d 100644
--- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
@@ -39,7 +39,7 @@ import Data.Text.Encoding
 import Data.Time
 import Data.Word
 import Text.Read (readMaybe)
-import Network.Socket hiding (Connected)
+import Network.Socket hiding (Connected, connect)
 import Network.Socket.ByteString as BS
 import Network.URI
 import System.Entropy
@@ -290,8 +290,8 @@ connectUDP tracker = do
     Failed    msg -> throwIO $ userError $ T.unpack msg
     _             -> throwIO $ userError "message type mismatch"
 
-initialTracker :: URI -> IO UDPTracker
-initialTracker uri = do
+connect :: URI -> IO UDPTracker
+connect uri = do
   tracker <- UDPTracker uri <$> (newIORef =<< initialConnection)
   connId  <- connectUDP tracker
   updateConnection connId tracker
@@ -305,20 +305,20 @@ freshConnection tracker @ UDPTracker {..} = do
     connId <- connectUDP tracker
     updateConnection connId tracker
 
-announce :: UDPTracker -> AnnounceQuery -> IO AnnounceInfo
-announce tracker ann = do
+announce :: AnnounceQuery -> UDPTracker -> IO AnnounceInfo
+announce ann tracker = do
   freshConnection tracker
   resp <- transaction tracker (Announce ann)
   case resp of
     Announced info -> return info
     _              -> fail "announce: response type mismatch"
 
-scrape :: UDPTracker -> ScrapeQuery -> IO Scrape
-scrape tracker scr = do
+scrape :: ScrapeQuery -> UDPTracker -> IO Scrape
+scrape ihs tracker = do
   freshConnection tracker
-  resp <- transaction tracker (Scrape scr)
+  resp <- transaction tracker (Scrape ihs)
   case resp of
-    Scraped info -> return $ M.fromList $ L.zip scr info
+    Scraped info -> return $ M.fromList $ 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 4cbaa09d..1a893011 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -1,7 +1,54 @@
+{-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Default
+import Data.List as L
+import Data.Maybe
+import Network.URI
 import Test.Hspec
+import Test.QuickCheck
+
+import Network.BitTorrent.Core.PeerAddr
+import Network.BitTorrent.Tracker.RPC.Message
+import Network.BitTorrent.Tracker.RPC.UDP
+import Network.BitTorrent.Tracker.RPC.MessageSpec ()
+
+
+arbitrarySample :: Arbitrary a => IO a
+arbitrarySample = L.head <$> sample' arbitrary
+
+trackerURIs :: [URI]
+trackerURIs =
+  [ fromJust $ parseURI "udp://tracker.openbittorrent.com:80/announce"
+  , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce"
+  ]
+
+-- relation with query: peer id, numwant
+validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
+validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
+    respComplete    `shouldSatisfy` isJust
+    respIncomplete  `shouldSatisfy` isJust
+    respMinInterval `shouldSatisfy` isNothing
+    respWarning     `shouldSatisfy` isNothing
+    peerList `shouldSatisfy` L.all (isNothing . peerID)
+    fromJust respComplete + fromJust respIncomplete `shouldBe` L.length peerList
+  where
+    peerList = getPeerList respPeers
+
 
 spec :: Spec
-spec =
-  describe "UDP tracker client RPC" $ do
-    return ()
\ No newline at end of file
+spec = do
+  forM_ trackerURIs $ \ uri ->
+    context (show uri) $ do
+      describe "announce" $ do
+        it "have valid response" $ do
+          query <- arbitrarySample
+          connect uri >>= announce query >>= validateInfo query
+
+      describe "scrape" $ do
+        it "have valid response" $ do
+          xs <- connect uri >>= scrape [def]
+          return ()
+--          L.length xs `shouldSatisfy` (>= 1)
-- 
cgit v1.2.3