From cee403c1ed9faa8fcbcc40e772596e18fce029fe Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Fri, 16 Dec 2022 15:56:16 +0400 Subject: [PATCH] core: simplify terminal mark messages read logic (#1589) --- src/Simplex/Chat.hs | 4 ++-- src/Simplex/Chat/Controller.hs | 1 - src/Simplex/Chat/Messages.hs | 10 ---------- src/Simplex/Chat/Terminal/Input.hs | 5 +---- src/Simplex/Chat/Terminal/Output.hs | 10 +++++----- src/Simplex/Chat/View.hs | 8 +++----- tests/ChatTests.hs | 11 +++++++++++ 7 files changed, 22 insertions(+), 27 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2f6fecdeed..ea26f1ac91 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -519,7 +519,7 @@ processChatCommand = \case withStore' $ \db -> setDirectChatItemDeleteAt db user chatId itemId deleteAt when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTDirect chatId, itemId) deleteAt withStore' $ \db -> updateDirectChatItemsRead db userId chatId fromToIds - pure CRChatRead + pure CRCmdOk CTGroup -> do timedItems <- withStore' $ \db -> getGroupUnreadTimedItems db user chatId fromToIds ts <- liftIO getCurrentTime @@ -528,7 +528,7 @@ processChatCommand = \case withStore' $ \db -> setGroupChatItemDeleteAt db user chatId itemId deleteAt when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTGroup chatId, itemId) deleteAt withStore' $ \db -> updateGroupChatItemsRead db userId chatId fromToIds - pure CRChatRead + pure CRCmdOk CTContactRequest -> pure $ chatCmdError "not supported" CTContactConnection -> pure $ chatCmdError "not supported" APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 21708a823c..e7fdf8b4d4 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -298,7 +298,6 @@ data ChatResponse | CRChatItemUpdated {chatItem :: AChatItem} | CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool} | CRChatItemDeletedNotFound {contact :: Contact, sharedMsgId :: SharedMsgId} - | CRChatRead | CRBroadcastSent MsgContent Int ZonedTime | CRMsgIntegrityError {msgError :: MsgErrorType} | CRCmdAccepted {corr :: CorrId} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 438ac9748d..3fd0ad80d9 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -41,22 +41,12 @@ import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection deriving (Eq, Show, Ord, Generic) -serializeChatType :: ChatType -> String -serializeChatType = \case - CTDirect -> "@" - CTGroup -> "#" - CTContactRequest -> "?" -- this isn't being parsed - CTContactConnection -> ":" - data ChatName = ChatName ChatType Text deriving (Show) data ChatRef = ChatRef ChatType Int64 deriving (Eq, Show, Ord) -serializeChatRef :: ChatRef -> String -serializeChatRef (ChatRef cType chatId) = serializeChatType cType <> show chatId - instance ToJSON ChatType where toJSON = J.genericToJSON . enumJSON $ dropPrefix "CT" toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CT" diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 018e7d8153..6c7ea54cdb 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -35,7 +35,7 @@ runInputLoop ct cc = forever $ do s <- atomically . readTBQueue $ inputQ cc let bs = encodeUtf8 $ T.pack s cmd = parseChatCommand bs - when (doEcho cmd) $ echo s + unless (isMessage cmd) $ echo s r <- runReaderT (execChatCommand bs) cc case r of CRChatCmdError _ -> when (isMessage cmd) $ echo s @@ -46,9 +46,6 @@ runInputLoop ct cc = forever $ do printToTerminal ct $ responseToView user testV ts r where echo s = printToTerminal ct [plain s] - doEcho cmd = case cmd of - Right APIChatRead {} -> False - _ -> not $ isMessage cmd isMessage = \case Right SendMessage {} -> True Right SendFile {} -> True diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 55c57cb62d..760f81ca39 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -8,9 +8,10 @@ module Simplex.Chat.Terminal.Output where import Control.Monad.Catch (MonadMask) -import Control.Monad.IO.Unlift +import Control.Monad.Except import Control.Monad.Reader import Data.Time.Clock (getCurrentTime) +import Simplex.Chat (processChatCommand) import Simplex.Chat.Controller import Simplex.Chat.Messages hiding (NewChatItem (..)) import Simplex.Chat.Styled @@ -75,7 +76,7 @@ withTermLock ChatTerminal {termLock} action = do atomically $ putTMVar termLock () runTerminalOutput :: ChatTerminal -> ChatController -> IO () -runTerminalOutput ct ChatController {currentUser, inputQ, outputQ, config = ChatConfig {testView}} = do +runTerminalOutput ct cc@ChatController {currentUser, outputQ, config = ChatConfig {testView}} = do forever $ do (_, r) <- atomically $ readTBQueue outputQ case r of @@ -91,9 +92,8 @@ runTerminalOutput ct ChatController {currentUser, inputQ, outputQ, config = Chat case (muted chat item, itemStatus) of (False, CISRcvNew) -> do let itemId = chatItemId' item - chatRef = serializeChatRef $ chatInfoToRef chat - cmd = "/_read chat " <> chatRef <> " from=" <> show itemId <> " to=" <> show itemId - atomically $ writeTBQueue inputQ cmd + chatRef = chatInfoToRef chat + void $ runReaderT (runExceptT $ processChatCommand (APIChatRead chatRef (Just (itemId, itemId)))) cc _ -> pure () printToTerminal :: ChatTerminal -> [StyledString] -> IO () diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index ab7be7bc02..dccd7c1146 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -84,7 +84,6 @@ responseToView user_ testView ts = \case CRChatItemUpdated (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item ts CRChatItemDeleted (AChatItem _ _ chat deletedItem) toItem byUser timed -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts CRChatItemDeletedNotFound Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"] - CRChatRead -> [] CRBroadcastSent mc n t -> viewSentBroadcast mc n ts t CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr CRCmdAccepted _ -> [] @@ -252,10 +251,9 @@ responseToView user_ testView ts = \case contactList :: [ContactRef] -> String contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs unmuted :: ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString] - unmuted chat chatItem s = - if muted chat chatItem - then [] - else s + unmuted chat chatItem s + | muted chat chatItem = [] + | otherwise = s muted :: ChatInfo c -> ChatItem c d -> Bool muted chat ChatItem {chatDir} = case (chat, chatDir) of diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index c7e12854d9..3770f618dc 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -305,6 +305,11 @@ testAddContact = versionTestMatrix2 runTestAddContact alice #$> ("/_get chat @2 before=" <> itemId 2 <> " count=100", chat, chatFeatures <> [(1, "hello there 🙂")]) -- search alice #$> ("/_get chat @2 count=100 search=ello ther", chat, [(1, "hello there 🙂"), (0, "hello there")]) + -- read messages + alice #$> ("/_read chat @2 from=1 to=100", id, "ok") + bob #$> ("/_read chat @2 from=1 to=100", id, "ok") + alice #$> ("/_read chat @2", id, "ok") + bob #$> ("/_read chat @2", id, "ok") testDeleteContactDeletesProfile :: IO () testDeleteContactDeletesProfile = @@ -610,6 +615,12 @@ testGroupShared alice bob cath checkMessages = do bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")]) cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] cath #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "connected"), (0, "hello"), (0, "hi there"), (1, "hey team")]) + alice #$> ("/_read chat #1 from=1 to=100", id, "ok") + bob #$> ("/_read chat #1 from=1 to=100", id, "ok") + cath #$> ("/_read chat #1 from=1 to=100", id, "ok") + alice #$> ("/_read chat #1", id, "ok") + bob #$> ("/_read chat #1", id, "ok") + cath #$> ("/_read chat #1", id, "ok") alice #$> ("/_unread chat #1 on", id, "ok") alice #$> ("/_unread chat #1 off", id, "ok")