core: set log level, log events

apps/simplex-directory-service/src/Directory/Service.hs

@@ -31,7 +31,7 @@ import Directory.Search
 import Directory.Store
 import Simplex.Chat.Bot
 import Simplex.Chat.Bot.KnownContacts
-import Simplex.Chat.Controller
+import Simplex.Chat.Controller hiding (logError, logInfo)
 import Simplex.Chat.Core
 import Simplex.Chat.Messages
 import Simplex.Chat.Options
@@ -586,7 +586,8 @@ directoryService st DirectoryOpts {superUsers, serviceName, searchResults, testi
             sendChatCmdStr cc cmdStr >>= \r -> do
               ts <- getCurrentTime
               tz <- getCurrentTimeZone
-              sendReply $ serializeChatResponse (Nothing, Just user) ts tz Nothing r
+              ll <- readTVarIO $ appLogLevel cc
+              sendReply $ serializeChatResponse (Nothing, Just user) ll ts tz Nothing r
           DCCommandError tag -> sendReply $ "Command error: " <> show tag
       | otherwise = sendReply "You are not allowed to use this command"
       where

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: 1116aeeea1869e0de38e9faccea76b329b549804
+    tag: 71489fe6fca70f32f18137186bab2b77304f11b0
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."1116aeeea1869e0de38e9faccea76b329b549804" = "07ynn7f70hfsdrirmhb9zd257bx90d29l5gjyhh50wd12gaqdm0w";
+  "https://github.com/simplex-chat/simplexmq.git"."71489fe6fca70f32f18137186bab2b77304f11b0" = "18inrqiab269w7dw1isjrijgnycv0dz0bp1y9sq5z9fykvwg5rlh";
   "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

@@ -17,7 +17,7 @@ module Simplex.Chat where
 
 import Control.Applicative (optional, (<|>))
 import Control.Concurrent.STM (retry)
-import Control.Logger.Simple
+import Control.Logger.Simple (LogConfig (..))
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -155,7 +155,6 @@ defaultChatConfig =
       autoAcceptFileSize = 0,
       showReactions = False,
       showReceipts = False,
-      logLevel = CLLImportant,
       subscriptionEvents = False,
       hostEvents = False,
       testView = False,
@@ -218,7 +217,7 @@ newChatController
   ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, optTempDirectory, showReactions, allowInstantFiles, autoAcceptFileSize}
   backgroundMode = do
     let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
-        config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
+        config = cfg {showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
         firstTime = dbNew chatStore
     currentUser <- newTVarIO user
     currentRemoteHost <- newTVarIO Nothing
@@ -241,6 +240,7 @@ newChatController
     remoteHostSessions <- atomically TM.empty
     remoteHostsFolder <- newTVarIO Nothing
     remoteCtrlSession <- newTVarIO Nothing
+    appLogLevel <- newTVarIO logLevel
     filesFolder <- newTVarIO optFilesFolder
     chatStoreChanged <- newTVarIO False
     expireCIThreads <- newTVarIO M.empty
@@ -279,6 +279,7 @@ newChatController
           remoteHostsFolder,
           remoteCtrlSession,
           config,
+          appLogLevel,
           filesFolder,
           expireCIThreads,
           expireCIFlags,
@@ -436,18 +437,19 @@ restoreCalls = do
   calls <- asks currentCalls
   atomically $ writeTVar calls callsMap
 
-stopChatController :: ChatController -> IO ()
+stopChatController :: ChatController -> CM' ()
 stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do
   readTVarIO remoteHostSessions >>= mapM_ (cancelRemoteHost False . snd)
-  atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (cancelRemoteCtrl False . snd)
-  disconnectAgentClient smpAgent
-  readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
-  closeFiles sndFiles
-  closeFiles rcvFiles
-  atomically $ do
-    keys <- M.keys <$> readTVar expireCIFlags
-    forM_ keys $ \k -> TM.insert k False expireCIFlags
-    writeTVar s Nothing
+  liftIO $ do
+    atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (cancelRemoteCtrl False . snd)
+    disconnectAgentClient smpAgent
+    readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2)
+    closeFiles sndFiles
+    closeFiles rcvFiles
+    atomically $ do
+      keys <- M.keys <$> readTVar expireCIFlags
+      forM_ keys $ \k -> TM.insert k False expireCIFlags
+      writeTVar s Nothing
   where
     closeFiles :: TVar (Map Int64 Handle) -> IO ()
     closeFiles files = do
