teminal: option to log errors and service messages to file, closes #1516 (#1957)

* teminal: option to log errors and service messages to file, closes #1516

* rename function

src/Simplex/Chat.hs

@@ -138,7 +138,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, defaultServers, inlineFiles} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
+newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
   let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
       config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'}
       sendNotification = fromMaybe (const $ pure ()) sendToast
@@ -163,7 +163,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   cleanupManagerAsync <- newTVarIO Nothing
   timedItemThreads <- atomically TM.empty
   showLiveItems <- newTVarIO False
-  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems}
+  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, logFilePath = logFile}
   where
     configServers :: DefaultAgentServers
     configServers =

src/Simplex/Chat/Controller.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
@@ -165,7 +166,8 @@ data ChatController = ChatController
     expireCIFlags :: TMap UserId Bool,
     cleanupManagerAsync :: TVar (Maybe (Async ())),
     timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))),
-    showLiveItems :: TVar Bool
+    showLiveItems :: TVar Bool,
+    logFilePath :: Maybe FilePath
   }
 
 data HelpSection = HSMain | HSFiles | HSGroups | HSMyAddress | HSMarkdown | HSMessages | HSSettings
@@ -487,6 +489,25 @@ data ChatResponse
   | CRChatError {user_ :: Maybe User, chatError :: ChatError}
   deriving (Show, Generic)
 
+logResponseToFile :: ChatResponse -> Bool
+logResponseToFile = \case
+  CRContactsDisconnected {} -> True
+  CRContactsSubscribed {} -> True
+  CRContactSubError {} -> True
+  CRMemberSubError {} -> True
+  CRSndFileSubError {} -> True
+  CRRcvFileSubError {} -> True
+  CRHostConnected {} -> True
+  CRHostDisconnected {} -> True
+  CRConnectionDisabled {} -> True
+  CRAgentRcvQueueDeleted {} -> True
+  CRAgentConnDeleted {} -> True
+  CRAgentUserDeleted {} -> True
+  CRChatCmdError {} -> True
+  CRChatError {} -> True
+  CRMessageError {} -> True
+  _ -> False
+
 instance ToJSON ChatResponse where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"

src/Simplex/Chat/Core.hs

@@ -14,11 +14,12 @@ import Simplex.Chat.Types
 import UnliftIO.Async
 
 simplexChatCore :: ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> (User -> ChatController -> IO ()) -> IO ()
-simplexChatCore cfg@ChatConfig {yesToMigrations} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} sendToast chat
+simplexChatCore cfg@ChatConfig {yesToMigrations} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} sendToast chat =
-  | logAgent = do
+  case logAgent of
-    setLogLevel LogInfo -- LogError
+    Just level -> do
-    withGlobalLogging logCfg initRun
+      setLogLevel level
-  | otherwise = initRun
+      withGlobalLogging logCfg initRun
+    _ -> initRun
   where
     initRun = do
       db@ChatDatabase {chatStore} <- createChatDatabase dbFilePrefix dbKey yesToMigrations

src/Simplex/Chat/Mobile.hs

@@ -134,7 +134,8 @@ mobileChatOpts dbFilePrefix dbKey =
             logLevel = CLLImportant,
             logConnections = False,
             logServerHosts = True,
-            logAgent = False,
+            logAgent = Nothing,
+            logFile = Nothing,
             tbqSize = 1024
           },
       chatCmd = "",

src/Simplex/Chat/Options.hs

@@ -16,6 +16,7 @@ module Simplex.Chat.Options
   )
 where
 
