diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index aa489e9a9..6e3d29940 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -937,6 +937,8 @@ processChatCommand = \case throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed") when (add && length rs >= maxMsgReactions) $ throwChatError (CECommandError "too many reactions") + APIUserRead userId -> withUserId userId $ \user -> withStore' (`setUserChatsRead` user) >> ok user + UserRead -> withUser $ \User {userId} -> processChatCommand $ APIUserRead userId APIChatRead (ChatRef cType chatId) fromToIds -> withUser $ \_ -> case cType of CTDirect -> do user <- withStore $ \db -> getUserByContactId db chatId @@ -5989,6 +5991,8 @@ chatCommandP = "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode), "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <* A.space <*> A.decimal <* A.space <*> A.decimal), "/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> onOffP <* A.space <*> jsonP), + "/_read user " *> (APIUserRead <$> A.decimal), + "/read user" $> UserRead, "/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))), "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP), "/_delete " *> (APIDeleteChat <$> chatRefP <*> (A.space *> "notify=" *> onOffP <|> pure True)), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index fb2ff89a2..c3bf84b33 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -256,6 +256,8 @@ data ChatCommand | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode | APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId | APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction} + | APIUserRead UserId + | UserRead | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId)) | APIChatUnread ChatRef Bool | APIDeleteChat ChatRef Bool -- `notify` flag is only applied to direct chats diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 67044d81a..0046bc990 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -43,6 +43,7 @@ module Simplex.Chat.Store.Direct deletePCCIncognitoProfile, updateContactUsed, updateContactUnreadChat, + setUserChatsRead, updateContactStatus, updateGroupUnreadChat, setConnectionVerified, @@ -78,6 +79,7 @@ import Data.Text (Text) import Data.Time.Clock (UTCTime (..), getCurrentTime) import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) +import Simplex.Chat.Messages import Simplex.Chat.Store.Shared import Simplex.Chat.Types import Simplex.Chat.Types.Preferences @@ -392,6 +394,13 @@ updateContactUnreadChat db User {userId} Contact {contactId} unreadChat = do updatedAt <- getCurrentTime DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (unreadChat, updatedAt, userId, contactId) +setUserChatsRead :: DB.Connection -> User -> IO () +setUserChatsRead db User {userId} = do + updatedAt <- getCurrentTime + DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True) + DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True) + DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND item_status = ?" (CISRcvRead, updatedAt, userId, CISRcvNew) + updateContactStatus :: DB.Connection -> User -> Contact -> ContactStatus -> IO Contact updateContactStatus db User {userId} ct@Contact {contactId} contactStatus = do currentTs <- getCurrentTime diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index d7c8ff458..7d299e296 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -175,6 +175,8 @@ testAddContact = versionTestMatrix2 runTestAddContact bob #$> ("/_read chat @2 from=1 to=100", id, "ok") alice #$> ("/_read chat @2", id, "ok") bob #$> ("/_read chat @2", id, "ok") + alice #$> ("/read user", id, "ok") + alice #$> ("/_read user 1", id, "ok") testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO () testDuplicateContactsSeparate =