@@ -601,7 +603,7 @@ processChatCommand' vr = \case
       Just _ -> pure CRChatRunning
       _ -> checkStoreNotChanged . lift $ startChatController mainApp $> CRChatStarted
   APIStopChat -> do
-    ask >>= liftIO . stopChatController
+    ask >>= lift . stopChatController
     pure CRChatStopped
   APIActivateChat restoreChat -> withUser $ \_ -> do
     lift $ when restoreChat restoreCalls
@@ -2199,6 +2201,10 @@ processChatCommand' vr = \case
     chatMigrations <- map upMigration <$> withStore' (Migrations.getCurrent . DB.conn)
     agentMigrations <- withAgent getAgentMigrations
     pure $ CRVersionInfo {versionInfo, chatMigrations, agentMigrations}
+  SetAppLogLevel ll -> do
+    chatWriteVar appLogLevel ll
+    lift $ withAgent' (`setAgentLogLevel` toLogLevel ll)
+    ok_
   DebugLocks -> lift $ do
     chatLockName <- atomically . tryReadTMVar =<< asks chatLock
     chatEntityLocks <- getLocks =<< asks entityLocks
@@ -3629,6 +3635,7 @@ processAgentMessageNoConn = \case
   UP srv conns -> serverEvent srv conns NSConnected CRContactsSubscribed
   SUSPENDED -> toView CRChatSuspended
   DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId
+  LOG ll s -> toView $ CRAgentLog ll s
   where
     hostEvent :: ChatResponse -> CM ()
     hostEvent = whenM (asks $ hostEvents . config) . toView
@@ -7377,6 +7384,7 @@ chatCommandP =
       "/_download " *> (APIDownloadStandaloneFile <$> A.decimal <* A.space <*> strP_ <*> cryptoFileP),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
       ("/version" <|> "/v") $> ShowVersion,
+      "/log " *> (SetAppLogLevel <$> strP),
       "/debug locks" $> DebugLocks,
       "/debug event " *> (DebugEvent <$> jsonP),
       "/get stats" $> GetAgentStats,

src/Simplex/Chat/Bot.hs

@@ -85,9 +85,9 @@ textMsgContent :: String -> MsgContent
 textMsgContent = MCText . T.pack
 
 printLog :: ChatController -> ChatLogLevel -> String -> IO ()
-printLog cc level s
-  | logLevel (config cc) <= level = putStrLn s
-  | otherwise = pure ()
+printLog cc level s = do
+  ll <- readTVarIO $ appLogLevel cc
+  when (ll <= level) $ putStrLn s
 
 contactInfo :: Contact -> String
 contactInfo Contact {contactId, localDisplayName} = T.unpack localDisplayName <> " (" <> show contactId <> ")"

src/Simplex/Chat/Controller.hs

@@ -19,6 +19,8 @@ module Simplex.Chat.Controller where
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
 import Control.Exception
+import qualified Control.Logger.Simple as Logger
+import Control.Monad (when)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -139,7 +141,6 @@ data ChatConfig = ChatConfig
     showReceipts :: Bool,
     subscriptionEvents :: Bool,
     hostEvents :: Bool,
-    logLevel :: ChatLogLevel,
     testView :: Bool,
     initialCleanupManagerDelay :: Int64,
     cleanupManagerInterval :: NominalDiffTime,
@@ -221,6 +222,7 @@ data ChatController = ChatController
     remoteHostsFolder :: TVar (Maybe FilePath), -- folder for remote hosts data
     remoteCtrlSession :: TVar (Maybe (SessionSeq, RemoteCtrlSession)), -- Supervisor process for hosted controllers
     config :: ChatConfig,
+    appLogLevel :: TVar ChatLogLevel,
     filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
     expireCIThreads :: TMap UserId (Maybe (Async ())),
     expireCIFlags :: TMap UserId Bool,
@@ -493,6 +495,7 @@ data ChatCommand
   | APIStandaloneFileInfo FileDescriptionURI
   | QuitChat
   | ShowVersion
+  | SetAppLogLevel ChatLogLevel
   | DebugLocks
   | DebugEvent ChatResponse
   | GetAgentStats
@@ -757,6 +760,8 @@ data ChatResponse
   | CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
   | CRChatError {user_ :: Maybe User, chatError :: ChatError}
   | CRChatErrors {user_ :: Maybe User, chatErrors :: [ChatError]}
