diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/Network/BitTorrent/Tracker/MessageSpec.hs | 14 | ||||
-rw-r--r-- | tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs | 29 | ||||
-rw-r--r-- | tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | 14 |
3 files changed, 34 insertions, 23 deletions
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 @@ | |||
4 | {-# OPTIONS -fno-warn-orphans #-} | 4 | {-# OPTIONS -fno-warn-orphans #-} |
5 | module Network.BitTorrent.Tracker.MessageSpec | 5 | module Network.BitTorrent.Tracker.MessageSpec |
6 | ( spec | 6 | ( spec |
7 | , validateInfo | ||
8 | , arbitrarySample | 7 | , arbitrarySample |
9 | ) where | 8 | ) where |
10 | 9 | ||
@@ -54,19 +53,6 @@ instance Arbitrary AnnounceInfo where | |||
54 | <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary | 53 | <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary |
55 | <*> arbitrary <*> arbitrary | 54 | <*> arbitrary <*> arbitrary |
56 | 55 | ||
57 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation | ||
58 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" | ||
59 | validateInfo AnnounceQuery {..} AnnounceInfo {..} = do | ||
60 | respComplete `shouldSatisfy` isJust | ||
61 | respIncomplete `shouldSatisfy` isJust | ||
62 | respMinInterval `shouldSatisfy` isNothing | ||
63 | respWarning `shouldSatisfy` isNothing | ||
64 | peerList `shouldSatisfy` L.all (isNothing . peerId) | ||
65 | fromJust respComplete + fromJust respIncomplete | ||
66 | `shouldBe` L.length peerList | ||
67 | where | ||
68 | peerList = getPeerList respPeers | ||
69 | |||
70 | arbitrarySample :: Arbitrary a => IO a | 56 | arbitrarySample :: Arbitrary a => IO a |
71 | arbitrarySample = L.head <$> sample' arbitrary | 57 | arbitrarySample = L.head <$> sample' arbitrary |
72 | 58 | ||
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 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
1 | module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where | 2 | module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where |
2 | 3 | ||
4 | import Control.Applicative | ||
3 | import Control.Monad | 5 | import Control.Monad |
4 | import Control.Monad.Trans.Resource | ||
5 | import Data.Default | 6 | import Data.Default |
6 | import Data.List as L | 7 | import Data.List as L |
7 | import Data.Maybe | 8 | import Data.Maybe |
8 | import Network.URI | 9 | import Network.URI |
9 | import Test.Hspec | 10 | import Test.Hspec |
10 | 11 | ||
11 | import Network.BitTorrent.Tracker.MessageSpec hiding (spec) | 12 | import Data.Torrent.Progress |
13 | import Network.BitTorrent.Tracker.Message as Message | ||
12 | import Network.BitTorrent.Tracker.RPC.HTTP | 14 | import Network.BitTorrent.Tracker.RPC.HTTP |
13 | 15 | ||
14 | 16 | -- TODO add a good working tracker! | |
15 | trackerURIs :: [URI] | 17 | trackerURIs :: [URI] |
16 | trackerURIs = | 18 | trackerURIs = fmap (fromJust . parseURI) |
17 | [ fromJust $ parseURI "http://announce.opensharing.org:2710/announce" | 19 | [ "http://tracker.openbittorrent.com:80/announce" |
18 | , fromJust $ parseURI "http://exodus.desync.com/announce" | 20 | , "http://tracker.publicbt.com:80/announce" |
19 | ] | 21 | ] |
20 | 22 | ||
23 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation | ||
24 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" | ||
25 | validateInfo AnnounceQuery {..} AnnounceInfo {..} = do | ||
26 | case respComplete <|> respIncomplete of | ||
27 | Nothing -> return () | ||
28 | Just n -> n `shouldBe` L.length (getPeerList respPeers) | ||
29 | |||
21 | spec :: Spec | 30 | spec :: Spec |
22 | spec = do | 31 | spec = do |
23 | forM_ trackerURIs $ \ uri -> | 32 | forM_ trackerURIs $ \ uri -> |
@@ -25,12 +34,14 @@ spec = do | |||
25 | describe "announce" $ do | 34 | describe "announce" $ do |
26 | it "have valid response" $ do | 35 | it "have valid response" $ do |
27 | withManager def $ \ mgr -> do | 36 | withManager def $ \ mgr -> do |
28 | q <- arbitrarySample | 37 | -- q <- arbitrarySample |
29 | info <- runResourceT $ announce mgr uri q | 38 | let q = AnnounceQuery def "-HS0003-203534.37420" 6000 |
39 | (Progress 0 0 0) Nothing Nothing (Just Started) | ||
40 | info <- announce mgr uri q | ||
30 | validateInfo q info | 41 | validateInfo q info |
31 | 42 | ||
32 | describe "scrape" $ do | 43 | describe "scrape" $ do |
33 | it "have valid response" $ do | 44 | it "have valid response" $ do |
34 | withManager def $ \ mgr -> do | 45 | withManager def $ \ mgr -> do |
35 | xs <- runResourceT $ scrape mgr uri [def] | 46 | xs <- scrape mgr uri [def] |
36 | L.length xs `shouldSatisfy` (>= 1) | 47 | 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 | |||
11 | import Network.BitTorrent.Tracker.MessageSpec hiding (spec) | 11 | import Network.BitTorrent.Tracker.MessageSpec hiding (spec) |
12 | import Network.BitTorrent.Tracker.RPC.UDP | 12 | import Network.BitTorrent.Tracker.RPC.UDP |
13 | 13 | ||
14 | import Network.BitTorrent.Core | ||
15 | import Network.BitTorrent.Tracker.Message as Message | ||
16 | |||
14 | 17 | ||
15 | trackerURIs :: [URI] | 18 | trackerURIs :: [URI] |
16 | trackerURIs = | 19 | trackerURIs = |
@@ -18,6 +21,17 @@ trackerURIs = | |||
18 | , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce" | 21 | , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce" |
19 | ] | 22 | ] |
20 | 23 | ||
24 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation | ||
25 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" | ||
26 | validateInfo AnnounceQuery {..} AnnounceInfo {..} = do | ||
27 | respComplete `shouldSatisfy` isJust | ||
28 | respIncomplete `shouldSatisfy` isJust | ||
29 | respMinInterval `shouldSatisfy` isNothing | ||
30 | respWarning `shouldSatisfy` isNothing | ||
31 | peerList `shouldSatisfy` L.all (isNothing . peerId) | ||
32 | where | ||
33 | peerList = getPeerList respPeers | ||
34 | |||
21 | spec :: Spec | 35 | spec :: Spec |
22 | spec = do | 36 | spec = do |
23 | forM_ trackerURIs $ \ uri -> | 37 | forM_ trackerURIs $ \ uri -> |