summaryrefslogtreecommitdiff
path: root/src/Erebos
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-07-27 23:25:12 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-07-27 23:25:12 +0200
commite43bdb1b58d68916524e7efa10df40f39edebe71 (patch)
treec04a3a7c1166c84dcec8a8fa911bffcef381e7a6 /src/Erebos
parent70e4a32784ba4a06af43a3eaf2c7db246330b868 (diff)
Explicit tunnel option in discovery result
Diffstat (limited to 'src/Erebos')
-rw-r--r--src/Erebos/Discovery.hs14
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 }