core, ui: member full delete with messages (#6994)

2026-08-29 01:09:15 +00:00 · 2026-05-25 10:43:36 +00:00
parent fe6b5186e1
commit c017c25d0f
11 changed files with 352 additions and 115 deletions
@@ -2871,7 +2871,6 @@ processChatCommand vr nm = \case
      let acis' = map (updateACIGroupInfo gInfo') acis
      unless (null acis') $ toView $ CEvtNewChatItems user acis'
      unless (null errs) $ toView $ CEvtChatErrors errs
-      when withMessages $ deleteMessages user gInfo' deleted
      pure $ CRUserDeletedMembers user gInfo' deleted withMessages msgSigned -- same order is not guaranteed
    where
      selectMembers :: S.Set GroupMemberId -> [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
@@ -2916,11 +2915,14 @@ processChatCommand vr nm = \case
                Left e -> Just $ Left e
              itemsData = mapMaybe skipUnwantedItem itemsData_
          cis_ <- saveSndChatItems user (CDGroupSnd gInfo chatScopeInfo) False itemsData Nothing False
+          -- MUST run before delMember so getGroupMemberFileInfo can still resolve file info under fullDelete.
+          when withMessages $ deleteMessages user gInfo memsToDelete
          deleteMembersConnections' user memsToDelete True
          (errs, deleted) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (delMember db) memsToDelete)
          let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo chatScopeInfo)) $ rights cis_
          pure (errs, deleted, acis, signed)
          where
+            fullDelete = withMessages && groupFeatureUserAllowed SGFFullDelete gInfo
            sndItemData :: GroupMember -> SndMessage -> Maybe (NewSndChatItemData c)
            sndItemData GroupMember {groupMemberId, memberProfile, memberStatus} msg
              | memberStatus == GSMemRemoved || memberStatus == GSMemLeft = Nothing
@@ -2933,10 +2935,12 @@ processChatCommand vr nm = \case
              -- voided result (updated group info) may have incorrect state of membersRequireAttention.
              -- To avoid complicating code by chaining group info updates,
              -- instead we re-read it once after deleting all members before response.
-              void $ deleteOrUpdateMemberRecordIO db user gInfo m
+              if fullDelete
+                then void $ fullyDeleteMemberRecordIO db user gInfo m
+                else void $ deleteOrUpdateMemberRecordIO db user gInfo m
              pure m {memberStatus = GSMemRemoved}
      deleteMessages user gInfo@GroupInfo {membership} ms
-        | groupFeatureUserAllowed SGFFullDelete gInfo = deleteGroupMembersCIs user gInfo ms membership
+        | groupFeatureUserAllowed SGFFullDelete gInfo = deleteGroupMembersCIs user gInfo ms
        | otherwise = markGroupMembersCIsDeleted user gInfo ms membership
  APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
    gInfo@GroupInfo {membership} <- withFastStore $ \db -> getGroupInfo db vr user groupId
