From 6a9a67db14a3dcf4fd70f42e98081645091d8c7d Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 3 Dec 2023 15:42:26 +0000 Subject: [PATCH] cli: option to mark shown messages as read (off by default) (#3506) * cli: option to mark shown messages as read (off by default) * fix tests * fix tests --- apps/simplex-broadcast-bot/src/Broadcast/Options.hs | 1 + .../src/Directory/Options.hs | 13 +++++++------ src/Simplex/Chat/Options.hs | 8 ++++++++ src/Simplex/Chat/Terminal.hs | 6 +++--- src/Simplex/Chat/Terminal/Output.hs | 8 ++++---- tests/ChatClient.hs | 3 ++- tests/RemoteTests.hs | 6 +++--- 7 files changed, 28 insertions(+), 17 deletions(-) diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Options.hs b/apps/simplex-broadcast-bot/src/Broadcast/Options.hs index 3758af2fc..9a79af4b4 100644 --- a/apps/simplex-broadcast-bot/src/Broadcast/Options.hs +++ b/apps/simplex-broadcast-bot/src/Broadcast/Options.hs @@ -83,5 +83,6 @@ mkChatOpts BroadcastBotOpts {coreOptions} = allowInstantFiles = True, autoAcceptFileSize = 0, muteNotifications = True, + markRead = False, maintenance = False } diff --git a/apps/simplex-directory-service/src/Directory/Options.hs b/apps/simplex-directory-service/src/Directory/Options.hs index 8f28c9013..0ca8cee78 100644 --- a/apps/simplex-directory-service/src/Directory/Options.hs +++ b/apps/simplex-directory-service/src/Directory/Options.hs @@ -5,10 +5,10 @@ {-# LANGUAGE ScopedTypeVariables #-} module Directory.Options - ( DirectoryOpts (..), - getDirectoryOpts, - mkChatOpts, - ) + ( DirectoryOpts (..), + getDirectoryOpts, + mkChatOpts, + ) where import Options.Applicative @@ -35,8 +35,8 @@ directoryOpts appDir defaultDbFileName = do <> help "Comma-separated list of super-users in the format CONTACT_ID:DISPLAY_NAME who will be allowed to manage the directory" ) directoryLog <- - Just <$> - strOption + Just + <$> strOption ( long "directory-file" <> metavar "DIRECTORY_FILE" <> help "Append only log for directory state" @@ -81,5 +81,6 @@ mkChatOpts DirectoryOpts {coreOptions} = allowInstantFiles = True, autoAcceptFileSize = 0, muteNotifications = True, + markRead = False, maintenance = False } diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index a6f2b759e..f8cab1e35 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -42,6 +42,7 @@ data ChatOpts = ChatOpts allowInstantFiles :: Bool, autoAcceptFileSize :: Integer, muteNotifications :: Bool, + markRead :: Bool, maintenance :: Bool } @@ -268,6 +269,12 @@ chatOptsP appDir defaultDbFileName = do ( long "mute" <> help "Mute notifications" ) + markRead <- + switch + ( long "mark-read" + <> short 'r' + <> help "Mark shown messages as read" + ) maintenance <- switch ( long "maintenance" @@ -286,6 +293,7 @@ chatOptsP appDir defaultDbFileName = do allowInstantFiles, autoAcceptFileSize, muteNotifications, + markRead, maintenance } diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index 89d234f94..c27675678 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/src/Simplex/Chat/Terminal.hs @@ -44,7 +44,7 @@ simplexChatTerminal cfg opts t = handle checkDBKeyError . simplexChatCore cfg opts $ \u cc -> do ct <- newChatTerminal t opts when (firstTime cc) . printToTerminal ct $ chatWelcome u - runChatTerminal ct cc + runChatTerminal ct cc opts checkDBKeyError :: SQLError -> IO () checkDBKeyError e = case sqlError e of @@ -53,5 +53,5 @@ checkDBKeyError e = case sqlError e of exitFailure _ -> throwIO e -runChatTerminal :: ChatTerminal -> ChatController -> IO () -runChatTerminal ct cc = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc, runInputLoop ct cc] +runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO () +runChatTerminal ct cc opts = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc opts, runInputLoop ct cc] diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 4fa6931f5..be8aa12cf 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -142,13 +142,13 @@ withTermLock ChatTerminal {termLock} action = do action atomically $ putTMVar termLock () -runTerminalOutput :: ChatTerminal -> ChatController -> IO () -runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = do +runTerminalOutput :: ChatTerminal -> ChatController -> ChatOpts -> IO () +runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} ChatOpts {markRead} = do forever $ do (_, outputRH, r) <- atomically $ readTBQueue outputQ case r of - CRNewChatItem u ci -> markChatItemRead u ci - CRChatItemUpdated u ci -> markChatItemRead u ci + CRNewChatItem u ci -> when markRead $ markChatItemRead u ci + CRChatItemUpdated u ci -> when markRead $ markChatItemRead u ci CRRemoteHostConnected {remoteHost = RemoteHostInfo {remoteHostId}} -> getRemoteUser remoteHostId CRRemoteHostStopped {remoteHostId_} -> mapM_ removeRemoteUser remoteHostId_ _ -> pure () diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 53101cd07..824e6be0a 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -82,6 +82,7 @@ testOpts = allowInstantFiles = True, autoAcceptFileSize = 0, muteNotifications = True, + markRead = True, maintenance = False } @@ -174,7 +175,7 @@ startTestChat_ db cfg opts user = do t <- withVirtualTerminal termSettings pure ct <- newChatTerminal t opts cc <- newChatController db (Just user) cfg opts - chatAsync <- async . runSimplexChat opts user cc . const $ runChatTerminal ct + chatAsync <- async . runSimplexChat opts user cc $ \_u cc' -> runChatTerminal ct cc' opts atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry termQ <- newTQueueIO termAsync <- async $ readTerminalOutput t termQ diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index f03e19149..13bc2942f 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -162,13 +162,13 @@ storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile deskto desktop ##> "/list remote hosts" desktop <## "Remote hosts:" - desktop <## "1. Mobile (connected) [lo 127.0.0.1:52230]" + desktop <##. "1. Mobile (connected) [" stopDesktop mobile desktop desktop ##> "/list remote hosts" desktop <## "Remote hosts:" - desktop <## "1. Mobile [lo 127.0.0.1:52230]" + desktop <##. "1. Mobile [" - -- TODO: more parser tests +-- TODO: more parser tests remoteMessageTest :: HasCallStack => FilePath -> IO () remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do