diff options
Diffstat (limited to 'src/Network/Tox/DHT')
-rw-r--r-- | src/Network/Tox/DHT/Handlers.hs | 19 |
1 files changed, 13 insertions, 6 deletions
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs index 2bce382a..25244a9b 100644 --- a/src/Network/Tox/DHT/Handlers.hs +++ b/src/Network/Tox/DHT/Handlers.hs | |||
@@ -179,7 +179,7 @@ newRouting addr crypto update4 update6 = do | |||
179 | cbvar <- newTVar HashMap.empty | 179 | cbvar <- newTVar HashMap.empty |
180 | return $ \client -> | 180 | return $ \client -> |
181 | -- Now we have a client, so tell the BucketRefresher how to search and ping. | 181 | -- Now we have a client, so tell the BucketRefresher how to search and ping. |
182 | let updIO r = updateRefresherIO (nodeSearch client) (ping client) r | 182 | let updIO r = updateRefresherIO (nodeSearch client cbvar) (ping client) r |
183 | in Routing { tentativeId = tentative_info | 183 | in Routing { tentativeId = tentative_info |
184 | , committee4 = committee4 | 184 | , committee4 = committee4 |
185 | , committee6 = committee6 | 185 | , committee6 = committee6 |
@@ -376,11 +376,18 @@ unsendNodes _ = Nothing | |||
376 | unwrapNodes :: SendNodes -> ( [NodeInfo], [NodeInfo], Maybe () ) | 376 | unwrapNodes :: SendNodes -> ( [NodeInfo], [NodeInfo], Maybe () ) |
377 | unwrapNodes (SendNodes ns) = (ns,ns,Just ()) | 377 | unwrapNodes (SendNodes ns) = (ns,ns,Just ()) |
378 | 378 | ||
379 | getNodes :: Client -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ())) | 379 | getNodes :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ())) |
380 | getNodes client nid addr = do | 380 | getNodes client cbvar nid addr = do |
381 | -- hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid | 381 | -- hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid |
382 | reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr | 382 | reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr |
383 | -- hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply | 383 | -- hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply |
384 | forM_ (join reply) $ \(SendNodes ns) -> | ||
385 | forM_ ns $ \n -> do | ||
386 | atomically $ do | ||
387 | mcbs <- HashMap.lookup (nodeId n) <$> readTVar cbvar | ||
388 | forM_ mcbs $ \cbs -> do | ||
389 | forM_ cbs $ \cb -> do | ||
390 | rumoredAddress cb (nodeAddr addr) n | ||
384 | return $ fmap unwrapNodes $ join reply | 391 | return $ fmap unwrapNodes $ join reply |
385 | 392 | ||
386 | updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO () | 393 | updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO () |
@@ -474,9 +481,9 @@ handlers crypto _ CookieRequestType = Just $ MethodHandler (isCookieReques | |||
474 | handlers _ _ DHTRequestType = Just $ NoReply (isDHTRequest snd) $ dhtRequestH | 481 | handlers _ _ DHTRequestType = Just $ NoReply (isDHTRequest snd) $ dhtRequestH |
475 | handlers _ _ typ = error $ "TODO DHT handlers " ++ show typ | 482 | handlers _ _ typ = error $ "TODO DHT handlers " ++ show typ |
476 | 483 | ||
477 | nodeSearch :: Client -> Search NodeId (IP,PortNumber) () NodeInfo NodeInfo | 484 | nodeSearch :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> Search NodeId (IP,PortNumber) () NodeInfo NodeInfo |
478 | nodeSearch client = Search | 485 | nodeSearch client cbvar = Search |
479 | { searchSpace = toxSpace | 486 | { searchSpace = toxSpace |
480 | , searchNodeAddress = nodeIP &&& nodePort | 487 | , searchNodeAddress = nodeIP &&& nodePort |
481 | , searchQuery = getNodes client | 488 | , searchQuery = getNodes client cbvar |
482 | } | 489 | } |