blob: 8a1ffc01a9703b9fd0bdf3fee8f467d3f572a8ef (
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.Core
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 ()
|
