core: command to debug user network state

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: 2d2cc86bd82a5c604901ae813a6cbcc21f3e2024
+    tag: 7d30eb6548e81df197931e755b8b6853774d622a
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."2d2cc86bd82a5c604901ae813a6cbcc21f3e2024" = "0gny4qywp2hda9fqs5gm3zkr8vd4jriy3iqp7ap7bwc12is6n8zw";
+  "https://github.com/simplex-chat/simplexmq.git"."7d30eb6548e81df197931e755b8b6853774d622a" = "07fs1y6mamkiz6cxv94n2palismxc0yi5mjwb03jla6hfvqdrmxp";
   "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";

src/Simplex/Chat.hs

@@ -91,7 +91,7 @@ import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescr
 import qualified Simplex.FileTransfer.Description as FD
 import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
 import Simplex.Messaging.Agent as Agent
-import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentWorkersDetails, getAgentWorkersSummary, temporaryAgentError, withLockMap)
+import Simplex.Messaging.Agent.Client (AgentStatsKey (..), agentClientStore, getAgentWorkersDetails, getAgentWorkersSummary, temporaryAgentError, withLockMap)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
 import Simplex.Messaging.Agent.Lock (withLock)
 import Simplex.Messaging.Agent.Protocol
@@ -2225,20 +2225,9 @@ processChatCommand' vr = \case
     counts <- map (first decodeLatin1) <$> withAgent' getMsgCounts
     let allMsgs = foldl' (\(ts, ds) (_, (t, d)) -> (ts + t, ds + d)) (0, 0) counts
     pure CRAgentMsgCounts {msgCounts = ("all", allMsgs) : sortOn (Down . snd) (filter (\(_, (_, d)) -> d /= 0) counts)}
-  GetAgentSubs -> lift $ summary <$> withAgent' getAgentSubscriptions
-    where
-      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
-          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 -> lift $ CRAgentSubsDetails <$> withAgent' getAgentSubscriptions
+  GetAgentUserNetworkState ->
+    CRAgentUserNetworkState <$> (readTVarIO =<< asks (userNetworkState . smpAgent))
+  GetAgentSubs diff -> withUser $ \User {userId} -> lift $ CRAgentSubs <$> withAgent' (\a -> getAgentSubscriptions a diff (Just userId))
   -- CustomChatCommand is unsupported, it can be processed in preCmdHook
   -- in a modified CLI app or core - the hook should return Either ChatResponse ChatCommand
   CustomChatCommand _cmd -> withUser $ \user -> pure $ chatCmdError (Just user) "not supported"
@@ -7381,11 +7370,11 @@ chatCommandP =
       "/debug event " *> (DebugEvent <$> jsonP),
       "/get stats" $> GetAgentStats,
       "/reset stats" $> ResetAgentStats,
-      "/get subs" $> GetAgentSubs,
-      "/get subs details" $> GetAgentSubsDetails,
+      "/get subs" *> (GetAgentSubs <$> (" diff" $> True <|> pure False)),
       "/get workers" $> GetAgentWorkers,
       "/get workers details" $> GetAgentWorkersDetails,
       "/get msgs" $> GetAgentMsgCounts,
+      "/debug net" $> GetAgentUserNetworkState,
       "//" *> (CustomChatCommand <$> A.takeByteString)
     ]
   where

src/Simplex/Chat/Controller.hs

@@ -67,7 +67,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, AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, UserNetworkInfo)
+import Simplex.Messaging.Agent.Client (AgentLocks, AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, UserNetworkInfo, UNSOffline, UserNetworkState)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
@@ -497,11 +497,11 @@ data ChatCommand
   | DebugEvent ChatResponse
   | GetAgentStats
   | ResetAgentStats
-  | GetAgentSubs
-  | GetAgentSubsDetails
+  | GetAgentSubs {diffOnly :: Bool}
   | GetAgentWorkers
   | GetAgentWorkersDetails
   | GetAgentMsgCounts
+  | GetAgentUserNetworkState
   | -- The parser will return this command for strings that start from "//".
     -- This command should be processed in preCmdHook
     CustomChatCommand ByteString
@@ -745,9 +745,9 @@ data ChatResponse
   | CRAgentStats {agentStats :: [[String]]}
   | CRAgentWorkersDetails {agentWorkersDetails :: AgentWorkersDetails}
   | CRAgentWorkersSummary {agentWorkersSummary :: AgentWorkersSummary}
-  | CRAgentSubs {activeSubs :: Map Text Int, pendingSubs :: Map Text Int, removedSubs :: Map Text [String]}
-  | CRAgentSubsDetails {agentSubs :: SubscriptionsInfo}
+  | CRAgentSubs {agentSubs :: SubscriptionsInfo}
   | CRAgentMsgCounts {msgCounts :: [(Text, (Int, Int))]}
+  | CRAgentUserNetworkState {networkState :: UserNetworkState}
   | CRContactDisabled {user :: User, contact :: Contact}
   | CRConnectionDisabled {connectionEntity :: ConnectionEntity}
   | CRAgentRcvQueueDeleted {agentConnId :: AgentConnId, server :: SMPServer, agentQueueId :: AgentQueueId, agentError_ :: Maybe AgentErrorType}
@@ -1480,6 +1480,10 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCSR") ''RemoteCtrlStopReason)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RHSR") ''RemoteHostStopReason)
 
+$(JQ.deriveJSON defaultJSON ''UNSOffline)
+
+$(JQ.deriveJSON defaultJSON ''UserNetworkState)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
 
 $(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)

src/Simplex/Chat/View.hs

@@ -22,7 +22,6 @@ 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)
@@ -52,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 (ActivePendingSubs (..), ProtocolTestFailure (..), ProtocolTestStep (..), SubInfo (..), SubscriptionsInfo (..))
 import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
@@ -358,24 +357,21 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
       plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)
     ]
   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)]
-      <> ("active subscriptions:" : listSubs activeSubs)
-      <> ("pending subscriptions:" : listSubs pendingSubs)
-      <> ("removed subscriptions:" : listSubs removedSubs)
+  CRAgentSubs SubscriptionsInfo {summary, servers} -> "Subscriptions:" : activePending summary <> concatMap (uncurry byServer) (M.assocs servers)
     where
-      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)
+      byServer srv aps = plain srv : activePending aps
+      activePending ActivePendingSubs {active_, pending_} =
+        [ "  active: " <> subInfo active_,
+          "  pending: " <> subInfo pending_
+        ]
+      subInfo SubInfo {count, clientsMissing, clientsExtra} = sShow count <> " (clients: -" <> sShow clientsMissing <> " +" <> sShow clientsExtra <> ")"
   CRAgentWorkersSummary {agentWorkersSummary} -> ["agent workers summary: " <> plain (LB.unpack $ J.encode agentWorkersSummary)]
   CRAgentWorkersDetails {agentWorkersDetails} ->
     [ "agent workers details:",
       plain . LB.unpack $ J.encode agentWorkersDetails -- this would be huge, but copypastable when has its own line
     ]
   CRAgentMsgCounts {msgCounts} -> ["received messages (total, duplicates):", plain . LB.unpack $ J.encode msgCounts]
+  CRAgentUserNetworkState {networkState} -> ["user network state:", plain . LB.unpack $ J.encode networkState]
   CRContactDisabled u c -> ttyUser u ["[" <> ttyContact' c <> "] connection is disabled, to enable: " <> highlight ("/enable " <> viewContactName c) <> ", to delete: " <> highlight ("/d " <> viewContactName c)]
   CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
   CRAgentRcvQueueDeleted acId srv aqId err_ ->