Separate HTTP/UDP tracker response validation

1 files changed, 20 insertions, 9 deletions

diff --git a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
index 81c4fae0..3e24c0f4 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
@@ -1,23 +1,32 @@
+{-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where
 
+import Control.Applicative
 import Control.Monad
-import Control.Monad.Trans.Resource
 import Data.Default
 import Data.List as L
 import Data.Maybe
 import Network.URI
 import Test.Hspec
 
-import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+import Data.Torrent.Progress
+import Network.BitTorrent.Tracker.Message as Message
 import Network.BitTorrent.Tracker.RPC.HTTP
 
-
+-- TODO add a good working tracker!
 trackerURIs :: [URI]
-trackerURIs =
-  [ fromJust $ parseURI "http://announce.opensharing.org:2710/announce"
-  , fromJust $ parseURI "http://exodus.desync.com/announce"
+trackerURIs = fmap (fromJust . parseURI)
+  [ "http://tracker.openbittorrent.com:80/announce"
+  , "http://tracker.publicbt.com:80/announce"
   ]
 
+validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
+validateInfo _ Message.Failure {..} = error "validateInfo: failure"
+validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
+  case respComplete <|> respIncomplete of
+    Nothing -> return ()
+    Just n  -> n  `shouldBe` L.length (getPeerList respPeers)
+
 spec :: Spec
 spec = do
   forM_ trackerURIs $ \ uri ->
@@ -25,12 +34,14 @@ spec = do
       describe "announce" $ do
         it "have valid response" $ do
           withManager def $ \ mgr -> do
-            q    <- arbitrarySample
-            info <- runResourceT $ announce mgr uri q
+--            q    <- arbitrarySample
+            let q = AnnounceQuery def "-HS0003-203534.37420" 6000
+                    (Progress 0 0 0) Nothing Nothing (Just Started)
+            info <- announce mgr uri q
             validateInfo q info
 
       describe "scrape" $ do
         it "have valid response" $ do
           withManager def $ \ mgr -> do
-            xs <- runResourceT $ scrape mgr uri [def]
+            xs <- scrape mgr uri [def]
             L.length xs `shouldSatisfy` (>= 1)