+  | CRAgentLog {agentLogLevel :: AgentLogLevel, errorMessage :: Text}
+  | CRChatLog {chatLogLevel :: ChatLogLevel, errorMessage :: Text}
   | CRArchiveImported {archiveErrors :: [ArchiveError]}
   | CRAppSettings {appSettings :: AppSettings}
   | CRTimedAction {action :: String, durationMilliseconds :: Int64}
@@ -1053,6 +1058,30 @@ tmeToPref currentTTL tme = uncurry TimedMessagesPreference $ case tme of
 data ChatLogLevel = CLLDebug | CLLInfo | CLLWarning | CLLError | CLLImportant
   deriving (Eq, Ord, Show)
 
+instance StrEncoding ChatLogLevel where
+  strEncode = \case
+    CLLDebug -> "debug"
+    CLLInfo -> "info"
+    CLLWarning -> "warn"
+    CLLError -> "error"
+    CLLImportant -> "important"
+  strP =
+    A.takeTill (== ' ')
+      >>= \case
+        "debug" -> pure CLLDebug
+        "info" -> pure CLLInfo
+        "warn" -> pure CLLWarning
+        "error" -> pure CLLError
+        "important" -> pure CLLImportant
+        _ -> fail "Invalid log level"
+
+instance ToJSON ChatLogLevel where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+instance FromJSON ChatLogLevel where
+  parseJSON = strParseJSON "ChatLogLevel"
+
 data CoreVersionInfo = CoreVersionInfo
   { version :: String,
     simplexmqVersion :: String,
@@ -1397,6 +1426,34 @@ withAgent action =
 withAgent' :: (AgentClient -> IO a) -> CM' a
 withAgent' action = asks smpAgent >>= liftIO . action
 
+logDebug :: Text -> CM ()
+logDebug = lift . logDebug'
+{-# INLINE logDebug #-}
+
+logDebug' :: Text -> CM' ()
+logDebug' s = logToView CLLDebug s >> Logger.logDebug s
+
+logInfo :: Text -> CM ()
+logInfo s = lift (logToView CLLInfo s) >> Logger.logInfo s
+
+logWarn :: Text -> CM ()
+logWarn s = lift (logToView CLLWarning s) >> Logger.logWarn s
+
+logError :: Text -> CM ()
+logError = lift . logError'
+{-# INLINE logError #-}
+
+logError' :: Text -> CM' ()
+logError' s = logToView CLLError s >> Logger.logError s
+
+logImportant :: Text -> CM ()
+logImportant s = lift (logToView CLLImportant s) >> Logger.logError s
+
+logToView :: ChatLogLevel -> Text -> CM' ()
+logToView ll' s = do
+  ll <- chatReadVar' appLogLevel
+  when (ll' >= ll) $ toView' $ CRChatLog ll s
+
 $(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CLQ") ''ChatListQuery)

src/Simplex/Chat/Core.hs

@@ -11,6 +11,7 @@ module Simplex.Chat.Core
   )
 where
 
+import Control.Concurrent.STM
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Reader
@@ -110,7 +111,8 @@ createActiveUser cc = do
         r -> do
           ts <- getCurrentTime
           tz <- getCurrentTimeZone
-          putStrLn $ serializeChatResponse (Nothing, Nothing) ts tz Nothing r
+          ll <- readTVarIO $ appLogLevel cc
+          putStrLn $ serializeChatResponse (Nothing, Nothing) ll ts tz Nothing r
           loop
 
 getWithPrompt :: String -> IO String

src/Simplex/Chat/Mobile.hs

@@ -193,7 +193,7 @@ mobileChatOpts dbFilePrefix =
             smpServers = [],
             xftpServers = [],
             networkConfig = defaultNetworkConfig,
-            logLevel = CLLImportant,
+            logLevel = CLLError,
             logConnections = False,
             logServerHosts = True,
             logAgent = Nothing,
@@ -220,7 +220,6 @@ defaultMobileConfig :: ChatConfig
 defaultMobileConfig =
   defaultChatConfig
     { confirmMigrations = MCYesUp,
-      logLevel = CLLError,
       coreApi = True,
       deviceNameForRemote = "Mobile"
     }

src/Simplex/Chat/Options.hs

@@ -14,6 +14,7 @@ module Simplex.Chat.Options
     getChatOpts,
     protocolServersP,
     fullNetworkConfig,
+    toLogLevel,
   )
 where
 
@@ -68,13 +69,13 @@ data CoreChatOpts = CoreChatOpts
 data ChatCmdLog = CCLAll | CCLMessages | CCLNone
   deriving (Eq)
 
-agentLogLevel :: ChatLogLevel -> LogLevel
-agentLogLevel = \case
+toLogLevel :: ChatLogLevel -> LogLevel
+toLogLevel = \case
   CLLDebug -> LogDebug
   CLLInfo -> LogInfo
   CLLWarning -> LogWarn
   CLLError -> LogError
-  CLLImportant -> LogInfo
+  CLLImportant -> LogError
 
 coreChatOptsP :: FilePath -> FilePath -> Parser CoreChatOpts
 coreChatOptsP appDir defaultDbFileName = do
@@ -194,11 +195,11 @@ coreChatOptsP appDir defaultDbFileName = do
         dbKey,
         smpServers,
         xftpServers,
-        networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel == CLLDebug),
+        networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel <= CLLDebug),
         logLevel,
         logConnections = logConnections || logLevel <= CLLInfo,
         logServerHosts = logServerHosts || logLevel <= CLLInfo,
-        logAgent = if logAgent || logLevel == CLLDebug then Just $ agentLogLevel logLevel else Nothing,
+        logAgent = if logAgent || logLevel <= CLLDebug then Just $ toLogLevel logLevel else Nothing,
         logFile,
         tbqSize,
         highlyAvailable
@@ -342,13 +343,7 @@ protocolServersP :: ProtocolTypeI p => A.Parser [ProtoServerWithAuth p]
 protocolServersP = strP `A.sepBy1` A.char ' '
 
 parseLogLevel :: ReadM ChatLogLevel
-parseLogLevel = eitherReader $ \case
-  "debug" -> Right CLLDebug
-  "info" -> Right CLLInfo
-  "warn" -> Right CLLWarning
-  "error" -> Right CLLError
-  "important" -> Right CLLImportant
-  _ -> Left "Invalid log level"
+parseLogLevel = eitherReader $ strDecode . B.pack
 
 parseChatCmdLog :: ReadM ChatCmdLog
 parseChatCmdLog = eitherReader $ \case

src/Simplex/Chat/Remote.hs

@@ -13,7 +13,6 @@
 module Simplex.Chat.Remote where
 
 import Control.Applicative ((<|>))
-import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
@@ -249,7 +248,7 @@ startRemoteHostSession rhKey = do
 
 closeRemoteHost :: RHKey -> CM ()
 closeRemoteHost rhKey = do
-  logNote $ "Closing remote host session for " <> tshow rhKey
+  logInfo $ "Closing remote host session for " <> tshow rhKey
   cancelRemoteHostSession Nothing rhKey
 
 cancelRemoteHostSession :: Maybe (SessionSeq, RemoteHostStopReason) -> RHKey -> CM ()
@@ -266,7 +265,7 @@ cancelRemoteHostSession handlerInfo_ rhKey = do
           modifyTVar' crh $ \cur -> if (RHId <$> cur) == Just rhKey then Nothing else cur -- only wipe the closing RH
           pure $ Just rhs
   forM_ deregistered $ \session -> do
-    liftIO $ cancelRemoteHost handlingError session `catchAny` (logError . tshow)
+    lift (cancelRemoteHost handlingError session) `catchAny` (logError . tshow)
     forM_ (snd <$> handlerInfo_) $ \rhStopReason ->
       toView CRRemoteHostStopped {remoteHostId_, rhsState = rhsSessionState session, rhStopReason}
   where
@@ -275,25 +274,26 @@ cancelRemoteHostSession handlerInfo_ rhKey = do
       RHNew -> Nothing
       RHId rhId -> Just rhId
 
-cancelRemoteHost :: Bool -> RemoteHostSession -> IO ()
+cancelRemoteHost :: Bool -> RemoteHostSession -> CM' ()
 cancelRemoteHost handlingError = \case
   RHSessionStarting -> pure ()
   RHSessionConnecting _inv rhs -> cancelPendingSession rhs
   RHSessionPendingConfirmation _sessCode tls rhs -> do
     cancelPendingSession rhs
-    closeConnection tls
+    closeConn tls
   RHSessionConfirmed tls rhs -> do
     cancelPendingSession rhs
-    closeConnection tls
+    closeConn tls
   RHSessionConnected {rchClient, tls, rhClient = RemoteHostClient {httpClient}, pollAction} -> do
     uninterruptibleCancel pollAction
-    cancelHostClient rchClient `catchAny` (logError . tshow)
-    closeConnection tls `catchAny` (logError . tshow)
-    unless handlingError $ closeHTTP2Client httpClient `catchAny` (logError . tshow)
+    liftIO (cancelHostClient rchClient) `catchAny` (logError' . tshow)
+    closeConn tls
+    unless handlingError $ liftIO (closeHTTP2Client httpClient) `catchAny` (logError' . tshow)
   where
+    closeConn tls = liftIO (closeConnection tls) `catchAny` (logError' . tshow)
     cancelPendingSession RHPendingSession {rchClient, rhsWaitSession} = do
-      unless handlingError $ uninterruptibleCancel rhsWaitSession `catchAny` (logError . tshow)
-      cancelHostClient rchClient `catchAny` (logError . tshow)
+      unless handlingError $ uninterruptibleCancel rhsWaitSession `catchAny` (logError' . tshow)
+      liftIO (cancelHostClient rchClient) `catchAny` (logError' . tshow)
 
 -- | Generate a random 16-char filepath without / in it by using base64url encoding.
 randomStorePath :: IO FilePath
@@ -495,7 +495,7 @@ parseCtrlAppInfo ctrlAppInfo = do
 
 handleRemoteCommand :: (ByteString -> CM' ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> CM' ()
 handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
-  logDebug "handleRemoteCommand"
+  logDebug' "handleRemoteCommand"
   liftIO (tryRemoteError' parseRequest) >>= \case
     Right (getNext, rc) -> do
       chatReadVar' currentUser >>= \case
@@ -511,7 +511,7 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
     processCommand :: User -> GetChunk -> RemoteCommand -> CM ()
     processCommand user getNext = \case
       RCSend {command} -> lift $ handleSend execChatCommand command >>= reply
-      RCRecv {wait = time} -> lift $ liftIO (handleRecv time remoteOutputQ) >>= reply
+      RCRecv {wait = time} -> lift $ handleRecv time remoteOutputQ >>= reply
       RCStoreFile {fileName, fileSize, fileDigest} -> lift $ handleStoreFile encryption fileName fileSize fileDigest getNext >>= reply
       RCGetFile {file} -> handleGetFile encryption user file replyWith
     reply :: RemoteResponse -> CM' ()
@@ -547,14 +547,14 @@ tryRemoteError' = tryAllErrors' (RPEException . tshow)
 
 handleSend :: (ByteString -> CM' ChatResponse) -> Text -> CM' RemoteResponse
 handleSend execChatCommand command = do
-  logDebug $ "Send: " <> tshow command
+  logDebug' $ "Send: " <> tshow command
   -- execChatCommand checks for remote-allowed commands
   -- convert errors thrown in execChatCommand into error responses to prevent aborting the protocol wrapper
   RRChatResponse <$> execChatCommand (encodeUtf8 command)
 
-handleRecv :: Int -> TBQueue ChatResponse -> IO RemoteResponse
+handleRecv :: Int -> TBQueue ChatResponse -> CM' RemoteResponse
 handleRecv time events = do
-  logDebug $ "Recv: " <> tshow time
+  logDebug' $ "Recv: " <> tshow time
   RRChatEvent <$> (timeout time . atomically $ readTBQueue events)
 
 -- TODO this command could remember stored files and return IDs to allow removing files that are not needed.

src/Simplex/Chat/Terminal/Main.hs

@@ -48,7 +48,8 @@ simplexChatCLI cfg server_ = do
           ts <- getCurrentTime
           tz <- getCurrentTimeZone
           rh <- readTVarIO $ currentRemoteHost cc
-          putStrLn $ serializeChatResponse (rh, Just user) ts tz rh r
+          ll <- readTVarIO $ appLogLevel cc
+          putStrLn $ serializeChatResponse (rh, Just user) ll ts tz rh r
 
 welcome :: ChatOpts -> IO ()
 welcome ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, networkConfig}} =

src/Simplex/Chat/Terminal/Output.hs

@@ -10,7 +10,6 @@
 module Simplex.Chat.Terminal.Output where
 
 import Control.Concurrent (ThreadId)
-import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Catch (MonadMask)
 import Control.Monad.Except
@@ -168,9 +167,10 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} Cha
         _ -> pure ()
     logResponse path s = withFile path AppendMode $ \h -> mapM_ (hPutStrLn h . unStyle) s
     getRemoteUser rhId =
-      runReaderT (execChatCommand (Just rhId) "/user") cc >>= \case
-        CRActiveUser {user} -> updateRemoteUser ct user rhId
-        cr -> logError $ "Unexpected reply while getting remote user: " <> tshow cr
+      flip runReaderT cc $
+        execChatCommand (Just rhId) "/user" >>= \case
+          CRActiveUser {user} -> liftIO $ updateRemoteUser ct user rhId
+          cr -> logError' $ "Unexpected reply while getting remote user: " <> tshow cr
     removeRemoteUser rhId = atomically $ TM.delete rhId (currentRemoteUsers ct)
 
 responseNotification :: ChatTerminal -> ChatController -> ChatResponse -> IO ()
@@ -275,7 +275,8 @@ responseString ct cc liveItems outputRH r = do
   cu <- getCurrentUser ct cc
   ts <- getCurrentTime
   tz <- getCurrentTimeZone
-  pure $ responseToView cu (config cc) liveItems ts tz outputRH r
+  ll <- readTVarIO $ appLogLevel cc
+  pure $ responseToView cu (config cc) ll liveItems ts tz outputRH r
 
 updateRemoteUser :: ChatTerminal -> User -> RemoteHostId -> IO ()
 updateRemoteUser ct user rhId = atomically $ TM.insert rhId user (currentRemoteUsers ct)

src/Simplex/Chat/View.hs

@@ -79,11 +79,11 @@ data WCallCommand
 
 $(JQ.deriveToJSON (taggedObjectJSON $ dropPrefix "WCCall") ''WCallCommand)
 
-serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> String
-serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz remoteHost_
+serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> ChatLogLevel -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> String
+serializeChatResponse user_ logLevel ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig logLevel False ts tz remoteHost_
 
-responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
-responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
+responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> ChatLogLevel -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
+responseToView hu@(currentRH, user_) ChatConfig {showReactions, showReceipts, testView} logLevel liveItems ts tz outputRH = \case
   CRActiveUser User {profile, uiThemes} -> viewUserProfile (fromLocalProfile profile) <> viewUITheme uiThemes
   CRUsersList users -> viewUsersList users
   CRChatStarted -> ["chat started"]
@@ -391,6 +391,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel testView e
   CRChatError u e -> ttyUser' u $ viewChatError logLevel testView e
   CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError logLevel testView) errs
+  CRAgentLog {} -> []
+  CRChatLog {} -> []
   CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
   CRAppSettings as -> ["app settings: " <> plain (LB.unpack $ J.encode as)]
   CRTimedAction _ _ -> []
@@ -1969,8 +1971,8 @@ viewChatError logLevel testView = \case
     CEFileImageType _ -> ["image type must be jpg, send as a file using " <> highlight' "/f"]
     CEFileImageSize _ -> ["max image size: " <> sShow maxImageSize <> " bytes, resize it or send as a file using " <> highlight' "/f"]
     CEFileNotReceived fileId -> ["file " <> sShow fileId <> " not received"]
-    CEXFTPRcvFile fileId aFileId e -> ["error receiving XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError]
-    CEXFTPSndFile fileId aFileId e -> ["error sending XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError]
+    CEXFTPRcvFile fileId aFileId e -> ["error receiving XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel <= CLLError]
+    CEXFTPSndFile fileId aFileId e -> ["error sending XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel <= CLLError]
     CEFallbackToSMPProhibited fileId -> ["recipient tried to accept file " <> sShow fileId <> " via old protocol, prohibited"]
     CEInlineFileProhibited _ -> ["A small file sent without acceptance - you can enable receiving such files with -f option."]
     CEInvalidQuote -> ["cannot reply to this message"]
@@ -2032,7 +2034,7 @@ viewChatError logLevel testView = \case
           <> "error: connection authorization failed - this could happen if connection was deleted,\
              \ secured with different credentials, or due to a bug - please re-create the connection"
       ]
-    AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel == CLLDebug]
+    AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel <= CLLDebug]
     AGENT A_PROHIBITED -> [withConnEntity <> "error: AGENT A_PROHIBITED" | logLevel <= CLLWarning]
     CONN NOT_FOUND -> [withConnEntity <> "error: CONN NOT_FOUND" | logLevel <= CLLWarning]
     CRITICAL restart e -> [plain $ "critical error: " <> e] <> ["please restart the app" | restart]