From bf60571e6c2e74e3c604a95b039e0db40e046624 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 18 Aug 2026 19:23:52 +0200
Subject: Discovery: include tunnel in via addresses

---
 src/Erebos/Discovery.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

(limited to 'src/Erebos')

diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index db7bd04..9cddbb2 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -229,13 +229,15 @@ emptyPeer = DiscoveryPeer
     , dpIceSession = Nothing
     }
 
-viaFromPeer :: DiscoveryPeer -> IO (Maybe DiscoveryVia)
-viaFromPeer DiscoveryPeer {..}
-    | Just peer <- dpPeer
-    , viaAddress@(_ : _) <- dpAddress
+viaFromPeer :: DiscoveryAttributes -> Peer -> DiscoveryPeer -> IO (Maybe DiscoveryVia)
+viaFromPeer attrs peer DiscoveryPeer {..}
+    | Just dpeer <- dpPeer
+    , _ : _ <- dpAddress
     = do
-        getPeerIdentity peer >>= \case
+        getPeerIdentity dpeer >>= \case
             PeerIdentityFull pid -> do
+                offerTunnel <- offerTunnelBetween attrs peer dpeer
+                let viaAddress = (if offerTunnel then (++ [ DiscoveryTunnel ]) else id) dpAddress
                 let viaIdentity = refDigest $ storedRef $ idData pid
                 return $ Just DiscoveryVia {..}
             _ -> return Nothing
@@ -409,7 +411,7 @@ instance Service DiscoveryService where
                             False -> id
                         Nothing -> return id
                     let results = offerTunnel $ maybe [] dpAddress $ rvDirect rv
-                    via <- liftIO $ fmap catMaybes $ mapM viaFromPeer $ rvVia rv
+                    via <- liftIO $ fmap catMaybes $ mapM (viaFromPeer attrs peer) $ rvVia rv
                     replyPacket $ DiscoveryResult edgst results via
                     debugLog $ "search by " <> show (refDigest $ storedRef $ idData pid) <>
                         " for " <> show (either refDigest id edgst) <>
-- 
cgit v1.2.3