dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-05-30 13:44:18 +00:00
Code Issues Packages Projects Releases Wiki Activity

group sessions

Browse Source
This commit is contained in:
spaced4ndy
2024-07-05 21:16:12 +04:00
parent 2069b86e6b
commit adde613492
2 changed files with 11 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Agent/Client.hs
+8 -2
View File
@@ -938,9 +938,11 @@ reconnectSMPServerClients c = do
-- 3. close clients
mapM_ (liftIO . forkIO . closeClient_ c) clients
-- 4. resubscribe pending subscriptions
mode <- liftIO $ getSessionMode c
pending <- readTVarIO (getRcvQueues $ pendingSubs c)
forM_ (M.toList pending) $ \((userId, srv, rId), _) ->
resubscribeSMPSession c (userId, srv, Just rId)
-- Group transport sessions to avoid multiple UP events in case session mode is TSMUser
let tSessions = queuesToSessions pending mode
forM_ tSessions $ \tSess -> resubscribeSMPSession c tSess
where
groupConnsByServer :: Map (UserId, SMPServer, RecipientId) RcvQueue -> Map SMPServer [ConnId]
groupConnsByServer = foldl' insertConnId M.empty
@@ -950,6 +952,10 @@ reconnectSMPServerClients c = do
M.insertWith (<>) server [connId] acc
notifyDOWN :: SMPServer -> [ConnId] -> IO ()
notifyDOWN server connIds = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone (DOWN server connIds))
queuesToSessions :: Map (UserId, SMPServer, RecipientId) RcvQueue -> TransportSessionMode -> Set SMPTransportSession
queuesToSessions qs mode = case mode of
TSMEntity -> M.foldrWithKey (\(userId, srv, rId) _ acc -> S.insert (userId, srv, Just rId) acc) S.empty qs
TSMUser -> M.foldrWithKey (\(userId, srv, _) _ acc -> S.insert (userId, srv, Nothing) acc) S.empty qs
reconnectSMPServer :: AgentClient -> UserId -> SMPServer -> IO ()
reconnectSMPServer c userId srv = do
tests/AgentTests/FunctionalAPITests.hs
+3 -8
View File
@@ -2828,6 +2828,7 @@ testTwoUsers = withAgentClients2 $ \a b -> do
liftIO $ threadDelay 250000
("", "", DOWN _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
a `hasClients` 2
exchangeGreetingsMsgId 4 a bId1 b aId1
@@ -2836,8 +2837,6 @@ testTwoUsers = withAgentClients2 $ \a b -> do
liftIO $ setNetworkConfig a nc {sessionMode = TSMUser}
liftIO $ threadDelay 250000
("", "", DOWN _ _) <- nGet a
("", "", DOWN _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
a `hasClients` 1
@@ -2851,7 +2850,8 @@ testTwoUsers = withAgentClients2 $ \a b -> do
liftIO $ setNetworkConfig a nc {sessionMode = TSMEntity}
liftIO $ threadDelay 250000
("", "", DOWN _ _) <- nGet a
("", "", DOWN _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
a `hasClients` 4
@@ -2863,11 +2863,6 @@ testTwoUsers = withAgentClients2 $ \a b -> do
liftIO $ setNetworkConfig a nc {sessionMode = TSMUser}
liftIO $ threadDelay 250000
("", "", DOWN _ _) <- nGet a
("", "", DOWN _ _) <- nGet a
("", "", DOWN _ _) <- nGet a
("", "", DOWN _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
("", "", UP _ _) <- nGet a
a `hasClients` 2