diff options
Diffstat (limited to 'tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs')
-rw-r--r-- | tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs | 51 |
1 files changed, 28 insertions, 23 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 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where | 2 | module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec) where |
3 | 3 | ||
4 | import Control.Applicative | 4 | import Control.Applicative |
5 | import Control.Monad | 5 | import Control.Monad |
6 | import Data.Default | 6 | import Data.Default |
7 | import Data.List as L | 7 | import Data.List as L |
8 | import Data.Maybe | ||
9 | import Network.URI | ||
10 | import Test.Hspec | 8 | import Test.Hspec |
11 | 9 | ||
12 | import Data.Torrent.Progress | 10 | import Data.Torrent.Progress |
13 | import Network.BitTorrent.Tracker.Message as Message | 11 | import Network.BitTorrent.Tracker.Message as Message |
14 | import Network.BitTorrent.Tracker.RPC.HTTP | 12 | import Network.BitTorrent.Tracker.RPC.HTTP |
15 | 13 | ||
16 | -- TODO add a good working tracker! | 14 | import Network.BitTorrent.Tracker.TestData |
17 | trackerURIs :: [URI] | 15 | |
18 | trackerURIs = fmap (fromJust . parseURI) | ||
19 | [ "http://tracker.openbittorrent.com:80/announce" | ||
20 | , "http://tracker.publicbt.com:80/announce" | ||
21 | ] | ||
22 | 16 | ||
23 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation | 17 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation |
24 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" | 18 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" |
@@ -28,20 +22,31 @@ validateInfo AnnounceQuery {..} AnnounceInfo {..} = do | |||
28 | Just n -> n `shouldBe` L.length (getPeerList respPeers) | 22 | Just n -> n `shouldBe` L.length (getPeerList respPeers) |
29 | 23 | ||
30 | spec :: Spec | 24 | spec :: Spec |
31 | spec = do | 25 | spec = parallel $ do |
32 | forM_ trackerURIs $ \ uri -> | 26 | forM_ (L.filter isHttpTracker trackers) $ \ TrackerEntry {..} -> |
33 | context (show uri) $ do | 27 | context trackerName $ do |
28 | |||
34 | describe "announce" $ do | 29 | describe "announce" $ do |
35 | it "have valid response" $ do | 30 | if tryAnnounce |
36 | withManager def $ \ mgr -> do | 31 | then do |
37 | -- q <- arbitrarySample | 32 | it "have valid response" $ do |
38 | let q = AnnounceQuery def "-HS0003-203534.37420" 6000 | 33 | withManager def $ \ mgr -> do |
39 | (Progress 0 0 0) Nothing Nothing (Just Started) | 34 | -- q <- arbitrarySample |
40 | info <- announce mgr uri q | 35 | let q = AnnounceQuery def "-HS0003-203534.37420" 6000 |
41 | validateInfo q info | 36 | (Progress 0 0 0) Nothing Nothing (Just Started) |
37 | info <- announce mgr trackerURI q | ||
38 | validateInfo q info | ||
39 | else do | ||
40 | it "should fail with RequestFailed" $ do | ||
41 | pending | ||
42 | 42 | ||
43 | describe "scrape" $ do | 43 | describe "scrape" $ do |
44 | it "have valid response" $ do | 44 | if tryScraping |
45 | withManager def $ \ mgr -> do | 45 | then do |
46 | xs <- scrape mgr uri [def] | 46 | it "have valid response" $ do |
47 | L.length xs `shouldSatisfy` (>= 1) | 47 | withManager def $ \ mgr -> do |
48 | xs <- scrape mgr trackerURI [def] | ||
49 | L.length xs `shouldSatisfy` (>= 1) | ||
50 | else do | ||
51 | it "should fail with ScrapelessTracker" $ do | ||
52 | pending | ||