summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/DHT')
-rw-r--r--src/Network/BitTorrent/DHT/Query.hs71
1 files changed, 42 insertions, 29 deletions
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index 67dc4541..4c980e22 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -123,7 +123,7 @@ import Data.String
123 123
124{- 124{-
125nodeHandler :: ( Address ip 125nodeHandler :: ( Address ip
126 , KRPC (Query KMessageOf a) (Response KMessageOf b) 126 , KRPC dht (Query KMessageOf a) (Response KMessageOf b)
127 ) 127 )
128 => (NodeInfo KMessageOf ip () -> Maybe ReflectedIP -> IO ()) -> (NodeAddr ip -> IO (NodeId KMessageOf)) -> (Char -> String -> Text -> IO ()) -> QueryMethod KMessageOf -> (NodeAddr ip -> a -> IO b) -> NodeHandler 128 => (NodeInfo KMessageOf ip () -> Maybe ReflectedIP -> IO ()) -> (NodeAddr ip -> IO (NodeId KMessageOf)) -> (Char -> String -> Text -> IO ()) -> QueryMethod KMessageOf -> (NodeAddr ip -> a -> IO b) -> NodeHandler
129-} 129-}
@@ -197,10 +197,10 @@ kademliaHandlers :: forall raw dht u ip. (Eq ip, Ord ip, Address ip
197 , Serialize (TransactionID dht) 197 , Serialize (TransactionID dht)
198 , WireFormat raw dht 198 , WireFormat raw dht
199 , Kademlia dht 199 , Kademlia dht
200 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 200 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
201 , Functor dht 201 , Functor dht
202 , Pretty (NodeInfo dht ip u) 202 , Pretty (NodeInfo dht ip u)
203 , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) 203 , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
204 , SerializableTo raw (Response dht (NodeFound dht ip)) 204 , SerializableTo raw (Response dht (NodeFound dht ip))
205 , SerializableTo raw (Query dht (FindNode dht ip)) 205 , SerializableTo raw (Query dht (FindNode dht ip))
206 ) => LogFun -> DHT raw dht u ip [Handler IO dht raw] 206 ) => LogFun -> DHT raw dht u ip [Handler IO dht raw]
@@ -208,7 +208,7 @@ kademliaHandlers :: forall raw dht u ip. (Eq ip, Ord ip, Address ip
208kademliaHandlers logger = do 208kademliaHandlers logger = do
209 groknode <- insertNode1 209 groknode <- insertNode1
210 mynid <- myNodeIdAccordingTo1 210 mynid <- myNodeIdAccordingTo1
211 let handler :: ( KRPC (Query dht a) (Response dht b) 211 let handler :: ( KRPC dht (Query dht a) (Response dht b)
212 , SerializableTo raw (Response dht b) 212 , SerializableTo raw (Response dht b)
213 , SerializableTo raw (Query dht a) 213 , SerializableTo raw (Query dht a)
214 ) => QueryMethod dht -> (NodeAddr ip -> a -> IO b) -> Handler IO dht raw 214 ) => QueryMethod dht -> (NodeAddr ip -> a -> IO b) -> Handler IO dht raw
@@ -264,10 +264,10 @@ defaultHandlers :: forall raw dht u ip.
264 , Serialize (TransactionID dht) 264 , Serialize (TransactionID dht)
265 , WireFormat raw dht 265 , WireFormat raw dht
266 , Kademlia dht 266 , Kademlia dht
267 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 267 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
268 , Functor dht 268 , Functor dht
269 , Pretty (NodeInfo dht ip u) 269 , Pretty (NodeInfo dht ip u)
270 , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) 270 , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
271 , SerializableTo raw (Response dht (NodeFound dht ip)) 271 , SerializableTo raw (Response dht (NodeFound dht ip))
272 , SerializableTo raw (Query dht (FindNode dht ip)) 272 , SerializableTo raw (Query dht (FindNode dht ip))
273 , Eq ip, Ord ip, Address ip, DataHandlers raw dht 273 , Eq ip, Ord ip, Address ip, DataHandlers raw dht
@@ -293,7 +293,7 @@ type Iteration raw dht u ip o = NodeInfo dht ip u -> DHT raw dht u ip (Either [N
293pingQ :: forall raw dht u ip. 293pingQ :: forall raw dht u ip.
294 ( DHT.Kademlia dht 294 ( DHT.Kademlia dht
295 , Address ip 295 , Address ip
296 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 296 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
297 , Default u 297 , Default u
298 , Show u 298 , Show u
299 , Ord (TransactionID dht) 299 , Ord (TransactionID dht)
@@ -361,7 +361,7 @@ ioGetPeers ih = do
361 361
362ioFindNode :: ( DHT.Kademlia dht 362ioFindNode :: ( DHT.Kademlia dht
363 , WireFormat raw dht 363 , WireFormat raw dht
364 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 364 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
365 , Address ip 365 , Address ip
366 , Default u 366 , Default u
367 , Show u 367 , Show u
@@ -371,7 +371,7 @@ ioFindNode :: ( DHT.Kademlia dht
371 , Ord (NodeId dht) 371 , Ord (NodeId dht)
372 , FiniteBits (NodeId dht) 372 , FiniteBits (NodeId dht)
373 , Show (NodeId dht) 373 , Show (NodeId dht)
374 , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) 374 , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
375 , Ord (TransactionID dht) 375 , Ord (TransactionID dht)
376 , Serialize (TransactionID dht) 376 , Serialize (TransactionID dht)
377 , SerializableTo raw (Response dht (NodeFound dht ip)) 377 , SerializableTo raw (Response dht (NodeFound dht ip))
@@ -390,7 +390,7 @@ ioFindNode ih = do
390-- | Like ioFindNode, but considers all found nodes to be 'Right' results. 390-- | Like ioFindNode, but considers all found nodes to be 'Right' results.
391ioFindNodes :: ( DHT.Kademlia dht 391ioFindNodes :: ( DHT.Kademlia dht
392 , WireFormat raw dht 392 , WireFormat raw dht
393 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 393 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
394 , Address ip 394 , Address ip
395 , Default u 395 , Default u
396 , Show u 396 , Show u
@@ -400,7 +400,7 @@ ioFindNodes :: ( DHT.Kademlia dht
400 , Ord (NodeId dht) 400 , Ord (NodeId dht)
401 , FiniteBits (NodeId dht) 401 , FiniteBits (NodeId dht)
402 , Show (NodeId dht) 402 , Show (NodeId dht)
403 , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) 403 , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
404 , Ord (TransactionID dht) 404 , Ord (TransactionID dht)
405 , Serialize (TransactionID dht) 405 , Serialize (TransactionID dht)
406 , SerializableTo raw (Response dht (NodeFound dht ip)) 406 , SerializableTo raw (Response dht (NodeFound dht ip))
@@ -481,7 +481,7 @@ publish = error "todo"
481 481
482probeNode :: ( Default u 482probeNode :: ( Default u
483 , Show u 483 , Show u
484 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 484 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
485 , DHT.Kademlia dht 485 , DHT.Kademlia dht
486 , Address ip 486 , Address ip
487 , Ord (TransactionID dht) 487 , Ord (TransactionID dht)
@@ -507,9 +507,22 @@ refreshNodes :: forall raw dht u ip.
507 , Default u 507 , Default u
508 , FiniteBits (NodeId dht) 508 , FiniteBits (NodeId dht)
509 , Pretty (NodeId dht) 509 , Pretty (NodeId dht)
510 , DHT.Kademlia dht ) => NodeId dht -> DHT raw dht u ip () -- [NodeInfo KMessageOf ip ()] 510 , DHT.Kademlia dht
511refreshNodes _ = return () -- TODO 511 , Ord ip
512#if 0 512 , Ord (TransactionID dht)
513 , SerializableTo raw (Response dht (NodeFound dht ip))
514 , SerializableTo raw (Query dht (FindNode dht ip))
515 , SerializableTo raw (Response dht (Ping dht))
516 , SerializableTo raw (Query dht (Ping dht))
517 , Pretty (NodeInfo dht ip u)
518 , Show (NodeId dht)
519 , Show u
520 , Show (QueryMethod dht)
521 , Serialize (TransactionID dht)
522 , WireFormat raw dht
523 , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
524 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
525 ) => NodeId dht -> DHT raw dht u ip () -- [NodeInfo KMessageOf ip ()]
513-- FIXME do not use getClosest sinse we should /refresh/ them 526-- FIXME do not use getClosest sinse we should /refresh/ them
514refreshNodes nid = do 527refreshNodes nid = do
515 $(logDebugS) "routing.refresh_bucket" (T.pack (render (pPrint nid))) 528 $(logDebugS) "routing.refresh_bucket" (T.pack (render (pPrint nid)))
@@ -520,15 +533,15 @@ refreshNodes nid = do
520 -- Expected type: ConduitM [NodeAddr ip] [NodeInfo KMessageOf ip ()] (DHT ip) () 533 -- Expected type: ConduitM [NodeAddr ip] [NodeInfo KMessageOf ip ()] (DHT ip) ()
521 -- Actual type: ConduitM [NodeInfo KMessageOf ip ()] [NodeInfo KMessageOf ip ()] (DHT ip) () 534 -- Actual type: ConduitM [NodeInfo KMessageOf ip ()] [NodeInfo KMessageOf ip ()] (DHT ip) ()
522 -- nss <- sourceList [[addr]] \$= search nid (findNodeQ nid) $$ C.consume 535 -- nss <- sourceList [[addr]] \$= search nid (findNodeQ nid) $$ C.consume
523 nss <- sourceList [nodes] $= search nid (findNodeQ (Proxy :: Proxy dht) nid) $$ C.consume 536 -- nss <- sourceList [nodes] \$= search nid (findNodeQ (Proxy :: Proxy dht) nid) $$ C.consume
524 $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length (L.concat nss))) <> " nodes." 537 ns <- bgsearch ioFindNodes nid
525 _ <- queryParallel $ flip L.map (L.concat nss) $ \n -> do 538 $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length ns)) <> " nodes."
539 _ <- queryParallel $ flip L.map ns $ \n -> do
526 $(logWarnS) "refreshNodes" $ "received node: " <> T.pack (show (pPrint n)) 540 $(logWarnS) "refreshNodes" $ "received node: " <> T.pack (show (pPrint n))
527 pingQ (nodeAddr n) 541 pingQ (nodeAddr n)
528 -- pingQ takes care of inserting the node. 542 -- pingQ takes care of inserting the node.
529 return () 543 return ()
530 return () -- \$ L.concat nss 544 return () -- \$ L.concat nss
531#endif
532 545
533logc :: Char -> String -> DHT raw dht u ip () 546logc :: Char -> String -> DHT raw dht u ip ()
534logc 'D' = $(logDebugS) "insertNode" . T.pack 547logc 'D' = $(logDebugS) "insertNode" . T.pack
@@ -546,7 +559,7 @@ insertNode :: forall raw dht u ip.
546 , Default u 559 , Default u
547 , Show u 560 , Show u
548 , DHT.Kademlia dht 561 , DHT.Kademlia dht
549 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 562 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
550 , Ord (TransactionID dht) 563 , Ord (TransactionID dht)
551 , WireFormat raw dht 564 , WireFormat raw dht
552 , Serialize (TransactionID dht) 565 , Serialize (TransactionID dht)
@@ -567,7 +580,7 @@ insertNode1 :: forall raw dht u ip.
567 , Ord (NodeId dht) 580 , Ord (NodeId dht)
568 , FiniteBits (NodeId dht) 581 , FiniteBits (NodeId dht)
569 , Show (NodeId dht) 582 , Show (NodeId dht)
570 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 583 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
571 , DHT.Kademlia dht 584 , DHT.Kademlia dht
572 , Ord (TransactionID dht) 585 , Ord (TransactionID dht)
573 , WireFormat raw dht 586 , WireFormat raw dht
@@ -611,8 +624,8 @@ insertNode1 = do
611-- | Throws exception if node is not responding. 624-- | Throws exception if node is not responding.
612queryNode :: forall raw dht u a b ip. 625queryNode :: forall raw dht u a b ip.
613 ( Address ip 626 ( Address ip
614 , KRPC (Query dht a) (Response dht b) 627 , KRPC dht (Query dht a) (Response dht b)
615 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 628 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
616 , Default u 629 , Default u
617 , Show u 630 , Show u
618 , DHT.Kademlia dht 631 , DHT.Kademlia dht
@@ -635,8 +648,8 @@ queryNode' :: forall raw dht u a b ip.
635 , Default u 648 , Default u
636 , Show u 649 , Show u
637 , DHT.Kademlia dht 650 , DHT.Kademlia dht
638 , KRPC (Query dht a) (Response dht b) 651 , KRPC dht (Query dht a) (Response dht b)
639 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 652 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
640 , Ord (TransactionID dht) 653 , Ord (TransactionID dht)
641 , Serialize (TransactionID dht) 654 , Serialize (TransactionID dht)
642 , WireFormat raw dht 655 , WireFormat raw dht
@@ -652,9 +665,9 @@ queryNode' :: forall raw dht u a b ip.
652queryNode' addr q = do 665queryNode' addr q = do
653 nid <- myNodeIdAccordingTo addr 666 nid <- myNodeIdAccordingTo addr
654 let read_only = False -- TODO: check for NAT issues. (BEP 43) 667 let read_only = False -- TODO: check for NAT issues. (BEP 43)
655 let KRPC.Method name = KRPC.method :: KRPC.Method (Query dht a) (Response dht b) 668 let KRPC.Method name = KRPC.method :: KRPC.Method dht (Query dht a) (Response dht b)
656 mgr <- asks manager 669 mgr <- asks manager
657 (Response remoteId r, witnessed_ip) <- liftIO $ query' mgr (error "TODO: name") (toSockAddr addr) (Query nid read_only q) 670 (Response remoteId r, witnessed_ip) <- liftIO $ query' mgr name (toSockAddr addr) (Query nid read_only q)
658 -- \$(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip) 671 -- \$(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip)
659 -- <> " by " <> T.pack (show (toSockAddr addr)) 672 -- <> " by " <> T.pack (show (toSockAddr addr))
660 _ <- insertNode (NodeInfo remoteId addr def) witnessed_ip 673 _ <- insertNode (NodeInfo remoteId addr def) witnessed_ip
@@ -662,8 +675,8 @@ queryNode' addr q = do
662 675
663-- | Infix version of 'queryNode' function. 676-- | Infix version of 'queryNode' function.
664(<@>) :: ( Address ip 677(<@>) :: ( Address ip
665 , KRPC (Query dht a) (Response dht b) 678 , KRPC dht (Query dht a) (Response dht b)
666 , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) 679 , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
667 , Default u 680 , Default u
668 , Show u 681 , Show u
669 , Show (QueryMethod dht) 682 , Show (QueryMethod dht)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 21:01:33 +0000