From 541eb8c462cd1f6f3a1aaaaddf15674b2f953795 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Thu, 6 Feb 2014 21:49:19 +0400
Subject: Separate HTTP/UDP tracker response validation

---
 tests/Network/BitTorrent/Tracker/MessageSpec.hs  | 14 ------------
 tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs | 29 ++++++++++++++++--------
 tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs  | 14 ++++++++++++
 3 files changed, 34 insertions(+), 23 deletions(-)

(limited to 'tests/Network')

diff --git a/tests/Network/BitTorrent/Tracker/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/MessageSpec.hs
index 5949de7a..87d9f191 100644
--- a/tests/Network/BitTorrent/Tracker/MessageSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/MessageSpec.hs
@@ -4,7 +4,6 @@
 {-# OPTIONS -fno-warn-orphans  #-}
 module Network.BitTorrent.Tracker.MessageSpec
        ( spec
-       , validateInfo
        , arbitrarySample
        ) where
 
@@ -54,19 +53,6 @@ instance Arbitrary AnnounceInfo where
     <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
     <*> arbitrary <*> arbitrary
 
-validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
-validateInfo _ Message.Failure {..} = error "validateInfo: failure"
-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
-
 arbitrarySample :: Arbitrary a => IO a
 arbitrarySample = L.head <$> sample' arbitrary
 
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)
diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
index f3dcec88..ae53c64b 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -11,6 +11,9 @@ import Test.Hspec
 import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
 import Network.BitTorrent.Tracker.RPC.UDP
 
+import Network.BitTorrent.Core
+import Network.BitTorrent.Tracker.Message as Message
+
 
 trackerURIs :: [URI]
 trackerURIs =
@@ -18,6 +21,17 @@ trackerURIs =
   , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce"
   ]
 
+validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
+validateInfo _ Message.Failure {..} = error "validateInfo: failure"
+validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
+    respComplete    `shouldSatisfy` isJust
+    respIncomplete  `shouldSatisfy` isJust
+    respMinInterval `shouldSatisfy` isNothing
+    respWarning     `shouldSatisfy` isNothing
+    peerList `shouldSatisfy` L.all (isNothing . peerId)
+  where
+    peerList = getPeerList respPeers
+
 spec :: Spec
 spec = do
   forM_ trackerURIs $ \ uri ->
-- 
cgit v1.2.3