diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Options.hs b/apps/simplex-broadcast-bot/src/Broadcast/Options.hs index 3758af2fcb..9a79af4b48 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 8f28c9013a..0ca8cee789 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 a6f2b759e6..f8cab1e357 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 89d234f944..c27675678e 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 4fa6931f57..be8aa12cfe 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 53101cd073..824e6be0a0 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 f03e19149f..13bc2942fc 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