From 2fc6873c42c18577f0267a83178e8dcdb5b92dff Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Sat, 27 Aug 2022 19:56:03 +0400 Subject: [PATCH] core: simplify incognito feature - remove host/invitee incognito profiles communication; remove incognito mode group creation and join; use same incognito profile known to host when joining (#978) --- docs/protocol/simplex-chat.schema.json | 12 - src/Simplex/Chat.hs | 119 +++--- src/Simplex/Chat/Controller.hs | 15 +- src/Simplex/Chat/Messages.hs | 15 +- .../M20220812_incognito_profiles.hs | 2 +- src/Simplex/Chat/Protocol.hs | 8 +- src/Simplex/Chat/Store.hs | 66 +--- src/Simplex/Chat/Types.hs | 1 - src/Simplex/Chat/View.hs | 126 +++--- tests/ChatTests.hs | 362 +++++++----------- tests/ProtocolTests.hs | 12 +- 11 files changed, 279 insertions(+), 459 deletions(-) diff --git a/docs/protocol/simplex-chat.schema.json b/docs/protocol/simplex-chat.schema.json index 76612d22fb..a0c6ec5706 100644 --- a/docs/protocol/simplex-chat.schema.json +++ b/docs/protocol/simplex-chat.schema.json @@ -108,12 +108,6 @@ "invitedMember": {"ref": "memberIdRole"}, "connRequest": {"ref": "connReqUri"}, "groupProfile": {"ref": "profile"} - }, - "optionalProperties": { - "fromMemberProfile": {"ref": "profile"}, - "metadata": { - "comment": "fromMemberProfile is user's custom profile to be used in the group - invitee should use this profile for the host's group member" - } } }, "memberIdRole": { @@ -323,12 +317,6 @@ "params": { "properties": { "memberId": {"ref": "base64url"} - }, - "optionalProperties": { - "memberProfile": {"ref": "profile"}, - "metadata": { - "comment": "memberProfile is user's custom profile to be used in the group - host should use this profile for the invitee's group member" - } } } } diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 5fd93ec61b..de5e74fa62 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -625,12 +625,10 @@ processChatCommand = \case incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) connectionStats <- withAgent (`getConnectionServers` contactConnId ct) pure $ CRContactInfo ct connectionStats (fmap fromLocalProfile incognitoProfile) - APIGroupMemberInfo gId gMemberId -> withUser $ \user@User {userId} -> do - -- [incognito] print group member main profile - (g, m@GroupMember {memberContactProfileId}) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId - mainProfile <- if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing + APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m) - pure $ CRGroupMemberInfo g m connectionStats mainProfile + pure $ CRGroupMemberInfo g m connectionStats ContactInfo cName -> withUser $ \User {userId} -> do contactId <- withStore $ \db -> getContactIdByName db userId cName processChatCommand $ APIContactInfo contactId @@ -724,32 +722,29 @@ processChatCommand = \case processChatCommand $ APIUpdateChatItem chatRef editedItemId mc NewGroup gProfile -> withUser $ \user -> do gVar <- asks idsDrg - -- [incognito] create membership with incognito profile - incognito <- readTVarIO =<< asks incognitoMode - incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile incognitoProfile) - pure $ CRGroupCreated groupInfo incognitoProfile + groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile) + pure $ CRGroupCreated groupInfo APIAddMember groupId contactId memRole -> withUser $ \user@User {userId} -> withChatLock $ do -- TODO for large groups: no need to load all members to determine if contact is a member (group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db userId contactId - -- [incognito] forbid to invite contact to whom user is connected as incognito if user's membership is not incognito let Group gInfo@GroupInfo {localDisplayName, groupProfile, membership} members = group GroupMember {memberRole = userRole, memberId = userMemberId} = membership Contact {localDisplayName = cName} = contact - when (contactConnIncognito contact && not (memberIncognito membership)) $ throwChatError CEGroupNotIncognitoCantInvite + -- [incognito] forbid to invite contact to whom user is connected incognito + when (contactConnIncognito contact) $ throwChatError CEContactIncognitoCantInvite + -- [incognito] forbid to invite contacts if user joined the group using an incognito profile + when (memberIncognito membership) $ throwChatError CEGroupIncognitoCantInvite when (userRole < GRAdmin || userRole < memRole) $ throwChatError CEGroupUserRole when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined gInfo) unless (memberActive membership) $ throwChatError CEGroupMemberNotActive let sendInvitation member@GroupMember {groupMemberId, memberId} cReq = do - -- [incognito] if membership is incognito, send its incognito profile in GroupInvitation - let incognitoProfile = if memberIncognito membership then Just (fromLocalProfile $ memberProfile membership) else Nothing - groupInv = GroupInvitation (MemberIdRole userMemberId userRole) incognitoProfile (MemberIdRole memberId memRole) cReq groupProfile + let groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile msg <- sendDirectContactMessage contact $ XGrpInv groupInv - let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending, invitedIncognito = Just $ memberIncognito membership}) memRole + let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole ci <- saveSndChatItem user (CDDirectSnd contact) msg content Nothing Nothing toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci setActive $ ActiveG localDisplayName - pure $ CRSentGroupInvitation gInfo contact member incognitoProfile + pure $ CRSentGroupInvitation gInfo contact member case contactMember contact members of Nothing -> do gVar <- asks idsDrg @@ -765,24 +760,13 @@ processChatCommand = \case APIJoinGroup groupId -> withUser $ \user@User {userId} -> do ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} <- withStore $ \db -> getGroupInvitation db user groupId withChatLock . procCmd $ do - -- [incognito] if incognito mode is enabled [AND membership is not incognito] update membership to use incognito profile - incognito <- readTVarIO =<< asks incognitoMode - g'@GroupInfo {membership = membership'} <- - if incognito && not (memberIncognito membership) - then do - incognitoProfile <- liftIO generateRandomProfile - membership' <- withStore $ \db -> createMemberIncognitoProfile db userId membership (Just incognitoProfile) - pure g {membership = membership'} - else pure g - -- [incognito] if membership is incognito, send its incognito profile in XGrpAcpt - let incognitoProfile = if memberIncognito membership' then Just (fromLocalProfile $ memberProfile membership') else Nothing - agentConnId <- withAgent $ \a -> joinConnection a True connRequest . directMessage $ XGrpAcpt (memberId (membership' :: GroupMember)) incognitoProfile + agentConnId <- withAgent $ \a -> joinConnection a True connRequest . directMessage $ XGrpAcpt (memberId (membership :: GroupMember)) withStore' $ \db -> do createMemberConnection db userId fromMember agentConnId updateGroupMemberStatus db userId fromMember GSMemAccepted - updateGroupMemberStatus db userId membership' GSMemAccepted + updateGroupMemberStatus db userId membership GSMemAccepted updateCIGroupInvitationStatus user - pure $ CRUserAcceptedGroupSent g' {membership = membership' {memberStatus = GSMemAccepted}} + pure $ CRUserAcceptedGroupSent g {membership = membership {memberStatus = GSMemAccepted}} where updateCIGroupInvitationStatus user@User {userId} = do AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db user groupId @@ -1445,10 +1429,11 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) Nothing Nothing toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci _ -> pure () - Just (gInfo, m@GroupMember {activeConn}) -> do + Just (gInfo@GroupInfo {membership}, m@GroupMember {activeConn}) -> do when (maybe False ((== ConnReady) . connStatus) activeConn) $ do notifyMemberConnected gInfo m - when (memberCategory m == GCPreMember) $ probeMatchingContacts ct + let connectedIncognito = contactConnIncognito ct || memberIncognito membership + when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito SENT msgId -> do sentMsgDeliveryEvent conn msgId withStore' (\db -> getDirectChatItemByAgentMsgId db userId contactId connId msgId) >>= \case @@ -1471,18 +1456,15 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage _ -> pure () processGroupMessage :: ACommand 'Agent -> Connection -> GroupInfo -> GroupMember -> m () - processGroupMessage agentMsg conn gInfo@GroupInfo {groupId, localDisplayName = gName, membership, chatSettings} m@GroupMember {memberContactProfileId} = case agentMsg of + processGroupMessage agentMsg conn gInfo@GroupInfo {groupId, localDisplayName = gName, membership, chatSettings} m = case agentMsg of CONF confId _ connInfo -> do ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo case memberCategory m of GCInviteeMember -> case chatMsgEvent of - XGrpAcpt memId incognitoProfile + XGrpAcpt memId | sameMemberId memId m -> do - -- [incognito] update member profile to incognito profile - withStore $ \db -> do - liftIO $ updateGroupMemberStatus db userId m GSMemAccepted - void $ createMemberIncognitoProfile db userId m incognitoProfile + withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted allowAgentConnection conn confId XOk | otherwise -> messageError "x.grp.acpt: memberId is different from expected" _ -> messageError "CONF from invited member must have x.grp.acpt" @@ -1491,7 +1473,6 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage XGrpMemInfo memId _memProfile | sameMemberId memId m -> do -- TODO update member profile - -- [incognito] send membership incognito profile allowAgentConnection conn confId $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" _ -> messageError "CONF from member must have x.grp.mem.info" @@ -1516,17 +1497,13 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage unless (enableNtfs chatSettings) . withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) False case memberCategory m of GCHostMember -> do - -- [incognito] chat item & event with indication that host connected incognito - mainProfile <- fmap fromLocalProfile <$> if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing - memberConnectedChatItem gInfo m mainProfile - toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} (memberIncognito membership) + memberConnectedChatItem gInfo m + toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} setActive $ ActiveG gName showToast ("#" <> gName) "you are connected to group" GCInviteeMember -> do - -- [incognito] chat item & event with indication that invitee connected incognito - mainProfile <- fmap fromLocalProfile <$> if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing - memberConnectedChatItem gInfo m mainProfile - toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected} mainProfile + memberConnectedChatItem gInfo m + toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected} setActive $ ActiveG gName showToast ("#" <> gName) $ "member " <> localDisplayName (m :: GroupMember) <> " is connected" intros <- withStore' $ \db -> createIntroductions db members m @@ -1544,7 +1521,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage Just ct@Contact {activeConn = Connection {connStatus}} -> when (connStatus == ConnReady) $ do notifyMemberConnected gInfo m - when (memberCategory m == GCPreMember) $ probeMatchingContacts ct + let connectedIncognito = contactConnIncognito ct || memberIncognito membership + when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito MSG msgMeta _msgFlags msgBody -> do msg@RcvMessage {chatMsgEvent} <- saveRcvMSG conn (GroupId groupId) msgMeta msgBody withAckMessage agentConnId msgMeta $ @@ -1713,12 +1691,10 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage cancelRcvFileTransfer user ft throwChatError $ CEFileRcvChunk err - memberConnectedChatItem :: GroupInfo -> GroupMember -> Maybe Profile -> m () - memberConnectedChatItem gInfo m mainProfile_ = do + memberConnectedChatItem :: GroupInfo -> GroupMember -> m () + memberConnectedChatItem gInfo m = do createdAt <- liftIO getCurrentTime - let content = CIRcvGroupEvent $ case mainProfile_ of - Just mainProfile -> RGEMemberConnected $ Just mainProfile - _ -> RGEMemberConnected Nothing + let content = CIRcvGroupEvent RGEMemberConnected cd = CDGroupRcv gInfo m -- first ts should be broker ts but we don't have it for CON ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content createdAt createdAt @@ -1727,20 +1703,24 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage notifyMemberConnected :: GroupInfo -> GroupMember -> m () notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} = do - memberConnectedChatItem gInfo m Nothing + memberConnectedChatItem gInfo m toView $ CRConnectedToGroupMember gInfo m let g = groupName' gInfo setActive $ ActiveG g showToast ("#" <> g) $ "member " <> c <> " is connected" - probeMatchingContacts :: Contact -> m () - probeMatchingContacts ct = do + probeMatchingContacts :: Contact -> Bool -> m () + probeMatchingContacts ct connectedIncognito = do gVar <- asks idsDrg (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId ct void . sendDirectContactMessage ct $ XInfoProbe probe - cs <- withStore' $ \db -> getMatchingContacts db userId ct - let probeHash = ProbeHash $ C.sha256Hash (unProbe probe) - forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ()) + if connectedIncognito + then + withStore' $ \db -> deleteSentProbe db userId probeId + else do + cs <- withStore' $ \db -> getMatchingContacts db userId ct + let probeHash = ProbeHash $ C.sha256Hash (unProbe probe) + forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ()) where sendProbeHash :: Contact -> ProbeHash -> Int64 -> m () sendProbeHash c probeHash probeId = do @@ -1915,20 +1895,17 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage toView . CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m () - processGroupInvitation ct@Contact {contactId, localDisplayName = c} inv@GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), fromMemberProfile, invitedMember = (MemberIdRole memId memRole)} msg msgMeta = do + processGroupInvitation ct@Contact {localDisplayName = c, activeConn = Connection {customUserProfileId}} inv@GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole)} msg msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId - -- [incognito] if (received group invitation has host's incognito profile OR direct connection with host is incognito), create membership with new incognito profile; incognito mode is checked when joining group - hostContact <- withStore $ \db -> getContact db userId contactId - let joinGroupIncognito = isJust fromMemberProfile || contactConnIncognito hostContact - incognitoProfile <- if joinGroupIncognito then Just <$> liftIO generateRandomProfile else pure Nothing - gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = GroupMember {groupMemberId}} <- withStore $ \db -> createGroupInvitation db user ct inv incognitoProfile - let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending, invitedIncognito = Just joinGroupIncognito}) memRole + -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile + gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = GroupMember {groupMemberId}} <- withStore $ \db -> createGroupInvitation db user ct inv customUserProfileId + let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content Nothing withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci - toView $ CRReceivedGroupInvitation gInfo ct memRole fromMemberProfile + toView $ CRReceivedGroupInvitation gInfo ct memRole showToast ("#" <> localDisplayName <> " " <> c <> "> ") "invited you to join the group" checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> m () @@ -2111,8 +2088,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage else do (groupConnId, groupConnReq) <- withAgent $ \a -> createConnection a True SCMInvitation (directConnId, directConnReq) <- withAgent $ \a -> createConnection a True SCMInvitation - -- [incognito] direct connection with member has to be established using same incognito profile - customUserProfileId <- if memberIncognito membership then Just <$> withStore (\db -> getGroupMemberProfileId db userId membership) else pure Nothing + -- [incognito] direct connection with member has to be established using the same incognito profile [that was known to host and used for group membership] + let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing newMember <- withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnId directConnId customUserProfileId let msg = XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq} void $ sendDirectMessage conn msg (GroupId groupId) @@ -2146,7 +2123,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage let msg = XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) groupConnId <- withAgent $ \a -> joinConnection a True groupConnReq $ directMessage msg directConnId <- withAgent $ \a -> joinConnection a True directConnReq $ directMessage msg - customUserProfileId <- if memberIncognito membership then Just <$> withStore (\db -> getGroupMemberProfileId db userId membership) else pure Nothing + let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing withStore' $ \db -> createIntroToMemberContact db userId m toMember groupConnId directConnId customUserProfileId xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m () diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index e1088a050b..0096ae7337 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -215,7 +215,7 @@ data ChatResponse | CRUserSMPServers {smpServers :: [SMPServer]} | CRNetworkConfig {networkConfig :: NetworkConfig} | CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile} - | CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats, localMainProfile :: Maybe LocalProfile} + | CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats} | CRNewChatItem {chatItem :: AChatItem} | CRChatItemStatusUpdated {chatItem :: AChatItem} | CRChatItemUpdated {chatItem :: AChatItem} @@ -227,7 +227,7 @@ data ChatResponse | CRCmdOk | CRChatHelp {helpSection :: HelpSection} | CRWelcome {user :: User} - | CRGroupCreated {groupInfo :: GroupInfo, customUserProfile :: Maybe Profile} + | CRGroupCreated {groupInfo :: GroupInfo} | CRGroupMembers {group :: Group} | CRContactsList {contacts :: [Contact]} | CRUserContactLink {connReqContact :: ConnReqContact, autoAccept :: Bool, autoReply :: Maybe MsgContent} @@ -236,7 +236,7 @@ data ChatResponse | CRUserAcceptedGroupSent {groupInfo :: GroupInfo} | CRUserDeletedMember {groupInfo :: GroupInfo, member :: GroupMember} | CRGroupsList {groups :: [GroupInfo]} - | CRSentGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember, sentCustomProfile :: Maybe Profile} + | CRSentGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember} | CRFileTransferStatus (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus | CRUserProfile {profile :: Profile} | CRUserProfileNoChange @@ -279,9 +279,9 @@ data ChatResponse | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost} | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost} | CRGroupInvitation {groupInfo :: GroupInfo} - | CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole, receivedCustomProfile :: Maybe Profile} - | CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember, usedCustomProfile :: Bool} - | CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember, mainProfile :: Maybe Profile} + | CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole} + | CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember} + | CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember} | CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember} | CRConnectedToGroupMember {groupInfo :: GroupInfo, member :: GroupMember} | CRDeletedMember {groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember} @@ -388,7 +388,8 @@ data ChatErrorType | CEContactNotReady {contact :: Contact} | CEContactGroups {contact :: Contact, groupNames :: [GroupName]} | CEGroupUserRole - | CEGroupNotIncognitoCantInvite + | CEContactIncognitoCantInvite + | CEGroupIncognitoCantInvite | CEGroupContactRole {contactName :: ContactName} | CEGroupDuplicateMember {contactName :: ContactName} | CEGroupDuplicateMemberId diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 8633d25207..07f77478fb 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -502,9 +502,7 @@ ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayN rcvGroupEventToText :: RcvGroupEvent -> Text rcvGroupEventToText = \case RGEMemberAdded _ p -> "added " <> profileToText p - RGEMemberConnected contactMainProfile -> case contactMainProfile of - Just p -> profileToText p <> " connected incognito" - Nothing -> "connected" + RGEMemberConnected -> "connected" RGEMemberLeft -> "left" RGEMemberDeleted _ p -> "removed " <> profileToText p RGEUserDeleted -> "removed you" @@ -535,15 +533,15 @@ data CIContent (d :: MsgDirection) where CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd --- ^^^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API --- ! ^^^ Nested sum types also have to use different encodings for database and API --- ! ^^^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent +-- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API +-- ! ^ Nested sum types also have to use different encodings for database and API +-- ! ^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent deriving instance Show (CIContent d) data RcvGroupEvent = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting - | RGEMemberConnected {contactMainProfile :: Maybe Profile} -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember + | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember | RGEMemberLeft -- CRLeftMember | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember | RGEUserDeleted -- CRDeletedMemberUser @@ -594,8 +592,7 @@ data CIGroupInvitation = CIGroupInvitation groupMemberId :: GroupMemberId, localDisplayName :: GroupName, groupProfile :: GroupProfile, - status :: CIGroupInvitationStatus, - invitedIncognito :: Maybe Bool + status :: CIGroupInvitationStatus } deriving (Eq, Show, Generic, FromJSON) diff --git a/src/Simplex/Chat/Migrations/M20220812_incognito_profiles.hs b/src/Simplex/Chat/Migrations/M20220812_incognito_profiles.hs index 2ece1be90d..e03eda2358 100644 --- a/src/Simplex/Chat/Migrations/M20220812_incognito_profiles.hs +++ b/src/Simplex/Chat/Migrations/M20220812_incognito_profiles.hs @@ -10,7 +10,7 @@ m20220812_incognito_profiles = [sql| ALTER TABLE connections ADD COLUMN custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL; -- only set for direct connections -ALTER TABLE group_members ADD COLUMN member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL; -- member profile id if incognito profile was saved for member (used for hosts and invitees in incognito groups) +ALTER TABLE group_members ADD COLUMN member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL; -- member profile id if incognito profile was saved for member (used when invitation is received via incognito direct connection with host) ALTER TABLE contact_profiles ADD COLUMN incognito INTEGER; -- 1 for incognito |] diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 3a957fbe2b..8b6a402288 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -124,7 +124,7 @@ data ChatMsgEvent | XInfo Profile | XContact Profile (Maybe XContactId) | XGrpInv GroupInvitation - | XGrpAcpt MemberId (Maybe Profile) + | XGrpAcpt MemberId | XGrpMemNew MemberInfo | XGrpMemIntro MemberInfo | XGrpMemInv MemberId IntroInvitation @@ -413,7 +413,7 @@ toCMEventTag = \case XInfo _ -> XInfo_ XContact _ _ -> XContact_ XGrpInv _ -> XGrpInv_ - XGrpAcpt _ _ -> XGrpAcpt_ + XGrpAcpt _ -> XGrpAcpt_ XGrpMemNew _ -> XGrpMemNew_ XGrpMemIntro _ -> XGrpMemIntro_ XGrpMemInv _ _ -> XGrpMemInv_ @@ -479,7 +479,7 @@ appToChatMessage AppMessage {msgId, event, params} = do XInfo_ -> XInfo <$> p "profile" XContact_ -> XContact <$> p "profile" <*> opt "contactReqId" XGrpInv_ -> XGrpInv <$> p "groupInvitation" - XGrpAcpt_ -> XGrpAcpt <$> p "memberId" <*> opt "memberProfile" + XGrpAcpt_ -> XGrpAcpt <$> p "memberId" XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo" XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro" @@ -521,7 +521,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, p XInfo profile -> o ["profile" .= profile] XContact profile xContactId -> o $ ("contactReqId" .=? xContactId) ["profile" .= profile] XGrpInv groupInv -> o ["groupInvitation" .= groupInv] - XGrpAcpt memId profile -> o $ ("memberProfile" .=? profile) ["memberId" .= memId] + XGrpAcpt memId -> o ["memberId" .= memId] XGrpMemNew memInfo -> o ["memberInfo" .= memInfo] XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo] XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro] diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 198e2e2d0a..e4391d651c 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -82,14 +82,12 @@ module Simplex.Chat.Store getMemberInvitation, createMemberConnection, updateGroupMemberStatus, - createMemberIncognitoProfile, createNewGroupMember, deleteGroupMember, deleteGroupMemberConnection, createIntroductions, updateIntroStatus, saveIntroInvitation, - getGroupMemberProfileId, createIntroReMember, createIntroToMemberContact, saveMemberInvitation, @@ -99,6 +97,7 @@ module Simplex.Chat.Store randomBytes, createSentProbe, createSentProbeHash, + deleteSentProbe, matchReceivedProbe, matchReceivedProbeHash, matchSentProbe, @@ -1046,6 +1045,13 @@ createSentProbeHash db userId probeId _to@Contact {contactId} = do "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?)" (probeId, contactId, userId, currentTs, currentTs) +deleteSentProbe :: DB.Connection -> UserId -> Int64 -> IO () +deleteSentProbe db userId probeId = + DB.execute + db + "DELETE FROM sent_probes WHERE user_id = ? AND sent_probe_id = ?" + (userId, probeId) + matchReceivedProbe :: DB.Connection -> UserId -> Contact -> Probe -> IO (Maybe Contact) matchReceivedProbe db userId _from@Contact {contactId} (Probe probe) = do let probeHash = C.sha256Hash probe @@ -1325,8 +1331,8 @@ updateConnectionStatus db Connection {connId} connStatus = do DB.execute db "UPDATE connections SET conn_status = ?, updated_at = ? WHERE connection_id = ?" (connStatus, currentTs, connId) -- | creates completely new group with a single member - the current user -createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo -createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do +createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo +createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do let GroupProfile {displayName, fullName, image} = groupProfile currentTs <- getCurrentTime withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do @@ -1342,14 +1348,13 @@ createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = Except (ldn, userId, profileId, True, currentTs, currentTs) insertedRowId db memberId <- liftIO $ encodedRandomBytes gVar 12 - -- TODO ldn from incognito profile - membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser incognitoProfile currentTs + membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs let chatSettings = ChatSettings {enableNtfs = True} pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs} -- | creates a new group record for the group the current user was invited to, or returns an existing one -createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe Profile -> ExceptT StoreError IO GroupInfo -createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Connection {customUserProfileId}} GroupInvitation {fromMember, fromMemberProfile, invitedMember, connRequest, groupProfile} incognitoProfile = do +createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO GroupInfo +createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do liftIO getInvitationGroupId_ >>= \case Nothing -> createGroupInvitation_ -- TODO treat the case that the invitation details could've changed @@ -1376,17 +1381,17 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" (profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs) insertedRowId db - _ <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown fromMemberProfile currentTs - membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfile currentTs + _ <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs + membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs let chatSettings = ChatSettings {enableNtfs = True} pure GroupInfo {groupId, localDisplayName, groupProfile, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs} -createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe Profile -> UTCTime -> ExceptT StoreError IO GroupMember -createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfile createdAt = do - incognitoProfileId <- liftIO $ createIncognitoProfile_ db userId createdAt incognitoProfile +createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> ExceptT StoreError IO GroupMember +createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt = do + incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId (localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of - (Just profile@Profile {displayName}, Just profileId) -> - (,toLocalProfile profileId profile "") <$> insertMemberIncognitoProfile_ displayName profileId + (Just profile@LocalProfile {displayName}, Just profileId) -> + (,profile) <$> insertMemberIncognitoProfile_ displayName profileId _ -> (,profile' userOrContact) <$> liftIO insertMember_ groupMemberId <- liftIO $ insertedRowId db pure @@ -1660,25 +1665,6 @@ updateGroupMemberStatus db userId GroupMember {groupMemberId} memStatus = do |] (memStatus, currentTs, userId, groupMemberId) -createMemberIncognitoProfile :: DB.Connection -> UserId -> GroupMember -> Maybe Profile -> ExceptT StoreError IO GroupMember -createMemberIncognitoProfile db userId m@GroupMember {groupMemberId} incognitoProfile = do - currentTs <- liftIO getCurrentTime - incognitoProfileId <- liftIO $ createIncognitoProfile_ db userId currentTs incognitoProfile - case (incognitoProfile, incognitoProfileId) of - (Just profile@Profile {displayName}, Just profileId) -> - ExceptT $ - withLocalDisplayName db userId displayName $ \incognitoLdn -> do - DB.execute - db - [sql| - UPDATE group_members - SET local_display_name = ?, member_profile_id = ?, updated_at = ? - WHERE user_id = ? AND group_member_id = ? - |] - (incognitoLdn, profileId, currentTs, userId, groupMemberId) - pure . Right $ m {localDisplayName = incognitoLdn, memberProfile = toLocalProfile profileId profile ""} - _ -> pure m - -- | add new member with profile createNewGroupMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember createNewGroupMember db user@User {userId} gInfo memInfo@(MemberInfo _ _ Profile {displayName, fullName, image}) memCategory memStatus = @@ -1834,18 +1820,6 @@ getIntroduction_ db reMember toMember = ExceptT $ do in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation} toIntro _ = Left SEIntroNotFound -getGroupMemberProfileId :: DB.Connection -> UserId -> GroupMember -> ExceptT StoreError IO Int64 -getGroupMemberProfileId db userId GroupMember {groupMemberId, groupId} = - ExceptT . firstRow fromOnly (SEGroupMemberNotFound {groupId, groupMemberId}) $ - DB.query - db - [sql| - SELECT contact_profile_id - FROM group_members - WHERE user_id = ? AND group_member_id = ? - |] - (userId, groupMemberId) - createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> ConnId -> ConnId -> Maybe ProfileId -> ExceptT StoreError IO GroupMember createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) groupAgentConnId directAgentConnId customUserProfileId = do let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 93612bd6a6..51abca2a7a 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -282,7 +282,6 @@ instance FromField ImageData where fromField = fmap ImageData . fromField data GroupInvitation = GroupInvitation { fromMember :: MemberIdRole, - fromMemberProfile :: Maybe Profile, invitedMember :: MemberIdRole, connRequest :: ConnReqInvitation, groupProfile :: GroupProfile diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 31b159af18..8e9825abb3 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -65,7 +65,7 @@ responseToView testView = \case CRUserSMPServers smpServers -> viewSMPServers smpServers testView CRNetworkConfig cfg -> viewNetworkConfig cfg CRContactInfo ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile - CRGroupMemberInfo g m cStats mainProfile -> viewGroupMemberInfo g m cStats mainProfile + CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item False CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True) chatItems CRChatItemStatusUpdated _ -> [] @@ -89,10 +89,10 @@ responseToView testView = \case CRUserContactLink cReqUri autoAccept autoReply -> connReqContact_ "Your chat address:" cReqUri <> autoAcceptStatus_ autoAccept autoReply CRUserContactLinkUpdated _ autoAccept autoReply -> autoAcceptStatus_ autoAccept autoReply CRContactRequestRejected UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"] - CRGroupCreated g customUserProfile -> viewGroupCreated g customUserProfile testView + CRGroupCreated g -> viewGroupCreated g CRGroupMembers g -> viewGroupMembers g CRGroupsList gs -> viewGroupsList gs - CRSentGroupInvitation g c _ sentCustomProfile -> viewSentGroupInvitation g c sentCustomProfile + CRSentGroupInvitation g c _ -> viewSentGroupInvitation g c CRFileTransferStatus ftStatus -> viewFileTransferStatus ftStatus CRUserProfile p -> viewUserProfile p CRUserProfileNoChange -> ["user profile did not change"] @@ -139,11 +139,10 @@ responseToView testView = \case [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors" where (errors, subscribed) = partition (isJust . contactError) summary - CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership} -> - [groupInvitation' ldn fullName $ memberIncognito membership] - CRReceivedGroupInvitation g c role receivedCustomProfile -> viewReceivedGroupInvitation g c role receivedCustomProfile - CRUserJoinedGroup g _ usedCustomProfile -> viewUserJoinedGroup g usedCustomProfile testView - CRJoinedGroupMember g m mainProfile -> viewJoinedGroupMember g m mainProfile + CRGroupInvitation g -> [groupInvitation' g] + CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role + CRUserJoinedGroup g _ -> viewUserJoinedGroup g + CRJoinedGroupMember g m -> viewJoinedGroupMember g m CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h] CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h] CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] @@ -370,11 +369,9 @@ viewConnReqInvitation cReq = "and ask them to connect: " <> highlight' "/c " ] -viewSentGroupInvitation :: GroupInfo -> Contact -> Maybe Profile -> [StyledString] -viewSentGroupInvitation g c sentCustomProfile = - if isJust sentCustomProfile - then ["invitation to join the group " <> ttyGroup' g <> " incognito sent to " <> ttyContact' c] - else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] +viewSentGroupInvitation :: GroupInfo -> Contact -> [StyledString] +viewSentGroupInvitation g c = + ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] viewChatCleared :: AChatInfo -> [StyledString] viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of @@ -428,22 +425,11 @@ viewReceivedContactRequest c Profile {fullName} = "to reject: " <> highlight ("/rc " <> c) <> " (the sender will NOT be notified)" ] -viewGroupCreated :: GroupInfo -> Maybe Profile -> Bool -> [StyledString] -viewGroupCreated g@GroupInfo {localDisplayName} incognitoProfile testView = - case incognitoProfile of - Just profile -> - if testView - then incognitoProfile' profile : message - else message - where - message = - [ "group " <> ttyFullGroup g <> " is created incognito, your profile for this group: " <> incognitoProfile' profile, - "use " <> highlight ("/a " <> localDisplayName <> " ") <> " to add members" - ] - Nothing -> - [ "group " <> ttyFullGroup g <> " is created", - "use " <> highlight ("/a " <> localDisplayName <> " ") <> " to add members" - ] +viewGroupCreated :: GroupInfo -> [StyledString] +viewGroupCreated g@GroupInfo {localDisplayName} = + [ "group " <> ttyFullGroup g <> " is created", + "use " <> highlight ("/a " <> localDisplayName <> " ") <> " to add members" + ] viewCannotResendInvitation :: GroupInfo -> ContactName -> [StyledString] viewCannotResendInvitation GroupInfo {localDisplayName = gn} c = @@ -451,33 +437,22 @@ viewCannotResendInvitation GroupInfo {localDisplayName = gn} c = "to re-send invitation: " <> highlight ("/rm " <> gn <> " " <> c) <> ", " <> highlight ("/a " <> gn <> " " <> c) ] -viewUserJoinedGroup :: GroupInfo -> Bool -> Bool -> [StyledString] -viewUserJoinedGroup g@GroupInfo {membership = GroupMember {memberProfile}} incognito testView = - if incognito - then - if testView - then incognitoProfile' (fromLocalProfile memberProfile) : incognitoMessage - else incognitoMessage +viewUserJoinedGroup :: GroupInfo -> [StyledString] +viewUserJoinedGroup g@GroupInfo {membership = membership@GroupMember {memberProfile}} = + if memberIncognito membership + then [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile memberProfile)] else [ttyGroup' g <> ": you joined the group"] - where - incognitoMessage = [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile memberProfile)] -viewJoinedGroupMember :: GroupInfo -> GroupMember -> Maybe Profile -> [StyledString] -viewJoinedGroupMember g m@GroupMember {localDisplayName} = \case - Just Profile {displayName = mainProfileName} -> [ttyGroup' g <> ": " <> ttyContact mainProfileName <> " joined the group incognito as " <> styleIncognito localDisplayName] - Nothing -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "] +viewJoinedGroupMember :: GroupInfo -> GroupMember -> [StyledString] +viewJoinedGroupMember g m = + [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "] -viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> Maybe Profile -> [StyledString] -viewReceivedGroupInvitation g c role hostIncognitoProfile = - case hostIncognitoProfile of - Just profile -> - [ ttyFullGroup g <> ": " <> ttyContact' c <> " (known to the group as " <> incognitoProfile' profile <> ") invites you to join the group incognito as " <> plain (strEncode role), - "use " <> highlight ("/j " <> groupName' g) <> " to join this group incognito" - ] - Nothing -> - [ ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role), - "use " <> highlight ("/j " <> groupName' g) <> " to accept" - ] +viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString] +viewReceivedGroupInvitation g@GroupInfo {membership = membership@GroupMember {memberProfile}} c role = + ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role) : + if memberIncognito membership + then ["use " <> highlight ("/j " <> groupName' g) <> " to join incognito as " <> incognitoProfile' (fromLocalProfile memberProfile)] + else ["use " <> highlight ("/j " <> groupName' g) <> " to accept"] groupPreserved :: GroupInfo -> [StyledString] groupPreserved g = ["use " <> highlight ("/d #" <> groupName' g) <> " to delete the group"] @@ -529,9 +504,9 @@ viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g GroupName) - groupSS GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership} = + groupSS g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership} = case memberStatus membership of - GSMemInvited -> groupInvitation' ldn fullName $ memberIncognito membership + GSMemInvited -> groupInvitation' g s -> incognito <> ttyGroup ldn <> optFullName ldn fullName <> viewMemberStatus s where incognito = if memberIncognito membership then incognitoPrefix else "" @@ -542,20 +517,20 @@ viewGroupsList gs = map groupSS $ sortOn ldn_ gs _ -> "" delete reason = " (" <> reason <> ", delete local copy: " <> highlight ("/d #" <> ldn) <> ")" -groupInvitation' :: GroupName -> Text -> Bool -> StyledString -groupInvitation' displayName fullName membershipIncognito = - highlight ("#" <> displayName) - <> optFullName displayName fullName - <> invitationText - <> highlight ("/j " <> displayName) - <> " to join, " - <> highlight ("/d #" <> displayName) +groupInvitation' :: GroupInfo -> StyledString +groupInvitation' GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership = membership@GroupMember {memberProfile}} = + highlight ("#" <> ldn) + <> optFullName ldn fullName + <> " - you are invited (" + <> highlight ("/j " <> ldn) + <> joinText + <> highlight ("/d #" <> ldn) <> " to delete invitation)" where - invitationText = - if membershipIncognito - then " - you are invited incognito (" - else " - you are invited (" + joinText = + if memberIncognito membership + then " to join as " <> incognitoProfile' (fromLocalProfile memberProfile) <> ", " + else " to join, " viewContactsMerged :: Contact -> Contact -> [StyledString] viewContactsMerged _into@Contact {localDisplayName = c1} _merged@Contact {localDisplayName = c2} = @@ -603,21 +578,13 @@ viewContactInfo Contact {contactId, profile = LocalProfile {localAlias}} stats i incognitoProfile <> if localAlias /= "" then ["alias: " <> plain localAlias] else ["alias not set"] -viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> Maybe LocalProfile -> [StyledString] -viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias = mpLocalAlias}} stats mainProfile = +viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString] +viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias}} stats = [ "group ID: " <> sShow groupId, "member ID: " <> sShow groupMemberId ] <> maybe ["member not connected"] viewConnectionStats stats - <> maybe - ["unknown whether group member uses his main profile or incognito one for the group"] - (\LocalProfile {displayName, fullName} -> ["member is using " <> styleIncognito' "incognito" <> " profile for the group, main profile known: " <> ttyFullName displayName fullName]) - mainProfile - <> if alias /= "" then ["alias: " <> plain alias] else ["no alias for contact"] - where - alias = case mainProfile of - Nothing -> mpLocalAlias - Just LocalProfile {localAlias = lpLocalAlias} -> lpLocalAlias + <> if localAlias /= "" then ["alias: " <> plain localAlias] else ["no alias for contact"] viewConnectionStats :: ConnectionStats -> [StyledString] viewConnectionStats ConnectionStats {rcvServers, sndServers} = @@ -916,7 +883,8 @@ viewChatError = \case 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"] - CEGroupNotIncognitoCantInvite -> ["you're using main profile for this group - prohibited to invite contact to whom you are connected incognito"] + CEContactIncognitoCantInvite -> ["you're using your main profile for this group - prohibited to invite contacts to whom you are connected incognito"] + CEGroupIncognitoCantInvite -> ["you've connected to this group using an incognito profile - prohibited to invite contacts"] CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"] CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> groupName' g)] CEGroupMemberNotActive -> ["you cannot invite other members yet, try later"] diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 06afb1595e..464cdd90cc 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -92,9 +92,8 @@ chatTests = do it "connect incognito via invitation link" testConnectIncognitoInvitationLink it "connect incognito via contact address" testConnectIncognitoContactAddress it "accept contact request incognito" testAcceptContactRequestIncognito - it "create group incognito" testCreateGroupIncognito it "join group incognito" testJoinGroupIncognito - it "can't invite contact to whom user connected incognito to non incognito group" testCantInviteIncognitoConnectionNonIncognitoGroup + it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito it "set contact alias" testSetAlias describe "SMP servers" $ it "get and set SMP servers" testGetSetSMPServers @@ -2147,278 +2146,199 @@ testAcceptContactRequestIncognito = testChat2 aliceProfile bobProfile $ bob #> ("@" <> aliceIncognito <> " I know!") alice ?<# "bob> I know!" -testCreateGroupIncognito :: IO () -testCreateGroupIncognito = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - -- non incognito connections - connectUsers alice cath - connectUsers bob cath - -- bob connected incognito to alice - alice ##> "/c" - inv <- getInvitation alice - bob #$> ("/incognito on", id, "ok") - bob ##> ("/c " <> inv) - bob <## "confirmation sent!" - bobIncognito <- getTermLine bob - concurrentlyN_ - [ 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", - alice <## (bobIncognito <> ": contact is connected") - ] - -- alice creates group incognito - alice #$> ("/incognito on", id, "ok") - alice ##> "/g secret_club" - aliceMemIncognito <- getTermLine alice - alice <## ("group #secret_club is created incognito, your profile for this group: " <> aliceMemIncognito) - alice <## "use /a secret_club to add members" - alice ##> ("/a secret_club " <> bobIncognito) - concurrentlyN_ - [ alice <## ("invitation to join the group #secret_club incognito sent to " <> bobIncognito), - do - bob <## ("#secret_club: alice (known to the group as " <> aliceMemIncognito <> ") invites you to join the group incognito as admin") - bob <## "use /j secret_club to join this group incognito" - ] - -- bob uses different profile when joining group - bob ##> "/j secret_club" - bobMemIncognito <- getTermLine bob - concurrently_ - (alice <## ("#secret_club: " <> bobIncognito <> " joined the group incognito as " <> bobMemIncognito)) - (bob <## ("#secret_club: you joined the group incognito as " <> bobMemIncognito)) - -- cath is invited incognito - alice ##> "/a secret_club cath" - concurrentlyN_ - [ alice <## "invitation to join the group #secret_club incognito sent to cath", - do - cath <## ("#secret_club: alice (known to the group as " <> aliceMemIncognito <> ") invites you to join the group incognito as admin") - cath <## "use /j secret_club to join this group incognito" - ] - cath ##> "/j secret_club" - cathMemIncognito <- getTermLine cath - -- bob and cath don't merge contacts - concurrentlyN_ - [ alice <## ("#secret_club: cath joined the group incognito as " <> cathMemIncognito), - do - cath <## ("#secret_club: you joined the group incognito as " <> cathMemIncognito) - cath <## ("#secret_club: member " <> bobMemIncognito <> " is connected"), - do - bob <## ("#secret_club: " <> aliceMemIncognito <> " added " <> cathMemIncognito <> " to the group (connecting...)") - bob <## ("#secret_club: new member " <> cathMemIncognito <> " is connected") - ] - -- send messages - group is incognito for everybody - alice #$> ("/incognito off", id, "ok") - bob #$> ("/incognito off", id, "ok") - cath #$> ("/incognito off", id, "ok") - alice ?#> "#secret_club hello" - concurrently_ - (bob ?<# ("#secret_club " <> aliceMemIncognito <> "> hello")) - (cath ?<# ("#secret_club " <> aliceMemIncognito <> "> hello")) - bob ?#> "#secret_club hi there" - concurrently_ - (alice ?<# ("#secret_club " <> bobMemIncognito <> "> hi there")) - (cath ?<# ("#secret_club " <> bobMemIncognito <> "> hi there")) - cath ?#> "#secret_club hey" - concurrently_ - (alice ?<# ("#secret_club " <> cathMemIncognito <> "> hey")) - (bob ?<# ("#secret_club " <> cathMemIncognito <> "> hey")) - -- bob and cath can send messages via direct incognito connections - bob ?#> ("@" <> cathMemIncognito <> " hi, I'm bob") - cath ?<# (bobMemIncognito <> "> hi, I'm bob") - cath ?#> ("@" <> bobMemIncognito <> " hey, I'm cath") - bob ?<# (cathMemIncognito <> "> hey, I'm cath") - -- non incognito connections are separate - bob <##> cath - -- list groups - alice ##> "/gs" - alice <## "i #secret_club" - -- list group members - alice ##> "/ms secret_club" - alice - <### [ "i " <> aliceMemIncognito <> ": owner, you, created group", - "i " <> bobMemIncognito <> ": admin, invited, connected", - "i " <> cathMemIncognito <> ": admin, invited, connected" - ] - -- remove member - bob ##> ("/rm secret_club " <> cathMemIncognito) - concurrentlyN_ - [ bob <## ("#secret_club: you removed " <> cathMemIncognito <> " from the group"), - alice <## ("#secret_club: " <> bobMemIncognito <> " removed " <> cathMemIncognito <> " from the group"), - do - cath <## ("#secret_club: " <> bobMemIncognito <> " removed you from the group") - cath <## "use /d #secret_club to delete the group" - ] - bob ?#> "#secret_club hi" - concurrently_ - (alice ?<# ("#secret_club " <> bobMemIncognito <> "> hi")) - (cath "#secret_club hello" - concurrently_ - (bob ?<# ("#secret_club " <> aliceMemIncognito <> "> hello")) - (cath "#secret_club hello" - cath <## "you are no longer a member of the group" - bob ?#> ("@" <> cathMemIncognito <> " I removed you from group") - cath ?<# (bobMemIncognito <> "> I removed you from group") - cath ?#> ("@" <> bobMemIncognito <> " ok") - bob ?<# (cathMemIncognito <> "> ok") - testJoinGroupIncognito :: IO () testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do -- non incognito connections - connectUsers alice cath + connectUsers alice bob + connectUsers alice dan connectUsers bob cath + connectUsers bob dan connectUsers cath dan - -- bob connected incognito to alice + -- cath connected incognito to alice alice ##> "/c" inv <- getInvitation alice - bob #$> ("/incognito on", id, "ok") - bob ##> ("/c " <> inv) - bob <## "confirmation sent!" - bobIncognito <- getTermLine bob + cath #$> ("/incognito on", id, "ok") + cath ##> ("/c " <> inv) + cath <## "confirmation sent!" + cathIncognito <- getTermLine cath concurrentlyN_ [ 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", - alice <## (bobIncognito <> ": contact is connected") + cath <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> cathIncognito) + cath <## "use /info alice to print out this incognito profile again", + alice <## (cathIncognito <> ": contact is connected") ] - -- alice creates group non incognito - alice ##> "/g club" - alice <## "group #club is created" - alice <## "use /a club to add members" - alice ##> ("/a club " <> bobIncognito) + -- alice creates group + alice ##> "/g secret_club" + alice <## "group #secret_club is created" + alice <## "use /a secret_club to add members" + -- alice invites bob + alice ##> "/a secret_club bob" concurrentlyN_ - [ alice <## ("invitation to join the group #club sent to " <> bobIncognito), + [ alice <## "invitation to join the group #secret_club sent to bob", do - bob <## "#club: alice invites you to join the group as admin" - bob <## "use /j club to accept" + bob <## "#secret_club: alice invites you to join the group as admin" + bob <## "use /j secret_club to accept" ] - -- since bob is connected incognito to host, he uses different profile when joining group even though he turned incognito mode off - bob #$> ("/incognito off", id, "ok") - bob ##> "/j club" - bobMemIncognito <- getTermLine bob + bob ##> "/j secret_club" concurrently_ - (alice <## ("#club: " <> bobIncognito <> " joined the group incognito as " <> bobMemIncognito)) - (bob <## ("#club: you joined the group incognito as " <> bobMemIncognito)) - -- cath joins incognito - alice ##> "/a club cath" + (alice <## "#secret_club: bob joined the group") + (bob <## "#secret_club: you joined the group") + -- alice invites cath + alice ##> ("/a secret_club " <> cathIncognito) concurrentlyN_ - [ alice <## "invitation to join the group #club sent to cath", + [ alice <## ("invitation to join the group #secret_club sent to " <> cathIncognito), do - cath <## "#club: alice invites you to join the group as admin" - cath <## "use /j club to accept" + cath <## "#secret_club: alice invites you to join the group as admin" + cath <## ("use /j secret_club to join incognito as " <> cathIncognito) ] - cath #$> ("/incognito on", id, "ok") - cath ##> "/j club" - cathMemIncognito <- getTermLine cath - -- bob and cath don't merge contacts + -- cath uses the same incognito profile when joining group, disabling incognito mode doesn't affect it + cath #$> ("/incognito off", id, "ok") + cath ##> "/j secret_club" + -- cath and bob don't merge contacts concurrentlyN_ - [ alice <## ("#club: cath joined the group incognito as " <> cathMemIncognito), + [ alice <## ("#secret_club: " <> cathIncognito <> " joined the group"), do - cath <## ("#club: you joined the group incognito as " <> cathMemIncognito) - cath <## ("#club: member " <> bobMemIncognito <> " is connected"), + cath <## ("#secret_club: you joined the group incognito as " <> cathIncognito) + cath <## "#secret_club: member bob_1 (Bob) is connected", do - bob <## ("#club: alice added " <> cathMemIncognito <> " to the group (connecting...)") - bob <## ("#club: new member " <> cathMemIncognito <> " is connected") + bob <## ("#secret_club: alice added " <> cathIncognito <> " to the group (connecting...)") + bob <## ("#secret_club: new member " <> cathIncognito <> " is connected") ] - -- cath invites dan incognito - cath ##> "/a club dan" + -- cath cannot invite to the group because her membership is incognito + cath ##> "/a secret_club dan" + cath <## "you've connected to this group using an incognito profile - prohibited to invite contacts" + -- alice invites dan + alice ##> "/a secret_club dan" concurrentlyN_ - [ cath <## "invitation to join the group #club incognito sent to dan", + [ alice <## "invitation to join the group #secret_club sent to dan", do - dan <## ("#club: cath (known to the group as " <> cathMemIncognito <> ") invites you to join the group incognito as admin") - dan <## "use /j club to join this group incognito" + dan <## "#secret_club: alice invites you to join the group as admin" + dan <## "use /j secret_club to accept" ] - dan ##> "/j club" - danMemIncognito <- getTermLine dan + dan ##> "/j secret_club" + -- cath and dan don't merge contacts concurrentlyN_ - [ cath <## ("#club: dan joined the group incognito as " <> danMemIncognito), + [ alice <## "#secret_club: dan joined the group", do - dan <## ("#club: you joined the group incognito as " <> danMemIncognito) + dan <## "#secret_club: you joined the group" dan - <### [ "#club: member alice (Alice) is connected", - "#club: member " <> bobMemIncognito <> " is connected" + <### [ "#secret_club: member " <> cathIncognito <> " is connected", + "#secret_club: member bob_1 (Bob) is connected", + "contact bob_1 is merged into bob", + "use @bob to send messages" ], do - alice <## ("#club: " <> cathMemIncognito <> " added " <> danMemIncognito <> " to the group (connecting...)") - alice <## ("#club: new member " <> danMemIncognito <> " is connected"), + bob <## "#secret_club: alice added dan_1 (Daniel) to the group (connecting...)" + bob <## "#secret_club: new member dan_1 is connected" + bob <## "contact dan_1 is merged into dan" + bob <## "use @dan to send messages", do - bob <## ("#club: " <> cathMemIncognito <> " added " <> danMemIncognito <> " to the group (connecting...)") - bob <## ("#club: new member " <> danMemIncognito <> " is connected") + cath <## "#secret_club: alice added dan_1 (Daniel) to the group (connecting...)" + cath <## "#secret_club: new member dan_1 is connected" ] - -- send messages - group is incognito for cath and dan - alice #$> ("/incognito off", id, "ok") - bob #$> ("/incognito off", id, "ok") - cath #$> ("/incognito off", id, "ok") - dan #$> ("/incognito off", id, "ok") - alice #> "#club hello" + -- send messages - group is incognito for cath + alice #> "#secret_club hello" concurrentlyN_ - [ bob ?<# "#club alice> hello", - cath ?<# "#club alice> hello", - dan ?<# "#club alice> hello" + [ bob <# "#secret_club alice> hello", + cath ?<# "#secret_club alice> hello", + dan <# "#secret_club alice> hello" ] - bob ?#> "#club hi there" + bob #> "#secret_club hi there" concurrentlyN_ - [ alice <# ("#club " <> bobMemIncognito <> "> hi there"), - cath ?<# ("#club " <> bobMemIncognito <> "> hi there"), - dan ?<# ("#club " <> bobMemIncognito <> "> hi there") + [ alice <# "#secret_club bob> hi there", + cath ?<# "#secret_club bob_1> hi there", + dan <# "#secret_club bob> hi there" ] - cath ?#> "#club hey" + cath ?#> "#secret_club hey" concurrentlyN_ - [ alice <# ("#club " <> cathMemIncognito <> "> hey"), - bob ?<# ("#club " <> cathMemIncognito <> "> hey"), - dan ?<# ("#club " <> cathMemIncognito <> "> hey") + [ alice <# ("#secret_club " <> cathIncognito <> "> hey"), + bob <# ("#secret_club " <> cathIncognito <> "> hey"), + dan <# ("#secret_club " <> cathIncognito <> "> hey") ] - dan ?#> "#club how is it going?" + dan #> "#secret_club how is it going?" concurrentlyN_ - [ alice <# ("#club " <> danMemIncognito <> "> how is it going?"), - bob ?<# ("#club " <> danMemIncognito <> "> how is it going?"), - cath ?<# ("#club " <> danMemIncognito <> "> how is it going?") + [ alice <# "#secret_club dan> how is it going?", + bob <# "#secret_club dan> how is it going?", + cath ?<# "#secret_club dan_1> how is it going?" ] - -- bob and cath can send messages via direct incognito connections - bob ?#> ("@" <> cathMemIncognito <> " hi, I'm bob") - cath ?<# (bobMemIncognito <> "> hi, I'm bob") - cath ?#> ("@" <> bobMemIncognito <> " hey, I'm cath") - bob ?<# (cathMemIncognito <> "> hey, I'm cath") + -- cath and bob can send messages via new direct connection, cath is incognito + bob #> ("@" <> cathIncognito <> " hi, I'm bob") + cath ?<# "bob_1> hi, I'm bob" + cath ?#> "@bob_1 hey, I'm incognito" + bob <# (cathIncognito <> "> hey, I'm incognito") + -- cath and dan can send messages via new direct connection, cath is incognito + dan #> ("@" <> cathIncognito <> " hi, I'm dan") + cath ?<# "dan_1> hi, I'm dan" + cath ?#> "@dan_1 hey, I'm incognito" + dan <# (cathIncognito <> "> hey, I'm incognito") -- non incognito connections are separate bob <##> cath - -- bob and dan can send messages via direct incognito connections - bob ?#> ("@" <> danMemIncognito <> " hi, I'm bob") - dan ?<# (bobMemIncognito <> "> hi, I'm bob") - dan ?#> ("@" <> bobMemIncognito <> " hey, I'm dan") - bob ?<# (danMemIncognito <> "> hey, I'm dan") + dan <##> cath + -- list groups + cath ##> "/gs" + cath <## "i #secret_club" -- list group members - alice ##> "/ms club" + alice ##> "/ms secret_club" alice <### [ "alice (Alice): owner, you, created group", - "i " <> bobMemIncognito <> ": admin, invited, connected", - "i " <> cathMemIncognito <> ": admin, invited, connected", - danMemIncognito <> ": admin, connected" + "bob (Bob): admin, invited, connected", + cathIncognito <> ": admin, invited, connected", + "dan (Daniel): admin, invited, connected" ] - bob ##> "/ms club" + bob ##> "/ms secret_club" bob <### [ "alice (Alice): owner, host, connected", - "i " <> bobMemIncognito <> ": admin, you, connected", - cathMemIncognito <> ": admin, connected", - danMemIncognito <> ": admin, connected" + "bob (Bob): admin, you, connected", + cathIncognito <> ": admin, connected", + "dan (Daniel): admin, connected" ] - cath ##> "/ms club" + cath ##> "/ms secret_club" cath <### [ "alice (Alice): owner, host, connected", - bobMemIncognito <> ": admin, connected", - "i " <> cathMemIncognito <> ": admin, you, connected", - "i " <> danMemIncognito <> ": admin, invited, connected" + "bob_1 (Bob): admin, connected", + "i " <> cathIncognito <> ": admin, you, connected", + "dan_1 (Daniel): admin, connected" ] - dan ##> "/ms club" + dan ##> "/ms secret_club" dan - <### [ "alice (Alice): owner, connected", - bobMemIncognito <> ": admin, connected", - "i " <> cathMemIncognito <> ": admin, host, connected", - "i " <> danMemIncognito <> ": admin, you, connected" + <### [ "alice (Alice): owner, host, connected", + "bob (Bob): admin, connected", + cathIncognito <> ": admin, connected", + "dan (Daniel): admin, you, connected" ] + -- remove member + bob ##> ("/rm secret_club " <> cathIncognito) + concurrentlyN_ + [ bob <## ("#secret_club: you removed " <> cathIncognito <> " from the group"), + alice <## ("#secret_club: bob removed " <> cathIncognito <> " from the group"), + dan <## ("#secret_club: bob removed " <> cathIncognito <> " from the group"), + do + cath <## "#secret_club: bob_1 removed you from the group" + cath <## "use /d #secret_club to delete the group" + ] + bob #> "#secret_club hi" + concurrentlyN_ + [ alice <# "#secret_club bob> hi", + dan <# "#secret_club bob> hi", + (cath "#secret_club hello" + concurrentlyN_ + [ bob <# "#secret_club alice> hello", + dan <# "#secret_club alice> hello", + (cath "#secret_club hello" + cath <## "you are no longer a member of the group" + -- cath can still message members directly + bob #> ("@" <> cathIncognito <> " I removed you from group") + cath ?<# "bob_1> I removed you from group" + cath ?#> "@bob_1 ok" + bob <# (cathIncognito <> "> ok") -testCantInviteIncognitoConnectionNonIncognitoGroup :: IO () -testCantInviteIncognitoConnectionNonIncognitoGroup = testChat2 aliceProfile bobProfile $ +testCantInviteContactIncognito :: IO () +testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $ \alice bob -> do -- alice connected incognito to bob alice #$> ("/incognito on", id, "ok") @@ -2439,7 +2359,9 @@ testCantInviteIncognitoConnectionNonIncognitoGroup = testChat2 aliceProfile bobP alice <## "group #club is created" alice <## "use /a club to add members" alice ##> "/a club bob" - alice <## "you're using main profile for this group - prohibited to invite contact to whom you are connected incognito" + alice <## "you're using your main profile for this group - prohibited to invite contacts to whom you are connected incognito" + -- bob doesn't receive invitation + (bob