terminal: options for log level and internal queue sizes (#1755)

* terminal: log levels

* option for internal queue sizes

package.yaml

@@ -46,6 +46,17 @@ dependencies:
   - unliftio-core == 0.2.*
   - zip == 1.7.*
 
+flags:
+  swift:
+    description: Enable swift JSON format
+    manual: True
+    default: False
+
+when:
+  - condition: flag(swift)
+    cpp-options:
+      - -DswiftJSON
+
 library:
   source-dirs: src
 

simplex-chat.cabal

@@ -17,6 +17,11 @@ build-type:     Simple
 extra-source-files:
     README.md
 
+flag swift
+  description: Enable swift JSON format
+  manual: True
+  default: False
+
 library
   exposed-modules:
       Simplex.Chat
@@ -127,6 +132,8 @@ library
     , unliftio-core ==0.2.*
     , zip ==1.7.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
 
 executable simplex-bot
   main-is: Main.hs
@@ -171,6 +178,8 @@ executable simplex-bot
     , unliftio-core ==0.2.*
     , zip ==1.7.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
 
 executable simplex-bot-advanced
   main-is: Main.hs
@@ -215,6 +224,8 @@ executable simplex-bot-advanced
     , unliftio-core ==0.2.*
     , zip ==1.7.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
 
 executable simplex-chat
   main-is: Main.hs
@@ -261,6 +272,8 @@ executable simplex-chat
     , websockets ==0.12.*
     , zip ==1.7.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
 
 test-suite simplex-chat-test
   type: exitcode-stdio-1.0
@@ -314,3 +327,5 @@ test-suite simplex-chat-test
     , unliftio-core ==0.2.*
     , zip ==1.7.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON

src/Simplex/Chat.hs

@@ -89,6 +89,7 @@ defaultChatConfig =
     { agentConfig =
         defaultAgentConfig
           { tcpPort = undefined, -- agent does not listen to TCP
+            tbqSize = 64,
             database = AgentDBFile {dbFile = "simplex_v1_agent", dbKey = ""},
             yesToMigrations = False
           },
@@ -102,6 +103,7 @@ defaultChatConfig =
       tbqSize = 64,
       fileChunkSize = 15780, -- do not change
       inlineFiles = defaultInlineFilesConfig,
+      logLevel = CLLImportant,
       subscriptionConcurrency = 16,
       subscriptionEvents = False,
       hostEvents = False,
@@ -135,14 +137,14 @@ 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, optFilesFolder, allowInstantFiles} sendToast = do
+newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles} ChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, tbqSize, 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'}
+      config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'}
       sendNotification = fromMaybe (const $ pure ()) sendToast
       firstTime = dbNew chatStore
   activeTo <- newTVarIO ActiveNone
   currentUser <- newTVarIO user
-  smpAgent <- getSMPAgentClient aCfg {database = AgentDB agentStore} =<< agentServers config
+  smpAgent <- getSMPAgentClient aCfg {tbqSize, database = AgentDB agentStore} =<< agentServers config
   agentAsync <- newTVarIO Nothing
   idsDrg <- newTVarIO =<< drgNew
   inputQ <- newTBQueueIO tbqSize

src/Simplex/Chat/Controller.hs

@@ -77,6 +77,7 @@ data ChatConfig = ChatConfig
     subscriptionConcurrency :: Int,
     subscriptionEvents :: Bool,
     hostEvents :: Bool,
+    logLevel :: ChatLogLevel,
     testView :: Bool
   }
 
@@ -543,6 +544,9 @@ tmeToPref currentTTL tme = uncurry TimedMessagesPreference $ case tme of
   TMEEnableKeepTTL -> (FAYes, currentTTL)
   TMEDisableKeepTTL -> (FANo, currentTTL)
 
+data ChatLogLevel = CLLDebug | CLLInfo | CLLWarning | CLLError | CLLImportant
+  deriving (Eq, Ord, Show)
+
 data ChatError
   = ChatError {errorType :: ChatErrorType}
   | ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity}

src/Simplex/Chat/Mobile.hs

@@ -123,9 +123,11 @@ mobileChatOpts =
       dbKey = "",
       smpServers = [],
       networkConfig = defaultNetworkConfig,
+      logLevel = CLLImportant,
       logConnections = False,
       logServerHosts = True,
       logAgent = False,
+      tbqSize = 64,
       chatCmd = "",
       chatCmdDelay = 3,
       chatServerPort = Nothing,

src/Simplex/Chat/Options.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -14,8 +15,9 @@ where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Numeric.Natural (Natural)
 import Options.Applicative
-import Simplex.Chat.Controller (updateStr, versionStr)
+import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionStr)
 import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
@@ -28,9 +30,11 @@ data ChatOpts = ChatOpts
     dbKey :: String,
     smpServers :: [SMPServerWithAuth],
     networkConfig :: NetworkConfig,
