5 files changed, 109 insertions, 71 deletions

diff --git a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
index 3e24c0f4..f9eb62d9 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs
@@ -1,24 +1,18 @@
 {-# LANGUAGE RecordWildCards #-}
-module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where
+module Network.BitTorrent.Tracker.RPC.HTTPSpec (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 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 = fmap (fromJust . parseURI)
-  [ "http://tracker.openbittorrent.com:80/announce"
-  , "http://tracker.publicbt.com:80/announce"
-  ]
+import Network.BitTorrent.Tracker.TestData
+
 
 validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
 validateInfo _ Message.Failure {..} = error "validateInfo: failure"
@@ -28,20 +22,31 @@ validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
     Just n  -> n  `shouldBe` L.length (getPeerList respPeers)
 
 spec :: Spec
-spec = do
-  forM_ trackerURIs $ \ uri ->
-    context (show uri) $ do
+spec = parallel $ do
+  forM_ (L.filter isHttpTracker trackers) $ \ TrackerEntry {..} ->
+    context trackerName $ do
+
       describe "announce" $ do
-        it "have valid response" $ do
-          withManager def $ \ mgr -> do
---            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
+        if tryAnnounce
+          then do
+            it "have valid response" $ do
+              withManager def $ \ mgr -> do
+--                q    <- arbitrarySample
+                let q = AnnounceQuery def "-HS0003-203534.37420" 6000
+                        (Progress 0 0 0) Nothing Nothing (Just Started)
+                info <- announce mgr trackerURI q
+                validateInfo q info
+          else do
+            it "should fail with RequestFailed" $ do
+               pending
 
       describe "scrape" $ do
-        it "have valid response" $ do
-          withManager def $ \ mgr -> do
-            xs <- scrape mgr uri [def]
-            L.length xs `shouldSatisfy` (>= 1)
+        if tryScraping
+          then do
+            it "have valid response" $ do
+              withManager def $ \ mgr -> do
+                xs <- scrape mgr trackerURI [def]
+                L.length xs `shouldSatisfy` (>= 1)
+          else do
+            it "should fail with ScrapelessTracker" $ do
+              pending
diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
index d0f0f26c..57680a5b 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -1,25 +1,19 @@
 {-# LANGUAGE RecordWildCards #-}
-module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, trackerURIs) where
+module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, rpcOpts) where
 import Control.Concurrent.Async
 import Control.Monad
 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 Network.BitTorrent.Tracker.RPC.UDP
-
 import Network.BitTorrent.Core
 import Network.BitTorrent.Tracker.Message as Message
 
+import Network.BitTorrent.Tracker.TestData
+import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+import Network.BitTorrent.Tracker.RPC.UDP
 
-trackerURIs :: [URI]
-trackerURIs =
-  [ fromJust $ parseURI "udp://tracker.openbittorrent.com:80/announce"
-  , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce"
-  ]
 
 validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
 validateInfo _ Message.Failure {..} = error "validateInfo: failure"
@@ -32,27 +26,45 @@ validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
   where
     peerList = getPeerList respPeers
 
+-- | Number of concurrent calls.
+rpcCount :: Int
+rpcCount = 100
+
+rpcOpts :: Options
+rpcOpts = def
+  { optMinTimeout = 1
+  , optMaxTimeout = 10
+  }
+
 spec :: Spec
-spec = do
---  describe "RpcException" $
+spec = parallel $ do
+  forM_ (L.filter isUdpTracker trackers) $ \ TrackerEntry {..} ->
+    context trackerName $ do
 
-  parallel $ do
-   forM_ trackerURIs $ \ uri ->
-    context (show uri) $ do
       describe "announce" $ do
-        it "have valid response" $ do
-          withManager def $ \ mgr -> do
-            q <- arbitrarySample
-            announce mgr uri q >>= validateInfo q
+        if tryAnnounce then do
+          it "have valid response" $ do
+            withManager rpcOpts $ \ mgr -> do
+              q <- arbitrarySample
+              announce mgr trackerURI q >>= validateInfo q
+        else do
+          it "should throw TrackerNotResponding" $ do
+            pending
 
       describe "scrape" $ do
-        it "have valid response" $ do
-          withManager def $ \ mgr -> do
-            xs <- scrape mgr uri [def]
-            L.length xs `shouldSatisfy` (>= 1)
+        if tryScraping then do
+          it "have valid response" $ do
+            withManager rpcOpts $ \ mgr -> do
+              xs <- scrape mgr trackerURI [def]
+              L.length xs `shouldSatisfy` (>= 1)
+        else do
+          it "should throw TrackerNotResponding" $ do
+            pending
+
 
       describe "Manager" $ do
-        it "should handle arbitrary intermixed concurrent queries" $ do
-          withManager def $ \ mgr -> do
-            _ <- mapConcurrently (\ _ -> scrape mgr uri [def]) [1..100 :: Int]
-            return ()
\ No newline at end of file
+        when tryScraping $ do
+          it "should handle arbitrary intermixed concurrent queries" $ do
+            withManager rpcOpts $ \ mgr -> do
+              _ <- mapConcurrently (\ _ -> scrape mgr trackerURI [def]) [1..rpcCount]
+              return ()
\ No newline at end of file
diff --git a/tests/Network/BitTorrent/Tracker/RPCSpec.hs b/tests/Network/BitTorrent/Tracker/RPCSpec.hs
index c3c7f9e2..3b89714c 100644
--- a/tests/Network/BitTorrent/Tracker/RPCSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPCSpec.hs
@@ -1,37 +1,50 @@
+{-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.Tracker.RPCSpec (spec) where
 import Control.Applicative
 import Control.Monad
 import Data.Default
 import Data.List as L
-import Network.URI
 import Test.Hspec
 import Test.QuickCheck
 
-import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
-import Network.BitTorrent.Tracker.RPC.HTTPSpec as HTTP hiding (spec)
-import Network.BitTorrent.Tracker.RPC.UDPSpec as UDP hiding (spec)
 import Network.BitTorrent.Tracker.RPC as RPC
 
-uris :: [URI]
-uris = UDP.trackerURIs ++ HTTP.trackerURIs
+import           Network.BitTorrent.Tracker.TestData
+import           Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+import qualified Network.BitTorrent.Tracker.RPC.UDPSpec as UDP (rpcOpts)
+
 
 instance Arbitrary SAnnounceQuery where
   arbitrary = SAnnounceQuery <$> arbitrary <*> arbitrary
                              <*> arbitrary <*> arbitrary
 
+rpcOpts :: Options
+rpcOpts = def
+  { optUdpRPC = UDP.rpcOpts
+  }
+
 spec :: Spec
 spec = do
-  forM_ uris $ \ uri ->
-    context (show uri) $ do
+  forM_ trackers $ \ TrackerEntry {..} ->
+    context trackerName $ do
+
       describe "announce" $ do
-        it "have valid response" $ do
-          withManager def def $ \ mgr -> do
-            q    <- arbitrarySample
-            _    <- announce mgr uri q
-            return ()
+        if tryAnnounce then do
+          it "have valid response" $ do
+            withManager rpcOpts def $ \ mgr -> do
+              q    <- arbitrarySample
+              _    <- announce mgr trackerURI q
+              return ()
+        else do
+          it "should throw exception" $ do
+            pending
 
       describe "scrape" $ do
-        it "have valid response" $ do
-          withManager def def $ \ mgr -> do
-            xs <- scrape mgr uri [def]
-            L.length xs `shouldSatisfy` (>= 1)
+        if tryScraping then do
+          it "have valid response" $ do
+            withManager rpcOpts def $ \ mgr -> do
+              xs <- scrape mgr trackerURI [def]
+              L.length xs `shouldSatisfy` (>= 1)
+        else do
+          it "should throw exception" $ do
+            pending
diff --git a/tests/Network/BitTorrent/Tracker/SessionSpec.hs b/tests/Network/BitTorrent/Tracker/SessionSpec.hs
index 0c75fcaa..db86b60e 100644
--- a/tests/Network/BitTorrent/Tracker/SessionSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/SessionSpec.hs
@@ -6,20 +6,18 @@ import Test.Hspec
 
 import Data.Torrent
 import Network.BitTorrent.Tracker.List
-import Network.BitTorrent.Tracker.RPC.UDPSpec (trackerURIs)
 import Network.BitTorrent.Tracker.RPC
 import Network.BitTorrent.Tracker.Session
 
+import Network.BitTorrent.Tracker.TestData
 
-trackers :: TrackerList URI
-trackers = trackerList def { tAnnounceList = Just [trackerURIs] }
 
 spec :: Spec
 spec = do
   describe "Session" $ do
     it "" $ do
       withManager def def $ \ m -> do
-        s <- newSession def trackers
+        s <- newSession def undefined
         notify m s Started
         peers <- askPeers m s
         peers `shouldSatisfy` (not . L.null)
\ No newline at end of file
diff --git a/tests/Network/BitTorrent/Tracker/TestData.hs b/tests/Network/BitTorrent/Tracker/TestData.hs
index 5d9718e5..85544b91 100644
--- a/tests/Network/BitTorrent/Tracker/TestData.hs
+++ b/tests/Network/BitTorrent/Tracker/TestData.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Network.BitTorrent.Tracker.TestData
        ( TrackerEntry (..)
+       , isUdpTracker
+       , isHttpTracker
        , trackers
        ) where
 
@@ -29,6 +32,13 @@ data TrackerEntry = TrackerEntry
   , hashList    :: Maybe [InfoHash]
   }
 
+isUdpTracker :: TrackerEntry -> Bool
+isUdpTracker TrackerEntry {..} = uriScheme trackerURI == "udp:"
+
+isHttpTracker :: TrackerEntry -> Bool
+isHttpTracker TrackerEntry {..} = uriScheme trackerURI == "http:"
+                               || uriScheme trackerURI == "https:"
+
 instance IsString URI where
   fromString str = fromMaybe err $ parseURI str
     where