mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-18 22:45:45 +00:00
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)
This commit is contained in:
JRoberts
+48
-71
@@ -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 ()
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|]
|
||||
|
||||
@@ -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]
|
||||
|
||||
+20
-46
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+47
-79
@@ -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"]
|
||||
|
||||
Reference in New Issue
Block a user