core: allow to delete contacts that are in groups; group contacts management rfc (#1229)

This commit is contained in:
JRoberts 2022-10-20 19:27:00 +04:00 committed by GitHub
parent c4fc8a97b1
commit 98cb1c39f2
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
13 changed files with 244 additions and 83 deletions

View file

@ -552,15 +552,6 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
r is CR.ContactDeleted && type == ChatType.Direct -> return true
r is CR.ContactConnectionDeleted && type == ChatType.ContactConnection -> return true
r is CR.GroupDeletedUser && type == ChatType.Group -> return true
r is CR.ChatCmdError -> {
val e = r.chatError
if (e is ChatError.ChatErrorChat && e.errorType is ChatErrorType.ContactGroups) {
AlertManager.shared.showAlertMsg(
generalGetString(R.string.cannot_delete_contact),
String.format(generalGetString(R.string.contact_cannot_be_deleted_as_they_are_in_groups), e.errorType.contact.displayName, e.errorType.groupNames.joinToString(", "))
)
}
}
else -> {
val titleId = when (type) {
ChatType.Direct -> R.string.error_deleting_contact
@ -2052,12 +2043,10 @@ sealed class ChatErrorType {
val string: String get() = when (this) {
is NoActiveUser -> "noActiveUser"
is InvalidConnReq -> "invalidConnReq"
is ContactGroups -> "groupNames $groupNames"
is СommandError -> "commandError $message"
}
@Serializable @SerialName("noActiveUser") class NoActiveUser: ChatErrorType()
@Serializable @SerialName("invalidConnReq") class InvalidConnReq: ChatErrorType()
@Serializable @SerialName("contactGroups") class ContactGroups(val contact: Contact, val groupNames: List<String>): ChatErrorType()
@Serializable @SerialName("commandError") class СommandError(val message: String): ChatErrorType()
}

View file

@ -61,8 +61,6 @@
<string name="connection_error_auth_desc">Entweder hat Ihr Kontakt die Verbindung gelöscht, oder dieser Link wurde bereits verwendet, es könnte sich um einen Fehler handeln - Bitte melden Sie es uns.\nBitten Sie Ihren Kontakt darum einen weiteren Verbindungs-Link zu erzeugen, um sich neu verbinden zu können und stellen Sie sicher, dass Sie eine stabile Netzwerk-Verbindung haben.</string>
<string name="error_accepting_contact_request">Fehler beim Akzeptieren der Kontaktanfrage</string>
<string name="sender_may_have_deleted_the_connection_request">Der Absender hat möglicherweise die Verbindungsanfrage gelöscht.</string>
<string name="cannot_delete_contact">Der Kontakt kann nicht gelöscht werden!</string>
<string name="contact_cannot_be_deleted_as_they_are_in_groups">Der Kontakt mit <xliff:g id="contactName" example="Jane Doe">%1$s!</xliff:g> kann nicht gelöscht werden, da er Mitglied einer oder mehrerer dieser Gruppen ist <xliff:g id="groups" example="[team, chess club]">%2$s</xliff:g>.</string>
<string name="error_deleting_contact">Fehler beim Löschen des Kontakts</string>
<string name="error_deleting_group">Fehler beim Löschen der Gruppe</string>
<string name="error_deleting_contact_request">Fehler beim Löschen der Kontakt-Anfrage</string>

View file

@ -61,8 +61,6 @@
<string name="connection_error_auth_desc">Возможно, ваш контакт удалил ссылку, или она уже была использована. Если это не так, то это может быть ошибкой - пожалуйста, сообщите нам об этом.\nЧтобы установить соединение, попросите ваш контакт создать еще одну ссылку и проверьте ваше соединение с сетью.</string>
<string name="error_accepting_contact_request">Ошибка при принятии запроса на соединение</string>
<string name="sender_may_have_deleted_the_connection_request">Отправитель мог удалить запрос на соединение.</string>
<string name="cannot_delete_contact">Невозможно удалить контакт!</string>
<string name="contact_cannot_be_deleted_as_they_are_in_groups">Контакт <xliff:g id="contactName" example="Jane Doe">%1$s!</xliff:g> не может быть удален, так как является членом групп(ы) <xliff:g id="groups" example="[team, chess club]">%2$s</xliff:g>.</string>
<string name="error_deleting_contact">Ошибка удаления контакта</string>
<string name="error_deleting_group">Ошибка удаления группы</string>
<string name="error_deleting_contact_request">Ошибка удаления запроса</string>

View file

@ -61,8 +61,6 @@
<string name="connection_error_auth_desc">Unless your contact deleted the connection or this link was already used, it might be a bug - please report it.\nTo connect, please ask your contact to create another connection link and check that you have a stable network connection.</string>
<string name="error_accepting_contact_request">Error accepting contact request</string>
<string name="sender_may_have_deleted_the_connection_request">Sender may have deleted the connection request.</string>
<string name="cannot_delete_contact">Can\'t delete contact!</string>
<string name="contact_cannot_be_deleted_as_they_are_in_groups">Contact <xliff:g id="contactName" example="Jane Doe">%1$s!</xliff:g> cannot be deleted, they are a member of the group(s) <xliff:g id="groups" example="[team, chess club]">%2$s</xliff:g>.</string>
<string name="error_deleting_contact">Error deleting contact</string>
<string name="error_deleting_group">Error deleting group</string>
<string name="error_deleting_contact_request">Error deleting contact request</string>

View file

@ -426,18 +426,10 @@ func deleteChat(_ chat: Chat) async {
DispatchQueue.main.async { ChatModel.shared.removeChat(cInfo.id) }
} catch let error {
logger.error("deleteChat apiDeleteChat error: \(responseError(error))")
switch error as? ChatResponse {
case let .chatCmdError(.error(.contactGroups(contact, groupNames))):
AlertManager.shared.showAlertMsg(
title: "Can't delete contact!",
message: "Contact \(contact.displayName) cannot be deleted, they are a member of the group(s) \(groupNames.joined(separator: ", "))."
)
default:
AlertManager.shared.showAlertMsg(
title: "Error deleting chat!",
message: "Error: \(responseError(error))"
)
}
AlertManager.shared.showAlertMsg(
title: "Error deleting chat!",
message: "Error: \(responseError(error))"
)
}
}

View file

@ -56,14 +56,12 @@ struct ChatInfoView: View {
enum ChatInfoViewAlert: Identifiable {
case deleteContactAlert
case contactGroupsAlert(groupNames: [GroupName])
case clearChatAlert
case networkStatusAlert
var id: String {
switch self {
case .deleteContactAlert: return "deleteContactAlert"
case .contactGroupsAlert: return "contactGroupsAlert"
case .clearChatAlert: return "clearChatAlert"
case .networkStatusAlert: return "networkStatusAlert"
}
@ -119,7 +117,6 @@ struct ChatInfoView: View {
.alert(item: $alert) { alertItem in
switch(alertItem) {
case .deleteContactAlert: return deleteContactAlert()
case let .contactGroupsAlert(groupNames): return contactGroupsAlert(groupNames)
case .clearChatAlert: return clearChatAlert()
case .networkStatusAlert: return networkStatusAlert()
}
@ -230,9 +227,6 @@ struct ChatInfoView: View {
}
} catch let error {
logger.error("deleteContactAlert apiDeleteChat error: \(error.localizedDescription)")
if case let .chatCmdError(.error(.contactGroups(_, groupNames))) = error as? ChatResponse {
alert = .contactGroupsAlert(groupNames: groupNames)
}
}
}
},
@ -240,13 +234,6 @@ struct ChatInfoView: View {
)
}
private func contactGroupsAlert(_ groupNames: [GroupName]) -> Alert {
Alert(
title: Text("Can't delete contact!"),
message: Text("Contact \(contact.displayName) cannot be deleted, they are a member of the group(s) \(groupNames.joined(separator: ", ")).")
)
}
private func clearChatAlert() -> Alert {
Alert(
title: Text("Clear conversation?"),

View file

@ -801,7 +801,6 @@ public enum ChatErrorType: Decodable {
case invalidConnReq
case invalidChatMessage(message: String)
case contactNotReady(contact: Contact)
case contactGroups(contact: Contact, groupNames: [GroupName])
case groupUserRole
case groupContactRole(contactName: ContactName)
case groupDuplicateMember(contactName: ContactName)

View file

@ -0,0 +1,83 @@
# Group contacts management
## Problem
Currently for each joining group member two connections are created - one for group communication, and one for member's direct contact. The member's contact connection is created to enable members to communicate with each other directly outside of group, as in "Send direct message" functionality we have in mobile applications, similarly to the same feature available in other messengers.
It works well for small groups where members trust each other, since it allows for immediate communication between members after connections are established on the group join - otherwise group members would have to establish direct connection separately, and often wait for several more asynchronous interactions before being able to send messages. It doesn't work as well in some other communication scenarios, and entails certain problems:
- Larger "public" groups and/or groups where members don't trust each other - such groups' members may want to communicate with other group members only inside the group, and not have a direct contact with each joining member.
- Groups where owner/host doesn't want group members to be able to communicate directly between each other, e.g. inter-business communication, or some other asymmetric scenario where sensitive messages should not be shared between members.
> It should be mentioned though that a group connection is no different from a direct connection on the protocol level, and it's entirely possible to use a group connection for direct communication with modified clients, so any change to the existing group protocol we make to SimpleX Chat clients does not fully solve this issue - group's owner/host can't know whether members' clients are unmodified. So probably we shouldn't be taking this scenario into consideration.
- Using a modified client, a host can carry out MITM attack(s) when introducing a new group member to existing members, so group members can't know whether their direct connection is secure.
> This problem can be partially softened by allowing members to validate some connection fingerprint out-of-band, or even to "straighten" their connection (replace it with one established by passing secret out-of-band). This can be a separate feature. It requires members to have access to some out-of-band channel and is also not possible entirely in the current group protocol, so anyway it's another scenario where automatically establishing a direct connection backfires.
> Another point to consider is that currently we do not expose the information about direct connection "indirectness" level enough for users to distinguish contacts created via groups (and so may have been compromised by a MITM attack) - we can mark such contacts in UI.
- Users can't delete group member contacts while they have groups that have these contacts as members. Users may want it either because of one of the reasons above, or purely out of aesthetic reasons, e.g. to avoid cluttering chat with unused contacts. It's not a protocol limitation, only a property of existing implementation, so we should be able to change it with some schema/code changes.
Another related problem is that for group members that join via a group link, a contact is created and not even hidden from chat list (unlike introduced members' contacts). This is true for both sides - the joining member, and the host who invites via a group link.
## Solution
Out of the listed problems in existing group protocol we could change the fact that direct connections and contacts are created unconditionally, allow to delete group member contacts without deleting groups and hide/disable/delete contacts created via group links.
### Establishing direct connections
- We can add a group wide configuration deciding whether to establish direct connections for this group or not, configurable by a group owner.
- Should it be a part of group profile? If so, profile update can be received by group members asynchronously and they should be able to process situations where one has this setting enabled and another not - probably if any one of them has it disabled, direct connection shouldn't be created. E.g., an introduced member can simply ignore `directConnReq` from `XGrpMemFwd`.
- Alternatively or additionally it can be a global user setting.
- If it's a user setting, it can be communicated when sending `XGrpAcpt` (additional field for host to consider in future introductions?), `XGrpMemIntro` (additional field in `MemberInfo`?), `XGrpMemInv`, `XGrpMemFwd` (make `directConnReq` Maybe in `IntroInvitation`?).
- How do we make it backwards compatible? Just send an empty string in `directConnReq` so the attempt to establish a direct connection by the introduced member is failed?
Should there still be an option to request direct connection with member, e.g. by sending a new type of message inside a group connection?
This is a rather complex change if it is to be properly communicated between group members and can be designed / implemented in a separate scope.
### Deleting group member contacts
Table `group_members` has `contact_id` foreign key with cascade deletion, options to allow contact deletion:
- When deleting contact, search group members with corresponding contact id and set it to null, also do not delete contact profile and local display name if it had associated members.
- Re-create table with constraint defined as `ON DELETE SET NULL` - the required migration is more complex than the first option and the resulting optimization is unnecessary.
Another option is to mark contact as deleted (could be a dedicated flag) and hide it, and delete the direct connection.
### Group link contacts
On the inviting side (the one that created link and auto-accepts group join requests):
- To hide joining contacts:
- We shouldn't create group invitation chat item in direct chat.
- Probably a new flag is required so that these contacts are filtered out together with introduced contacts (see `c.conn_level = 0 OR i.chat_item_id IS NOT NULL` filter in `getDirectChatPreviews_`).
- We should also filter out pending connections in `getContactConnectionChatPreviews_`, probably a separate flag is needed in the `connections` for that as well.
- We already filter out respective contact requests out in `getContactRequestChatPreviews_`, see `uc.group_id IS NULL`).
- User should still be made aware that his client auto-accepted and invited a joining member - it can be done via a new `RcvGroupEvent` chat item, e.g., "invited a new contact X via group link" (should it be created as unread?).
- Interaction between group links and "no direct connections for groups" feature:
- Delete created contact after member joins group?
- Communicate the setting to the joining member's client, if he still sends messages ignore them. Can be part of group link metadata.
On the joining side:
- Same or similar filtering logic for contact pending connections and contacts can be applied if we include metadata into group link - the fact that it's a group link should be enough.
- Interaction with "no direct connections for groups" feature - group link metadata can include flag that host's contact and direct connection are to be removed after joining. Joining client should respect this flag, otherwise his messages other than required for group join may be ignored by host's client - see above.
> The problem that a group link contact is not filtered out is less pressing on the joining side compared to the inviting side as the latter will/may have uncontrolled amount of contacts connected via a group link, when the joining side will only have one per link and it's created on user action, so we may ignore this for the joining side initially.

View file

@ -486,20 +486,17 @@ processChatCommand = \case
APIDeleteChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of
CTDirect -> do
ct@Contact {localDisplayName} <- withStore $ \db -> getContact db userId chatId
withStore' (\db -> getContactGroupNames db userId ct) >>= \case
[] -> do
filesInfo <- withStore' $ \db -> getContactFileInfo db user ct
conns <- withStore $ \db -> getContactConnections db userId ct
withChatLock . procCmd $ do
forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo
forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure ()
-- functions below are called in separate transactions to prevent crashes on android
-- (possibly, race condition on integrity check?)
withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct
withStore' $ \db -> deleteContact db userId ct
unsetActive $ ActiveC localDisplayName
pure $ CRContactDeleted ct
gs -> throwChatError $ CEContactGroups ct gs
filesInfo <- withStore' $ \db -> getContactFileInfo db user ct
conns <- withStore $ \db -> getContactConnections db userId ct
withChatLock . procCmd $ do
forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo
forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure ()
-- functions below are called in separate transactions to prevent crashes on android
-- (possibly, race condition on integrity check?)
withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct
withStore' $ \db -> deleteContact db userId ct
unsetActive $ ActiveC localDisplayName
pure $ CRContactDeleted ct
CTContactConnection -> withChatLock . procCmd $ do
conn@PendingContactConnection {pccConnId, pccAgentConnId} <- withStore $ \db -> getPendingContactConnection db userId chatId
deleteAgentConnectionAsync' user pccConnId pccAgentConnId
@ -518,7 +515,7 @@ processChatCommand = \case
-- functions below are called in separate transactions to prevent crashes on android
-- (possibly, race condition on integrity check?)
withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members
withStore' $ \db -> deleteGroupItemsAndMembers db user gInfo
withStore' $ \db -> deleteGroupItemsAndMembers db user gInfo members
withStore' $ \db -> deleteGroup db user gInfo
pure $ CRGroupDeletedUser gInfo
CTContactRequest -> pure $ chatCmdError "not supported"
@ -1814,7 +1811,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
withStore' (\db -> getViaGroupContact db user m) >>= \case
Nothing -> do
notifyMemberConnected gInfo m
messageError "implementation error: connected member does not have contact"
messageWarning "connected member does not have contact"
Just ct@Contact {activeConn = Connection {connStatus}} ->
when (connStatus == ConnReady) $ do
notifyMemberConnected gInfo m

View file

@ -464,7 +464,6 @@ data ChatErrorType
| CEInvalidConnReq
| CEInvalidChatMessage {message :: String}
| CEContactNotReady {contact :: Contact}
| CEContactGroups {contact :: Contact, groupNames :: [GroupName]}
| CEGroupUserRole
| CEContactIncognitoCantInvite
| CEGroupIncognitoCantInvite

View file

@ -31,7 +31,6 @@ module Simplex.Chat.Store
getProfileById,
getConnReqContactXContactId,
createDirectContact,
getContactGroupNames,
deleteContactConnectionsAndFiles,
deleteContact,
getContactByName,
@ -241,7 +240,7 @@ import Data.Functor (($>))
import Data.Int (Int64)
import Data.List (find, sortBy, sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe)
import Data.Ord (Down (..))
import Data.Text (Text)
import qualified Data.Text as T
@ -534,19 +533,6 @@ createContact_ db userId connId Profile {displayName, fullName, image} localAlia
DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
pure . Right $ (ldn, contactId, profileId)
getContactGroupNames :: DB.Connection -> UserId -> Contact -> IO [GroupName]
getContactGroupNames db userId Contact {contactId} =
map fromOnly
<$> DB.query
db
[sql|
SELECT DISTINCT g.local_display_name
FROM groups g
JOIN group_members m ON m.group_id = g.group_id
WHERE g.user_id = ? AND m.contact_id = ?
|]
(userId, contactId)
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
DB.execute
@ -565,9 +551,15 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do
deleteContact :: DB.Connection -> UserId -> Contact -> IO ()
deleteContact db userId Contact {contactId, localDisplayName} = do
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
deleteContactProfile_ db userId contactId
ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
if isNothing ctMember
then do
deleteContactProfile_ db userId contactId
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
else do
currentTs <- getCurrentTime
DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO ()
deleteContactProfile_ db userId contactId =
@ -1641,10 +1633,13 @@ deleteGroupConnectionsAndFiles db User {userId} GroupInfo {groupId} members = do
forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId' m)
DB.execute db "DELETE FROM files WHERE user_id = ? AND group_id = ?" (userId, groupId)
deleteGroupItemsAndMembers :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroupItemsAndMembers db User {userId} GroupInfo {groupId} = do
deleteGroupItemsAndMembers :: DB.Connection -> User -> GroupInfo -> [GroupMember] -> IO ()
deleteGroupItemsAndMembers db user@User {userId} GroupInfo {groupId} members = do
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId)
DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
forM_ members $ \m@GroupMember {groupMemberId, memberContactId, memberContactProfileId} -> unless (isJust memberContactId) $ 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) $ deleteMemberProfileAndName_ db user m
deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroup db User {userId} GroupInfo {groupId, localDisplayName} = do
@ -1953,9 +1948,17 @@ createNewMember_
pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn}
deleteGroupMember :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId} = do
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, memberContactId, memberContactProfileId} = do
deleteGroupMemberConnection db user m
DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId)
unless (isJust memberContactId) $ 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) $ deleteMemberProfileAndName_ db user m
deleteMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO ()
deleteMemberProfileAndName_ db User {userId} GroupMember {memberContactProfileId, localDisplayName} = 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} =

