dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-03-30 16:25:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

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)

Browse Source
This commit is contained in:
JRoberts
2022-08-27 19:56:03 +04:00
committed by GitHub
parent 7683254de2
commit 2fc6873c42
11 changed files with 279 additions and 459 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
docs/protocol/simplex-chat.schema.json
View File

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

119
src/Simplex/Chat.hs
View File

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

15
src/Simplex/Chat/Controller.hs
View File

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

15
src/Simplex/Chat/Messages.hs
View File

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

2
src/Simplex/Chat/Migrations/M20220812_incognito_profiles.hs
View File

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

8
src/Simplex/Chat/Protocol.hs
View File

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

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

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

1
src/Simplex/Chat/Types.hs
View File

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

126
src/Simplex/Chat/View.hs
View File

@@ -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 <invitation_link_above>"
]
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 <> " <name>") <> " to add members"
]
Nothing ->
[ "group " <> ttyFullGroup g <> " is created",
"use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " to add members"
]
viewGroupCreated :: GroupInfo -> [StyledString]
viewGroupCreated g@GroupInfo {localDisplayName} =
[ "group " <> ttyFullGroup g <> " is created",
"use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " 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 <nam
viewGroupsList gs = map groupSS $ sortOn ldn_ gs
where
ldn_ = T.toLower . (localDisplayName :: GroupInfo -> 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"]

362
tests/ChatTests.hs
View File

@@ -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 <name> 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 </)
alice ?#> "#secret_club hello"
concurrently_
(bob ?<# ("#secret_club " <> aliceMemIncognito <> "> hello"))
(cath </)
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 <name> 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 <name> 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 <message> 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 <message> 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 </)
]
alice #> "#secret_club hello"
concurrentlyN_
[ bob <# "#secret_club alice> hello",
dan <# "#secret_club alice> hello",
(cath </)
]
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 <name> 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 </)
testSetAlias :: IO ()
testSetAlias = testChat2 aliceProfile bobProfile $

12
tests/ProtocolTests.hs
View File

@@ -187,18 +187,12 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
it "x.contact with content (ignored)" $
"{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
==# XContact testProfile Nothing
it "x.grp.inv with incognito profile" $
"{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\"},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"},\"fromMemberProfile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}}"
#==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, fromMemberProfile = Just testProfile, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile}
it "x.grp.inv without incognito profile" $
it "x.grp.inv" $
"{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\"},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}"
#==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, fromMemberProfile = Nothing, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile}
it "x.grp.acpt with incognito profile" $
"{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\", \"memberProfile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
#==# XGrpAcpt (MemberId "\1\2\3\4") (Just testProfile)
#==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile}
it "x.grp.acpt without incognito profile" $
"{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}"
#==# XGrpAcpt (MemberId "\1\2\3\4") Nothing
#==# XGrpAcpt (MemberId "\1\2\3\4")
it "x.grp.mem.new" $
"{\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}}"
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile}