summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/DHT/MessageSpec.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Network/BitTorrent/DHT/MessageSpec.hs')
-rw-r--r--tests/Network/BitTorrent/DHT/MessageSpec.hs38
1 files changed, 19 insertions, 19 deletions
diff --git a/tests/Network/BitTorrent/DHT/MessageSpec.hs b/tests/Network/BitTorrent/DHT/MessageSpec.hs
index ae9ab487..3b1f5acd 100644
--- a/tests/Network/BitTorrent/DHT/MessageSpec.hs
+++ b/tests/Network/BitTorrent/DHT/MessageSpec.hs
@@ -61,16 +61,16 @@ spec = do
61 running <- retry 5 $ timeout (100 * 1000) $ do 61 running <- retry 5 $ timeout (100 * 1000) $ do
62 nid <- genNodeId 62 nid <- genNodeId
63 Response _remoteAddr Ping <- 63 Response _remoteAddr Ping <-
64 rpc (query remoteAddr (Query nid Ping)) 64 rpc (query remoteAddr (Query nid False Ping))
65 return () 65 return ()
66 running `shouldSatisfy` isJust 66 running `shouldSatisfy` isJust
67 67
68 describe "ping" $ do 68 describe "ping" $ do
69 it "properly bencoded" $ do 69 it "properly bencoded" $ do
70 BE.decode "d2:id20:abcdefghij0123456789e" 70 BE.decode "d2:id20:abcdefghij0123456789e"
71 `shouldBe` Right (Query "abcdefghij0123456789" Ping) 71 `shouldBe` Right (Query "abcdefghij0123456789" False Ping)
72 72
73 BE.encode (Query "abcdefghij0123456789" Ping) 73 BE.encode (Query "abcdefghij0123456789" False Ping)
74 `shouldBe` "d2:id20:abcdefghij0123456789e" 74 `shouldBe` "d2:id20:abcdefghij0123456789e"
75 75
76 BE.decode "d2:id20:mnopqrstuvwxyz123456e" 76 BE.decode "d2:id20:mnopqrstuvwxyz123456e"
@@ -80,22 +80,22 @@ spec = do
80 `shouldBe` "d2:id20:mnopqrstuvwxyz123456e" 80 `shouldBe` "d2:id20:mnopqrstuvwxyz123456e"
81 81
82 it "properly bencoded (iso)" $ property $ \ nid -> do 82 it "properly bencoded (iso)" $ property $ \ nid -> do
83 prop_bencode (Query nid Ping) 83 prop_bencode (Query nid False Ping)
84 prop_bencode (Response nid Ping) 84 prop_bencode (Response nid Ping)
85 85
86 it "does compatible with existing DHT" $ do 86 it "does compatible with existing DHT" $ do
87 nid <- genNodeId 87 nid <- genNodeId
88 Response _remoteAddr Ping <- rpc (query remoteAddr (Query nid Ping)) 88 Response _remoteAddr Ping <- rpc (query remoteAddr (Query nid False Ping))
89 return () 89 return ()
90 90
91 describe "find_node" $ do 91 describe "find_node" $ do
92 it "properly bencoded" $ do 92 it "properly bencoded" $ do
93 BE.decode "d2:id20:abcdefghij0123456789\ 93 BE.decode "d2:id20:abcdefghij0123456789\
94 \6:target20:mnopqrstuvwxyz123456e" 94 \6:target20:mnopqrstuvwxyz123456e"
95 `shouldBe` Right (Query "abcdefghij0123456789" 95 `shouldBe` Right (Query "abcdefghij0123456789" False
96 (FindNode "mnopqrstuvwxyz123456")) 96 (FindNode "mnopqrstuvwxyz123456"))
97 97
98 BE.encode (Query "abcdefghij0123456789" 98 BE.encode (Query "abcdefghij0123456789" False
99 (FindNode "mnopqrstuvwxyz123456")) 99 (FindNode "mnopqrstuvwxyz123456"))
100 `shouldBe` 100 `shouldBe`
101 "d2:id20:abcdefghij01234567896:target20:mnopqrstuvwxyz123456e" 101 "d2:id20:abcdefghij01234567896:target20:mnopqrstuvwxyz123456e"
@@ -109,13 +109,13 @@ spec = do
109 `shouldBe` Right (Response nid (NodeFound [NodeInfo nid' naddr])) 109 `shouldBe` Right (Response nid (NodeFound [NodeInfo nid' naddr]))
110 110
111 it "properly bencoded (iso)" $ property $ \ nid x xs -> do 111 it "properly bencoded (iso)" $ property $ \ nid x xs -> do
112 prop_bencode (Query nid (FindNode x)) 112 prop_bencode (Query nid False (FindNode x))
113 prop_bencode (Response nid (NodeFound (xs :: [NodeInfo IPv4] ))) 113 prop_bencode (Response nid (NodeFound (xs :: [NodeInfo IPv4] )))
114 114
115 it "does compatible with existing DHT" $ do 115 it "does compatible with existing DHT" $ do
116 nid <- genNodeId 116 nid <- genNodeId
117 Response _remoteAddr (NodeFound xs) <- rpc $ do 117 Response _remoteAddr (NodeFound xs) <- rpc $ do
118 query remoteAddr (Query nid (FindNode nid)) 118 query remoteAddr (Query nid False (FindNode nid))
119 L.length (xs :: [NodeInfo IPv4]) `shouldSatisfy` (> 0) 119 L.length (xs :: [NodeInfo IPv4]) `shouldSatisfy` (> 0)
120 120
121 describe "get_peers" $ do 121 describe "get_peers" $ do
@@ -123,7 +123,7 @@ spec = do
123 BE.decode "d2:id20:abcdefghij0123456789\ 123 BE.decode "d2:id20:abcdefghij0123456789\
124 \9:info_hash20:mnopqrstuvwxyz123456\ 124 \9:info_hash20:mnopqrstuvwxyz123456\
125 \e" 125 \e"
126 `shouldBe` Right (Query "abcdefghij0123456789" 126 `shouldBe` Right (Query "abcdefghij0123456789" False
127 (GetPeers "mnopqrstuvwxyz123456")) 127 (GetPeers "mnopqrstuvwxyz123456"))
128 128
129 BE.decode "d2:id20:abcdefghij0123456789\ 129 BE.decode "d2:id20:abcdefghij0123456789\
@@ -147,7 +147,7 @@ spec = do
147 })) 147 }))
148 148
149 it "properly bencoded (iso)" $ property $ \ nid topic exs token -> do 149 it "properly bencoded (iso)" $ property $ \ nid topic exs token -> do
150 prop_bencode (Query nid (GetPeers topic)) 150 prop_bencode (Query nid False (GetPeers topic))
151 let _ = exs :: Either [NodeInfo IPv4] [PeerAddr IPv4] 151 let _ = exs :: Either [NodeInfo IPv4] [PeerAddr IPv4]
152 let nullPeerId paddr = paddr {peerId = Nothing} 152 let nullPeerId paddr = paddr {peerId = Nothing}
153 let nullPeerIds = either Left (Right . L.map nullPeerId) 153 let nullPeerIds = either Left (Right . L.map nullPeerId)
@@ -156,7 +156,7 @@ spec = do
156 it "does compatible with existing DHT" $ do 156 it "does compatible with existing DHT" $ do
157 nid <- genNodeId 157 nid <- genNodeId
158 Response _remoteId (GotPeers {..}) 158 Response _remoteId (GotPeers {..})
159 <- rpc $ query remoteAddr (Query nid (GetPeers def)) 159 <- rpc $ query remoteAddr (Query nid False (GetPeers def))
160 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4] 160 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
161 either L.length L.length peers `shouldSatisfy` (> 0) 161 either L.length L.length peers `shouldSatisfy` (> 0)
162 162
@@ -167,7 +167,7 @@ spec = do
167 \4:porti6881e\ 167 \4:porti6881e\
168 \5:token8:aoeusnth\ 168 \5:token8:aoeusnth\
169 \e" `shouldBe` Right 169 \e" `shouldBe` Right
170 (Query "abcdefghij0123456789" 170 (Query "abcdefghij0123456789" False
171 (Announce False "mnopqrstuvwxyz123456" 6881 "aoeusnth")) 171 (Announce False "mnopqrstuvwxyz123456" 6881 "aoeusnth"))
172 172
173 BE.decode "d2:id20:abcdefghij0123456789\ 173 BE.decode "d2:id20:abcdefghij0123456789\
@@ -176,7 +176,7 @@ spec = do
176 \4:porti6881e\ 176 \4:porti6881e\
177 \5:token8:aoeusnth\ 177 \5:token8:aoeusnth\
178 \e" `shouldBe` Right 178 \e" `shouldBe` Right
179 (Query "abcdefghij0123456789" 179 (Query "abcdefghij0123456789" False
180 (Announce True "mnopqrstuvwxyz123456" 6881 "aoeusnth")) 180 (Announce True "mnopqrstuvwxyz123456" 6881 "aoeusnth"))
181 181
182 182
@@ -185,27 +185,27 @@ spec = do
185 (Response "mnopqrstuvwxyz123456" Announced) 185 (Response "mnopqrstuvwxyz123456" Announced)
186 186
187 it "properly bencoded (iso)" $ property $ \ nid flag topic port token -> do 187 it "properly bencoded (iso)" $ property $ \ nid flag topic port token -> do
188 prop_bencode (Query nid (Announce flag topic port token)) 188 prop_bencode (Query nid False (Announce flag topic port token))
189 prop_bencode (Response nid (Announced)) 189 prop_bencode (Response nid (Announced))
190 190
191 191
192 it "does compatible with existing DHT" $ do 192 it "does compatible with existing DHT" $ do
193 nid <- genNodeId 193 nid <- genNodeId
194 Response _remoteId Announced <- rpc $ do 194 Response _remoteId Announced <- rpc $ do
195 Response _ GotPeers {..} <- query remoteAddr (Query nid (GetPeers def)) 195 Response _ GotPeers {..} <- query remoteAddr (Query nid False (GetPeers def))
196 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4] 196 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
197 query remoteAddr (Query nid (Announce False def thisPort grantedToken)) 197 query remoteAddr (Query nid False (Announce False def thisPort grantedToken))
198 return () 198 return ()
199 199
200 it "does fail on invalid token" $ do 200 it "does fail on invalid token" $ do
201 nid <- genNodeId 201 nid <- genNodeId
202 (rpc $ do 202 (rpc $ do
203 Response _ GotPeers {..} <- query remoteAddr (Query nid (GetPeers def)) 203 Response _ GotPeers {..} <- query remoteAddr (Query nid False (GetPeers def))
204 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4] 204 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
205 let invalidToken = "" 205 let invalidToken = ""
206 let q :: MonadKRPC h m => SockAddr -> Query Announce 206 let q :: MonadKRPC h m => SockAddr -> Query Announce
207 -> m (Response Announced) 207 -> m (Response Announced)
208 q = query 208 q = query
209 q remoteAddr (Query nid (Announce False def thisPort invalidToken))) 209 q remoteAddr (Query nid False (Announce False def thisPort invalidToken)))
210 `shouldThrow` isQueryError 210 `shouldThrow` isQueryError
211 return () 211 return ()