mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: delete unused contacts after deleting group (#1503)
This commit is contained in:
JRoberts
GitHub
+32
-9
@@ -525,7 +525,19 @@ processChatCommand = \case
|
||||
withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members
|
||||
withStore' $ \db -> deleteGroupItemsAndMembers db user gInfo members
|
||||
withStore' $ \db -> deleteGroup db user gInfo
|
||||
let contactIds = mapMaybe memberContactId members
|
||||
forM_ contactIds $ \ctId ->
|
||||
deleteUnusedContact ctId `catchError` (toView . CRChatError)
|
||||
pure $ CRGroupDeletedUser gInfo
|
||||
where
|
||||
deleteUnusedContact contactId = do
|
||||
ct <- withStore $ \db -> getContact db user contactId
|
||||
unless (directContact ct) $ do
|
||||
ctGroupId <- withStore' $ \db -> checkContactHasGroups db user ct
|
||||
when (isNothing ctGroupId) $ do
|
||||
conns <- withStore $ \db -> getContactConnections db userId ct
|
||||
forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure ()
|
||||
withStore' $ \db -> deleteContactWithoutGroups db user ct
|
||||
CTContactRequest -> pure $ chatCmdError "not supported"
|
||||
APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of
|
||||
CTDirect -> do
|
||||
@@ -926,7 +938,7 @@ processChatCommand = \case
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent) Nothing Nothing
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
pure CRMemberRoleUser {groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
|
||||
APIRemoveMember groupId memberId -> withUser $ \user@User {userId} -> do
|
||||
APIRemoveMember groupId memberId -> withUser $ \user -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
|
||||
case find ((== memberId) . groupMemberId') members of
|
||||
Nothing -> throwChatError CEGroupMemberNotFound
|
||||
@@ -944,10 +956,8 @@ processChatCommand = \case
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) Nothing Nothing
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
deleteMemberConnection user m
|
||||
withStore' $ \db ->
|
||||
checkGroupMemberHasItems db user m >>= \case
|
||||
Just _ -> updateGroupMemberStatus db userId m GSMemRemoved
|
||||
Nothing -> deleteGroupMember db user m
|
||||
-- undeleted "member connected" chat item will prevent deletion of member record
|
||||
deleteOrUpdateMemberRecord user m
|
||||
pure $ CRUserDeletedMember gInfo m {memberStatus = GSMemRemoved}
|
||||
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
|
||||
@@ -957,6 +967,7 @@ processChatCommand = \case
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
-- TODO delete direct connections that were unused
|
||||
deleteGroupLink' user gInfo `catchError` \_ -> pure ()
|
||||
-- member records are not deleted to keep history
|
||||
forM_ members $ deleteMemberConnection user
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft
|
||||
pure $ CRLeftMemberUser gInfo {membership = membership {memberStatus = GSMemLeft}}
|
||||
@@ -2792,23 +2803,26 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
if memberId (membership :: GroupMember) == memId
|
||||
then checkRole membership $ do
|
||||
deleteGroupLink' user gInfo `catchError` \_ -> pure ()
|
||||
-- member records are not deleted to keep history
|
||||
forM_ members $ deleteMemberConnection user
|
||||
deleteMember membership RGEUserDeleted
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved
|
||||
deleteMemberItem RGEUserDeleted
|
||||
toView $ CRDeletedMemberUser gInfo {membership = membership {memberStatus = GSMemRemoved}} m
|
||||
else case find (sameMemberId memId) members of
|
||||
Nothing -> messageError "x.grp.mem.del with unknown member ID"
|
||||
Just member@GroupMember {groupMemberId, memberProfile} ->
|
||||
checkRole member $ do
|
||||
deleteMemberConnection user member
|
||||
deleteMember member $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)
|
||||
-- undeleted "member connected" chat item will prevent deletion of member record
|
||||
deleteOrUpdateMemberRecord user member
|
||||
deleteMemberItem $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)
|
||||
toView $ CRDeletedMember gInfo m member {memberStatus = GSMemRemoved}
|
||||
where
|
||||
checkRole GroupMember {memberRole} a
|
||||
| senderRole < GRAdmin || senderRole < memberRole =
|
||||
messageError "x.grp.mem.del with insufficient member permissions"
|
||||
| otherwise = a
|
||||
deleteMember member gEvent = do
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId member GSMemRemoved
|
||||
deleteMemberItem gEvent = do
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
|
||||
@@ -2818,6 +2832,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> MsgMeta -> m ()
|
||||
xGrpLeave gInfo m msg msgMeta = do
|
||||
deleteMemberConnection user m
|
||||
-- member record is not deleted to allow creation of "member left" chat item
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
@@ -2830,6 +2845,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
members <- getGroupMembers db user gInfo
|
||||
updateGroupMemberStatus db userId membership GSMemGroupDeleted
|
||||
pure members
|
||||
-- member records are not deleted to keep history
|
||||
forM_ ms $ deleteMemberConnection user
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted) Nothing
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
@@ -2987,6 +3003,13 @@ deleteMemberConnection user GroupMember {activeConn} = do
|
||||
deleteAgentConnectionAsync user conn `catchError` \_ -> pure ()
|
||||
withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
|
||||
|
||||
deleteOrUpdateMemberRecord :: ChatMonad m => User -> GroupMember -> m ()
|
||||
deleteOrUpdateMemberRecord user@User {userId} member =
|
||||
withStore' $ \db ->
|
||||
checkGroupMemberHasItems db user member >>= \case
|
||||
Just _ -> updateGroupMemberStatus db userId member GSMemRemoved
|
||||
Nothing -> deleteGroupMember db user member
|
||||
|
||||
sendDirectContactMessage :: (MsgEncodingI e, ChatMonad m) => Contact -> ChatMsgEvent e -> m (SndMessage, Int64)
|
||||
sendDirectContactMessage ct@Contact {activeConn = conn@Connection {connId, connStatus}} chatMsgEvent = do
|
||||
if connStatus == ConnReady || connStatus == ConnSndReady
|
||||
|
||||
+49
-19
@@ -35,6 +35,7 @@ module Simplex.Chat.Store
|
||||
createDirectContact,
|
||||
deleteContactConnectionsAndFiles,
|
||||
deleteContact,
|
||||
deleteContactWithoutGroups,
|
||||
getContactByName,
|
||||
getContact,
|
||||
getContactIdByName,
|
||||
@@ -47,6 +48,7 @@ module Simplex.Chat.Store
|
||||
updateContactUnreadChat,
|
||||
updateGroupUnreadChat,
|
||||
getUserContacts,
|
||||
getUserContactProfiles,
|
||||
createUserContactLink,
|
||||
getUserAddressConnections,
|
||||
getUserContactLinks,
|
||||
@@ -92,6 +94,7 @@ module Simplex.Chat.Store
|
||||
getUserGroups,
|
||||
getUserGroupDetails,
|
||||
getContactGroupPreferences,
|
||||
checkContactHasGroups,
|
||||
getGroupInvitation,
|
||||
createNewContactMember,
|
||||
createNewContactMemberAsync,
|
||||
@@ -595,6 +598,15 @@ deleteContact db user@User {userId} Contact {contactId, localDisplayName, active
|
||||
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
forM_ customUserProfileId $ \profileId -> deleteUnusedIncognitoProfileById_ db user profileId
|
||||
|
||||
-- should only be used if contact is not member of any groups
|
||||
deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> IO ()
|
||||
deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn = Connection {customUserProfileId}} = do
|
||||
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
deleteContactProfile_ db userId contactId
|
||||
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
forM_ customUserProfileId $ \profileId -> deleteUnusedIncognitoProfileById_ db user profileId
|
||||
|
||||
deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO ()
|
||||
deleteUnusedIncognitoProfileById_ db User {userId} profile_id =
|
||||
DB.executeNamed
|
||||
@@ -770,6 +782,22 @@ getUserContacts db user@User {userId} = do
|
||||
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ?" (Only userId)
|
||||
rights <$> mapM (runExceptT . getContact db user) contactIds
|
||||
|
||||
-- only used in tests
|
||||
getUserContactProfiles :: DB.Connection -> User -> IO [Profile]
|
||||
getUserContactProfiles db User {userId} =
|
||||
map toContactProfile
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT display_name, full_name, image, preferences
|
||||
FROM contact_profiles
|
||||
WHERE user_id = ?
|
||||
|]
|
||||
(Only userId)
|
||||
where
|
||||
toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe Preferences) -> (Profile)
|
||||
toContactProfile (displayName, fullName, image, preferences) = Profile {displayName, fullName, image, preferences}
|
||||
|
||||
createUserContactLink :: DB.Connection -> UserId -> ConnId -> ConnReqContact -> ExceptT StoreError IO ()
|
||||
createUserContactLink db userId agentConnId cReq =
|
||||
checkConstraint SEDuplicateContactLink . liftIO $ do
|
||||
@@ -1759,7 +1787,9 @@ deleteGroupItemsAndMembers db user@User {userId} GroupInfo {groupId} members = d
|
||||
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
void $ runExceptT cleanupHostGroupLinkConn_ -- to allow repeat connection via the same group link if one was used
|
||||
DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
forM_ members $ \m -> cleanupMemberContactAndProfile_ db user m
|
||||
forM_ members $ \m@GroupMember {memberProfile = LocalProfile {profileId}} -> do
|
||||
cleanupMemberProfileAndName_ db user m
|
||||
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user profileId
|
||||
where
|
||||
cleanupHostGroupLinkConn_ = do
|
||||
hostId <- getHostMemberId_ db user groupId
|
||||
@@ -1777,10 +1807,11 @@ deleteGroupItemsAndMembers db user@User {userId} GroupInfo {groupId} members = d
|
||||
(userId, userId, hostId)
|
||||
|
||||
deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
|
||||
deleteGroup db User {userId} GroupInfo {groupId, localDisplayName} = do
|
||||
deleteGroup db user@User {userId} GroupInfo {groupId, localDisplayName, membership = membership@GroupMember {memberProfile = LocalProfile {profileId}}} = do
|
||||
deleteGroupProfile_ db userId groupId
|
||||
DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
when (memberIncognito membership) $ deleteUnusedIncognitoProfileById_ db user profileId
|
||||
|
||||
deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
|
||||
deleteGroupProfile_ db userId groupId =
|
||||
@@ -1832,6 +1863,10 @@ getContactGroupPreferences db User {userId} Contact {contactId} = do
|
||||
|]
|
||||
(userId, contactId)
|
||||
|
||||
checkContactHasGroups :: DB.Connection -> User -> Contact -> IO (Maybe GroupId)
|
||||
checkContactHasGroups db User {userId} Contact {contactId} =
|
||||
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
|
||||
|
||||
getGroupInfoByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupInfo
|
||||
getGroupInfoByName db user gName = do
|
||||
gId <- getGroupIdByName db user gName
|
||||
@@ -2130,27 +2165,22 @@ checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} =
|
||||
maybeFirstRow fromOnly $ DB.query db "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ? LIMIT 1" (userId, groupId, groupMemberId)
|
||||
|
||||
deleteGroupMember :: DB.Connection -> User -> GroupMember -> IO ()
|
||||
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId} = do
|
||||
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, memberProfile = LocalProfile {profileId}} = do
|
||||
deleteGroupMemberConnection db user m
|
||||
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?" (userId, groupId, groupMemberId)
|
||||
DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId)
|
||||
cleanupMemberContactAndProfile_ db user m
|
||||
cleanupMemberProfileAndName_ db user m
|
||||
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user profileId
|
||||
|
||||
-- it's important this function is used in transaction after the actual group_members record is deleted, see checkIncognitoProfileInUse_
|
||||
cleanupMemberContactAndProfile_ :: DB.Connection -> User -> GroupMember -> IO ()
|
||||
cleanupMemberContactAndProfile_ db user@User {userId} m@GroupMember {groupMemberId, localDisplayName, memberContactId, memberContactProfileId, memberProfile = LocalProfile {profileId}} =
|
||||
case memberContactId of
|
||||
Just contactId ->
|
||||
runExceptT (getContact db user contactId) >>= \case
|
||||
Right ct@Contact {activeConn = Connection {connLevel, viaGroupLink}, contactUsed} ->
|
||||
unless ((connLevel == 0 && not viaGroupLink) || contactUsed) $ deleteContact db user ct
|
||||
_ -> pure ()
|
||||
Nothing -> do
|
||||
sameProfileMember :: (Maybe GroupMemberId) <- maybeFirstRow fromOnly $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1" (userId, memberContactProfileId, groupMemberId)
|
||||
unless (isJust sameProfileMember) $ do
|
||||
DB.execute db "DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?" (userId, memberContactProfileId)
|
||||
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user profileId
|
||||
cleanupMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO ()
|
||||
cleanupMemberProfileAndName_ db User {userId} GroupMember {groupMemberId, memberContactId, memberContactProfileId, localDisplayName} =
|
||||
-- check record has no memberContactId (contact_id) - it means contact has been deleted and doesn't use profile & ldn
|
||||
when (isNothing memberContactId) $ do
|
||||
-- check other group member records don't use profile & ldn
|
||||
sameProfileMember :: (Maybe GroupMemberId) <- maybeFirstRow fromOnly $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1" (userId, memberContactProfileId, groupMemberId)
|
||||
when (isNothing sameProfileMember) $ do
|
||||
DB.execute db "DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?" (userId, memberContactProfileId)
|
||||
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
|
||||
deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO ()
|
||||
deleteGroupMemberConnection db User {userId} GroupMember {groupMemberId} =
|
||||
|
||||
Reference in New Issue
Block a user