diff options
Diffstat (limited to 'tests/Network/BitTorrent/DHT/MessageSpec.hs')
-rw-r--r-- | tests/Network/BitTorrent/DHT/MessageSpec.hs | 38 |
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 () |