core: add debug info for subscriptions (#3014)

cabal.project

@@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 17a1a911d885eae8b939fd6deaa797f3dc72289c
+    tag: 980e5c4d1ec15f44290542fd2a5d1c08456f00d1
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."17a1a911d885eae8b939fd6deaa797f3dc72289c" = "03530jwrdn3skmyzhvaml01j41lynl0m2ym0wvppj19sckg7a6mh";
+  "https://github.com/simplex-chat/simplexmq.git"."980e5c4d1ec15f44290542fd2a5d1c08456f00d1" = "1lqciyy215dvmbhykyp80bwipqmxybv39p6jff6vjgd5r34958nh";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";

src/Simplex/Chat.hs

@@ -25,7 +25,7 @@ import Crypto.Random (drgNew)
 import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Bifunctor (bimap, first, second)
+import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -41,7 +41,6 @@ import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
-import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -1757,17 +1756,17 @@ processChatCommand = \case
   ResetAgentStats -> withAgent resetAgentStats >> ok_
   GetAgentSubs -> summary <$> withAgent getAgentSubscriptions
     where
-      summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions} =
-        CRAgentSubs {activeSubs, distinctActiveSubs, pendingSubs, distinctPendingSubs}
+      summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions} =
+        CRAgentSubs
+          { activeSubs = foldl' countSubs M.empty activeSubscriptions,
+            pendingSubs = foldl' countSubs M.empty pendingSubscriptions,
+            removedSubs = foldl' accSubErrors M.empty removedSubscriptions
+          }
         where
-          (activeSubs, distinctActiveSubs) = foldSubs activeSubscriptions
-          (pendingSubs, distinctPendingSubs) = foldSubs pendingSubscriptions
-          foldSubs :: [SubInfo] -> (Map Text Int, Map Text Int)
-          foldSubs = second (M.map S.size) . foldl' acc (M.empty, M.empty)
-          acc (m, m') SubInfo {server, rcvId} =
-            ( M.alter (Just . maybe 1 (+ 1)) server m,
-              M.alter (Just . maybe (S.singleton rcvId) (S.insert rcvId)) server m'
-            )
+          countSubs m SubInfo {server} = M.alter (Just . maybe 1 (+ 1)) server m
+          accSubErrors m = \case
+            SubInfo {server, subError = Just e} -> M.alter (Just . maybe [e] (e :)) server m
+            _ -> m
   GetAgentSubsDetails -> CRAgentSubsDetails <$> withAgent getAgentSubscriptions
   where
     withChatLock name action = asks chatLock >>= \l -> withLock l name action

src/Simplex/Chat/Controller.hs

@@ -573,7 +573,7 @@ data ChatResponse
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
   | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
   | CRAgentStats {agentStats :: [[String]]}
-  | CRAgentSubs {activeSubs :: Map Text Int, distinctActiveSubs :: Map Text Int, pendingSubs :: Map Text Int, distinctPendingSubs :: Map Text Int}
+  | CRAgentSubs {activeSubs :: Map Text Int, pendingSubs :: Map Text Int, removedSubs :: Map Text [String]}
   | CRAgentSubsDetails {agentSubs :: SubscriptionsInfo}
   | CRConnectionDisabled {connectionEntity :: ConnectionEntity}
   | CRAgentRcvQueueDeleted {agentConnId :: AgentConnId, server :: SMPServer, agentQueueId :: AgentQueueId, agentError_ :: Maybe AgentErrorType}

src/Simplex/Chat/View.hs

@@ -20,6 +20,7 @@ import Data.Int (Int64)
 import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
+import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
 import Data.Text (Text)
@@ -262,17 +263,18 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
       plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)
     ]
   CRAgentStats stats -> map (plain . intercalate ",") stats
-  CRAgentSubs {activeSubs, distinctActiveSubs, pendingSubs, distinctPendingSubs} ->
-    [plain $ "Subscriptions: active = " <> show (sum activeSubs) <> ", distinct active = " <> show (sum distinctActiveSubs) <> ", pending = " <> show (sum pendingSubs) <> ", distinct pending = " <> show (sum distinctPendingSubs)]
+  CRAgentSubs {activeSubs, pendingSubs, removedSubs} ->
+    [plain $ "Subscriptions: active = " <> show (sum activeSubs) <> ", pending = " <> show (sum pendingSubs) <> ", removed = " <> show (sum $ M.map length removedSubs)]
       <> ("active subscriptions:" : listSubs activeSubs)
-      <> ("distinct active subscriptions:" : listSubs distinctActiveSubs)
       <> ("pending subscriptions:" : listSubs pendingSubs)
-      <> ("distinct pending subscriptions:" : listSubs distinctPendingSubs)
+      <> ("removed subscriptions:" : listSubs removedSubs)
     where
-      listSubs = map (\(srv, count) -> plain $ srv <> ": " <> tshow count) . M.assocs
-  CRAgentSubsDetails SubscriptionsInfo {activeSubscriptions, pendingSubscriptions} ->
+      listSubs :: Show a => Map Text a -> [StyledString]
+      listSubs = map (\(srv, info) -> plain $ srv <> ": " <> tshow info) . M.assocs
+  CRAgentSubsDetails SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions} ->
     ("active subscriptions:" : map sShow activeSubscriptions)
       <> ("pending subscriptions: " : map sShow pendingSubscriptions)
+      <> ("removed subscriptions: " : map sShow removedSubscriptions)
   CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
   CRAgentRcvQueueDeleted acId srv aqId err_ ->
     [ ("completed deleting rcv queue, agent connection id: " <> sShow acId)

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 17a1a911d885eae8b939fd6deaa797f3dc72289c
+    commit: 980e5c4d1ec15f44290542fd2a5d1c08456f00d1
   - github: kazu-yamamoto/http2
     commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
   # - ../direct-sqlcipher