diff options
author | joe <joe@jerkface.net> | 2017-09-15 06:22:10 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-09-15 06:22:10 -0400 |
commit | 12cbb3af2413dc28838ed271351dda16df8f7bdb (patch) | |
tree | 2db77a787e18a81a8369a8d73fee369d8826f064 /bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs | |
parent | 362357c6d08cbd8dffa627a1e80199dcb9ba231f (diff) |
Separating dht-client library from bittorrent package.
Diffstat (limited to 'bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs')
-rw-r--r-- | bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs b/bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs new file mode 100644 index 00000000..dfc13a1e --- /dev/null +++ b/bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs | |||
@@ -0,0 +1,79 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
2 | {-# OPTIONS_GHC -fno-warn-orphans #-} | ||
3 | module Network.BitTorrent.Tracker.RPCSpec (spec) where | ||
4 | import Control.Applicative | ||
5 | import Control.Monad | ||
6 | import Data.Default | ||
7 | import Data.List as L | ||
8 | import Test.Hspec | ||
9 | import Test.QuickCheck | ||
10 | |||
11 | import Network.BitTorrent.Tracker.RPC as RPC | ||
12 | |||
13 | import Network.BitTorrent.Tracker.TestData | ||
14 | import Network.BitTorrent.Tracker.MessageSpec hiding (spec) | ||
15 | import qualified Network.BitTorrent.Tracker.RPC.UDPSpec as UDP (rpcOpts) | ||
16 | |||
17 | |||
18 | instance Arbitrary SAnnounceQuery where | ||
19 | arbitrary = SAnnounceQuery <$> arbitrary <*> arbitrary | ||
20 | <*> arbitrary <*> arbitrary | ||
21 | |||
22 | rpcOpts :: Options | ||
23 | rpcOpts = def | ||
24 | { optUdpRPC = UDP.rpcOpts | ||
25 | } | ||
26 | |||
27 | matchUnrecognizedScheme :: String -> RpcException -> Bool | ||
28 | matchUnrecognizedScheme x (UnrecognizedScheme scheme) = x == scheme | ||
29 | matchUnrecognizedScheme _ _ = False | ||
30 | |||
31 | spec :: Spec | ||
32 | spec = parallel $ do | ||
33 | describe "Manager" $ do | ||
34 | describe "newManager" $ do | ||
35 | it "" $ pending | ||
36 | |||
37 | describe "closeManager" $ do | ||
38 | it "" $ pending | ||
39 | |||
40 | describe "withManager" $ do | ||
41 | it "" $ pending | ||
42 | |||
43 | describe "RPC" $ do | ||
44 | describe "announce" $ do | ||
45 | it "must fail on bad uri scheme" $ do | ||
46 | withManager rpcOpts def $ \ mgr -> do | ||
47 | q <- arbitrarySample | ||
48 | announce mgr "magnet://foo.bar" q | ||
49 | `shouldThrow` matchUnrecognizedScheme "magnet:" | ||
50 | |||
51 | describe "scrape" $ do | ||
52 | it "must fail on bad uri scheme" $ do | ||
53 | withManager rpcOpts def $ \ mgr -> do | ||
54 | scrape mgr "magnet://foo.bar" [] | ||
55 | `shouldThrow` matchUnrecognizedScheme "magnet:" | ||
56 | |||
57 | forM_ trackers $ \ TrackerEntry {..} -> | ||
58 | context trackerName $ do | ||
59 | |||
60 | describe "announce" $ do | ||
61 | if tryAnnounce then do | ||
62 | it "have valid response" $ do | ||
63 | withManager rpcOpts def $ \ mgr -> do | ||
64 | q <- arbitrarySample | ||
65 | _ <- announce mgr trackerURI q | ||
66 | return () | ||
67 | else do | ||
68 | it "should throw exception" $ do | ||
69 | pending | ||
70 | |||
71 | describe "scrape" $ do | ||
72 | if tryScraping then do | ||
73 | it "have valid response" $ do | ||
74 | withManager rpcOpts def $ \ mgr -> do | ||
75 | xs <- scrape mgr trackerURI [def] | ||
76 | L.length xs `shouldSatisfy` (>= 1) | ||
77 | else do | ||
78 | it "should throw exception" $ do | ||
79 | pending | ||