diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 2ed4aae24..3dab2ab39 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -106,6 +106,7 @@ module Simplex.Messaging.Agent rcDiscoverCtrl, getAgentServersSummary, resetAgentServersStats, + getAgentSubsSummary, foregroundAgent, suspendAgent, execAgentStoreSQL, diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index ec8424745..0a25e4741 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -93,6 +93,7 @@ module Simplex.Messaging.Agent.Client ServerSessions (..), SMPServerSubs (..), getAgentServersSummary, + getAgentSubsSummary, getAgentSubscriptions, slowNetworkConfig, protocolClientError, @@ -1997,6 +1998,15 @@ data ServerSessions = ServerSessions } deriving (Show) +getAgentSubsSummary :: AgentClient -> IO (Map UserId SMPServerSubs) +getAgentSubsSummary c = do + subs <- M.foldrWithKey' (addSub incActive) M.empty <$> readTVarIO (getRcvQueues $ activeSubs c) + M.foldrWithKey' (addSub incPending) subs <$> readTVarIO (getRcvQueues $ pendingSubs c) + where + addSub f (userId, _, _) _ = M.alter (Just . f . fromMaybe SMPServerSubs {ssActive = 0, ssPending = 0}) userId + incActive ss = ss {ssActive = ssActive ss + 1} + incPending ss = ss {ssPending = ssPending ss + 1} + getAgentServersSummary :: AgentClient -> IO AgentServersSummary getAgentServersSummary c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt, agentEnv} = do sss <- mapM getAgentSMPServerStats =<< readTVarIO smpServersStats