summaryrefslogtreecommitdiff
path: root/dht/bittorrent/tests/Network/BitTorrent/Tracker/RPCSpec.hs
blob: dfc13a1e55f0eb5af41f922641e358912599c40c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.BitTorrent.Tracker.RPCSpec (spec) where
import Control.Applicative
import Control.Monad
import Data.Default
import Data.List as L
import Test.Hspec
import Test.QuickCheck

import Network.BitTorrent.Tracker.RPC as RPC

import           Network.BitTorrent.Tracker.TestData
import           Network.BitTorrent.Tracker.MessageSpec hiding (spec)
import qualified Network.BitTorrent.Tracker.RPC.UDPSpec as UDP (rpcOpts)


instance Arbitrary SAnnounceQuery where
  arbitrary = SAnnounceQuery <$> arbitrary <*> arbitrary
                             <*> arbitrary <*> arbitrary

rpcOpts :: Options
rpcOpts = def
  { optUdpRPC = UDP.rpcOpts
  }

matchUnrecognizedScheme :: String -> RpcException -> Bool
matchUnrecognizedScheme x (UnrecognizedScheme scheme) = x == scheme
matchUnrecognizedScheme _  _                          = False

spec :: Spec
spec = parallel $ do
  describe "Manager" $ do
    describe "newManager" $ do
      it "" $ pending

    describe "closeManager" $ do
      it "" $ pending

    describe "withManager" $ do
      it "" $ pending

  describe "RPC" $ do
    describe "announce" $ do
      it "must fail on bad uri scheme" $ do
        withManager rpcOpts def $ \ mgr -> do
          q    <- arbitrarySample
          announce mgr "magnet://foo.bar" q
            `shouldThrow` matchUnrecognizedScheme "magnet:"

    describe "scrape" $ do
      it "must fail on bad uri scheme" $ do
        withManager rpcOpts def $ \ mgr -> do
          scrape mgr "magnet://foo.bar" []
            `shouldThrow` matchUnrecognizedScheme "magnet:"

    forM_ trackers $ \ TrackerEntry {..} ->
      context trackerName $ do

        describe "announce" $ do
          if tryAnnounce then do
            it "have valid response" $ do
              withManager rpcOpts def $ \ mgr -> do
                q    <- arbitrarySample
                _    <- announce mgr trackerURI q
                return ()
          else do
            it "should throw exception" $ do
              pending

        describe "scrape" $ do
          if tryScraping then do
            it "have valid response" $ do
              withManager rpcOpts def $ \ mgr -> do
                xs <- scrape mgr trackerURI [def]
                L.length xs `shouldSatisfy` (>= 1)
          else do
            it "should throw exception" $ do
              pending