From af414d7f6efe1538874f12aa89afd99984fd5b8c Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 16 Jan 2023 09:13:46 +0000 Subject: [PATCH] terminal: options for log level and internal queue sizes (#1755) * terminal: log levels * option for internal queue sizes --- package.yaml | 11 ++++++ simplex-chat.cabal | 15 ++++++++ src/Simplex/Chat.hs | 8 +++-- src/Simplex/Chat/Controller.hs | 4 +++ src/Simplex/Chat/Mobile.hs | 2 ++ src/Simplex/Chat/Options.hs | 55 +++++++++++++++++++++++------ src/Simplex/Chat/Terminal/Output.hs | 3 +- src/Simplex/Chat/View.hs | 32 ++++++++--------- tests/ChatClient.hs | 4 ++- tests/MobileTests.hs | 2 +- 10 files changed, 102 insertions(+), 34 deletions(-) diff --git a/package.yaml b/package.yaml index 24c572453..07cecaca9 100644 --- a/package.yaml +++ b/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 diff --git a/simplex-chat.cabal b/simplex-chat.cabal index a7a4606e3..ac6cd8fc8 100644 --- a/simplex-chat.cabal +++ b/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 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index ab63e88eb..39e58102d 100644 --- a/src/Simplex/Chat.hs +++ b/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 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 8266f49de..8176aaa71 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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} diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index bbbdcbe1e..46e44570c 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/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, diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index 9c6fd9a90..39d073104 100644 --- a/src/Simplex/Chat/Options.hs +++ b/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 $ diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 854bc3898..65881e4bc 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/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 = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 154d1d8cf..814162b26 100644 --- a/src/Simplex/Chat/View.hs +++ b/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 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 15674bfef..e7353d985 100644 --- a/tests/ChatClient.hs +++ b/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, diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 29c3f2d98..1f43b8c6a 100644 --- a/tests/MobileTests.hs +++ b/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