From eb54b4d99fa8683084ced2e8b16ae18b819a35df Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Wed, 26 Feb 2014 15:33:05 +0400 Subject: Use TestData in tracker spec --- tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs | 51 +++++++++--------- tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | 66 ++++++++++++++---------- tests/Network/BitTorrent/Tracker/RPCSpec.hs | 47 +++++++++++------ tests/Network/BitTorrent/Tracker/SessionSpec.hs | 6 +-- tests/Network/BitTorrent/Tracker/TestData.hs | 10 ++++ 5 files changed, 109 insertions(+), 71 deletions(-) (limited to 'tests/Network/BitTorrent') 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 -- cgit v1.2.3