core: simplify terminal mark messages read logic (#1589)

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

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}

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"

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

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 ()

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

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")