diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/Tox.hs | 6 | ||||
-rw-r--r-- | src/Network/Tox/DHT/Handlers.hs | 19 |
2 files changed, 17 insertions, 8 deletions
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 68714224..41deff42 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs | |||
@@ -449,7 +449,9 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do | |||
449 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id | 449 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id |
450 | $ \client net -> onInbound (DHT.updateRouting client (mkrouting client) orouter) net | 450 | $ \client net -> onInbound (DHT.updateRouting client (mkrouting client) orouter) net |
451 | 451 | ||
452 | orouter <- forkRouteBuilder orouter $ \nid ni -> fmap (\(_,ns,_)->ns) <$> DHT.getNodes dhtclient nid ni | 452 | orouter' <- forkRouteBuilder orouter |
453 | $ \nid ni -> fmap (\(_,ns,_)->ns) | ||
454 | <$> DHT.getNodes dhtclient (DHT.nodesOfInterest $ mkrouting dhtclient) nid ni | ||
453 | 455 | ||
454 | toks <- do | 456 | toks <- do |
455 | nil <- nullSessionTokens | 457 | nil <- nullSessionTokens |
@@ -459,7 +461,7 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do | |||
459 | onionclient <- newClient oniondrg onionnet (const Onion.classify) | 461 | onionclient <- newClient oniondrg onionnet (const Onion.classify) |
460 | (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient)) | 462 | (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient)) |
461 | (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb) | 463 | (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb) |
462 | (hookQueries orouter DHT.transactionKey) | 464 | (hookQueries orouter' DHT.transactionKey) |
463 | (const id) | 465 | (const id) |
464 | 466 | ||
465 | return Tox | 467 | return Tox |
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 | } |