add APIChatRead chat command (#282)

src/Simplex/Chat.hs

@@ -160,6 +160,10 @@ processChatCommand = \case
       setActive $ ActiveG gName
       pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
     CTContactRequest -> pure $ chatCmdError "not supported"
+  APIChatRead cType chatId fromToIds -> withChatLock $ case cType of
+    CTDirect -> withStore (\st -> updateDirectChatItemsRead st chatId fromToIds) $> CRCmdOk
+    CTGroup -> withStore (\st -> updateGroupChatItemsRead st chatId fromToIds) $> CRCmdOk
+    CTContactRequest -> pure $ chatCmdError "not supported"
   APIDeleteChat cType chatId -> withUser $ \User {userId} -> case cType of
     CTDirect -> do
       ct@Contact {localDisplayName} <- withStore $ \st -> getContact st userId chatId
@@ -1393,6 +1397,7 @@ chatCommandP =
     <|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP)
     <|> "/_get items count=" *> (APIGetChatItems <$> A.decimal)
     <|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <* A.space <*> msgContentP)
+    <|> "/_read chat " *> (APIChatRead <$> chatTypeP <*> A.decimal <* A.space <*> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))
     <|> "/_delete " *> (APIDeleteChat <$> chatTypeP <*> A.decimal)
     <|> "/_accept " *> (APIAcceptContact <$> A.decimal)
     <|> "/_reject " *> (APIRejectContact <$> A.decimal)

src/Simplex/Chat/Controller.hs

@@ -88,6 +88,7 @@ data ChatCommand
   | APIGetChat ChatType Int64 ChatPagination
   | APIGetChatItems Int
   | APISendMessage ChatType Int64 MsgContent
+  | APIChatRead ChatType Int64 (ChatItemId, ChatItemId)
   | APIDeleteChat ChatType Int64
   | APIAcceptContact Int64
   | APIRejectContact Int64
@@ -134,6 +135,7 @@ data ChatResponse
   | CRChatItemUpdated {chatItem :: AChatItem}
   | CRMsgIntegrityError {msgerror :: MsgErrorType} -- TODO make it chat item to support in mobile
   | CRCmdAccepted {corr :: CorrId}
+  | CRCmdOk
   | CRChatHelp {helpSection :: HelpSection}
   | CRWelcome {user :: User}
   | CRGroupCreated {groupInfo :: GroupInfo}

src/Simplex/Chat/Store.hs

@@ -116,6 +116,8 @@ module Simplex.Chat.Store
     getGroupChat,
     getChatItemIdByAgentMsgId,
     updateDirectChatItem,
+    updateDirectChatItemsRead,
+    updateGroupChatItemsRead,
   )
 where
 
@@ -2408,7 +2410,8 @@ updateDirectChatItem :: (StoreMonad m, MsgDirectionI d) => SQLiteStore -> ChatIt
 updateDirectChatItem st itemId itemStatus =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
     ci <- ExceptT $ getDirectChatItem_ db itemId
-    liftIO $ DB.execute db "UPDATE chat_items SET item_status = ? WHERE chat_item_id = ?" (itemStatus, itemId)
+    currentTs <- liftIO getCurrentTime
+    liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE chat_item_id = ?" (itemStatus, currentTs, itemId)
     pure ci {meta = (meta ci) {itemStatus}}
 
 getDirectChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> ChatItemId -> IO (Either StoreError (ChatItem 'CTDirect d))
@@ -2433,6 +2436,30 @@ getDirectChatItem_ db itemId = do
     correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
     correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
 
+updateDirectChatItemsRead :: (StoreMonad m) => SQLiteStore -> Int64 -> (ChatItemId, ChatItemId) -> m ()
+updateDirectChatItemsRead st contactId (fromItemId, toItemId) = do
+  currentTs <- liftIO getCurrentTime
+  liftIO . withTransaction st $ \db ->
+    DB.execute
+      db
+      [sql|
+        UPDATE chat_items SET item_status = ?, updated_at = ?
+        WHERE contact_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_sent = ?
+      |]
+      (CISRcvRead, currentTs, contactId, fromItemId, toItemId, SMDRcv)
+
+updateGroupChatItemsRead :: (StoreMonad m) => SQLiteStore -> Int64 -> (ChatItemId, ChatItemId) -> m ()
+updateGroupChatItemsRead st groupId (fromItemId, toItemId) = do
+  currentTs <- liftIO getCurrentTime
+  liftIO . withTransaction st $ \db ->
+    DB.execute
+      db
+      [sql|
+        UPDATE chat_items SET item_status = ?, updated_at = ?
+        WHERE group_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_sent = ?
+      |]
+      (CISRcvRead, currentTs, groupId, fromItemId, toItemId, SMDRcv)
+
 type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, UTCTime)
 
 type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe UTCTime)

src/Simplex/Chat/View.hs

@@ -42,6 +42,7 @@ responseToView cmd = \case
   CRChatItemUpdated _ -> []
   CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr
   CRCmdAccepted _ -> r []
+  CRCmdOk -> r ["ok"]
   CRChatHelp section -> case section of
     HSMain -> r chatHelpInfo
     HSFiles -> r filesHelpInfo