+    logLevel :: ChatLogLevel,
     logConnections :: Bool,
     logServerHosts :: Bool,
     logAgent :: Bool,
+    tbqSize :: Natural,
     chatCmd :: String,
     chatCmdDelay :: Int,
     chatServerPort :: Maybe String,
@@ -84,27 +88,45 @@ chatOpts appDir defaultDbFileName = do
           <> help "TCP timeout, seconds (default: 5/10 without/with SOCKS5 proxy)"
           <> value 0
       )
+  logLevel <-
+    option
+      parseLogLevel
+      ( long "log-level"
+          <> short 'l'
+          <> metavar "LEVEL"
+          <> help "Log level: debug, info, warn, error, important (default)"
+          <> value CLLImportant
+      )
   logTLSErrors <-
     switch
       ( long "log-tls-errors"
-          <> help "Log TLS errors"
+          <> help "Log TLS errors (also enabled with `-l debug`)"
       )
   logConnections <-
     switch
       ( long "connections"
           <> short 'c'
-          <> help "Log every contact and group connection on start"
+          <> help "Log every contact and group connection on start (also with `-l info`)"
       )
   logServerHosts <-
     switch
       ( long "log-hosts"
-          <> short 'l'
-          <> help "Log connections to servers"
+          <> help "Log connections to servers (also with `-l info`)"
       )
   logAgent <-
     switch
       ( long "log-agent"
-          <> help "Enable logs from SMP agent"
+          <> help "Enable logs from SMP agent (also with `-l debug`)"
+      )
+  tbqSize <-
+    option
+      auto
+      ( long "queue-size"
+          <> short 'q'
+          <> metavar "SIZE"
+          <> help "Internal queue size"
+          <> value 64
+          <> showDefault
       )
   chatCmd <-
     strOption
@@ -139,7 +161,7 @@ chatOpts appDir defaultDbFileName = do
         ( long "files-folder"
             <> metavar "FOLDER"
             <> help "Folder to use for sent and received files"
-      )
+        )
   allowInstantFiles <-
     switch
       ( long "allow-instant-files"
@@ -157,10 +179,12 @@ chatOpts appDir defaultDbFileName = do
       { dbFilePrefix,
         dbKey,
         smpServers,
-        networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) logTLSErrors,
-        logConnections,
-        logServerHosts,
-        logAgent,
+        networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel == CLLDebug),
+        logLevel,
+        logConnections = logConnections || logLevel <= CLLInfo,
+        logServerHosts = logServerHosts || logLevel <= CLLInfo,
+        logAgent = logAgent || logLevel == CLLDebug,
+        tbqSize,
         chatCmd,
         chatCmdDelay,
         chatServerPort,
@@ -192,6 +216,15 @@ serverPortP = Just . B.unpack <$> A.takeWhile A.isDigit
 smpServersP :: A.Parser [SMPServerWithAuth]
 smpServersP = 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"
+
 getChatOpts :: FilePath -> FilePath -> IO ChatOpts
 getChatOpts appDir defaultDbFileName =
   execParser $

src/Simplex/Chat/Terminal/Output.hs

@@ -112,10 +112,9 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems} = do
 
 printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> ChatResponse -> IO ()
 printRespToTerminal ct cc liveItems r = do
-  let testV = testView $ config cc
   user <- readTVarIO $ currentUser cc
   ts <- getCurrentTime
-  printToTerminal ct $ responseToView user testV liveItems ts r
+  printToTerminal ct $ responseToView user (config cc) liveItems ts r
 
 printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
 printToTerminal ct s =

src/Simplex/Chat/View.hs

