diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 47281fc06..32251338f 100644 --- a/src/Simplex/Chat.hs +++ b/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) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index d6c6eb6f6..516ff68a2 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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} diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index bac860396..8030f1bd0 100644 --- a/src/Simplex/Chat/Store.hs +++ b/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) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index b79886171..0f0a0476d 100644 --- a/src/Simplex/Chat/View.hs +++ b/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