summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network/Tox.hs6
-rw-r--r--src/Network/Tox/DHT/Handlers.hs19
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
376unwrapNodes :: SendNodes -> ( [NodeInfo], [NodeInfo], Maybe () ) 376unwrapNodes :: SendNodes -> ( [NodeInfo], [NodeInfo], Maybe () )
377unwrapNodes (SendNodes ns) = (ns,ns,Just ()) 377unwrapNodes (SendNodes ns) = (ns,ns,Just ())
378 378
379getNodes :: Client -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ())) 379getNodes :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ()))
380getNodes client nid addr = do 380getNodes 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
386updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO () 393updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO ()
@@ -474,9 +481,9 @@ handlers crypto _ CookieRequestType = Just $ MethodHandler (isCookieReques
474handlers _ _ DHTRequestType = Just $ NoReply (isDHTRequest snd) $ dhtRequestH 481handlers _ _ DHTRequestType = Just $ NoReply (isDHTRequest snd) $ dhtRequestH
475handlers _ _ typ = error $ "TODO DHT handlers " ++ show typ 482handlers _ _ typ = error $ "TODO DHT handlers " ++ show typ
476 483
477nodeSearch :: Client -> Search NodeId (IP,PortNumber) () NodeInfo NodeInfo 484nodeSearch :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> Search NodeId (IP,PortNumber) () NodeInfo NodeInfo
478nodeSearch client = Search 485nodeSearch 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 }