@@ -515,22 +515,20 @@ updateACIGroupInfo gInfo' = \case
    AChatItem SCTGroup dir (GroupChat gInfo' chatScopeInfo) ci
  aci -> aci

-deleteGroupMemberCIs :: MsgDirectionI d => User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> CM ()
-deleteGroupMemberCIs user gInfo member byGroupMember msgDir = do
-  deletedTs <- liftIO getCurrentTime
-  filesInfo <- withStore' $ \db -> deleteGroupMemberCIs_ db user gInfo member byGroupMember msgDir deletedTs
+deleteGroupMemberCIs :: User -> GroupInfo -> GroupMember -> CM ()
+deleteGroupMemberCIs user gInfo member = do
+  filesInfo <- withStore' $ \db -> deleteGroupMemberCIs_ db user gInfo member
  deleteCIFiles user filesInfo

-deleteGroupMembersCIs :: User -> GroupInfo -> [GroupMember] -> GroupMember -> CM ()
-deleteGroupMembersCIs user gInfo members byGroupMember = do
-  deletedTs <- liftIO getCurrentTime
-  filesInfo <- withStore' $ \db -> fmap concat $ forM members $ \m -> deleteGroupMemberCIs_ db user gInfo m byGroupMember SMDRcv deletedTs
+deleteGroupMembersCIs :: User -> GroupInfo -> [GroupMember] -> CM ()
+deleteGroupMembersCIs user gInfo members = do
+  filesInfo <- withStore' $ \db -> fmap concat $ forM members $ deleteGroupMemberCIs_ db user gInfo
  deleteCIFiles user filesInfo

-deleteGroupMemberCIs_ :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> UTCTime -> IO [CIFileInfo]
-deleteGroupMemberCIs_ db user gInfo member byGroupMember msgDir deletedTs = do
+deleteGroupMemberCIs_ :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO [CIFileInfo]
+deleteGroupMemberCIs_ db user gInfo member = do
  fs <- getGroupMemberFileInfo db user gInfo member
-  updateMemberCIsModerated db user gInfo member byGroupMember msgDir deletedTs
+  deleteMemberCIs db user gInfo member
  pure fs

 deleteLocalCIs :: User -> NoteFolder -> [CChatItem 'CTLocal] -> Bool -> Bool -> CM ChatResponse
@@ -1853,6 +1851,17 @@ deleteOrUpdateMemberRecordIO db user@User {userId} gInfo m = do
        Nothing -> deleteGroupMember db user m'
  pure gInfo'

+-- Unlike deleteOrUpdateMemberRecord, skips checkGroupMemberHasItems.
+fullyDeleteMemberRecord :: User -> GroupInfo -> GroupMember -> CM GroupInfo
+fullyDeleteMemberRecord user gInfo m =
+  withStore' $ \db -> fullyDeleteMemberRecordIO db user gInfo m
+
+fullyDeleteMemberRecordIO :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO GroupInfo
+fullyDeleteMemberRecordIO db user gInfo m = do
+  (gInfo', m') <- deleteSupportChatIfExists db user gInfo m
+  deleteGroupMember db user m'
+  pure gInfo'
+
 updateMemberRecordDeleted :: User -> GroupInfo -> GroupMember -> GroupMemberStatus -> CM GroupInfo
 updateMemberRecordDeleted user@User {userId} gInfo m newStatus =
  withStore' $ \db -> do
@@ -3176,7 +3176,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
            updateGroupMemberStatus db userId membership GSMemRemoved
            when (maybe False (/= RSRejected) (relayOwnStatus gInfo)) $ updateRelayOwnStatus_ db gInfo RSInactive
          let membership' = membership {memberStatus = GSMemRemoved}
-          when withMessages $ deleteMessages gInfo membership' SMDSnd
+          when withMessages $ deleteMessages gInfo membership'
          deleteMemberItem msg gInfo RGEUserDeleted
          toView $ CEvtDeletedMemberUser user gInfo {membership = membership'} m withMessages msgSigned
          pure $ Just DJSGroup {jobSpec = DJRelayRemoved}
@@ -3196,15 +3196,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                    deleteMemberConnection' deletedMember True
                  else deleteMemberConnection deletedMember
                let deliveryScope = memberEventDeliveryScope deletedMember
+                    deletedMember' = deletedMember {memberStatus = GSMemRemoved}
+                when withMessages $ deleteMessages gInfo deletedMember'
                gInfo' <- case deliveryScope of
                  -- Keep member record if it's support scope - it will be required for forwarding inside that scope.
                  Just (DJSMemberSupport _) | shouldForward -> updateMemberRecordDeleted user gInfo deletedMember GSMemRemoved
-                  -- Undeleted "member connected" chat item will prevent deletion of member record.
-                  _ -> deleteOrUpdateMemberRecord user gInfo deletedMember
+                  _
+                    | withMessages && groupFeatureMemberAllowed SGFFullDelete m gInfo ->
+                        fullyDeleteMemberRecord user gInfo deletedMember
+                    -- Undeleted "member connected" chat item will prevent deletion of member record.
+                    | otherwise -> deleteOrUpdateMemberRecord user gInfo deletedMember
                gInfo'' <- updatePublicGroupData user gInfo'
                let wasDeleted = memberStatus == GSMemRemoved || memberStatus == GSMemLeft
-                    deletedMember' = deletedMember {memberStatus = GSMemRemoved}
-                when withMessages $ deleteMessages gInfo'' deletedMember' SMDRcv
                -- Clear forwardedByMember if it references the deleted member,
                -- as the member record was already deleted above.
                let RcvMessage {forwardedByMember = fwdBy} = msg
@@ -3221,9 +3224,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
          (gi', m', scopeInfo) <- mkGroupChatScope gi m
          (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gi' scopeInfo m') msg' brokerTs (CIRcvGroupEvent gEvent)
          groupMsgToView cInfo ci
-        deleteMessages :: MsgDirectionI d => GroupInfo -> GroupMember -> SMsgDirection d -> CM ()
-        deleteMessages gInfo' delMem msgDir
-          | groupFeatureMemberAllowed SGFFullDelete m gInfo' = deleteGroupMemberCIs user gInfo' delMem m msgDir
+        deleteMessages :: GroupInfo -> GroupMember -> CM ()
+        deleteMessages gInfo' delMem
+          | groupFeatureMemberAllowed SGFFullDelete m gInfo' = deleteGroupMemberCIs user gInfo' delMem
          | otherwise = markGroupMemberCIsDeleted user gInfo' delMem m
        forwardToMember :: GroupMember -> CM ()
        forwardToMember member =
@@ -65,7 +65,7 @@ module Simplex.Chat.Store.Messages
    updateGroupCIMentions,
    deleteGroupChatItem,
    updateGroupChatItemModerated,
-    updateMemberCIsModerated,
+    deleteMemberCIs,
    updateGroupCIBlockedByAdmin,
    markGroupChatItemDeleted,
    markMemberCIsDeleted,
@@ -211,9 +211,19 @@ getGroupFileInfo db User {userId} GroupInfo {groupId} =
    <$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.group_id = ?") (userId, groupId)

 getGroupMemberFileInfo :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO [CIFileInfo]
-getGroupMemberFileInfo db User {userId} GroupInfo {groupId} GroupMember {groupMemberId} =
-  map toFileInfo
-    <$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.group_id = ? AND i.group_member_id = ?") (userId, groupId, groupMemberId)
+getGroupMemberFileInfo db User {userId} GroupInfo {groupId, membership} member
+  | groupMemberId' member == groupMemberId' membership =
+      map toFileInfo
+        <$> DB.query
+          db
+          (fileInfoQuery <> " WHERE i.user_id = ? AND i.group_id = ? AND i.group_member_id IS NULL AND i.item_sent = 1")
+          (userId, groupId)
+  | otherwise =
+      map toFileInfo
+        <$> DB.query
+          db
+          (fileInfoQuery <> " WHERE i.user_id = ? AND i.group_id = ? AND i.group_member_id = ?")
+          (userId, groupId, groupMemberId' member)

 deleteGroupChatItemsMessages :: DB.Connection -> User -> GroupInfo -> IO ()
 deleteGroupChatItemsMessages db User {userId} GroupInfo {groupId} = do
@@ -2814,39 +2824,60 @@ updateGroupChatItemModerated db User {userId} GroupInfo {groupId} ci m@GroupMemb
      (deletedTs, groupMemberId, toContent, toText, currentTs, userId, groupId, itemId)
  pure ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just deletedTs) m), editable = False, deletable = False}, formattedText = Nothing}

