From a02886ca5d46a444d7edd4645a415b2c16b8dd9d Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Wed, 18 Oct 2023 10:19:24 +0100 Subject: [PATCH] core: fix editing and status changes removing reactions from view (#3245) * core: fix editing and status changes removing reactions from view * refactor * refactor 2 * case --- src/Simplex/Chat.hs | 19 ++++--- src/Simplex/Chat/Store/Messages.hs | 80 ++++++++++++++++-------------- 2 files changed, 55 insertions(+), 44 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 89f64189af..82499baee6 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -760,8 +760,9 @@ processChatCommand = \case unzipMaybe3 _ = (Nothing, Nothing, Nothing) APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of CTDirect -> do - (ct@Contact {contactId}, cci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId + ct@Contact {contactId} <- withStore $ \db -> getContact db user chatId assertDirectAllowed user MDSnd ct XMsgUpdate_ + cci <- withStore $ \db -> getDirectCIWithReactions db user ct itemId case cci of CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do case (ciContent, itemSharedMsgId, editable) of @@ -783,7 +784,7 @@ processChatCommand = \case CTGroup -> do Group gInfo@GroupInfo {groupId} ms <- withStore $ \db -> getGroup db user chatId assertUserGroupRole gInfo GRAuthor - cci <- withStore $ \db -> getGroupChatItem db user chatId itemId + cci <- withStore $ \db -> getGroupCIWithReactions db user gInfo itemId case cci of CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do case (ciContent, itemSharedMsgId, editable) of @@ -2390,8 +2391,8 @@ updateCallItemStatus user ct Call {chatItemId} receivedStatus msgId_ = do forM_ aciContent_ $ \aciContent -> updateDirectChatItemView user ct chatItemId aciContent False msgId_ updateDirectChatItemView :: ChatMonad m => User -> Contact -> ChatItemId -> ACIContent -> Bool -> Maybe MessageId -> m () -updateDirectChatItemView user ct@Contact {contactId} chatItemId (ACIContent msgDir ciContent) live msgId_ = do - ci' <- withStore $ \db -> updateDirectChatItem db user contactId chatItemId ciContent live msgId_ +updateDirectChatItemView user ct chatItemId (ACIContent msgDir ciContent) live msgId_ = do + ci' <- withStore $ \db -> updateDirectChatItem db user ct chatItemId ciContent live msgId_ toView $ CRChatItemUpdated user (AChatItem SCTDirect msgDir (DirectChat ct) ci') callStatusItemContent :: ChatMonad m => User -> Contact -> ChatItemId -> WebRTCCallStatus -> m (Maybe ACIContent) @@ -3996,7 +3997,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ci' <- withStore' $ \db -> do when changed $ addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) - updateDirectChatItem' db user contactId ci content live $ Just msgId + reactions <- getDirectCIReactions db ct sharedMsgId + updateDirectChatItem' db user contactId ci {reactions} content live $ Just msgId toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' else toView $ CRChatItemNotChanged user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) @@ -4134,7 +4136,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ci' <- withStore' $ \db -> do when changed $ addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) - updateGroupChatItem db user groupId ci content live $ Just msgId + reactions <- getGroupCIReactions db gInfo memberId sharedMsgId + updateGroupChatItem db user groupId ci {reactions} content live $ Just msgId toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) @@ -4939,7 +4942,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) | itemStatus == newStatus -> pure () | otherwise -> do - chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId itemId newStatus + chatItem <- withStore $ \db -> updateDirectChatItemStatus db user ct itemId newStatus toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) _ -> pure () @@ -4962,7 +4965,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do memStatusCounts <- withStore' (`getGroupSndStatusCounts` itemId) let newStatus = membersGroupItemStatus memStatusCounts when (newStatus /= itemStatus) $ do - chatItem <- withStore $ \db -> updateGroupChatItemStatus db user groupId itemId newStatus + chatItem <- withStore $ \db -> updateGroupChatItemStatus db user gInfo itemId newStatus toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem) _ -> pure () diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 0f9abaa465..35a8bad698 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -15,7 +15,6 @@ module Simplex.Chat.Store.Messages ( getContactConnIds_, - getDirectChatReactions_, -- * Message and chat item functions deleteContactCIs, @@ -68,9 +67,11 @@ module Simplex.Chat.Store.Messages setGroupReaction, getChatItemIdByAgentMsgId, getDirectChatItem, + getDirectCIWithReactions, getDirectChatItemBySharedMsgId, getDirectChatItemByAgentMsgId, getGroupChatItem, + getGroupCIWithReactions, getGroupChatItemBySharedMsgId, getGroupMemberCIBySharedMsgId, getGroupChatItemByAgentMsgId, @@ -755,7 +756,7 @@ getGroupChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String getGroupChat db user groupId pagination search_ = do let search = fromMaybe "" search_ g <- getGroupInfo db user groupId - liftIO . getGroupChatReactions_ db g =<< case pagination of + case pagination of CPLast count -> getGroupChatLast_ db user g count search CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search CPBefore beforeId count -> getGroupChatBefore_ db user g beforeId count search @@ -764,7 +765,7 @@ getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> Exce getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} chatItemIds <- liftIO getGroupChatItemIdsLast_ - chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds + chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds pure $ Chat (GroupChat g) (reverse chatItems) stats where getGroupChatItemIdsLast_ :: IO [ChatItemId] @@ -802,7 +803,7 @@ getGroupChatAfter_ db user@User {userId} g@GroupInfo {groupId} afterChatItemId c let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} afterChatItem <- getGroupChatItem db user groupId afterChatItemId chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem) - chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds + chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds pure $ Chat (GroupChat g) chatItems stats where getGroupChatItemIdsAfter_ :: UTCTime -> IO [ChatItemId] @@ -825,7 +826,7 @@ getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem) - chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds + chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds pure $ Chat (GroupChat g) (reverse chatItems) stats where getGroupChatItemIdsBefore_ :: UTCTime -> IO [ChatItemId] @@ -1149,23 +1150,24 @@ getChatItemIdByAgentMsgId db connId msgId = |] (connId, msgId) -updateDirectChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTDirect d) -updateDirectChatItemStatus db user@User {userId} contactId itemId itemStatus = do - ci <- liftEither . correctDir =<< getDirectChatItem db user contactId itemId +updateDirectChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Contact -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTDirect d) +updateDirectChatItemStatus db user@User {userId} ct@Contact {contactId} itemId itemStatus = do + ci <- liftEither . correctDir =<< getDirectCIWithReactions db user ct itemId currentTs <- liftIO getCurrentTime liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?" (itemStatus, currentTs, userId, contactId, itemId) pure ci {meta = (meta ci) {itemStatus}} - where - correctDir :: CChatItem c -> Either StoreError (ChatItem c d) - correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci -updateDirectChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d) -updateDirectChatItem db user contactId itemId newContent live msgId_ = do - ci <- liftEither . correctDir =<< getDirectChatItem db user contactId itemId +updateDirectChatItem :: MsgDirectionI d => DB.Connection -> User -> Contact -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d) +updateDirectChatItem db user ct@Contact {contactId} itemId newContent live msgId_ = do + ci <- liftEither . correctDir =<< getDirectCIWithReactions db user ct itemId liftIO $ updateDirectChatItem' db user contactId ci newContent live msgId_ - where - correctDir :: CChatItem c -> Either StoreError (ChatItem c d) - correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci + +getDirectCIWithReactions :: DB.Connection -> User -> Contact -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect) +getDirectCIWithReactions db user ct@Contact {contactId} itemId = + liftIO . directCIWithReactions db ct =<< getDirectChatItem db user contactId itemId + +correctDir :: MsgDirectionI d => CChatItem c -> Either StoreError (ChatItem c d) +correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci updateDirectChatItem' :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTDirect d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTDirect d) updateDirectChatItem' db User {userId} contactId ci newContent live msgId_ = do @@ -1303,7 +1305,7 @@ getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId = getDirectChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect) getDirectChatItem db User {userId} contactId itemId = ExceptT $ do currentTs <- getCurrentTime - join <$> firstRow (toDirectChatItem currentTs) (SEChatItemNotFound itemId) getItem + firstRow' (toDirectChatItem currentTs) (SEChatItemNotFound itemId) getItem where getItem = DB.query @@ -1351,17 +1353,26 @@ getDirectChatItemIdByText' db User {userId} contactId msg = |] (userId, contactId, msg <> "%") -updateGroupChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupId -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d) -updateGroupChatItemStatus db user@User {userId} groupId itemId itemStatus = do - ci <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId +updateGroupChatItemStatus :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d) +updateGroupChatItemStatus db user@User {userId} g@GroupInfo {groupId} itemId itemStatus = do + ci <- liftEither . correctDir =<< getGroupCIWithReactions db user g itemId currentTs <- liftIO getCurrentTime liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?" (itemStatus, currentTs, userId, groupId, itemId) pure ci {meta = (meta ci) {itemStatus}} - where - correctDir :: CChatItem c -> Either StoreError (ChatItem c d) - correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci -updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d) +getGroupCIWithReactions :: DB.Connection -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup) +getGroupCIWithReactions db user g@GroupInfo {groupId} itemId = do + liftIO . groupCIWithReactions db g =<< getGroupChatItem db user groupId itemId + +groupCIWithReactions :: DB.Connection -> GroupInfo -> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup) +groupCIWithReactions db g cci@(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of + Just sharedMsgId -> do + let GroupMember {memberId} = chatItemMember g ci + reactions <- getGroupCIReactions db g memberId sharedMsgId + pure $ CChatItem md ci {reactions} + Nothing -> pure cci + +updateGroupChatItem :: MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d) updateGroupChatItem db user groupId ci newContent live msgId_ = do currentTs <- liftIO getCurrentTime let ci' = updatedChatItem ci newContent live currentTs @@ -1370,7 +1381,7 @@ updateGroupChatItem db user groupId ci newContent live msgId_ = do -- this function assumes that the group item with correct chat direction already exists, -- it should be checked before calling it -updateGroupChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> Maybe MessageId -> IO () +updateGroupChatItem_ :: MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> Maybe MessageId -> IO () updateGroupChatItem_ db User {userId} groupId ChatItem {content, meta} msgId_ = do let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, itemTimed, itemLive, updatedAt} = meta itemDeleted' = isJust itemDeleted @@ -1501,7 +1512,7 @@ getGroupChatItemByAgentMsgId db user groupId connId msgId = do getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup) getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do currentTs <- getCurrentTime - join <$> firstRow (toGroupChatItem currentTs userContactId) (SEChatItemNotFound itemId) getItem + firstRow' (toGroupChatItem currentTs userContactId) (SEChatItemNotFound itemId) getItem where getItem = DB.query @@ -1671,18 +1682,15 @@ getChatItemVersions db itemId = do getDirectChatReactions_ :: DB.Connection -> Contact -> Chat 'CTDirect -> IO (Chat 'CTDirect) getDirectChatReactions_ db ct c@Chat {chatItems} = do - chatItems' <- forM chatItems $ \(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) -> do - reactions <- maybe (pure []) (getDirectCIReactions db ct) itemSharedMsgId - pure $ CChatItem md ci {reactions} + chatItems' <- mapM (directCIWithReactions db ct) chatItems pure c {chatItems = chatItems'} -getGroupChatReactions_ :: DB.Connection -> GroupInfo -> Chat 'CTGroup -> IO (Chat 'CTGroup) -getGroupChatReactions_ db g c@Chat {chatItems} = do - chatItems' <- forM chatItems $ \(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) -> do - let GroupMember {memberId} = chatItemMember g ci - reactions <- maybe (pure []) (getGroupCIReactions db g memberId) itemSharedMsgId +directCIWithReactions :: DB.Connection -> Contact -> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect) +directCIWithReactions db ct cci@(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of + Just sharedMsgId -> do + reactions <- getDirectCIReactions db ct sharedMsgId pure $ CChatItem md ci {reactions} - pure c {chatItems = chatItems'} + Nothing -> pure cci getDirectCIReactions :: DB.Connection -> Contact -> SharedMsgId -> IO [CIReactionCount] getDirectCIReactions db Contact {contactId} itemSharedMsgId =