summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
blob: 1ec3bdb765ce21d1f13b64778a85e3c616fea24e (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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent.Tracker.RPC.UDPSpec (spec, rpcOpts) where
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception
import Control.Monad
import Data.Default
import Data.List as L
import Data.Maybe
import Test.Hspec

import Network.BitTorrent.Address
import Network.BitTorrent.Tracker.Message as Message

import Network.BitTorrent.Tracker.TestData
import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
import Network.BitTorrent.Tracker.RPC.UDP


validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
validateInfo _ Message.Failure {..} = error "validateInfo: failure"
validateInfo AnnounceQuery {..}  AnnounceInfo {..} = do
    respComplete    `shouldSatisfy` isJust
    respIncomplete  `shouldSatisfy` isJust
    respMinInterval `shouldSatisfy` isNothing
    respWarning     `shouldSatisfy` isNothing
    peerList `shouldSatisfy` L.all (isNothing . peerId)
  where
    peerList = getPeerList respPeers

-- | Number of concurrent calls.
rpcCount :: Int
rpcCount = 100

rpcOpts :: Options
rpcOpts = def
  { optMinTimeout = 1
  , optMaxTimeout = 10
  }

isTimeoutExpired :: RpcException -> Bool
isTimeoutExpired (TimeoutExpired _) = True
isTimeoutExpired  _                 = False

isSomeException :: SomeException -> Bool
isSomeException _ = True

isIOException :: IOException -> Bool
isIOException _ = True

spec :: Spec
spec = parallel $ do
  describe "newManager" $ do
    it "should throw exception on zero optMaxPacketSize" $ do
      let opts = def { optMaxPacketSize = 0 }
      newManager opts `shouldThrow` isSomeException

    it "should throw exception on zero optMinTimout" $ do
      let opts = def { optMinTimeout = 0 }
      newManager opts `shouldThrow` isSomeException

    it "should throw exception on zero optMaxTimeout" $ do
      let opts = def { optMaxTimeout = 0 }
      newManager opts `shouldThrow` isSomeException

    it "should throw exception on maxTimeout < minTimeout" $ do
      let opts = def { optMinTimeout = 2, optMaxTimeout = 1 }
      newManager opts `shouldThrow` isSomeException

    it "should throw exception on  optMultiplier" $ do
      let opts = def { optMultiplier = 0 }
      newManager opts `shouldThrow` isSomeException

  describe "closeManager" $ do
    it "unblock rpc calls" $ do
      mgr <- newManager rpcOpts
      _   <- forkIO $ do
        threadDelay 10000000
        closeManager mgr
      q <- arbitrarySample
      announce mgr (trackerURI badTracker) q `shouldThrow` (== ManagerClosed)

    it "announce throw exception after manager closed" $ do
      mgr <- newManager rpcOpts
      closeManager mgr
      q <- arbitrarySample
      announce mgr (trackerURI badTracker) q `shouldThrow` isIOException

    it "scrape throw exception after manager closed" $ do
      mgr <- newManager rpcOpts
      closeManager mgr
      scrape mgr (trackerURI badTracker) [def] `shouldThrow` isIOException

  describe "withManager" $ do
    it "closesManager at exit" $ do
      mgr <- withManager rpcOpts return
      scrape mgr (trackerURI badTracker) [def] `shouldThrow` isSomeException

  describe "RPC" $ do
    describe "announce" $ do
      it "must fail on bad scheme" $ do
        withManager rpcOpts $ \ mgr -> do
          q <- arbitrarySample
          announce mgr "magnet://a.com" q
            `shouldThrow` (== UnrecognizedScheme "magnet:")

    describe "scrape" $ do
      it "must fail on bad scheme" $ do
        withManager rpcOpts $ \ mgr -> do
          scrape mgr "magnet://a.com" []
            `shouldThrow` (== UnrecognizedScheme "magnet:")

    forM_ (L.filter isUdpTracker trackers) $ \ TrackerEntry {..} ->
      context trackerName $ do

        describe "announce" $ do
          if tryAnnounce then do
            it "have valid response" $ do
              withManager rpcOpts $ \ mgr -> do
                q <- arbitrarySample
                announce mgr trackerURI q >>= validateInfo q
          else do
            it "should throw TimeoutExpired" $ do
              withManager rpcOpts $ \ mgr -> do
                q <- arbitrarySample
                announce mgr trackerURI q `shouldThrow` isTimeoutExpired

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

        describe "Manager" $ do
          when tryScraping $ do
            it "should handle arbitrary intermixed concurrent queries" $ do
              withManager rpcOpts $ \ mgr -> do
                _ <- mapConcurrently (\ _ -> scrape mgr trackerURI [def]) [1..rpcCount]
                return ()