From 8f3abc22cff98472b4d74d0c2f7985b4cceca300 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 16 Aug 2026 16:34:16 +0200
Subject: Discovery: use the via field in search for own devices

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

(limited to 'src/Erebos/Discovery.hs')

diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index 6c86e83..db7bd04 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -360,14 +360,23 @@ instance Service DiscoveryService where
                                     offerTunnel <- offerTunnelBetween attrs peer sp >>= return . \case
                                         True  -> (++ [ DiscoveryTunnel ])
                                         False -> id
-                                    let results = offerTunnel matchedAddrs
+                                    let discoveryAddrs = offerTunnel matchedAddrs
+                                    let ( results, via )
+                                            | dgst == (refDigest $ storedRef $ idData pid)
+                                            = ( discoveryAddrs, [] )
+                                            | otherwise
+                                            -- Results should be empty for this case (not searching exactly for the device id),
+                                            -- but keep compatibility for now.
+                                            = ( discoveryAddrs, [ DiscoveryVia (refDigest $ storedRef $ idData pid) discoveryAddrs ] )
+
                                     debugLog $
                                         "found for " <> show (refDigest $ storedRef $ idData spid) <>
                                         " dgst " <> show dgst <>
-                                        " result [" <> T.unpack (T.intercalate "," $ map toText results) <> "]"
+                                        " result [" <> T.unpack (T.intercalate "," $ map toText results) <> "]" <>
+                                        " via " <> show (map (\v -> ( viaIdentity v, map toText $ viaAddress v )) via)
                                     -- Try to promote weak ref to normal one for older peers:
                                     edgst <- maybe (Right dgst) Left <$> liftIO (refFromDigest st dgst)
-                                    replyPacket $ DiscoveryResult edgst results []
+                                    replyPacket $ DiscoveryResult edgst results via
                             debugLog $
                                 "remains asked by " <> show (refDigest $ storedRef $ idData spid) <>
                                 ": " <> show (M.keys peerSearchingFor')
@@ -404,7 +413,8 @@ instance Service DiscoveryService where
                     replyPacket $ DiscoveryResult edgst results via
                     debugLog $ "search by " <> show (refDigest $ storedRef $ idData pid) <>
                         " for " <> show (either refDigest id edgst) <>
-                        " result [" <> T.unpack (T.intercalate "," $ map toText results) <> "]"
+                        " result [" <> T.unpack (T.intercalate "," $ map toText results) <> "]" <>
+                        " via " <> show (map (\v -> ( viaIdentity v, map toText $ viaAddress v )) via)
 
                 Nothing -> do
                     now <- liftIO $ getTime Monotonic
@@ -417,7 +427,7 @@ instance Service DiscoveryService where
                     debugLog $ "peer " <> show (refDigest $ storedRef $ idData pid) <>
                         " searching for " <> show (M.keys seachingFor')
 
-        DiscoveryResult edgst addrs _ -> do
+        DiscoveryResult edgst addrs via -> do
             let dgst = either refDigest id edgst
             server <- asks svcServer
             st <- getStorage
@@ -430,6 +440,7 @@ instance Service DiscoveryService where
             debugLog $
                 "result from " <> show (refDigest $ storedRef $ idData pid) <>
                 " for " <> show dgst <> ": [" <> T.unpack (T.intercalate "," $ map toText addrs) <> "]" <>
+                " via " <> show (map (\v -> ( viaIdentity v, map toText $ viaAddress v )) via) <>
                 (if askedFor then "" else " (not asked for)")
 
             when askedFor $ do
@@ -490,7 +501,12 @@ instance Service DiscoveryService where
                     [] -> debugLog $ "no (supported) address received for " <> show dgst
 
             when askedFor $ do
-                tryAddresses addrs
+                tryAddresses $ concat
+                    -- ignore direct connections for self/owner
+                    [ if dgst `elem` identityDigests self then [] else addrs
+                    ] ++
+                    -- ignore connections via ourselves
+                    concat (map viaAddress $ filter ((refDigest (storedRef (idData self)) /=) . viaIdentity) via)
 
         DiscoveryConnectionRequest conn -> do
             self <- svcSelf
-- 
cgit v1.2.3