IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: delete unused contacts after deleting group (#1503)

Browse Source
This commit is contained in:
JRoberts
2022-12-06 17:12:39 +04:00
committed by GitHub
parent edf2d02a0d
commit fb05218558
3 changed files with 303 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
src/Simplex/Chat.hs
View File

@@ -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

68
src/Simplex/Chat/Store.hs
View File

@@ -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} =

226
tests/ChatTests.hs
View File

@@ -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 <name> 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 <message> 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 <message> 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 <name> 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 </)
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` ["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 <name> 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 </)
bob `hasContactProfiles` ["bob"]
testSetAlias :: IO ()
testSetAlias = testChat2 aliceProfile bobProfile $
\alice 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