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-14 15:45:06 +0200 |
| commit | 934d7c13bc144e8db23c53058e605f508c1fda77 (patch) | |
| tree | 5744cb6c3e9f6e804f95aedccf60550395283f1c | |
| parent | cc7ac84b840973f602c4e59cca22bf304321db6b (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 9b6eccf..d203866 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -147,6 +147,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 ) @@ -263,13 +271,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 () @@ -282,13 +285,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 @@ -340,9 +338,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 (refDigest $ dconnTarget conn) - (DiscoveryPeer 0 (Just peer) [] Nothing) $ dgsPeers s } + { dgsPeers = M.alter (Just . upd . fromMaybe emptyPeer) (refDigest $ dconnTarget conn) $ dgsPeers s } #ifdef ENABLE_ICE_SUPPORT | Just dp <- M.lookup (refDigest $ dconnTarget conn) dpeers |