GetAgentSubsSummary api

2026-04-25 22:52:12 +00:00 · 2024-06-26 13:39:56 +04:00
parent 9268c9762e
commit d7d9e69b6f
6 changed files with 39 additions and 16 deletions
--- a/cabal.project
+++ b/cabal.project
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
    type: git
    location: https://github.com/simplex-chat/simplexmq.git
-    tag: c7886926870e97fa592d51fa36a2cdec49296388
+    tag: 9459964d204d0717f04cecf3473c2387461905ae

 source-repository-package
    type: git
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."c7886926870e97fa592d51fa36a2cdec49296388" = "1r3nibcgw3whl0q3ssyr1606x4ilqphhzqyihi3aw4nw5fmz226h";
+  "https://github.com/simplex-chat/simplexmq.git"."9459964d204d0717f04cecf3473c2387461905ae" = "0yrcdc07q86kaw35y3pk52chgmxhv5yc348wd2fw89p7lfqcgwwy";
  "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
  "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
  "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -20,7 +20,6 @@ import Control.Applicative (optional, (<|>))
 import Control.Concurrent.STM (retry)
 import Control.Logger.Simple
 import Control.Monad
-import Simplex.Chat.Stats
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -72,6 +71,7 @@ import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Stats
 import Simplex.Chat.Store
 import Simplex.Chat.Store.AppSettings
 import Simplex.Chat.Store.Connections
@@ -95,7 +95,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
 import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
-import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getNetworkConfig', ipAddressProtected, withLockMap)
+import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SMPServerSubs (..), SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getNetworkConfig', ipAddressProtected, withLockMap)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
 import Simplex.Messaging.Agent.Lock (withLock)
 import Simplex.Messaging.Agent.Protocol
@@ -113,7 +113,7 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (base64P)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol, ProtocolServer)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
@@ -2269,6 +2269,18 @@ processChatCommand' vr = \case
        let srvs = if null servers then L.toList defServers else servers
        pure $ map protoServer srvs
  ResetAgentServersStats -> withAgent resetAgentServersStats >> ok_
+  GetAgentSubsSummary userId -> withUserId userId $ \user -> do
+    agentSubsSummary <- lift $ withAgent' getAgentSubsSummary
+    users <- withStore' getUsers
+    let subs = countSubs agentSubsSummary user users
+    pure $ CRAgentSubsSummary user subs
+    where
+      countSubs agentSubsSummary user users = do
+        M.foldrWithKey' addSubs SMPServerSubs {ssActive = 0, ssPending = 0} agentSubsSummary
+        where
+          addSubs auId subs subsAcc
+            | countUserInAllStats (AgentUserId auId) user users = addSMPSubs subs subsAcc
+            | otherwise = subsAcc
  GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary
  GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails
  GetAgentStats -> lift $ CRAgentStats . map stat <$> withAgent' getAgentStats
@@ -7629,6 +7641,7 @@ chatCommandP =
      "/debug event " *> (DebugEvent <$> jsonP),
      "/get servers summary " *> (GetAgentServersSummary <$> A.decimal),
      "/reset servers stats" $> ResetAgentServersStats,
+      "/get subs summary " *> (GetAgentSubsSummary <$> A.decimal),
      "/get stats" $> GetAgentStats,
      "/reset stats" $> ResetAgentStats,
      "/get subs" $> GetAgentSubs,
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -69,7 +69,7 @@ import Simplex.Chat.Types.UITheme
 import Simplex.Chat.Util (liftIOEither)
 import Simplex.FileTransfer.Description (FileDescriptionURI)
 import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
-import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, UserNetworkInfo)
+import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, SMPServerSubs, UserNetworkInfo)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
@@ -508,6 +508,7 @@ data ChatCommand
  | DebugEvent ChatResponse
  | GetAgentServersSummary UserId
  | ResetAgentServersStats
+  | GetAgentSubsSummary UserId
  | GetAgentStats
  | ResetAgentStats
  | GetAgentSubs
@@ -760,6 +761,7 @@ data ChatResponse
  | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
  | CRDebugLocks {chatLockName :: Maybe String, chatEntityLocks :: Map String String, agentLocks :: AgentLocks}
  | CRAgentServersSummary {user :: User, serversSummary :: PresentedServersSummary}
