From fb0521855878983b213fcc569055f6416d5528a1 Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Tue, 6 Dec 2022 17:12:39 +0400 Subject: [PATCH] core: delete unused contacts after deleting group (#1503) --- src/Simplex/Chat.hs | 41 +++++-- src/Simplex/Chat/Store.hs | 68 ++++++++---- tests/ChatTests.hs | 226 +++++++++++++++++++++++++++++++++++++- 3 files changed, 303 insertions(+), 32 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index aa107f54b..4dc814875 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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 diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 3755d3da5..0d92f443c 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -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} = diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 6c183e9bb..a8b2f66e9 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -24,7 +24,9 @@ import qualified Data.Text as T import Simplex.Chat.Call import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Options (ChatOpts (..)) +import Simplex.Chat.Store (getUserContactProfiles) import Simplex.Chat.Types +import Simplex.Messaging.Agent.Store.SQLite (withTransaction) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Util (unlessM) import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist) @@ -71,6 +73,7 @@ chatTests = do it "group message delete" testGroupMessageDelete it "update group profile" testUpdateGroupProfile it "update member role" testUpdateMemberRole + it "unused contacts are deleted after all their groups are deleted" testGroupDeleteUnusedContacts describe "async group connections" $ do xit "create and join group when clients go offline" testGroupAsync describe "user profiles" $ do @@ -116,6 +119,8 @@ chatTests = do it "join group incognito" testJoinGroupIncognito it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito it "can't see global preferences update" testCantSeeGlobalPrefsUpdateIncognito + it "deleting contact first, group second deletes incognito profile" testDeleteContactThenGroupDeletesIncognitoProfile + it "deleting group first, contact second deletes incognito profile" testDeleteGroupThenContactDeletesIncognitoProfile describe "contact aliases" $ do it "set contact alias" testSetAlias it "set connection alias" testSetConnectionAlias @@ -1379,6 +1384,102 @@ testUpdateMemberRole = alice ##> "/d #team" alice <## "you have insufficient permissions for this group command" +testGroupDeleteUnusedContacts :: IO () +testGroupDeleteUnusedContacts = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + -- create group 1 + createGroup3 "team" alice bob cath + -- create group 2 + alice ##> "/g club" + alice <## "group #club is created" + alice <## "use /a club to add members" + alice ##> "/a club bob" + concurrentlyN_ + [ alice <## "invitation to join the group #club sent to bob", + do + bob <## "#club: alice invites you to join the group as admin" + bob <## "use /j club to accept" + ] + bob ##> "/j club" + concurrently_ + (alice <## "#club: bob joined the group") + (bob <## "#club: you joined the group") + alice ##> "/a club cath" + concurrentlyN_ + [ alice <## "invitation to join the group #club sent to cath", + do + cath <## "#club: alice invites you to join the group as admin" + cath <## "use /j club to accept" + ] + cath ##> "/j club" + concurrentlyN_ + [ alice <## "#club: cath joined the group", + do + cath <## "#club: you joined the group" + cath <## "#club: member bob_1 (Bob) is connected" + cath <## "contact bob_1 is merged into bob" + cath <## "use @bob to send messages", + do + bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)" + bob <## "#club: new member cath_1 is connected" + bob <## "contact cath_1 is merged into cath" + bob <## "use @cath to send messages" + ] + -- list contacts + bob ##> "/cs" + bob <## "alice (Alice)" + bob <## "cath (Catherine)" + cath ##> "/cs" + cath <## "alice (Alice)" + cath <## "bob (Bob)" + -- delete group 1 + alice ##> "/d #team" + concurrentlyN_ + [ alice <## "#team: you deleted the group", + do + bob <## "#team: alice deleted the group" + bob <## "use /d #team to delete the local copy of the group", + do + cath <## "#team: alice deleted the group" + cath <## "use /d #team to delete the local copy of the group" + ] + bob ##> "/d #team" + bob <## "#team: you deleted the group" + cath ##> "/d #team" + cath <## "#team: you deleted the group" + -- contacts and profiles are kept + bob ##> "/cs" + bob <## "alice (Alice)" + bob <## "cath (Catherine)" + bob `hasContactProfiles` ["alice", "bob", "cath"] + cath ##> "/cs" + cath <## "alice (Alice)" + cath <## "bob (Bob)" + cath `hasContactProfiles` ["alice", "bob", "cath"] + -- delete group 2 + alice ##> "/d #club" + concurrentlyN_ + [ alice <## "#club: you deleted the group", + do + bob <## "#club: alice deleted the group" + bob <## "use /d #club to delete the local copy of the group", + do + cath <## "#club: alice deleted the group" + cath <## "use /d #club to delete the local copy of the group" + ] + bob ##> "/d #club" + bob <## "#club: you deleted the group" + cath ##> "/d #club" + cath <## "#club: you deleted the group" + -- unused contacts and profiles are deleted + bob ##> "/cs" + bob <## "alice (Alice)" + bob `hasContactProfiles` ["alice", "bob"] + cath ##> "/cs" + cath <## "alice (Alice)" + cath `hasContactProfiles` ["alice", "cath"] + testGroupAsync :: IO () testGroupAsync = withTmpFiles $ do print (0 :: Integer) @@ -2955,6 +3056,110 @@ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathPr cath <## "alice updated preferences for you:" cath <## "Full deletion: off (you allow: default (no), contact allows: yes)" +testDeleteContactThenGroupDeletesIncognitoProfile :: IO () +testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $ + \alice bob -> do + -- bob connects incognito to alice + alice ##> "/c" + inv <- getInvitation alice + bob #$> ("/incognito on", id, "ok") + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + bobIncognito <- getTermLine bob + concurrentlyN_ + [ alice <## (bobIncognito <> ": contact is connected"), + do + bob <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito) + bob <## "use /info alice to print out this incognito profile again" + ] + -- bob joins group using incognito profile + alice ##> "/g team" + alice <## "group #team is created" + alice <## "use /a team to add members" + alice ##> ("/a team " <> bobIncognito) + concurrentlyN_ + [ alice <## ("invitation to join the group #team sent to " <> bobIncognito), + do + bob <## "#team: alice invites you to join the group as admin" + bob <## ("use /j team to join incognito as " <> bobIncognito) + ] + bob ##> "/j team" + concurrently_ + (alice <## ("#team: " <> bobIncognito <> " joined the group")) + (bob <## ("#team: you joined the group incognito as " <> bobIncognito)) + bob ##> "/cs" + bob <## "i alice (Alice)" + bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito] + -- delete contact + bob ##> "/d alice" + bob <## "alice: contact is deleted" + bob ##> "/cs" + (bob "/l team" + concurrentlyN_ + [ do + bob <## "#team: you left the group" + bob <## "use /d #team to delete the group", + alice <## ("#team: " <> bobIncognito <> " left the group") + ] + bob ##> "/d #team" + bob <## "#team: you deleted the group" + bob `hasContactProfiles` ["bob"] + +testDeleteGroupThenContactDeletesIncognitoProfile :: IO () +testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $ + \alice bob -> do + -- bob connects incognito to alice + alice ##> "/c" + inv <- getInvitation alice + bob #$> ("/incognito on", id, "ok") + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + bobIncognito <- getTermLine bob + concurrentlyN_ + [ alice <## (bobIncognito <> ": contact is connected"), + do + bob <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito) + bob <## "use /info alice to print out this incognito profile again" + ] + -- bob joins group using incognito profile + alice ##> "/g team" + alice <## "group #team is created" + alice <## "use /a team to add members" + alice ##> ("/a team " <> bobIncognito) + concurrentlyN_ + [ alice <## ("invitation to join the group #team sent to " <> bobIncognito), + do + bob <## "#team: alice invites you to join the group as admin" + bob <## ("use /j team to join incognito as " <> bobIncognito) + ] + bob ##> "/j team" + concurrently_ + (alice <## ("#team: " <> bobIncognito <> " joined the group")) + (bob <## ("#team: you joined the group incognito as " <> bobIncognito)) + bob ##> "/cs" + bob <## "i alice (Alice)" + bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito] + -- delete group + bob ##> "/l team" + concurrentlyN_ + [ do + bob <## "#team: you left the group" + bob <## "use /d #team to delete the group", + alice <## ("#team: " <> bobIncognito <> " left the group") + ] + bob ##> "/d #team" + bob <## "#team: you deleted the group" + bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito] + -- delete contact + bob ##> "/d alice" + bob <## "alice: contact is deleted" + bob ##> "/cs" + (bob do @@ -3185,10 +3390,10 @@ testProhibitDirectMessages = [ cath <## ("#team: dan joined the group"), do dan <## ("#team: you joined the group") - dan <### - [ "#team: member alice (Alice) is connected", - "#team: member bob (Bob) is connected" - ], + dan + <### [ "#team: member alice (Alice) is connected", + "#team: member bob (Bob) is connected" + ], do alice <## ("#team: cath added dan (Daniel) to the group (connecting...)") alice <## ("#team: new member dan is connected"), @@ -4482,3 +4687,16 @@ getGroupLink cc gName created = do cc <## ("to show it again: /show link #" <> gName) cc <## ("to delete it: /delete link #" <> gName <> " (joined members will remain connected to you)") pure link + +hasContactProfiles :: TestCC -> [ContactName] -> Expectation +hasContactProfiles cc names = + getContactProfiles cc >>= \ps -> ps `shouldMatchList` names + +getContactProfiles :: TestCC -> IO [ContactName] +getContactProfiles cc = do + user_ <- readTVarIO (currentUser $ chatController cc) + case user_ of + Nothing -> pure [] + Just user -> do + profiles <- withTransaction (chatStore $ chatController cc) $ \db -> getUserContactProfiles db user + pure $ map (\Profile {displayName} -> displayName) profiles