diff options
Diffstat (limited to 'dht/src')
-rw-r--r-- | dht/src/Network/QueryResponse.hs | 4 | ||||
-rw-r--r-- | dht/src/Network/Tox.hs | 11 | ||||
-rw-r--r-- | dht/src/Network/Tox/DHT/Handlers.hs | 27 |
3 files changed, 28 insertions, 14 deletions
diff --git a/dht/src/Network/QueryResponse.hs b/dht/src/Network/QueryResponse.hs index 89723da2..44039ee0 100644 --- a/dht/src/Network/QueryResponse.hs +++ b/dht/src/Network/QueryResponse.hs | |||
@@ -161,6 +161,10 @@ partitionTransport parse encodex tr = | |||
161 | -- * f add x --> Nothing, consume x | 161 | -- * f add x --> Nothing, consume x |
162 | -- --> Just id, leave x to a different handler | 162 | -- --> Just id, leave x to a different handler |
163 | -- --> Just g, apply g to x and leave that to a different handler | 163 | -- --> Just g, apply g to x and leave that to a different handler |
164 | -- | ||
165 | -- Note: If you add a handler to one of the branches before applying a | ||
166 | -- 'mergeTransports' combinator, then this handler may not block or return | ||
167 | -- Nothing. | ||
164 | addHandler :: (err -> IO ()) -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x | 168 | addHandler :: (err -> IO ()) -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x |
165 | addHandler onParseError f tr = tr | 169 | addHandler onParseError f tr = tr |
166 | { awaitMessage = \kont -> fix $ \eat -> awaitMessage tr $ \case | 170 | { awaitMessage = \kont -> fix $ \eat -> awaitMessage tr $ \case |
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs index 60b793af..f17bad2c 100644 --- a/dht/src/Network/Tox.hs +++ b/dht/src/Network/Tox.hs | |||
@@ -327,9 +327,16 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do | |||
327 | tbl4 = DHT.routing4 $ mkrouting (error "missing client") | 327 | tbl4 = DHT.routing4 $ mkrouting (error "missing client") |
328 | tbl6 = DHT.routing6 $ mkrouting (error "missing client") | 328 | tbl6 = DHT.routing6 $ mkrouting (error "missing client") |
329 | updateOnion bkts tr = hookBucketList DHT.toxSpace bkts orouter (trampolinesUDP orouter) tr | 329 | updateOnion bkts tr = hookBucketList DHT.toxSpace bkts orouter (trampolinesUDP orouter) tr |
330 | updateOnUDP client = DHT.updateRouting client (mkrouting client) updateOnion | ||
331 | -- -- I was going to update the kademlia tables on onion responses so | ||
332 | -- -- that there is a pool of nodes to search without UDP, but it is a | ||
333 | -- -- bad idea because the kademlia table update algorithm requires the | ||
334 | -- -- ability to do a ping and it's not clear what that ping operation | ||
335 | -- -- should be. | ||
336 | -- updateOnTCP = const $ DHT.updateTable dhtclient (mkrouting client) updateOnion . udpNodeInfo | ||
330 | 337 | ||
331 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id | 338 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id |
332 | (\client net -> onInbound (DHT.updateRouting client (mkrouting client) updateOnion) net) | 339 | (\client net -> onInbound (updateOnUDP client) net) |
333 | 340 | ||
334 | hscache <- newHandshakeCache crypto (sendMessage handshakes) | 341 | hscache <- newHandshakeCache crypto (sendMessage handshakes) |
335 | let sparams = SessionParams | 342 | let sparams = SessionParams |
@@ -351,7 +358,7 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do | |||
351 | 358 | ||
352 | onioncrypt <- mergeTransports $ DMap.fromList | 359 | onioncrypt <- mergeTransports $ DMap.fromList |
353 | [ Multi.OnionUDP :=> ByAddress onioncryptUDP | 360 | [ Multi.OnionUDP :=> ByAddress onioncryptUDP |
354 | , Multi.OnionTCP :=> ByAddress onioncryptTCP ] | 361 | , Multi.OnionTCP :=> ByAddress {- $ onInbound updateOnTCP -} onioncryptTCP ] |
355 | oniondrg <- drgNew | 362 | oniondrg <- drgNew |
356 | let onionnet = layerTransportM | 363 | let onionnet = layerTransportM |
357 | (\msg od -> Onion.decrypt crypto msg $ Multi.untagOnion od) | 364 | (\msg od -> Onion.decrypt crypto msg $ Multi.untagOnion od) |
diff --git a/dht/src/Network/Tox/DHT/Handlers.hs b/dht/src/Network/Tox/DHT/Handlers.hs index 5156ec44..73bc2229 100644 --- a/dht/src/Network/Tox/DHT/Handlers.hs +++ b/dht/src/Network/Tox/DHT/Handlers.hs | |||
@@ -445,30 +445,33 @@ updateRouting client routing orouter naddr0 msg | |||
445 | forM_ m $ mapM_ $ \NodeInfoCallback{interestingNodeId,observedAddress} -> do | 445 | forM_ m $ mapM_ $ \NodeInfoCallback{interestingNodeId,observedAddress} -> do |
446 | when (interestingNodeId == nodeId naddr) | 446 | when (interestingNodeId == nodeId naddr) |
447 | $ observedAddress now naddr | 447 | $ observedAddress now naddr |
448 | case prefer4or6 (Multi.UDP ==> naddr) Nothing of | 448 | updateTable client routing orouter naddr |
449 | Want_IP4 -> updateTable client naddr orouter (committee4 routing) (refresher4 routing) | ||
450 | Want_IP6 -> updateTable client naddr orouter (committee6 routing) (refresher6 routing) | ||
451 | Want_Both -> do dput XMisc "BUG:unreachable" | ||
452 | error $ "BUG:unreachable at " ++ __FILE__ ++ ":" ++ show __LINE__ | ||
453 | 449 | ||
454 | updateTable :: Client -> NodeInfo | 450 | updateTable :: Client -> Routing |
455 | -> (TVar (R.BucketList NodeInfo) -> RoutingTransition NodeInfo -> STM ()) | 451 | -> (TVar (R.BucketList NodeInfo) -> RoutingTransition NodeInfo -> STM ()) |
456 | -> TriadCommittee NodeId SockAddr | 452 | -> NodeInfo |
457 | -> BucketRefresher NodeId NodeInfo | ||
458 | -> IO () | 453 | -> IO () |
459 | updateTable client naddr orouter committee refresher = do | 454 | updateTable client routing orouter naddr = do |
455 | case prefer4or6 (Multi.UDP ==> naddr) Nothing of | ||
456 | Want_IP4 -> go (committee4 routing) (refresher4 routing) | ||
457 | Want_IP6 -> go (committee6 routing) (refresher6 routing) | ||
458 | Want_Both -> do dput XMisc "BUG:unreachable" | ||
459 | error $ "BUG:unreachable at " ++ __FILE__ ++ ":" ++ show __LINE__ | ||
460 | where | ||
461 | go :: TriadCommittee NodeId SockAddr -> BucketRefresher NodeId NodeInfo -> IO () | ||
462 | go committee refresher = do | ||
460 | self <- atomically $ R.thisNode <$> readTVar (refreshBuckets refresher) | 463 | self <- atomically $ R.thisNode <$> readTVar (refreshBuckets refresher) |
461 | -- dput XMisc $ "(tox)updateRouting: " ++ show (nodeIP self, nodeIP naddr) | 464 | -- dput XMisc $ "(tox)updateRouting: " ++ show (nodeIP self, nodeIP naddr) |
462 | when (self /= naddr) $ do | 465 | when (self /= naddr) $ do |
463 | -- TODO: IP address vote? | 466 | -- TODO: IP address vote? |
464 | insertNode (toxKademlia client committee orouter refresher) naddr | 467 | insertNode (toxKademlia client orouter committee refresher) naddr |
465 | 468 | ||
466 | toxKademlia :: Client | 469 | toxKademlia :: Client |
467 | -> TriadCommittee NodeId SockAddr | ||
468 | -> (TVar (R.BucketList NodeInfo) -> RoutingTransition NodeInfo -> STM ()) | 470 | -> (TVar (R.BucketList NodeInfo) -> RoutingTransition NodeInfo -> STM ()) |
471 | -> TriadCommittee NodeId SockAddr | ||
469 | -> BucketRefresher NodeId NodeInfo | 472 | -> BucketRefresher NodeId NodeInfo |
470 | -> Kademlia NodeId NodeInfo | 473 | -> Kademlia NodeId NodeInfo |
471 | toxKademlia client committee orouter refresher | 474 | toxKademlia client orouter committee refresher |
472 | = Kademlia quietInsertions | 475 | = Kademlia quietInsertions |
473 | toxSpace | 476 | toxSpace |
474 | (vanillaIO (refreshBuckets refresher) $ pingUDP client) | 477 | (vanillaIO (refreshBuckets refresher) $ pingUDP client) |