diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2025-06-08 22:03:17 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-06-10 22:23:31 +0200 |
| commit | 614e557db3ce4123377f04d84c0c3ac9474e53db (patch) | |
| tree | 6110e93a8ec65f36963517d76ab7b13f6aca29f3 | |
| parent | 987f25596b0c718bd2fa800da9423524cc1a6988 (diff) | |
Update instead of replacing discovery peer info
| -rw-r--r-- | src/Erebos/Discovery.hs | 30 |
1 files changed, 14 insertions, 16 deletions
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs index 0ae4925..28388e9 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -160,6 +160,14 @@ data DiscoveryPeer = DiscoveryPeer , dpIceSession :: Maybe IceSession } +emptyPeer :: DiscoveryPeer +emptyPeer = DiscoveryPeer + { dpPriority = 0 + , dpPeer = Nothing + , dpAddress = [] + , dpIceSession = Nothing + } + data DiscoveryPeerState = DiscoveryPeerState { dpsStunServer :: Maybe ( Text, Word16 ) , dpsTurnServer :: Maybe ( Text, Word16 ) @@ -284,13 +292,8 @@ instance Service DiscoveryService where Left err -> putStrLn $ "Discovery: failed to send connection request: " ++ err runAsService $ do - let dp = DiscoveryPeer - { dpPriority = 0 - , dpPeer = Nothing - , dpAddress = [] - , dpIceSession = Just ice - } - svcModifyGlobal $ \s -> s { dgsPeers = M.insert dgst dp $ dgsPeers s } + let upd dp = dp { dpIceSession = Just ice } + svcModifyGlobal $ \s -> s { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) dgst $ dgsPeers s } Nothing -> do return () @@ -303,13 +306,8 @@ instance Service DiscoveryService where getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port) peer <- serverPeer server (addrAddress saddr) runAsService $ do - let dp = DiscoveryPeer - { dpPriority = 0 - , dpPeer = Just peer - , dpAddress = [] - , dpIceSession = Nothing - } - svcModifyGlobal $ \s -> s { dgsPeers = M.insert dgst dp $ dgsPeers s } + let upd dp = dp { dpPeer = Just peer } + svcModifyGlobal $ \s -> s { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) dgst $ dgsPeers s } | otherwise -> do svcPrint $ "Discovery: invalid address in result: " ++ T.unpack addr @@ -361,9 +359,9 @@ instance Service DiscoveryService where saddr <- liftIO $ head <$> getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port) peer <- liftIO $ serverPeer server (addrAddress saddr) + let upd dp = dp { dpPeer = Just peer } svcModifyGlobal $ \s -> s - { dgsPeers = M.insert (either refDigest id $ dconnTarget conn) - (DiscoveryPeer 0 (Just peer) [] Nothing) $ dgsPeers s } + { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) (either refDigest id $ dconnTarget conn) $ dgsPeers s } #ifdef ENABLE_ICE_SUPPORT | Just dp <- M.lookup (either refDigest id $ dconnTarget conn) dpeers |