-updateMemberCIsModerated :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> UTCTime -> IO ()
-updateMemberCIsModerated db User {userId} GroupInfo {groupId, membership} member byGroupMember md deletedTs = do
-  itemIds <- updateCIs =<< getCurrentTime
+deleteMemberCIs :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO ()
+deleteMemberCIs db User {userId} GroupInfo {groupId, membership} member = do
+  items <- selectItems
+  let itemMemberId = memberId' member
 #if defined(dbPostgres)
-  let inItemIds = Only $ In (map fromOnly itemIds)
-  DB.execute db "DELETE FROM messages WHERE message_id IN (SELECT message_id FROM chat_item_messages WHERE chat_item_id IN ?)" inItemIds
-  DB.execute db "DELETE FROM chat_item_versions WHERE chat_item_id IN ?" inItemIds
+  let itemIds = map fst items
+      sharedMsgIds = mapMaybe snd items
+  unless (null itemIds) $ do
+    DB.execute
+      db
+      [sql|
+        DELETE FROM messages WHERE message_id IN (
+          SELECT message_id FROM chat_item_messages WHERE chat_item_id IN ?
+        )
+      |]
+      (Only (In itemIds))
+    DB.execute db "DELETE FROM chat_item_versions WHERE chat_item_id IN ?" (Only (In itemIds))
+  unless (null sharedMsgIds) $
+    DB.execute
+      db
+      "DELETE FROM chat_item_reactions WHERE group_id = ? AND shared_msg_id IN ? AND item_member_id IS NOT DISTINCT FROM ?"
+      (groupId, In sharedMsgIds, itemMemberId)
+  unless (null itemIds) $
+    DB.execute
+      db
+      "DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND chat_item_id IN ?"
+      (userId, groupId, In itemIds)
 #else
