summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/Tracker/RPC
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Network/BitTorrent/Tracker/RPC')
-rw-r--r--tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs29
-rw-r--r--tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs14
2 files changed, 34 insertions, 9 deletions
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 #-}
1module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where 2module Network.BitTorrent.Tracker.RPC.HTTPSpec (spec, trackerURIs) where
2 3
4import Control.Applicative
3import Control.Monad 5import Control.Monad
4import Control.Monad.Trans.Resource
5import Data.Default 6import Data.Default
6import Data.List as L 7import Data.List as L
7import Data.Maybe 8import Data.Maybe
8import Network.URI 9import Network.URI
9import Test.Hspec 10import Test.Hspec
10 11
11import Network.BitTorrent.Tracker.MessageSpec hiding (spec) 12import Data.Torrent.Progress
13import Network.BitTorrent.Tracker.Message as Message
12import Network.BitTorrent.Tracker.RPC.HTTP 14import Network.BitTorrent.Tracker.RPC.HTTP
13 15
14 16-- TODO add a good working tracker!
15trackerURIs :: [URI] 17trackerURIs :: [URI]
16trackerURIs = 18trackerURIs = 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
23validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
24validateInfo _ Message.Failure {..} = error "validateInfo: failure"
25validateInfo AnnounceQuery {..} AnnounceInfo {..} = do
26 case respComplete <|> respIncomplete of
27 Nothing -> return ()
28 Just n -> n `shouldBe` L.length (getPeerList respPeers)
29
21spec :: Spec 30spec :: Spec
22spec = do 31spec = 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
11import Network.BitTorrent.Tracker.MessageSpec hiding (spec) 11import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
12import Network.BitTorrent.Tracker.RPC.UDP 12import Network.BitTorrent.Tracker.RPC.UDP
13 13
14import Network.BitTorrent.Core
15import Network.BitTorrent.Tracker.Message as Message
16
14 17
15trackerURIs :: [URI] 18trackerURIs :: [URI]
16trackerURIs = 19trackerURIs =
@@ -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
24validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
25validateInfo _ Message.Failure {..} = error "validateInfo: failure"
26validateInfo 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
21spec :: Spec 35spec :: Spec
22spec = do 36spec = do
23 forM_ trackerURIs $ \ uri -> 37 forM_ trackerURIs $ \ uri ->