core: api to archive reports (#5618)

* core: api to archive reports

* fix queries

* query plans

* fix test

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}

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),

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

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

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 </)
+        ]
+      alice #$> ("/_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 </)
+      alice #$> ("/_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 </)
+        ]
+      alice ##> "/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 =