From b53ece2247e46d5eea9e433a54d0a833216fcc6d Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 30 Jun 2017 19:09:08 -0400 Subject: Bug fixes. --- src/Network/BitTorrent/DHT.hs | 8 ++--- src/Network/BitTorrent/DHT/Query.hs | 71 ++++++++++++++++++++++--------------- 2 files changed, 46 insertions(+), 33 deletions(-) (limited to 'src/Network/BitTorrent') diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs index 6d31eab2..fa8071d5 100644 --- a/src/Network/BitTorrent/DHT.hs +++ b/src/Network/BitTorrent/DHT.hs @@ -119,8 +119,8 @@ dht :: , Show (QueryMethod dht) , Pretty (NodeInfo dht ip u) , Kademlia dht - , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , DataHandlers raw dht , WireFormat raw dht , Show u @@ -227,8 +227,8 @@ bootstrap :: forall raw dht u ip. , Show (QueryMethod dht) , Pretty (NodeInfo dht ip u) , Kademlia dht - , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , DataHandlers raw dht , WireFormat raw dht , Show u 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 {- nodeHandler :: ( Address ip - , KRPC (Query KMessageOf a) (Response KMessageOf b) + , KRPC dht (Query KMessageOf a) (Response KMessageOf b) ) => (NodeInfo KMessageOf ip () -> Maybe ReflectedIP -> IO ()) -> (NodeAddr ip -> IO (NodeId KMessageOf)) -> (Char -> String -> Text -> IO ()) -> QueryMethod KMessageOf -> (NodeAddr ip -> a -> IO b) -> NodeHandler -} @@ -197,10 +197,10 @@ kademliaHandlers :: forall raw dht u ip. (Eq ip, Ord ip, Address ip , Serialize (TransactionID dht) , WireFormat raw dht , Kademlia dht - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Functor dht , Pretty (NodeInfo dht ip u) - , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) + , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) , SerializableTo raw (Response dht (NodeFound dht ip)) , SerializableTo raw (Query dht (FindNode dht ip)) ) => 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 kademliaHandlers logger = do groknode <- insertNode1 mynid <- myNodeIdAccordingTo1 - let handler :: ( KRPC (Query dht a) (Response dht b) + let handler :: ( KRPC dht (Query dht a) (Response dht b) , SerializableTo raw (Response dht b) , SerializableTo raw (Query dht a) ) => QueryMethod dht -> (NodeAddr ip -> a -> IO b) -> Handler IO dht raw @@ -264,10 +264,10 @@ defaultHandlers :: forall raw dht u ip. , Serialize (TransactionID dht) , WireFormat raw dht , Kademlia dht - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Functor dht , Pretty (NodeInfo dht ip u) - , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) + , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) , SerializableTo raw (Response dht (NodeFound dht ip)) , SerializableTo raw (Query dht (FindNode dht ip)) , 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 pingQ :: forall raw dht u ip. ( DHT.Kademlia dht , Address ip - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Default u , Show u , Ord (TransactionID dht) @@ -361,7 +361,7 @@ ioGetPeers ih = do ioFindNode :: ( DHT.Kademlia dht , WireFormat raw dht - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Address ip , Default u , Show u @@ -371,7 +371,7 @@ ioFindNode :: ( DHT.Kademlia dht , Ord (NodeId dht) , FiniteBits (NodeId dht) , Show (NodeId dht) - , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) + , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) , Ord (TransactionID dht) , Serialize (TransactionID dht) , SerializableTo raw (Response dht (NodeFound dht ip)) @@ -390,7 +390,7 @@ ioFindNode ih = do -- | Like ioFindNode, but considers all found nodes to be 'Right' results. ioFindNodes :: ( DHT.Kademlia dht , WireFormat raw dht - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Address ip , Default u , Show u @@ -400,7 +400,7 @@ ioFindNodes :: ( DHT.Kademlia dht , Ord (NodeId dht) , FiniteBits (NodeId dht) , Show (NodeId dht) - , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) + , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) , Ord (TransactionID dht) , Serialize (TransactionID dht) , SerializableTo raw (Response dht (NodeFound dht ip)) @@ -481,7 +481,7 @@ publish = error "todo" probeNode :: ( Default u , Show u - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , DHT.Kademlia dht , Address ip , Ord (TransactionID dht) @@ -507,9 +507,22 @@ refreshNodes :: forall raw dht u ip. , Default u , FiniteBits (NodeId dht) , Pretty (NodeId dht) - , DHT.Kademlia dht ) => NodeId dht -> DHT raw dht u ip () -- [NodeInfo KMessageOf ip ()] -refreshNodes _ = return () -- TODO -#if 0 + , DHT.Kademlia dht + , Ord ip + , Ord (TransactionID dht) + , SerializableTo raw (Response dht (NodeFound dht ip)) + , SerializableTo raw (Query dht (FindNode dht ip)) + , SerializableTo raw (Response dht (Ping dht)) + , SerializableTo raw (Query dht (Ping dht)) + , Pretty (NodeInfo dht ip u) + , Show (NodeId dht) + , Show u + , Show (QueryMethod dht) + , Serialize (TransactionID dht) + , WireFormat raw dht + , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) + ) => NodeId dht -> DHT raw dht u ip () -- [NodeInfo KMessageOf ip ()] -- FIXME do not use getClosest sinse we should /refresh/ them refreshNodes nid = do $(logDebugS) "routing.refresh_bucket" (T.pack (render (pPrint nid))) @@ -520,15 +533,15 @@ refreshNodes nid = do -- Expected type: ConduitM [NodeAddr ip] [NodeInfo KMessageOf ip ()] (DHT ip) () -- Actual type: ConduitM [NodeInfo KMessageOf ip ()] [NodeInfo KMessageOf ip ()] (DHT ip) () -- nss <- sourceList [[addr]] \$= search nid (findNodeQ nid) $$ C.consume - nss <- sourceList [nodes] $= search nid (findNodeQ (Proxy :: Proxy dht) nid) $$ C.consume - $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length (L.concat nss))) <> " nodes." - _ <- queryParallel $ flip L.map (L.concat nss) $ \n -> do + -- nss <- sourceList [nodes] \$= search nid (findNodeQ (Proxy :: Proxy dht) nid) $$ C.consume + ns <- bgsearch ioFindNodes nid + $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length ns)) <> " nodes." + _ <- queryParallel $ flip L.map ns $ \n -> do $(logWarnS) "refreshNodes" $ "received node: " <> T.pack (show (pPrint n)) pingQ (nodeAddr n) -- pingQ takes care of inserting the node. return () return () -- \$ L.concat nss -#endif logc :: Char -> String -> DHT raw dht u ip () logc 'D' = $(logDebugS) "insertNode" . T.pack @@ -546,7 +559,7 @@ insertNode :: forall raw dht u ip. , Default u , Show u , DHT.Kademlia dht - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Ord (TransactionID dht) , WireFormat raw dht , Serialize (TransactionID dht) @@ -567,7 +580,7 @@ insertNode1 :: forall raw dht u ip. , Ord (NodeId dht) , FiniteBits (NodeId dht) , Show (NodeId dht) - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , DHT.Kademlia dht , Ord (TransactionID dht) , WireFormat raw dht @@ -611,8 +624,8 @@ insertNode1 = do -- | Throws exception if node is not responding. queryNode :: forall raw dht u a b ip. ( Address ip - , KRPC (Query dht a) (Response dht b) - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht a) (Response dht b) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Default u , Show u , DHT.Kademlia dht @@ -635,8 +648,8 @@ queryNode' :: forall raw dht u a b ip. , Default u , Show u , DHT.Kademlia dht - , KRPC (Query dht a) (Response dht b) - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht a) (Response dht b) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Ord (TransactionID dht) , Serialize (TransactionID dht) , WireFormat raw dht @@ -652,9 +665,9 @@ queryNode' :: forall raw dht u a b ip. queryNode' addr q = do nid <- myNodeIdAccordingTo addr let read_only = False -- TODO: check for NAT issues. (BEP 43) - let KRPC.Method name = KRPC.method :: KRPC.Method (Query dht a) (Response dht b) + let KRPC.Method name = KRPC.method :: KRPC.Method dht (Query dht a) (Response dht b) mgr <- asks manager - (Response remoteId r, witnessed_ip) <- liftIO $ query' mgr (error "TODO: name") (toSockAddr addr) (Query nid read_only q) + (Response remoteId r, witnessed_ip) <- liftIO $ query' mgr name (toSockAddr addr) (Query nid read_only q) -- \$(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip) -- <> " by " <> T.pack (show (toSockAddr addr)) _ <- insertNode (NodeInfo remoteId addr def) witnessed_ip @@ -662,8 +675,8 @@ queryNode' addr q = do -- | Infix version of 'queryNode' function. (<@>) :: ( Address ip - , KRPC (Query dht a) (Response dht b) - , KRPC (Query dht (Ping dht)) (Response dht (Ping dht)) + , KRPC dht (Query dht a) (Response dht b) + , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht)) , Default u , Show u , Show (QueryMethod dht) -- cgit v1.2.3