+import Control.Logger.Simple (LogLevel (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Numeric.Natural (Natural)
@@ -46,10 +47,19 @@ data CoreChatOpts = CoreChatOpts
     logLevel :: ChatLogLevel,
     logConnections :: Bool,
     logServerHosts :: Bool,
-    logAgent :: Bool,
+    logAgent :: Maybe LogLevel,
+    logFile :: Maybe FilePath,
     tbqSize :: Natural
   }
 
+agentLogLevel :: ChatLogLevel -> LogLevel
+agentLogLevel = \case
+  CLLDebug -> LogDebug
+  CLLInfo -> LogInfo
+  CLLWarning -> LogWarn
+  CLLError -> LogError
+  CLLImportant -> LogInfo
+
 coreChatOptsP :: FilePath -> FilePath -> Parser CoreChatOpts
 coreChatOptsP appDir defaultDbFileName = do
   dbFilePrefix <-
@@ -125,6 +135,12 @@ coreChatOptsP appDir defaultDbFileName = do
       ( long "log-agent"
           <> help "Enable logs from SMP agent (also with `-l debug`)"
       )
+  logFile <-
+    optional $
+      strOption
+        ( long "log-file"
+            <> help "Log to specified file / device"
+        )
   tbqSize <-
     option
       auto
@@ -144,7 +160,8 @@ coreChatOptsP appDir defaultDbFileName = do
         logLevel,
         logConnections = logConnections || logLevel <= CLLInfo,
         logServerHosts = logServerHosts || logLevel <= CLLInfo,
-        logAgent = logAgent || logLevel == CLLDebug,
+        logAgent = if logAgent || logLevel == CLLDebug then Just $ agentLogLevel logLevel else Nothing,
+        logFile,
         tbqSize
       }
   where

src/Simplex/Chat/Terminal/Output.hs

@@ -19,6 +19,7 @@ import Simplex.Chat.Messages hiding (NewChatItem (..))
 import Simplex.Chat.Styled
 import Simplex.Chat.View
 import System.Console.ANSI.Types
+import System.IO (IOMode (..), hPutStrLn, withFile)
 import System.Mem.Weak (Weak)
 import System.Terminal
 import System.Terminal.Internal (LocalTerminal, Terminal, VirtualTerminal)
@@ -91,17 +92,19 @@ withTermLock ChatTerminal {termLock} action = do
   atomically $ putTMVar termLock ()
 
 runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
-runTerminalOutput ct cc@ChatController {outputQ, showLiveItems} = do
+runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = do
   forever $ do
     (_, r) <- atomically $ readTBQueue outputQ
     case r of
       CRNewChatItem _ ci -> markChatItemRead ci
       CRChatItemUpdated _ ci -> markChatItemRead ci
       _ -> pure ()
+    let printResp = case logFilePath of
+          Just path -> if logResponseToFile r then logResponse path else printToTerminal ct
+          _ -> printToTerminal ct
     liveItems <- readTVarIO showLiveItems
-    printRespToTerminal ct cc liveItems r
+    responseString cc liveItems r >>= printResp
   where
-    markChatItemRead :: AChatItem -> IO ()
     markChatItemRead (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) =
       case (muted chat item, itemStatus) of
         (False, CISRcvNew) -> do
@@ -109,12 +112,16 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems} = do
               chatRef = chatInfoToRef chat
           void $ runReaderT (runExceptT $ processChatCommand (APIChatRead chatRef (Just (itemId, itemId)))) cc
         _ -> pure ()
+    logResponse path s = withFile path AppendMode $ \h -> mapM_ (hPutStrLn h . unStyle) s
 
 printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> ChatResponse -> IO ()
-printRespToTerminal ct cc liveItems r = do
+printRespToTerminal ct cc liveItems r = responseString cc liveItems r >>= printToTerminal ct
+
+responseString :: ChatController -> Bool -> ChatResponse -> IO [StyledString]
+responseString cc liveItems r = do
   user <- readTVarIO $ currentUser cc
   ts <- getCurrentTime
-  printToTerminal ct $ responseToView user (config cc) liveItems ts r
+  pure $ responseToView user (config cc) liveItems ts r
 
 printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
 printToTerminal ct s =

tests/ChatClient.hs

@@ -59,8 +59,9 @@ testOpts =
             logLevel = CLLImportant,
             logConnections = False,
             logServerHosts = False,
-            logAgent = False,
+            logAgent = Nothing,
-            tbqSize = 64
+            logFile = Nothing,
+            tbqSize = 16
           },
       chatCmd = "",
       chatCmdDelay = 3,
@@ -91,7 +92,7 @@ data TestCC = TestCC
   }
 
 aCfg :: AgentConfig
-aCfg = agentConfig defaultChatConfig
+aCfg = (agentConfig defaultChatConfig) {tbqSize = 16}
 
 testAgentCfg :: AgentConfig
 testAgentCfg = aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}}
@@ -100,7 +101,8 @@ testCfg :: ChatConfig
 testCfg =
   defaultChatConfig
     { agentConfig = testAgentCfg,
-      testView = True
+      testView = True,
+      tbqSize = 16
     }
 
 testAgentCfgV1 :: AgentConfig