diff options
Diffstat (limited to 'src/Network/DHT/Mainline.hs')
-rw-r--r-- | src/Network/DHT/Mainline.hs | 89 |
1 files changed, 44 insertions, 45 deletions
diff --git a/src/Network/DHT/Mainline.hs b/src/Network/DHT/Mainline.hs index d118ceb0..29d4231d 100644 --- a/src/Network/DHT/Mainline.hs +++ b/src/Network/DHT/Mainline.hs | |||
@@ -123,6 +123,8 @@ import Network.BitTorrent.DHT.Token | |||
123 | import Network.DatagramServer () | 123 | import Network.DatagramServer () |
124 | #endif | 124 | #endif |
125 | import Network.DatagramServer.Types hiding (Query,Response) | 125 | import Network.DatagramServer.Types hiding (Query,Response) |
126 | import Network.DHT.Types | ||
127 | import Network.DHT.Routing | ||
126 | 128 | ||
127 | {----------------------------------------------------------------------- | 129 | {----------------------------------------------------------------------- |
128 | -- envelopes | 130 | -- envelopes |
@@ -140,15 +142,7 @@ read_only_key = "ro" | |||
140 | 142 | ||
141 | 143 | ||
142 | #ifdef VERSION_bencoding | 144 | #ifdef VERSION_bencoding |
143 | -- | All queries have an \"id\" key and value containing the node ID | 145 | instance BEncode a => BEncode (Query KMessageOf a) where |
144 | -- of the querying node. | ||
145 | data Query a = Query | ||
146 | { queringNodeId :: NodeId KMessageOf -- ^ node id of /quering/ node; | ||
147 | , queryIsReadOnly :: Bool -- ^ node is read-only as per BEP 43 | ||
148 | , queryParams :: a -- ^ query parameters. | ||
149 | } deriving (Show, Eq, Typeable) | ||
150 | |||
151 | instance BEncode a => BEncode (Query a) where | ||
152 | toBEncode Query {..} = toDict $ | 146 | toBEncode Query {..} = toDict $ |
153 | BDict.union ( node_id_key .=! queringNodeId | 147 | BDict.union ( node_id_key .=! queringNodeId |
154 | .: read_only_key .=? bool Nothing (Just (1 :: Integer)) queryIsReadOnly | 148 | .: read_only_key .=? bool Nothing (Just (1 :: Integer)) queryIsReadOnly |
@@ -167,14 +161,7 @@ data Query a = Query a | |||
167 | #endif | 161 | #endif |
168 | 162 | ||
169 | #ifdef VERSION_bencoding | 163 | #ifdef VERSION_bencoding |
170 | -- | All responses have an \"id\" key and value containing the node ID | 164 | instance BEncode a => BEncode (Response KMessageOf a) where |
171 | -- of the responding node. | ||
172 | data Response a = Response | ||
173 | { queredNodeId :: NodeId KMessageOf -- ^ node id of /quered/ node; | ||
174 | , responseVals :: a -- ^ query result. | ||
175 | } deriving (Show, Eq, Typeable) | ||
176 | |||
177 | instance BEncode a => BEncode (Response a) where | ||
178 | toBEncode = toBEncode . toQuery | 165 | toBEncode = toBEncode . toQuery |
179 | where | 166 | where |
180 | toQuery (Response nid a) = Query nid False a | 167 | toQuery (Response nid a) = Query nid False a |
@@ -183,28 +170,23 @@ instance BEncode a => BEncode (Response a) where | |||
183 | where | 170 | where |
184 | fromQuery (Query nid _ a) = Response nid a | 171 | fromQuery (Query nid _ a) = Response nid a |
185 | #else | 172 | #else |
186 | data Response a = Response a | 173 | data Response KMessageOf a = Response KMessageOf a |
187 | #endif | 174 | #endif |
188 | 175 | ||
189 | {----------------------------------------------------------------------- | 176 | {----------------------------------------------------------------------- |
190 | -- ping method | 177 | -- ping method |
191 | -----------------------------------------------------------------------} | 178 | -----------------------------------------------------------------------} |
192 | 179 | ||
193 | -- | The most basic query is a ping. Ping query is used to check if a | 180 | -- / The most basic query is a ping. Ping query is used to check if a |
194 | -- quered node is still alive. | 181 | -- quered node is still alive. |
195 | #ifdef VERSION_bencoding | 182 | -- data Ping = Ping Tox.Nonce8 deriving (Show, Eq, Typeable) |
196 | data Ping = Ping | ||
197 | #else | ||
198 | data Ping = Ping Tox.Nonce8 | ||
199 | #endif | ||
200 | deriving (Show, Eq, Typeable) | ||
201 | 183 | ||
202 | #ifdef VERSION_bencoding | 184 | #ifdef VERSION_bencoding |
203 | instance BEncode Ping where | 185 | instance BEncode (Ping KMessageOf) where |
204 | toBEncode Ping = toDict endDict | 186 | toBEncode Ping = toDict endDict |
205 | fromBEncode _ = pure Ping | 187 | fromBEncode _ = pure Ping |
206 | #else | 188 | #else |
207 | instance Serialize (Query Ping) where | 189 | instance Serialize (Query (Ping KMessageOf)) where |
208 | get = do | 190 | get = do |
209 | b <- get | 191 | b <- get |
210 | when ( (b::Word8) /= 0) $ fail "Bad ping request" | 192 | when ( (b::Word8) /= 0) $ fail "Bad ping request" |
@@ -225,7 +207,7 @@ instance Serialize (Response Ping) where | |||
225 | #endif | 207 | #endif |
226 | 208 | ||
227 | -- | \"q\" = \"ping\" | 209 | -- | \"q\" = \"ping\" |
228 | instance KRPC (Query Ping) (Response Ping) where | 210 | instance KRPC (Query KMessageOf (Ping KMessageOf)) (Response KMessageOf (Ping KMessageOf)) where |
229 | #ifdef VERSION_bencoding | 211 | #ifdef VERSION_bencoding |
230 | method = "ping" | 212 | method = "ping" |
231 | #else | 213 | #else |
@@ -236,24 +218,20 @@ instance KRPC (Query Ping) (Response Ping) where | |||
236 | -- find_node method | 218 | -- find_node method |
237 | -----------------------------------------------------------------------} | 219 | -----------------------------------------------------------------------} |
238 | 220 | ||
239 | -- | Find node is used to find the contact information for a node | 221 | -- / Find node is used to find the contact information for a node |
240 | -- given its ID. | 222 | -- given its ID. |
241 | #ifdef VERSION_bencoding | 223 | -- data FindNode KMessageOf ip = FindNode (NodeId Tox.Message) Tox.Nonce8 -- Tox: Get Nodes |
242 | newtype FindNode ip = FindNode (NodeId KMessageOf) | 224 | -- deriving (Show, Eq, Typeable) |
243 | #else | ||
244 | data FindNode ip = FindNode (NodeId Tox.Message) Tox.Nonce8 -- Tox: Get Nodes | ||
245 | #endif | ||
246 | deriving (Show, Eq, Typeable) | ||
247 | 225 | ||
248 | target_key :: BKey | 226 | target_key :: BKey |
249 | target_key = "target" | 227 | target_key = "target" |
250 | 228 | ||
251 | #ifdef VERSION_bencoding | 229 | #ifdef VERSION_bencoding |
252 | instance Typeable ip => BEncode (FindNode ip) where | 230 | instance Typeable ip => BEncode (FindNode KMessageOf ip) where |
253 | toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict | 231 | toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict |
254 | fromBEncode = fromDict $ FindNode <$>! target_key | 232 | fromBEncode = fromDict $ FindNode <$>! target_key |
255 | #else | 233 | #else |
256 | instance Serialize (Query (FindNode ip)) where | 234 | instance Serialize (Query KMessageOf (FindNode KMessageOf ip)) where |
257 | get = do | 235 | get = do |
258 | nid <- get | 236 | nid <- get |
259 | nonce <- get | 237 | nonce <- get |
@@ -268,12 +246,11 @@ instance Serialize (Query (FindNode ip)) where | |||
268 | -- nodes in its own routing table. | 246 | -- nodes in its own routing table. |
269 | -- | 247 | -- |
270 | #ifdef VERSION_bencoding | 248 | #ifdef VERSION_bencoding |
271 | newtype NodeFound ip = NodeFound [NodeInfo KMessageOf ip ()] | 249 | -- newtype NodeFound KMessageOf ip = NodeFound [NodeInfo KMessageOf ip ()] deriving (Show, Eq, Typeable) |
272 | #else | 250 | #else |
273 | data NodeFound ip = NodeFound [Tox.NodeFormat] Tox.Nonce8 | 251 | data NodeFound KMessageOf ip = NodeFound [Tox.NodeFormat] Tox.Nonce8 deriving (Show, Eq, Typeable) |
274 | #endif | 252 | #endif |
275 | -- Tox: send_nodes | 253 | -- Tox: send_nodes |
276 | deriving (Show, Eq, Typeable) | ||
277 | 254 | ||
278 | nodes_key :: BKey | 255 | nodes_key :: BKey |
279 | nodes_key = "nodes" | 256 | nodes_key = "nodes" |
@@ -290,7 +267,7 @@ binary k = field (req k) >>= either (fail . format) return . | |||
290 | where | 267 | where |
291 | format str = "fail to deserialize " ++ show k ++ " field: " ++ str | 268 | format str = "fail to deserialize " ++ show k ++ " field: " ++ str |
292 | 269 | ||
293 | instance Address ip => BEncode (NodeFound ip) where | 270 | instance Address ip => BEncode (NodeFound KMessageOf ip) where |
294 | toBEncode (NodeFound ns) = toDict $ | 271 | toBEncode (NodeFound ns) = toDict $ |
295 | nodes_key .=! runPut (mapM_ put ns) | 272 | nodes_key .=! runPut (mapM_ put ns) |
296 | .: endDict | 273 | .: endDict |
@@ -298,7 +275,7 @@ instance Address ip => BEncode (NodeFound ip) where | |||
298 | -- TODO: handle IPv6 by reading the "nodes6" key (see bep 32) | 275 | -- TODO: handle IPv6 by reading the "nodes6" key (see bep 32) |
299 | fromBEncode bval = NodeFound <$> (traverse from4 =<< fromDict (binary nodes_key) bval) | 276 | fromBEncode bval = NodeFound <$> (traverse from4 =<< fromDict (binary nodes_key) bval) |
300 | #else | 277 | #else |
301 | instance Serialize (Response (NodeFound ip)) where | 278 | instance Serialize (Response KMessageOf (NodeFound KMessageOf ip)) where |
302 | get = do | 279 | get = do |
303 | count <- get :: Get Word8 | 280 | count <- get :: Get Word8 |
304 | nodes <- sequence $ replicate (fromIntegral count) get | 281 | nodes <- sequence $ replicate (fromIntegral count) get |
@@ -314,7 +291,7 @@ instance Serialize (Response (NodeFound ip)) where | |||
314 | 291 | ||
315 | -- | \"q\" == \"find_node\" | 292 | -- | \"q\" == \"find_node\" |
316 | instance (Address ip, Typeable ip) | 293 | instance (Address ip, Typeable ip) |
317 | => KRPC (Query (FindNode ip)) (Response (NodeFound ip)) where | 294 | => KRPC (Query KMessageOf (FindNode KMessageOf ip)) (Response KMessageOf (NodeFound KMessageOf ip)) where |
318 | #ifdef VERSION_bencoding | 295 | #ifdef VERSION_bencoding |
319 | method = "find_node" | 296 | method = "find_node" |
320 | #else | 297 | #else |
@@ -383,7 +360,7 @@ instance (Typeable ip, Serialize ip) => BEncode (GotPeers ip) where | |||
383 | 360 | ||
384 | -- | \"q" = \"get_peers\" | 361 | -- | \"q" = \"get_peers\" |
385 | instance (Typeable ip, Serialize ip) => | 362 | instance (Typeable ip, Serialize ip) => |
386 | KRPC (Query (GetPeers ip)) (Response (GotPeers ip)) where | 363 | KRPC (Query KMessageOf (GetPeers ip)) (Response KMessageOf (GotPeers ip)) where |
387 | method = "get_peers" | 364 | method = "get_peers" |
388 | 365 | ||
389 | {----------------------------------------------------------------------- | 366 | {----------------------------------------------------------------------- |
@@ -455,7 +432,7 @@ instance BEncode Announced where | |||
455 | fromBEncode _ = pure Announced | 432 | fromBEncode _ = pure Announced |
456 | 433 | ||
457 | -- | \"q" = \"announce\" | 434 | -- | \"q" = \"announce\" |
458 | instance KRPC (Query Announce) (Response Announced) where | 435 | instance KRPC (Query KMessageOf Announce) (Response KMessageOf Announced) where |
459 | method = "announce_peer" | 436 | method = "announce_peer" |
460 | 437 | ||
461 | -- endif VERSION_bencoding | 438 | -- endif VERSION_bencoding |
@@ -495,3 +472,25 @@ bep42 addr (NodeId r) | |||
495 | where msk | BS.length ip == 4 = ip4mask | 472 | where msk | BS.length ip == 4 = ip4mask |
496 | | otherwise = ip6mask | 473 | | otherwise = ip6mask |
497 | 474 | ||
475 | instance Kademlia KMessageOf where | ||
476 | data Ping KMessageOf = Ping | ||
477 | deriving (Show, Eq, Typeable) | ||
478 | newtype FindNode KMessageOf ip = FindNode (NodeId KMessageOf) | ||
479 | deriving (Show, Eq, Typeable) | ||
480 | newtype NodeFound KMessageOf ip = NodeFound [NodeInfo KMessageOf ip ()] | ||
481 | deriving (Show, Eq, Typeable) | ||
482 | pingMessage _ = Ping | ||
483 | pongMessage _ = Ping | ||
484 | findNodeMessage _ k = FindNode (toNodeId k) | ||
485 | foundNodes (NodeFound ns) = ns | ||
486 | |||
487 | dhtAdjustID _ fallback ip0 arrival | ||
488 | = fromMaybe fallback $ do | ||
489 | ip <- fromSockAddr ip0 -- :: Maybe ip | ||
490 | let _ = ip `asTypeOf` nodeAddr (foreignNode arrival) | ||
491 | listToMaybe | ||
492 | $ rank id (nodeId $ foreignNode arrival) | ||
493 | $ bep42s ip fallback | ||
494 | |||
495 | namePing _ = "ping" | ||
496 | nameFindNodes _ = "find-nodes" | ||