@@ -28,7 +28,7 @@ import Data.Time.LocalTime (ZonedTime (..), localDay, localTimeOfDay, timeOfDayT
 import GHC.Generics (Generic)
 import qualified Network.HTTP.Types as Q
 import Numeric (showFFloat)
-import Simplex.Chat (maxImageSize)
+import Simplex.Chat (defaultChatConfig, maxImageSize)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
 import Simplex.Chat.Help
@@ -48,16 +48,16 @@ import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
 import Simplex.Messaging.Protocol (AProtocolType, ProtocolServer (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Util (bshow, tshow)
 import System.Console.ANSI.Types
 
 type CurrentTime = UTCTime
 
 serializeChatResponse :: Maybe User -> CurrentTime -> ChatResponse -> String
-serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ False False ts
+serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ defaultChatConfig False ts
 
-responseToView :: Maybe User -> Bool -> Bool -> CurrentTime -> ChatResponse -> [StyledString]
-responseToView user_ testView liveItems ts = \case
+responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> ChatResponse -> [StyledString]
+responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
   CRChatStarted -> ["chat started"]
   CRChatRunning -> ["chat is running"]
@@ -112,7 +112,7 @@ responseToView user_ testView liveItems ts = \case
   CRUserProfile p -> viewUserProfile p
   CRUserProfileNoChange -> ["user profile did not change"]
   CRVersionInfo _ -> [plain versionStr, plain updateStr]
-  CRChatCmdError e -> viewChatError e
+  CRChatCmdError e -> viewChatError logLevel e
   CRInvitation cReq -> viewConnReqInvitation cReq
   CRSentConfirmation -> ["confirmation sent!"]
   CRSentInvitation customUserProfile -> viewSentInvitation customUserProfile testView
@@ -218,8 +218,8 @@ responseToView user_ testView liveItems ts = \case
     ]
   CRAgentStats stats -> map (plain . intercalate ",") stats
   CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
-  CRMessageError prefix err -> [plain prefix <> ": " <> plain err]
-  CRChatError e -> viewChatError e
+  CRMessageError prefix err -> [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
+  CRChatError e -> viewChatError logLevel e
   where
     testViewChats :: [AChat] -> [StyledString]
     testViewChats chats = [sShow $ map toChatView chats]
@@ -1127,8 +1127,8 @@ instance ToJSON WCallCommand where
   toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "WCCall"
   toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "WCCall"
 
-viewChatError :: ChatError -> [StyledString]
-viewChatError = \case
+viewChatError :: ChatLogLevel -> ChatError -> [StyledString]
+viewChatError logLevel = \case
   ChatError err -> case err of
     CENoActiveUser -> ["error: active user is required"]
     CEActiveUserExists -> ["error: active user already exists"]
@@ -1139,7 +1139,7 @@ viewChatError = \case
     CEInvalidChatMessage e -> ["chat message error: " <> sShow e]
     CEContactNotReady c -> [ttyContact' c <> ": not ready"]
     CEContactDisabled Contact {localDisplayName = c} -> [ttyContact c <> ": disabled, to enable: " <> highlight ("/enable " <> c) <> ", to delete: " <> highlight ("/d " <> c)]
-    CEConnectionDisabled _ -> []
+    CEConnectionDisabled Connection {connId, connType} -> [plain $ "connection " <> textEncode connType <> " (" <> tshow connId <> ") is disabled" | logLevel <= CLLWarning]
     CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
     CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
     CEGroupUserRole -> ["you have insufficient permissions for this group command"]
@@ -1193,7 +1193,7 @@ viewChatError = \case
     SEUserContactLinkNotFound -> ["no chat address, to create: " <> highlight' "/ad"]
     SEContactRequestNotFoundByName c -> ["no contact request from " <> ttyContact c]
     SEFileIdNotFoundBySharedMsgId _ -> [] -- recipient tried to accept cancelled file
-    SEConnectionNotFound _ -> [] -- TODO mutes delete group error, but also mutes any error from getConnectionEntity
+    SEConnectionNotFound agentConnId -> ["event connection not found, agent ID: " <> sShow agentConnId | logLevel <= CLLWarning] -- mutes delete group error
     SEQuotedChatItemNotFound -> ["message not found - reply is not sent"]
     SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> groupName' g)]
     SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> groupName' g)]
@@ -1210,10 +1210,10 @@ viewChatError = \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 -> []
-    AGENT A_PROHIBITED -> []
-    CONN NOT_FOUND -> []
-    e -> [withConnEntity <> "smp agent error: " <> sShow e]
+    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]
+    e -> [withConnEntity <> "smp agent error: " <> sShow e | logLevel <= CLLWarning]
     where
       withConnEntity = case entity_ of
         Just entity@(RcvDirectMsgConnection conn contact_) -> case contact_ of

tests/ChatClient.hs

@@ -19,7 +19,7 @@ import Data.Maybe (fromJust, isNothing)
 import qualified Data.Text as T
 import Network.Socket
 import Simplex.Chat
-import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatDatabase (..))
+import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..))
 import Simplex.Chat.Core
 import Simplex.Chat.Options
 import Simplex.Chat.Store
@@ -53,9 +53,11 @@ testOpts =
       -- dbKey = "this is a pass-phrase to encrypt the database",
       smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:5001"],
       networkConfig = defaultNetworkConfig,
+      logLevel = CLLImportant,
       logConnections = False,
       logServerHosts = False,
       logAgent = False,
+      tbqSize = 64,
       chatCmd = "",
       chatCmdDelay = 3,
       chatServerPort = Nothing,

tests/MobileTests.hs

@@ -32,7 +32,7 @@ activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\"
 
 activeUser :: String
 #if defined(darwin_HOST_OS) && defined(swiftJSON)
-activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"no\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"}},\"activeUser\":true}}}"
+activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"no\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"}},\"activeUser\":true}}}}"
 #else
 activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"no\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"}},\"activeUser\":true}}}"
 #endif