+  | CRAgentSubsSummary {user :: User, subsSummary :: SMPServerSubs}
  | CRAgentStats {agentStats :: [[String]]}
  | CRAgentWorkersDetails {agentWorkersDetails :: AgentWorkersDetails}
  | CRAgentWorkersSummary {agentWorkersSummary :: AgentWorkersSummary}
--- a/src/Simplex/Chat/Stats.hs
+++ b/src/Simplex/Chat/Stats.hs
@@ -5,7 +5,6 @@

 module Simplex.Chat.Stats where

-import Control.Applicative ((<|>))
 import qualified Data.Aeson.TH as J
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -113,8 +112,7 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
    }
  where
    AgentServersSummary {statsStartedAt, smpServersSessions, smpServersSubs, smpServersStats, xftpServersSessions, xftpServersStats, xftpRcvInProgress, xftpSndInProgress, xftpDelInProgress} = agentSummary
-    countUserInAll auId = auId == aUserId currentUser || auId `notElem` hiddenUserIds
-    hiddenUserIds = map aUserId $ filter (isJust . viewPwdHash) users
+    countUserInAll auId = countUserInAllStats (AgentUserId auId) currentUser users
    smpSummsIntoCategories :: Map SMPServer SMPServerSummary -> ([SMPServerSummary], [SMPServerSummary], [SMPServerSummary])
    smpSummsIntoCategories = foldr partitionSummary ([], [], [])
      where
@@ -213,12 +211,6 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
          ssErrors = ssErrors ss1 + ssErrors ss2,
          ssConnecting = ssConnecting ss1 + ssConnecting ss2
        }
-    addSMPSubs :: SMPServerSubs -> SMPServerSubs -> SMPServerSubs
-    addSMPSubs ss1 ss2 =
-      SMPServerSubs
-        { ssActive = ssActive ss1 + ssActive ss2,
-          ssPending = ssPending ss1 + ssPending ss2
-        }
    addSMPStats :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData
    addSMPStats sd1 sd2 =
      AgentSMPServerStatsData
@@ -236,6 +228,8 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
          _recvDuplicates = _recvDuplicates sd1 + _recvDuplicates sd2,
          _recvCryptoErrs = _recvCryptoErrs sd1 + _recvCryptoErrs sd2,
          _recvErrs = _recvErrs sd1 + _recvErrs sd2,
+          _ackMsgs = _ackMsgs sd1 + _ackMsgs sd2,
+          _ackAttempts = _ackAttempts sd1 + _ackAttempts sd2,
          _connCreated = _connCreated sd1 + _connCreated sd2,
          _connSecured = _connSecured sd1 + _connSecured sd2,
          _connCompleted = _connCompleted sd1 + _connCompleted sd2,
@@ -259,6 +253,19 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
          _deleteErrs = _deleteErrs sd1 + _deleteErrs sd2
        }

+countUserInAllStats :: AgentUserId -> User -> [User] -> Bool
+countUserInAllStats (AgentUserId auId) currentUser users =
+  auId == aUserId currentUser || auId `notElem` hiddenUserIds
+  where
+    hiddenUserIds = map aUserId $ filter (isJust . viewPwdHash) users
+
+addSMPSubs :: SMPServerSubs -> SMPServerSubs -> SMPServerSubs
+addSMPSubs ss1 ss2 =
+  SMPServerSubs
+    { ssActive = ssActive ss1 + ssActive ss2,
+      ssPending = ssPending ss1 + ssPending ss2
+    }
+
 $(J.deriveJSON defaultJSON ''SMPServerSummary)

 $(J.deriveJSON defaultJSON ''XFTPServerSummary)
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -51,7 +51,7 @@ import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
 import qualified Simplex.FileTransfer.Transport as XFTP
-import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
+import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SMPServerSubs (..), SubscriptionsInfo (..))
 import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
@@ -366,6 +366,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
      "agent locks: " <> viewJSON agentLocks
    ]
  CRAgentServersSummary u serversSummary -> ttyUser u ["agent servers summary: " <> viewJSON serversSummary]
+  CRAgentSubsSummary u SMPServerSubs {ssActive, ssPending} -> ttyUser u ["agent subscriptions summary: active = " <> sShow ssActive <> ", pending = " <> sShow ssPending]
  CRAgentStats stats -> map (plain . intercalate ",") stats
  CRAgentSubs {activeSubs, pendingSubs, removedSubs} ->
    [plain $ "Subscriptions: active = " <> show (sum activeSubs) <> ", pending = " <> show (sum pendingSubs) <> ", removed = " <> show (sum $ M.map length removedSubs)]