View file

@ -955,7 +955,6 @@ viewChatError = \case
CEInvalidConnReq -> viewInvalidConnReq
CEInvalidChatMessage e -> ["chat message error: " <> sShow e]
CEContactNotReady c -> [ttyContact' c <> ": not ready"]
CEContactGroups c gNames -> [ttyContact' c <> ": contact cannot be deleted, it is a member of the group(s) " <> ttyGroups gNames]
CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
CEGroupUserRole -> ["you have insufficient permissions for this group command"]

View file

@ -58,6 +58,8 @@ chatTests = do
it "create group with the same displayName" testGroupSameName
it "invitee delete group when in status invited" testGroupDeleteWhenInvited
it "re-add member in status invited" testGroupReAddInvited
it "delete contact before they accept group invitation, contact joins group" testGroupDeleteInvitedContact
it "member profile is kept when deleting group if other groups have this member" testDeleteGroupMemberProfileKept
it "remove contact from group and add again" testGroupRemoveAdd
it "list groups containing group invitations" testGroupList
it "group message quoted replies" testGroupMessageQuotedReply
@ -466,12 +468,12 @@ testGroupShared alice bob cath checkMessages = do
concurrently_
(bob <# "#team alice> hello")
(cath <# "#team alice> hello")
threadDelay 1000000 -- server assigns timestamps with one second precision
when checkMessages $ threadDelay 1000000 -- server assigns timestamps with one second precision
bob #> "#team hi there"
concurrently_
(alice <# "#team bob> hi there")
(cath <# "#team bob> hi there")
threadDelay 1000000
when checkMessages $ threadDelay 1000000
cath #> "#team hey team"
concurrently_
(alice <# "#team cath> hey team")
@ -512,6 +514,20 @@ testGroupShared alice bob cath checkMessages = do
cath ##> "#team hello"
cath <## "you are no longer a member of the group"
bob <##> cath
-- delete contact
alice ##> "/d bob"
alice <## "bob: contact is deleted"
alice ##> "@bob hey"
alice <## "no contact bob"
when checkMessages $ threadDelay 1000000
alice #> "#team checking connection"
bob <# "#team alice> checking connection"
when checkMessages $ threadDelay 1000000
bob #> "#team received"
alice <# "#team bob> received"
when checkMessages $ do
alice @@@ [("@cath", "sent invitation to join group team as admin"), ("#team", "received")]
bob @@@ [("@alice", "received invitation to join group team as admin"), ("@cath", "hey"), ("#team", "received")]
-- test clearing chat
alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
alice #$> ("/_get chat #1 count=100", chat, [])
@ -539,6 +555,8 @@ testGroupShared alice bob cath checkMessages = do
alice #$> ("/_read chat #1", id, "ok")
bob #$> ("/_read chat #1", id, "ok")
cath #$> ("/_read chat #1", id, "ok")
alice #$> ("/_unread chat #1 on", id, "ok")
alice #$> ("/_unread chat #1 off", id, "ok")
testGroup2 :: IO ()
testGroup2 =
@ -746,6 +764,9 @@ testGroupDelete =
cath <## "you are no longer a member of the group"
cath ##> "/d #team"
cath <## "#team: you deleted the group"
alice <##> bob
alice <##> cath
bob <##> cath
testGroupSameName :: IO ()
testGroupSameName =
@ -820,6 +841,104 @@ testGroupReAddInvited =
bob <## "use /j team_1 to accept"
]
testGroupDeleteInvitedContact :: IO ()
testGroupDeleteInvitedContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/g team"
alice <## "group #team is created"
alice <## "use /a team <name> to add members"
alice ##> "/a team bob"
concurrentlyN_
[ alice <## "invitation to join the group #team sent to bob",
do
bob <## "#team: alice invites you to join the group as admin"
bob <## "use /j team to accept"
]
alice ##> "/d bob"
alice <## "bob: contact is deleted"
bob ##> "/j team"
concurrently_
(alice <## "#team: bob joined the group")
(bob <## "#team: you joined the group")
alice #> "#team hello"
bob <# "#team alice> hello"
bob #> "#team hi there"
alice <# "#team bob> hi there"
alice ##> "@bob hey"
alice <## "no contact bob"
bob #> "@alice hey"
(alice </)
testDeleteGroupMemberProfileKept :: IO ()
testDeleteGroupMemberProfileKept =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
-- group 1
alice ##> "/g team"
alice <## "group #team is created"
alice <## "use /a team <name> to add members"
alice ##> "/a team bob"
concurrentlyN_
[ alice <## "invitation to join the group #team sent to bob",
do
bob <## "#team: alice invites you to join the group as admin"
bob <## "use /j team to accept"
]
bob ##> "/j team"
concurrently_
(alice <## "#team: bob joined the group")
(bob <## "#team: you joined the group")
alice #> "#team hello"
bob <# "#team alice> hello"
bob #> "#team hi there"
alice <# "#team bob> hi there"
-- 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 #> "#club hello"
bob <# "#club alice> hello"
bob #> "#club hi there"
alice <# "#club bob> hi there"
-- delete contact
alice ##> "/d bob"
alice <## "bob: contact is deleted"
alice ##> "@bob hey"
alice <## "no contact bob"
bob #> "@alice hey"
(alice </)
-- 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"
]
alice ##> "#team hi"
alice <## "no group #team"
bob ##> "/d #team"
bob <## "#team: you deleted the group"
-- group 2 still works
alice #> "#club checking connection"
bob <# "#club alice> checking connection"
bob #> "#club received"
alice <# "#club bob> received"
testGroupRemoveAdd :: IO ()
testGroupRemoveAdd =
testChat3 aliceProfile bobProfile cathProfile $