diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2014-02-26 15:33:05 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2014-02-26 15:33:05 +0400 |
commit | eb54b4d99fa8683084ced2e8b16ae18b819a35df (patch) | |
tree | 750c77d78fdf06320f93e68c506dc4e436daaaf2 /tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | |
parent | a92c7e63331614afba13e0d8e43791e0f440f2fc (diff) |
Use TestData in tracker spec
Diffstat (limited to 'tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs')
-rw-r--r-- | tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | 66 |
1 files changed, 39 insertions, 27 deletions
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 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, trackerURIs) where | 2 | module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, rpcOpts) where |
3 | import Control.Concurrent.Async | 3 | import Control.Concurrent.Async |
4 | import Control.Monad | 4 | import Control.Monad |
5 | import Data.Default | 5 | import Data.Default |
6 | import Data.List as L | 6 | import Data.List as L |
7 | import Data.Maybe | 7 | import Data.Maybe |
8 | import Network.URI | ||
9 | import Test.Hspec | 8 | import Test.Hspec |
10 | 9 | ||
11 | import Network.BitTorrent.Tracker.MessageSpec hiding (spec) | ||
12 | import Network.BitTorrent.Tracker.RPC.UDP | ||
13 | |||
14 | import Network.BitTorrent.Core | 10 | import Network.BitTorrent.Core |
15 | import Network.BitTorrent.Tracker.Message as Message | 11 | import Network.BitTorrent.Tracker.Message as Message |
16 | 12 | ||
13 | import Network.BitTorrent.Tracker.TestData | ||
14 | import Network.BitTorrent.Tracker.MessageSpec hiding (spec) | ||
15 | import Network.BitTorrent.Tracker.RPC.UDP | ||
17 | 16 | ||
18 | trackerURIs :: [URI] | ||
19 | trackerURIs = | ||
20 | [ fromJust $ parseURI "udp://tracker.openbittorrent.com:80/announce" | ||
21 | , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce" | ||
22 | ] | ||
23 | 17 | ||
24 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation | 18 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation |
25 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" | 19 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" |
@@ -32,27 +26,45 @@ validateInfo AnnounceQuery {..} AnnounceInfo {..} = do | |||
32 | where | 26 | where |
33 | peerList = getPeerList respPeers | 27 | peerList = getPeerList respPeers |
34 | 28 | ||
29 | -- | Number of concurrent calls. | ||
30 | rpcCount :: Int | ||
31 | rpcCount = 100 | ||
32 | |||
33 | rpcOpts :: Options | ||
34 | rpcOpts = def | ||
35 | { optMinTimeout = 1 | ||
36 | , optMaxTimeout = 10 | ||
37 | } | ||
38 | |||
35 | spec :: Spec | 39 | spec :: Spec |
36 | spec = do | 40 | spec = parallel $ do |
37 | -- describe "RpcException" $ | 41 | forM_ (L.filter isUdpTracker trackers) $ \ TrackerEntry {..} -> |
42 | context trackerName $ do | ||
38 | 43 | ||
39 | parallel $ do | ||
40 | forM_ trackerURIs $ \ uri -> | ||
41 | context (show uri) $ do | ||
42 | describe "announce" $ do | 44 | describe "announce" $ do |
43 | it "have valid response" $ do | 45 | if tryAnnounce then do |
44 | withManager def $ \ mgr -> do | 46 | it "have valid response" $ do |
45 | q <- arbitrarySample | 47 | withManager rpcOpts $ \ mgr -> do |
46 | announce mgr uri q >>= validateInfo q | 48 | q <- arbitrarySample |
49 | announce mgr trackerURI q >>= validateInfo q | ||
50 | else do | ||
51 | it "should throw TrackerNotResponding" $ do | ||
52 | pending | ||
47 | 53 | ||
48 | describe "scrape" $ do | 54 | describe "scrape" $ do |
49 | it "have valid response" $ do | 55 | if tryScraping then do |
50 | withManager def $ \ mgr -> do | 56 | it "have valid response" $ do |
51 | xs <- scrape mgr uri [def] | 57 | withManager rpcOpts $ \ mgr -> do |
52 | L.length xs `shouldSatisfy` (>= 1) | 58 | xs <- scrape mgr trackerURI [def] |
59 | L.length xs `shouldSatisfy` (>= 1) | ||
60 | else do | ||
61 | it "should throw TrackerNotResponding" $ do | ||
62 | pending | ||
63 | |||
53 | 64 | ||
54 | describe "Manager" $ do | 65 | describe "Manager" $ do |
55 | it "should handle arbitrary intermixed concurrent queries" $ do | 66 | when tryScraping $ do |
56 | withManager def $ \ mgr -> do | 67 | it "should handle arbitrary intermixed concurrent queries" $ do |
57 | _ <- mapConcurrently (\ _ -> scrape mgr uri [def]) [1..100 :: Int] | 68 | withManager rpcOpts $ \ mgr -> do |
58 | return () \ No newline at end of file | 69 | _ <- mapConcurrently (\ _ -> scrape mgr trackerURI [def]) [1..rpcCount] |
70 | return () \ No newline at end of file | ||