core: agent stats (#1650)

cabal.project

@@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: fb21d9836e07706c7498baa967f932cb11b818e5
+    tag: 267236a4f8d2787d59ad1f9a0be40f3f4eb898dd
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."fb21d9836e07706c7498baa967f932cb11b818e5" = "0dl08ag38d1azzil1xxi6xrzqwfcv550wi5kjdmxn4h820icl2ja";
+  "https://github.com/simplex-chat/simplexmq.git"."267236a4f8d2787d59ad1f9a0be40f3f4eb898dd" = "0vn0sn2486rdr3wm2937q7rr58bj0bgqbblrsr29ys96qkvlkykd";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0";
   "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";

src/Simplex/Chat.hs

@@ -57,6 +57,7 @@ import Simplex.Chat.Store
 import Simplex.Chat.Types
 import Simplex.Chat.Util (diffInMicros, diffInSeconds)
 import Simplex.Messaging.Agent as Agent
+import Simplex.Messaging.Agent.Client (AgentStatsKey (..))
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), AgentDatabase (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
@@ -134,7 +135,7 @@ createChatDatabase filePrefix key yesToMigrations = do
   pure ChatDatabase {chatStore, agentStore}
 
 newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
-newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers, inlineFiles} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts, allowInstantFiles} sendToast = do
+newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers, inlineFiles} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts, optFilesFolder, allowInstantFiles} sendToast = do
   let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
       config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'}
       sendNotification = fromMaybe (const $ pure ()) sendToast
@@ -151,7 +152,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   sndFiles <- newTVarIO M.empty
   rcvFiles <- newTVarIO M.empty
   currentCalls <- atomically TM.empty
-  filesFolder <- newTVarIO Nothing
+  filesFolder <- newTVarIO optFilesFolder
   incognitoMode <- newTVarIO False
   chatStoreChanged <- newTVarIO False
   expireCIsAsync <- newTVarIO Nothing
@@ -1198,6 +1199,11 @@ processChatCommand = \case
     chatLockName <- atomically . tryReadTMVar =<< asks chatLock
     agentLocks <- withAgent debugAgentLocks
     pure CRDebugLocks {chatLockName, agentLocks}
+  GetAgentStats -> CRAgentStats . map stat <$> withAgent getAgentStats
+    where
+      stat (AgentStatsKey {host, clientTs, cmd, res}, count) =
+        map B.unpack [host, clientTs, cmd, res, bshow count]
+  ResetAgentStats -> CRCmdOk <$ withAgent resetAgentStats
   where
     withChatLock name action = asks chatLock >>= \l -> withLock l name action
     -- below code would make command responses asynchronous where they can be slow
@@ -3786,7 +3792,9 @@ chatCommandP =
       "/incognito " *> (SetIncognito <$> onOffP),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
       ("/version" <|> "/v") $> ShowVersion,
-      "/debug locks" $> DebugLocks
+      "/debug locks" $> DebugLocks,
+      "/get stats" $> GetAgentStats,
+      "/reset stats" $> ResetAgentStats
     ]
   where
     choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput)

src/Simplex/Chat/Controller.hs

@@ -280,6 +280,8 @@ data ChatCommand
   | QuitChat
   | ShowVersion
   | DebugLocks
+  | GetAgentStats
+  | ResetAgentStats
   deriving (Show)
 
 data ChatResponse
@@ -411,6 +413,7 @@ data ChatResponse
   | CRContactConnectionDeleted {connection :: PendingContactConnection}
   | CRSQLResult {rows :: [Text]}
   | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
+  | CRAgentStats {agentStats :: [[String]]}
   | CRMessageError {severity :: Text, errorMessage :: Text}
   | CRChatCmdError {chatError :: ChatError}
   | CRChatError {chatError :: ChatError}

src/Simplex/Chat/Mobile.hs

@@ -129,6 +129,7 @@ mobileChatOpts =
       chatCmd = "",
       chatCmdDelay = 3,
       chatServerPort = Nothing,
+      optFilesFolder = Nothing,
       allowInstantFiles = True,
       maintenance = True
     }

src/Simplex/Chat/Options.hs

@@ -34,6 +34,7 @@ data ChatOpts = ChatOpts
     chatCmd :: String,
     chatCmdDelay :: Int,
     chatServerPort :: Maybe String,
+    optFilesFolder :: Maybe FilePath,
     allowInstantFiles :: Bool,
     maintenance :: Bool
   }
@@ -127,9 +128,16 @@ chatOpts appDir defaultDbFileName = do
           <> help "Run chat server on specified port"
           <> value Nothing
       )
+  optFilesFolder <-
+    optional $
+      strOption
+        ( long "files-folder"
+            <> metavar "FOLDER"
+            <> help "Folder to use for sent and received files"
+      )
   allowInstantFiles <-
     switch
-      ( long "--allow-instant-files"
+      ( long "allow-instant-files"
           <> short 'f'
           <> help "Send and receive instant files without acceptance"
       )
@@ -151,6 +159,7 @@ chatOpts appDir defaultDbFileName = do
         chatCmd,
         chatCmdDelay,
         chatServerPort,
+        optFilesFolder,
         allowInstantFiles,
         maintenance
       }

src/Simplex/Chat/View.hs

@@ -216,6 +216,7 @@ responseToView user_ testView liveItems ts = \case
     [ maybe "no chat lock" (("chat lock: " <>) . plain) chatLockName,
       plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)
     ]
+  CRAgentStats stats -> map (plain . intercalate ",") stats
   CRMessageError prefix err -> [plain prefix <> ": " <> plain err]
   CRChatError e -> viewChatError e
   where

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: fb21d9836e07706c7498baa967f932cb11b818e5
+    commit: 267236a4f8d2787d59ad1f9a0be40f3f4eb898dd
   # - ../direct-sqlcipher
   - github: simplex-chat/direct-sqlcipher
     commit: 34309410eb2069b029b8fc1872deb1e0db123294

tests/ChatClient.hs

@@ -59,6 +59,7 @@ testOpts =
       chatCmd = "",
       chatCmdDelay = 3,
       chatServerPort = Nothing,
+      optFilesFolder = Nothing,
       allowInstantFiles = True,
       maintenance = False
     }