From 614e557db3ce4123377f04d84c0c3ac9474e53db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 8 Jun 2025 22:03:17 +0200
Subject: Update instead of replacing discovery peer info

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

(limited to 'src')

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
-- 
cgit v1.2.3