diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2025-07-27 23:25:12 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-07-27 23:25:12 +0200 |
commit | e43bdb1b58d68916524e7efa10df40f39edebe71 (patch) | |
tree | c04a3a7c1166c84dcec8a8fa911bffcef381e7a6 /src/Erebos | |
parent | 70e4a32784ba4a06af43a3eaf2c7db246330b868 (diff) |
Explicit tunnel option in discovery result
Diffstat (limited to 'src/Erebos')
-rw-r--r-- | src/Erebos/Discovery.hs | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs index 63f5cf1..3c15f94 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -292,7 +292,12 @@ instance Service DiscoveryService where DiscoverySearch edgst -> do dpeer <- M.lookup (either refDigest id edgst) . dgsPeers <$> svcGetGlobal - replyPacket $ DiscoveryResult edgst $ maybe [] dpAddress dpeer + peer <- asks svcPeer + attrs <- asks svcAttributes + let offerTunnel + | discoveryProvideTunnel attrs peer = (++ [ DiscoveryTunnel ]) + | otherwise = id + replyPacket $ DiscoveryResult edgst $ maybe [] (offerTunnel . dpAddress) dpeer DiscoveryResult _ [] -> do -- not found @@ -345,6 +350,9 @@ instance Service DiscoveryService where #endif tryAddresses rest + DiscoveryTunnel : _ -> do + discoverySetupTunnelResponse dgst + addr : rest -> do svcPrint $ "Discovery: unsupported address in result: " ++ T.unpack (toText addr) tryAddresses rest @@ -629,6 +637,10 @@ receiveFromTunnel server taddr = do discoverySetupTunnel :: Peer -> RefDigest -> IO () discoverySetupTunnel via target = do runPeerService via $ do + discoverySetupTunnelResponse target + +discoverySetupTunnelResponse :: RefDigest -> ServiceHandler DiscoveryService () +discoverySetupTunnelResponse target = do self <- refDigest . storedRef . idData <$> svcSelf stream <- openStream svcModify $ \s -> s { dpsOurTunnelRequests = ( target, stream ) : dpsOurTunnelRequests s } |