diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Options.hs b/apps/simplex-broadcast-bot/src/Broadcast/Options.hs index 9a79af4b4..bce0f9497 100644 --- a/apps/simplex-broadcast-bot/src/Broadcast/Options.hs +++ b/apps/simplex-broadcast-bot/src/Broadcast/Options.hs @@ -10,7 +10,7 @@ import Data.Maybe (fromMaybe) import Options.Applicative import Simplex.Chat.Bot.KnownContacts import Simplex.Chat.Controller (updateStr, versionNumber, versionString) -import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts, coreChatOptsP) +import Simplex.Chat.Options (ChatCmdLog (..), ChatOpts (..), CoreChatOpts, coreChatOptsP) data BroadcastBotOpts = BroadcastBotOpts { coreOptions :: CoreChatOpts, @@ -77,6 +77,7 @@ mkChatOpts BroadcastBotOpts {coreOptions} = deviceName = Nothing, chatCmd = "", chatCmdDelay = 3, + chatCmdLog = CCLNone, chatServerPort = Nothing, optFilesFolder = Nothing, showReactions = False, diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index ccfc6a484..f47bd6c7c 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -1,13 +1,15 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} module Main where -import Control.Concurrent (threadDelay) -import Control.Concurrent.STM.TVar (readTVarIO) +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.STM +import Control.Monad import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (getCurrentTimeZone) import Server -import Simplex.Chat.Controller (currentRemoteHost, versionNumber, versionString) +import Simplex.Chat.Controller (ChatController (..), ChatResponse (..), currentRemoteHost, versionNumber, versionString) import Simplex.Chat.Core import Simplex.Chat.Options import Simplex.Chat.Terminal @@ -22,20 +24,28 @@ main = do opts@ChatOpts {chatCmd, chatServerPort} <- getChatOpts appDir "simplex_v1" if null chatCmd then case chatServerPort of - Just chatPort -> - simplexChatServer defaultChatServerConfig {chatPort} terminalChatConfig opts - _ -> do - welcome opts - t <- withTerminal pure - simplexChatTerminal terminalChatConfig opts t - else simplexChatCore terminalChatConfig opts $ \user cc -> do - rh <- readTVarIO $ currentRemoteHost cc - let cmdRH = rh -- response RemoteHost is the same as for the command itself - r <- sendChatCmdStr cc chatCmd - ts <- getCurrentTime - tz <- getCurrentTimeZone - putStrLn $ serializeChatResponse (rh, Just user) ts tz cmdRH r - threadDelay $ chatCmdDelay opts * 1000000 + Just chatPort -> simplexChatServer defaultChatServerConfig {chatPort} terminalChatConfig opts + _ -> runCLI opts + else simplexChatCore terminalChatConfig opts $ runCommand opts + where + runCLI opts = do + welcome opts + t <- withTerminal pure + simplexChatTerminal terminalChatConfig opts t + runCommand ChatOpts {chatCmd, chatCmdLog, chatCmdDelay} user cc = do + when (chatCmdLog /= CCLNone) . void . forkIO . forever $ do + (_, _, r') <- atomically . readTBQueue $ outputQ cc + case r' of + CRNewChatItem {} -> printResponse r' + _ -> when (chatCmdLog == CCLAll) $ printResponse r' + sendChatCmdStr cc chatCmd >>= printResponse + threadDelay $ chatCmdDelay * 1000000 + where + printResponse r = do + ts <- getCurrentTime + tz <- getCurrentTimeZone + rh <- readTVarIO $ currentRemoteHost cc + putStrLn $ serializeChatResponse (rh, Just user) ts tz rh r welcome :: ChatOpts -> IO () welcome ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, networkConfig}} = diff --git a/apps/simplex-directory-service/src/Directory/Options.hs b/apps/simplex-directory-service/src/Directory/Options.hs index 6d4e1296f..78157d7e1 100644 --- a/apps/simplex-directory-service/src/Directory/Options.hs +++ b/apps/simplex-directory-service/src/Directory/Options.hs @@ -14,7 +14,7 @@ where import Options.Applicative import Simplex.Chat.Bot.KnownContacts import Simplex.Chat.Controller (updateStr, versionNumber, versionString) -import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts, coreChatOptsP) +import Simplex.Chat.Options (ChatOpts (..), ChatCmdLog (..), CoreChatOpts, coreChatOptsP) data DirectoryOpts = DirectoryOpts { coreOptions :: CoreChatOpts, @@ -77,6 +77,7 @@ mkChatOpts DirectoryOpts {coreOptions} = deviceName = Nothing, chatCmd = "", chatCmdDelay = 3, + chatCmdLog = CCLNone, chatServerPort = Nothing, optFilesFolder = Nothing, showReactions = False, diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 3671844d7..7c74a7325 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -197,6 +197,7 @@ mobileChatOpts dbFilePrefix = deviceName = Nothing, chatCmd = "", chatCmdDelay = 3, + chatCmdLog = CCLNone, chatServerPort = Nothing, optFilesFolder = Nothing, showReactions = False, diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index 85298ae31..a222e2e77 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -8,6 +8,7 @@ module Simplex.Chat.Options ( ChatOpts (..), CoreChatOpts (..), + ChatCmdLog (..), chatOptsP, coreChatOptsP, getChatOpts, @@ -37,6 +38,7 @@ data ChatOpts = ChatOpts deviceName :: Maybe Text, chatCmd :: String, chatCmdDelay :: Int, + chatCmdLog :: ChatCmdLog, chatServerPort :: Maybe String, optFilesFolder :: Maybe FilePath, showReactions :: Bool, @@ -62,6 +64,9 @@ data CoreChatOpts = CoreChatOpts highlyAvailable :: Bool } +data ChatCmdLog = CCLAll | CCLMessages | CCLNone + deriving (Eq) + agentLogLevel :: ChatLogLevel -> LogLevel agentLogLevel = \case CLLDebug -> LogDebug @@ -229,6 +234,14 @@ chatOptsP appDir defaultDbFileName = do <> value 3 <> showDefault ) + chatCmdLog <- + option + parseChatCmdLog + ( long "execute-log" + <> metavar "EXEC_LOG" + <> help "Log during command execution: all, messages, none (default)" + <> value CCLNone + ) chatServerPort <- option parseServerPort @@ -288,6 +301,7 @@ chatOptsP appDir defaultDbFileName = do deviceName, chatCmd, chatCmdDelay, + chatCmdLog, chatServerPort, optFilesFolder, showReactions, @@ -327,6 +341,13 @@ parseLogLevel = eitherReader $ \case "important" -> Right CLLImportant _ -> Left "Invalid log level" +parseChatCmdLog :: ReadM ChatCmdLog +parseChatCmdLog = eitherReader $ \case + "all" -> Right CCLAll + "messages" -> Right CCLMessages + "none" -> Right CCLNone + _ -> Left "Invalid chat command log level" + getChatOpts :: FilePath -> FilePath -> IO ChatOpts getChatOpts appDir defaultDbFileName = execParser $ diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 578eef4e4..f7982c5fb 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -63,6 +63,7 @@ testOpts = deviceName = Nothing, chatCmd = "", chatCmdDelay = 3, + chatCmdLog = CCLNone, chatServerPort = Nothing, optFilesFolder = Nothing, showReactions = True,