-  DB.executeMany db deleteChatItemMessagesQuery itemIds
-  DB.executeMany db "DELETE FROM chat_item_versions WHERE chat_item_id = ?" itemIds
+  forM_ items $ \(itemId, itemSharedMsgId_) -> do
+    deleteChatItemMessages_ db itemId
+    deleteChatItemVersions_ db itemId
+    forM_ itemSharedMsgId_ $ \sharedMsgId ->
+      DB.execute
+        db
+        "DELETE FROM chat_item_reactions WHERE group_id = ? AND shared_msg_id = ? AND item_member_id IS NOT DISTINCT FROM ?"
+        (groupId, sharedMsgId, itemMemberId)
+    DB.execute
+      db
+      "DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND chat_item_id = ?"
+      (userId, groupId, itemId)
 #endif
  where
-    memId = groupMemberId' member
-    updateQuery =
-      [sql|
-        UPDATE chat_items
-        SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
-        WHERE user_id = ? AND group_id = ?
-      |]
-    updateCIs :: UTCTime -> IO [Only Int64]
-    updateCIs currentTs
-      | memId == groupMemberId' membership =
+    selectItems :: IO [(ChatItemId, Maybe SharedMsgId)]
+    selectItems
+      | groupMemberId' member == groupMemberId' membership =
          DB.query
            db
-            (updateQuery <> " AND group_member_id IS NULL AND item_sent = 1 RETURNING chat_item_id")
-            (columns :. (userId, groupId))
+            "SELECT chat_item_id, shared_msg_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id IS NULL AND item_sent = 1"
+            (userId, groupId)
      | otherwise =
          DB.query
            db
-            (updateQuery <> " AND group_member_id = ? RETURNING chat_item_id")
-            (columns :. (userId, groupId, memId))
-      where
-        columns = (deletedTs, groupMemberId' byGroupMember, msgDirToModeratedContent_ md, ciModeratedText, currentTs)
+            "SELECT chat_item_id, shared_msg_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?"
+            (userId, groupId, groupMemberId' member)

 updateGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> UTCTime -> IO (ChatItem 'CTGroup d)
 updateGroupCIBlockedByAdmin db User {userId} GroupInfo {groupId} ci deletedTs = do
@@ -3925,22 +3925,6 @@ Query:
 Plan:
 SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?)

-Query: 
-        UPDATE chat_items
-        SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
-        WHERE user_id = ? AND group_id = ?
-       AND group_member_id = ? RETURNING chat_item_id
-Plan:
-SEARCH chat_items USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
-
-Query: 
-        UPDATE chat_items
-        SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
-        WHERE user_id = ? AND group_id = ?
-       AND group_member_id IS NULL AND item_sent = 1 RETURNING chat_item_id
-Plan:
-SEARCH chat_items USING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
-
 Query: 
        UPDATE chat_items
        SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
@@ -5682,6 +5666,15 @@ Plan:
 SEARCH i USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
 SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)

+Query: 
+    SELECT f.file_id, f.ci_file_status, f.file_path
+    FROM chat_items i
+    JOIN files f ON f.chat_item_id = i.chat_item_id
+   WHERE i.user_id = ? AND i.group_id = ? AND i.group_member_id IS NULL AND i.item_sent = 1
+Plan:
+SEARCH i USING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
+SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
+
 Query: 
    SELECT f.file_id, f.ci_file_status, f.file_path
    FROM chat_items i
@@ -6171,6 +6164,18 @@ SEARCH chat_items USING COVERING INDEX idx_chat_items_fwd_from_chat_item_id (fwd
 SEARCH files USING COVERING INDEX idx_files_chat_item_id (chat_item_id=?)
 SEARCH groups USING COVERING INDEX idx_groups_chat_item_id (chat_item_id=?)

+Query: DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
+Plan:
+SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
+SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
+SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
+SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
+SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
+SEARCH chat_item_messages USING COVERING INDEX sqlite_autoindex_chat_item_messages_2 (chat_item_id=?)
+SEARCH chat_items USING COVERING INDEX idx_chat_items_fwd_from_chat_item_id (fwd_from_chat_item_id=?)
+SEARCH files USING COVERING INDEX idx_files_chat_item_id (chat_item_id=?)
+SEARCH groups USING COVERING INDEX idx_groups_chat_item_id (chat_item_id=?)
+
 Query: DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?
 Plan:
 SEARCH chat_items USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
@@ -6717,6 +6722,14 @@ Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AN
 Plan:
 SEARCH chat_items USING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=? AND shared_msg_id=?)

+Query: SELECT chat_item_id, shared_msg_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?
+Plan:
+SEARCH chat_items USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
+
+Query: SELECT chat_item_id, shared_msg_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id IS NULL AND item_sent = 1
+Plan:
+SEARCH chat_items USING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
+
 Query: SELECT chat_item_ttl FROM contacts WHERE contact_id = ? LIMIT 1
 Plan:
 SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?)