diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 2c47a383f2..31f158e780 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -317,6 +317,8 @@ data ChatCommand | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, updatedMessage :: UpdatedMessage} | APIDeleteChatItem ChatRef (NonEmpty ChatItemId) CIDeleteMode | APIDeleteMemberChatItem GroupId (NonEmpty ChatItemId) + | APIArchiveReceivedReports GroupId + | APIDeleteReceivedReports GroupId (NonEmpty ChatItemId) CIDeleteMode | APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction} | APIGetReactionMembers UserId GroupId ChatItemId MsgReaction | APIPlanForwardChatItems {fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 220d50f2d1..e54eae4472 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -678,11 +678,11 @@ processChatCommand' vr = \case else markDirectCIsDeleted user ct items True =<< liftIO getCurrentTime CTGroup -> withGroupLock "deleteChatItem" chatId $ do (gInfo, items) <- getCommandGroupChatItems user chatId itemIds - ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo case mode of CIDMInternal -> deleteGroupCIs user gInfo items True False Nothing =<< liftIO getCurrentTime CIDMInternalMark -> markGroupCIsDeleted user gInfo items True Nothing =<< liftIO getCurrentTime CIDMBroadcast -> do + ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo assertDeletable items assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier let msgIds = itemsMsgIds items @@ -711,30 +711,25 @@ processChatCommand' vr = \case APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do (gInfo, items) <- getCommandGroupChatItems user gId itemIds ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo - assertDeletable gInfo items - assertUserGroupRole gInfo GRAdmin -- TODO GRModerator when most users migrate - let msgMemIds = itemsMsgMemIds gInfo items - events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId (Just memId)) msgMemIds - mapM_ (sendGroupMessages user gInfo ms) events - delGroupChatItems user gInfo items True + delGroupChatItemsForMembers user gInfo ms items + APIArchiveReceivedReports gId -> withUser $ \user -> withFastStore $ \db -> do + g <- getGroupInfo db vr user gId + deleteTs <- liftIO getCurrentTime + ciIds <- liftIO $ markReceivedGroupReportsDeleted db user g deleteTs + pure $ CRGroupChatItemsDeleted user g ciIds True (Just $ membership g) + APIDeleteReceivedReports gId itemIds mode -> withUser $ \user -> withGroupLock "deleteReports" gId $ do + (gInfo, items) <- getCommandGroupChatItems user gId itemIds + unless (all isRcvReport items) $ throwChatError $ CECommandError "some items are not received reports" + case mode of + CIDMInternal -> deleteGroupCIs user gInfo items True False Nothing =<< liftIO getCurrentTime + CIDMInternalMark -> markGroupCIsDeleted user gInfo items True Nothing =<< liftIO getCurrentTime + CIDMBroadcast -> do + ms <- withFastStore' $ \db -> getGroupModerators db vr user gInfo + delGroupChatItemsForMembers user gInfo ms items where - assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM () - assertDeletable GroupInfo {membership = GroupMember {memberRole = membershipMemRole}} items = - unless (all itemDeletable items) $ throwChatError CEInvalidChatItemDelete - where - itemDeletable :: CChatItem 'CTGroup -> Bool - itemDeletable (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = - case chatDir of - CIGroupRcv GroupMember {memberRole} -> membershipMemRole >= memberRole && isJust itemSharedMsgId - CIGroupSnd -> isJust itemSharedMsgId - itemsMsgMemIds :: GroupInfo -> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)] - itemsMsgMemIds GroupInfo {membership = GroupMember {memberId = membershipMemId}} = mapMaybe itemMsgMemIds - where - itemMsgMemIds :: CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId) - itemMsgMemIds (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = - join <$> forM itemSharedMsgId $ \msgId -> Just $ case chatDir of - CIGroupRcv GroupMember {memberId} -> (msgId, memberId) - CIGroupSnd -> (msgId, membershipMemId) + isRcvReport = \case + CChatItem _ ChatItem {content = CIRcvMsgContent (MCReport {})} -> True + _ -> False APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> case cType of CTDirect -> withContactLock "chatItemReaction" chatId $ @@ -2718,12 +2713,39 @@ processChatCommand' vr = \case when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved unless (memberActive membership) $ throwChatError CEGroupMemberNotActive + delGroupChatItemsForMembers :: User -> GroupInfo -> [GroupMember] -> [CChatItem CTGroup] -> CM ChatResponse + delGroupChatItemsForMembers user gInfo ms items = do + assertDeletable gInfo items + assertUserGroupRole gInfo GRAdmin -- TODO GRModerator when most users migrate + let msgMemIds = itemsMsgMemIds gInfo items + events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId (Just memId)) msgMemIds + mapM_ (sendGroupMessages user gInfo ms) events + delGroupChatItems user gInfo items True + where + assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM () + assertDeletable GroupInfo {membership = GroupMember {memberRole = membershipMemRole}} items = + unless (all itemDeletable items) $ throwChatError CEInvalidChatItemDelete + where + itemDeletable :: CChatItem 'CTGroup -> Bool + itemDeletable (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = + case chatDir of + CIGroupRcv GroupMember {memberRole} -> membershipMemRole >= memberRole && isJust itemSharedMsgId + CIGroupSnd -> isJust itemSharedMsgId + itemsMsgMemIds :: GroupInfo -> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)] + itemsMsgMemIds GroupInfo {membership = GroupMember {memberId = membershipMemId}} = mapMaybe itemMsgMemIds + where + itemMsgMemIds :: CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId) + itemMsgMemIds (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = + join <$> forM itemSharedMsgId $ \msgId -> Just $ case chatDir of + CIGroupRcv GroupMember {memberId} -> (msgId, memberId) + CIGroupSnd -> (msgId, membershipMemId) + delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> CM ChatResponse delGroupChatItems user gInfo@GroupInfo {membership} items moderation = do deletedTs <- liftIO getCurrentTime when moderation $ do ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci membership deletedTs) - unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just membership) + unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds True (Just membership) let m = if moderation then Just membership else Nothing if groupFeatureMemberAllowed SGFFullDelete membership gInfo then deleteGroupCIs user gInfo items True False m deletedTs @@ -3718,6 +3740,8 @@ chatCommandP = "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <*> (" json" *> jsonP <|> " text " *> updatedMessagesTextP)), "/_delete item " *> (APIDeleteChatItem <$> chatRefP <*> _strP <*> _strP), "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <*> _strP), + "/_archive reports " *> (APIArchiveReceivedReports <$> A.decimal), + "/_delete reports " *> (APIDeleteReceivedReports <$> A.decimal <*> _strP <*> _strP), "/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> onOffP <* A.space <*> jsonP), "/_reaction members " *> (APIGetReactionMembers <$> A.decimal <* " #" <*> A.decimal <* A.space <*> A.decimal <* A.space <*> jsonP), "/_forward plan " *> (APIPlanForwardChatItems <$> chatRefP <*> _strP), diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index c72935eeac..f849223440 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -62,6 +62,7 @@ module Simplex.Chat.Store.Messages markGroupChatItemBlocked, markGroupCIBlockedByAdmin, markMessageReportsDeleted, + markReceivedGroupReportsDeleted, deleteLocalChatItem, updateDirectChatItemsRead, getDirectUnreadTimedItems, @@ -2438,10 +2439,24 @@ markMessageReportsDeleted db User {userId} GroupInfo {groupId} ChatItem {meta = [sql| UPDATE chat_items SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ? - WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND quoted_shared_msg_id = ? + WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND quoted_shared_msg_id = ? AND item_deleted = ? RETURNING chat_item_id; |] - (DBCIDeleted, deletedTs, groupMemberId, currentTs, userId, groupId, MCReport_, itemSharedMsgId) + (DBCIDeleted, deletedTs, groupMemberId, currentTs, userId, groupId, MCReport_, itemSharedMsgId, DBCINotDeleted) + +markReceivedGroupReportsDeleted :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO [ChatItemId] +markReceivedGroupReportsDeleted db User {userId} GroupInfo {groupId, membership} deletedTs = do + currentTs <- liftIO getCurrentTime + map fromOnly + <$> DB.query + db + [sql| + UPDATE chat_items + SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ? + WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND item_deleted = ? AND item_sent = ? + RETURNING chat_item_id + |] + (DBCIDeleted, deletedTs, groupMemberId' membership, currentTs, userId, groupId, MCReport_, DBCINotDeleted, False) getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupInfo -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup) getGroupChatItemBySharedMsgId db user@User {userId} g@GroupInfo {groupId} groupMemberId sharedMsgId = do diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index a94da2dbe6..2df28067ad 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -3325,11 +3325,11 @@ SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?) Query: UPDATE chat_items SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ? - WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND quoted_shared_msg_id = ? + WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND quoted_shared_msg_id = ? AND item_deleted = ? RETURNING chat_item_id; Plan: -SEARCH chat_items USING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id=? AND msg_content_tag=?) +SEARCH chat_items USING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id=? AND msg_content_tag=? AND item_deleted=?) Query: UPDATE chat_items diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 0c5a6bef36..254fc6e813 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -5978,7 +5978,7 @@ testGroupMemberReports = alice ##> "\\\\ #jokes cath inappropriate joke" concurrentlyN_ [ do - alice <## "#jokes: 1 messages deleted by member alice" + alice <## "#jokes: 1 messages deleted by user" alice <## "message marked deleted by you", do bob <# "#jokes cath> [marked deleted by alice] inappropriate joke" @@ -5991,6 +5991,77 @@ testGroupMemberReports = alice #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by you]")]) bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by alice]")]) dan #$> ("/_get chat #1 content=report count=100", chat, [(1, "report content [marked deleted by alice]")]) + -- delete all reports locally + alice #$> ("/clear #jokes", id, "#jokes: all messages are removed locally ONLY") + bob #$> ("/clear #jokes", id, "#jokes: all messages are removed locally ONLY") + dan #$> ("/clear #jokes", id, "#jokes: all messages are removed locally ONLY") + cath #> "#jokes ok joke" + concurrentlyN_ + [ alice <# "#jokes cath> ok joke", + bob <# "#jokes cath> ok joke", + dan <# "#jokes cath> ok joke" + ] + dan ##> "/report #jokes content ok joke" + dan <# "#jokes > cath ok joke" + dan <## " report content" + dan ##> "/report #jokes spam ok joke" + dan <# "#jokes > cath ok joke" + dan <## " report spam" + concurrentlyN_ + [ do + alice <# "#jokes dan> > cath ok joke" + alice <## " report content" + alice <# "#jokes dan> > cath ok joke" + alice <## " report spam", + do + bob <# "#jokes dan> > cath ok joke" + bob <## " report content" + bob <# "#jokes dan> > cath ok joke" + bob <## " report spam", + (cath ("/_get chat #1 content=report count=100", chat, [(0, "report content"), (0, "report spam")]) + bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content"), (0, "report spam")]) + cath #$> ("/_get chat #1 content=report count=100", chat, []) + dan #$> ("/_get chat #1 content=report count=100", chat, [(1, "report content"), (1, "report spam")]) + alice ##> "/_archive reports 1" + alice <## "#jokes: 2 messages deleted by user" + (bob ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by you]"), (0, "report spam [marked deleted by you]")]) + bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content"), (0, "report spam")]) + bob ##> "/_archive reports 1" + bob <## "#jokes: 2 messages deleted by user" + bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by you]"), (0, "report spam [marked deleted by you]")]) + -- delete reports for all admins + alice #$> ("/clear #jokes", id, "#jokes: all messages are removed locally ONLY") + bob #$> ("/clear #jokes", id, "#jokes: all messages are removed locally ONLY") + dan #$> ("/clear #jokes", id, "#jokes: all messages are removed locally ONLY") + cath #> "#jokes ok joke 2" + concurrentlyN_ + [ alice <# "#jokes cath> ok joke 2", + bob <# "#jokes cath> ok joke 2", + dan <# "#jokes cath> ok joke 2" + ] + dan ##> "/report #jokes content ok joke 2" + dan <# "#jokes > cath ok joke 2" + dan <## " report content" + concurrentlyN_ + [ do + alice <# "#jokes dan> > cath ok joke 2" + alice <## " report content", + do + bob <# "#jokes dan> > cath ok joke 2" + bob <## " report content", + (cath "/last_item_id" + i :: ChatItemId <- read <$> getTermLine alice + alice ##> ("/_delete reports 1 " <> show i <> " broadcast") + alice <## "message marked deleted by you" + bob <# "#jokes dan> [marked deleted by alice] report content" + alice #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by you]")]) + bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by alice]")]) + dan #$> ("/_get chat #1 content=report count=100", chat, [(1, "report content")]) testMemberMention :: HasCallStack => TestParams -> IO () testMemberMention =