diff options
Diffstat (limited to 'tests/Network')
-rw-r--r-- | tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs | 27 | ||||
-rw-r--r-- | tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | 23 |
2 files changed, 26 insertions, 24 deletions
diff --git a/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs index 8e95286a..f8cf052a 100644 --- a/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs +++ b/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs | |||
@@ -1,7 +1,14 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
1 | {-# OPTIONS -fno-warn-orphans #-} | 2 | {-# OPTIONS -fno-warn-orphans #-} |
2 | module Network.BitTorrent.Tracker.RPC.MessageSpec (spec) where | 3 | module Network.BitTorrent.Tracker.RPC.MessageSpec |
4 | ( spec | ||
5 | , validateInfo | ||
6 | , arbitrarySample | ||
7 | ) where | ||
3 | 8 | ||
4 | import Control.Applicative | 9 | import Control.Applicative |
10 | import Data.List as L | ||
11 | import Data.Maybe | ||
5 | import Data.Word | 12 | import Data.Word |
6 | import Network | 13 | import Network |
7 | import Test.Hspec | 14 | import Test.Hspec |
@@ -11,7 +18,8 @@ import Data.Torrent.InfoHashSpec () | |||
11 | import Data.Torrent.ProgressSpec () | 18 | import Data.Torrent.ProgressSpec () |
12 | import Network.BitTorrent.Core.PeerIdSpec () | 19 | import Network.BitTorrent.Core.PeerIdSpec () |
13 | 20 | ||
14 | import Network.BitTorrent.Tracker.RPC.Message | 21 | import Network.BitTorrent.Tracker.RPC.Message as Message |
22 | import Network.BitTorrent.Core.PeerAddr | ||
15 | 23 | ||
16 | 24 | ||
17 | --prop_bencode :: Eq a => BEncode a => a -> Bool | 25 | --prop_bencode :: Eq a => BEncode a => a -> Bool |
@@ -31,6 +39,21 @@ instance Arbitrary AnnounceQuery where | |||
31 | <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary | 39 | <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary |
32 | <*> arbitrary <*> arbitrary <*> arbitrary | 40 | <*> arbitrary <*> arbitrary <*> arbitrary |
33 | 41 | ||
42 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation | ||
43 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" | ||
44 | validateInfo AnnounceQuery {..} AnnounceInfo {..} = do | ||
45 | respComplete `shouldSatisfy` isJust | ||
46 | respIncomplete `shouldSatisfy` isJust | ||
47 | respMinInterval `shouldSatisfy` isNothing | ||
48 | respWarning `shouldSatisfy` isNothing | ||
49 | peerList `shouldSatisfy` L.all (isNothing . peerID) | ||
50 | fromJust respComplete + fromJust respIncomplete `shouldBe` L.length peerList | ||
51 | where | ||
52 | peerList = getPeerList respPeers | ||
53 | |||
54 | arbitrarySample :: Arbitrary a => IO a | ||
55 | arbitrarySample = L.head <$> sample' arbitrary | ||
56 | |||
34 | spec :: Spec | 57 | spec :: Spec |
35 | spec = do | 58 | spec = do |
36 | describe "Announce" $ do | 59 | describe "Announce" $ do |
diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs index 73cf07f3..4954ee25 100644 --- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs +++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs | |||
@@ -1,44 +1,23 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where | 2 | module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where |
3 | 3 | ||
4 | import Control.Applicative | ||
5 | import Control.Monad | 4 | import Control.Monad |
6 | import Data.Default | 5 | import Data.Default |
7 | import Data.List as L | 6 | import Data.List as L |
8 | import Data.Maybe | 7 | import Data.Maybe |
9 | import Network.URI | 8 | import Network.URI |
10 | import Test.Hspec | 9 | import Test.Hspec |
11 | import Test.QuickCheck | ||
12 | 10 | ||
13 | import Network.BitTorrent.Core.PeerAddr | 11 | import Network.BitTorrent.Tracker.RPC.MessageSpec hiding (spec) |
14 | import Network.BitTorrent.Tracker.RPC.Message as Message | ||
15 | import Network.BitTorrent.Tracker.RPC.UDP | 12 | import Network.BitTorrent.Tracker.RPC.UDP |
16 | import Network.BitTorrent.Tracker.RPC.MessageSpec () | ||
17 | 13 | ||
18 | 14 | ||
19 | arbitrarySample :: Arbitrary a => IO a | ||
20 | arbitrarySample = L.head <$> sample' arbitrary | ||
21 | |||
22 | trackerURIs :: [URI] | 15 | trackerURIs :: [URI] |
23 | trackerURIs = | 16 | trackerURIs = |
24 | [ fromJust $ parseURI "udp://tracker.openbittorrent.com:80/announce" | 17 | [ fromJust $ parseURI "udp://tracker.openbittorrent.com:80/announce" |
25 | , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce" | 18 | , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce" |
26 | ] | 19 | ] |
27 | 20 | ||
28 | -- relation with query: peer id, numwant | ||
29 | validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation | ||
30 | validateInfo _ Message.Failure {..} = error "validateInfo: failure" | ||
31 | validateInfo AnnounceQuery {..} AnnounceInfo {..} = do | ||
32 | respComplete `shouldSatisfy` isJust | ||
33 | respIncomplete `shouldSatisfy` isJust | ||
34 | respMinInterval `shouldSatisfy` isNothing | ||
35 | respWarning `shouldSatisfy` isNothing | ||
36 | peerList `shouldSatisfy` L.all (isNothing . peerID) | ||
37 | fromJust respComplete + fromJust respIncomplete `shouldBe` L.length peerList | ||
38 | where | ||
39 | peerList = getPeerList respPeers | ||
40 | |||
41 | |||
42 | spec :: Spec | 21 | spec :: Spec |
43 | spec = do | 22 | spec = do |
44 | forM_ trackerURIs $ \ uri -> | 23 | forM_ trackerURIs $ \ uri -> |