diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-16 16:34:16 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-18 19:25:19 +0200 |
| commit | 8f3abc22cff98472b4d74d0c2f7985b4cceca300 (patch) | |
| tree | 42bf5c68b7b35752e1868c000ff60556b3c61f13 /src | |
| parent | bba8c1f5dba992dd0699992d72c600b067a09a04 (diff) | |
Discovery: use the via field in search for own devices
Diffstat (limited to 'src')
| -rw-r--r-- | src/Erebos/Discovery.hs | 28 |
1 files changed, 22 insertions, 6 deletions
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 |