blob: 6f3c7489e624e76ab96529ae7af3ec03c27e8ea2 (
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent.DHT.MessageSpec (spec) where
import Control.Monad.Reader
import Control.Monad.Logger
import Control.Concurrent
import Data.BEncode as BE
import Data.ByteString.Lazy as BL
import Data.Default
import Data.List as L
import Data.Maybe
import Network.BitTorrent.Address
import Network.BitTorrent.DHT.Message
import qualified Network.KRPC as KRPC (def)
import Network.KRPC hiding (def)
import Network.Socket (PortNumber)
import Test.Hspec
import Test.QuickCheck
import System.Timeout
import Data.TorrentSpec ()
import Network.BitTorrent.CoreSpec ()
import Network.BitTorrent.DHT.TokenSpec ()
-- Arbitrary queries and responses.
instance Arbitrary Ping where arbitrary = pure Ping
instance Arbitrary FindNode where arbitrary = FindNode <$> arbitrary
instance Arbitrary ip => Arbitrary (NodeFound ip) where arbitrary = NodeFound <$> arbitrary
instance Arbitrary GetPeers where arbitrary = GetPeers <$> arbitrary
instance Arbitrary ip => Arbitrary (GotPeers ip) where arbitrary = GotPeers <$> arbitrary <*> arbitrary
instance Arbitrary Announce where arbitrary = Announce <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
instance Arbitrary Announced where arbitrary = pure Announced
instance Arbitrary x => Arbitrary (Query x) where arbitrary = Query <$> arbitrary <*> arbitrary <*> arbitrary
instance Arbitrary x => Arbitrary (Response x) where arbitrary = Response <$> arbitrary <*> arbitrary
instance MonadLogger IO where
monadLoggerLog _ _ _ _ = return ()
remoteAddr :: SockAddr
remoteAddr = SockAddrInet 6881 (256 * 256 * 256 + 127)
thisAddr :: SockAddr
thisAddr = SockAddrInet 60000 (256 * 256 * 256 + 127)
thisPort :: PortNumber
thisPort = 60001
rpc :: ReaderT (Manager IO) IO a -> IO a
rpc action = do
withManager KRPC.def thisAddr [] $ runReaderT $ do
listen
action
isQueryError :: QueryFailure -> Bool
isQueryError _ = True
prop_bencode :: Eq a => Show a => BEncode a => a -> Expectation
prop_bencode x = BE.decode (BL.toStrict (BE.encode x)) `shouldBe` Right x
retry :: Int -> IO (Maybe a) -> IO (Maybe a)
retry 0 _ = return Nothing
retry n a = do
res <- a
case res of
Just _ -> return res
Nothing -> threadDelay (100 * 1000) >> retry (n-1) a
spec :: Spec
spec = do
context ("you need running DHT node at " ++ show remoteAddr) $ do
it "is running" $ do
running <- retry 5 $ timeout (100 * 1000) $ do
nid <- genNodeId
Response _remoteAddr Ping <-
rpc (query remoteAddr (Query nid False Ping))
return ()
running `shouldSatisfy` isJust
describe "ping" $ do
it "properly bencoded" $ do
BE.decode "d2:id20:abcdefghij0123456789e"
`shouldBe` Right (Query "abcdefghij0123456789" False Ping)
BE.encode (Query "abcdefghij0123456789" False Ping)
`shouldBe` "d2:id20:abcdefghij0123456789e"
BE.decode "d2:id20:mnopqrstuvwxyz123456e"
`shouldBe` Right (Response "mnopqrstuvwxyz123456" Ping)
BE.encode (Response "mnopqrstuvwxyz123456" Ping)
`shouldBe` "d2:id20:mnopqrstuvwxyz123456e"
it "properly bencoded (iso)" $ property $ \ nid -> do
prop_bencode (Query nid False Ping)
prop_bencode (Response nid Ping)
it "does compatible with existing DHT" $ do
nid <- genNodeId
Response _remoteAddr Ping <- rpc (query remoteAddr (Query nid False Ping))
return ()
describe "find_node" $ do
it "properly bencoded" $ do
BE.decode "d2:id20:abcdefghij0123456789\
\6:target20:mnopqrstuvwxyz123456e"
`shouldBe` Right (Query "abcdefghij0123456789" False
(FindNode "mnopqrstuvwxyz123456"))
BE.encode (Query "abcdefghij0123456789" False
(FindNode "mnopqrstuvwxyz123456"))
`shouldBe`
"d2:id20:abcdefghij01234567896:target20:mnopqrstuvwxyz123456e"
let naddr = "127.0.0.1:258" :: NodeAddr IPv4
let nid = "0123456789abcdefghij"
let nid' = "mnopqrstuvwxyz123456"
BE.decode "d2:id20:0123456789abcdefghij\
\5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\1\2\
\e"
`shouldBe` Right (Response nid (NodeFound [NodeInfo nid' naddr]))
it "properly bencoded (iso)" $ property $ \ nid x xs -> do
prop_bencode (Query nid False (FindNode x))
prop_bencode (Response nid (NodeFound (xs :: [NodeInfo IPv4] )))
it "does compatible with existing DHT" $ do
nid <- genNodeId
Response _remoteAddr (NodeFound xs) <- rpc $ do
query remoteAddr (Query nid False (FindNode nid))
L.length (xs :: [NodeInfo IPv4]) `shouldSatisfy` (> 0)
describe "get_peers" $ do
it "properly bencoded" $ do
BE.decode "d2:id20:abcdefghij0123456789\
\9:info_hash20:mnopqrstuvwxyz123456\
\e"
`shouldBe` Right (Query "abcdefghij0123456789" False
(GetPeers "mnopqrstuvwxyz123456"))
BE.decode "d2:id20:abcdefghij0123456789\
\5:token8:aoeusnth\
\6:valuesl6:\127\0\0\1\1\2\&6:\192\168\1\100\1\2e\
\e"
`shouldBe` Right (Response "abcdefghij0123456789"
(GotPeers (Right [ "127.0.0.1:258" :: PeerAddr IPv4
, "192.168.1.100:258"
]) "aoeusnth"))
BE.decode "d2:id20:abcdefghij0123456789\
\5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\1\2\
\5:token8:aoeusnth\
\e"
`shouldBe` Right (Response "abcdefghij0123456789"
(GotPeers
{ peers = Left [NodeInfo "mnopqrstuvwxyz123456" "127.0.0.1:258"
:: NodeInfo IPv4]
, grantedToken = "aoeusnth"
}))
it "properly bencoded (iso)" $ property $ \ nid topic exs token -> do
prop_bencode (Query nid False (GetPeers topic))
let _ = exs :: Either [NodeInfo IPv4] [PeerAddr IPv4]
let nullPeerId paddr = paddr {peerId = Nothing}
let nullPeerIds = either Left (Right . L.map nullPeerId)
prop_bencode (Response nid (GotPeers (nullPeerIds exs) token))
it "does compatible with existing DHT" $ do
nid <- genNodeId
Response _remoteId (GotPeers {..})
<- rpc $ query remoteAddr (Query nid False (GetPeers def))
let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
either L.length L.length peers `shouldSatisfy` (> 0)
describe "announce" $ do
it "properly bencoded" $ do
BE.decode "d2:id20:abcdefghij0123456789\
\9:info_hash20:mnopqrstuvwxyz123456\
\4:porti6881e\
\5:token8:aoeusnth\
\e" `shouldBe` Right
(Query "abcdefghij0123456789" False
(Announce False "mnopqrstuvwxyz123456" Nothing 6881 "aoeusnth"))
BE.decode "d2:id20:abcdefghij0123456789\
\12:implied_porti1e\
\9:info_hash20:mnopqrstuvwxyz123456\
\4:porti6881e\
\5:token8:aoeusnth\
\e" `shouldBe` Right
(Query "abcdefghij0123456789" False
(Announce True "mnopqrstuvwxyz123456" Nothing 6881 "aoeusnth"))
BE.decode "d2:id20:mnopqrstuvwxyz123456e"
`shouldBe` Right
(Response "mnopqrstuvwxyz123456" Announced)
it "properly bencoded (iso)" $ property $ \ nid flag topic port token -> do
prop_bencode (Query nid False (Announce flag topic Nothing port token))
prop_bencode (Response nid (Announced))
it "does compatible with existing DHT" $ do
nid <- genNodeId
Response _remoteId Announced <- rpc $ do
Response _ GotPeers {..} <- query remoteAddr (Query nid False (GetPeers def))
let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
query remoteAddr (Query nid False (Announce False def Nothing thisPort grantedToken))
return ()
it "does fail on invalid token" $ do
nid <- genNodeId
(rpc $ do
Response _ GotPeers {..} <- query remoteAddr (Query nid False (GetPeers def))
let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
let invalidToken = ""
let q :: MonadKRPC h m => SockAddr -> Query Announce
-> m (Response Announced)
q = query
q remoteAddr (Query nid False (Announce False def Nothing thisPort invalidToken)))
`shouldThrow` isQueryError
return ()
|
