core: refactor incognito membership (#3079)

This commit is contained in:
Evgeny Poberezkin
2023-09-19 18:50:10 +01:00
committed by GitHub
parent 2524609a97
commit ed3fb0b222
4 changed files with 50 additions and 39 deletions
+11 -10
View File
@@ -1470,13 +1470,13 @@ processChatCommand = \case
-- 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 user contactId
assertDirectAllowed user MDSnd contact XGrpInv_
let Group gInfo@GroupInfo {membership} members = group
let Group gInfo members = group
Contact {localDisplayName = cName} = contact
assertUserGroupRole gInfo $ max GRAdmin memRole
-- [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 (incognitoMembership gInfo) $ throwChatError CEGroupIncognitoCantInvite
let sendInvitation = sendGrpInvitation user contact gInfo
case contactMember contact members of
Nothing -> do
@@ -3103,10 +3103,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode
_ -> pure ()
Just (gInfo@GroupInfo {membership}, m@GroupMember {activeConn}) ->
Just (gInfo, m@GroupMember {activeConn}) ->
when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
notifyMemberConnected gInfo m $ Just ct
let connectedIncognito = contactConnIncognito ct || memberIncognito membership
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito
SENT msgId -> do
sentMsgDeliveryEvent conn msgId
@@ -3279,7 +3279,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just ct@Contact {activeConn = Connection {connStatus}} ->
when (connStatus == ConnReady) $ do
notifyMemberConnected gInfo m $ Just ct
let connectedIncognito = contactConnIncognito ct || memberIncognito membership
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito
MSG msgMeta _msgFlags msgBody -> do
cmdId <- createAckCmd conn
@@ -3565,8 +3565,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ct <- acceptContactRequestAsync user cReq incognitoProfile
toView $ CRAcceptingContactRequest user ct
Just groupId -> do
gInfo@GroupInfo {membership = membership@GroupMember {memberProfile}} <- withStore $ \db -> getGroupInfo db user groupId
let profileMode = if memberIncognito membership then Just $ ExistingIncognito memberProfile else Nothing
gInfo <- withStore $ \db -> getGroupInfo db user groupId
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
ct <- acceptContactRequestAsync user cReq profileMode
toView $ CRAcceptingGroupJoinRequest user gInfo ct
_ -> do
@@ -4413,7 +4413,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
toView $ CRJoinedGroupMemberConnecting user gInfo m newMember
xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m ()
xGrpMemIntro gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do
xGrpMemIntro gInfo@GroupInfo {chatSettings = ChatSettings {enableNtfs}} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do
case memberCategory m of
GCHostMember -> do
members <- withStore' $ \db -> getGroupMembers db user gInfo
@@ -4429,7 +4429,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just mcvr
| isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> Just <$> createConn subMode -- pure Nothing
| otherwise -> Just <$> createConn subMode
let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing
let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId subMode
_ -> messageError "x.grp.mem.intro can be only sent by host member"
where
@@ -4473,7 +4473,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- [async agent commands] no continuation needed, but commands should be asynchronous for stability
groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr dm subMode
let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing
let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange
withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode
@@ -4598,6 +4598,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
(mCt', m') <- withStore' $ \db -> createMemberContactInvited db user connIds g m mConn subMode
createItems mCt' m'
joinConn subMode = do
-- TODO send user's profile for this group membership
dm <- directMessage XOk
joinAgentConnectionAsync user True connReq dm subMode
createItems mCt' m' = do
+13 -16
View File
@@ -420,13 +420,12 @@ deleteGroupConnectionsAndFiles db User {userId} GroupInfo {groupId} members = do
DB.execute db "DELETE FROM files WHERE user_id = ? AND group_id = ?" (userId, groupId)
deleteGroupItemsAndMembers :: DB.Connection -> User -> GroupInfo -> [GroupMember] -> IO ()
deleteGroupItemsAndMembers db user@User {userId} GroupInfo {groupId} members = do
deleteGroupItemsAndMembers db user@User {userId} g@GroupInfo {groupId} members = do
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId)
void $ runExceptT cleanupHostGroupLinkConn_ -- to allow repeat connection via the same group link if one was used
DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
forM_ members $ \m@GroupMember {memberProfile = LocalProfile {profileId}} -> do
cleanupMemberProfileAndName_ db user m
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user profileId
forM_ members $ cleanupMemberProfileAndName_ db user
forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
where
cleanupHostGroupLinkConn_ = do
hostId <- getHostMemberId_ db user groupId
@@ -444,11 +443,11 @@ deleteGroupItemsAndMembers db user@User {userId} GroupInfo {groupId} members = d
(userId, userId, hostId)
deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroup db user@User {userId} GroupInfo {groupId, localDisplayName, membership = membership@GroupMember {memberProfile = LocalProfile {profileId}}} = do
deleteGroup db user@User {userId} g@GroupInfo {groupId, localDisplayName} = do
deleteGroupProfile_ db userId groupId
DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
when (memberIncognito membership) $ deleteUnusedIncognitoProfileById_ db user profileId
forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
deleteGroupProfile_ db userId groupId =
@@ -815,12 +814,12 @@ checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} =
maybeFirstRow fromOnly $ DB.query db "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ? LIMIT 1" (userId, groupId, groupMemberId)
deleteGroupMember :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, memberProfile = LocalProfile {profileId}} = do
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, memberProfile} = do
deleteGroupMemberConnection db user m
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?" (userId, groupId, groupMemberId)
DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId)
cleanupMemberProfileAndName_ db user m
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user profileId
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user $ localProfileId memberProfile
cleanupMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO ()
cleanupMemberProfileAndName_ db User {userId} GroupMember {groupMemberId, memberContactId, memberContactProfileId, localDisplayName} =
@@ -1398,12 +1397,12 @@ createMemberContact
user@User {userId, profile = LocalProfile {preferences}}
acId
cReq
GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
gInfo
GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId}
Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
subMode = do
currentTs <- getCurrentTime
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
let incognitoProfile = incognitoMembershipProfile gInfo
customUserProfileId = localProfileId <$> incognitoProfile
userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
DB.execute
@@ -1464,13 +1463,12 @@ createMemberContactInvited
db
user@User {userId, profile = LocalProfile {preferences}}
connIds
gInfo@GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
gInfo
m@GroupMember {groupMemberId, localDisplayName = memberLDN, memberProfile, memberContactProfileId}
mConn
subMode = do
currentTs <- liftIO getCurrentTime
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
let userPreferences = fromMaybe emptyChatPrefs $ incognitoMembershipProfile gInfo >> preferences
contactId <- createContactUpdateMember currentTs userPreferences
ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
@@ -1523,13 +1521,12 @@ createMemberContactConn_
db
user@User {userId}
(cmdId, acId)
GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
gInfo
_memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
contactId
subMode = do
currentTs <- liftIO getCurrentTime
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
customUserProfileId = localProfileId <$> incognitoProfile
let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
DB.execute
db
[sql|
+14
View File
@@ -590,8 +590,13 @@ data GroupMember = GroupMember
memberStatus :: GroupMemberStatus,
invitedBy :: InvitedBy,
localDisplayName :: ContactName,
-- for membership, memberProfile can be either user's profile or incognito profile, based on memberIncognito test.
-- for other members it's whatever profile the local user can see (there is no info about whether it's main or incognito profile for remote users).
memberProfile :: LocalProfile,
-- this is the ID of the associated contact (it will be used to send direct messages to the member)
memberContactId :: Maybe ContactId,
-- for membership it would always point to user's contact
-- it is used to test for incognito status by comparing with ID in memberProfile
memberContactProfileId :: ProfileId,
activeConn :: Maybe Connection
}
@@ -622,6 +627,15 @@ groupMemberId' GroupMember {groupMemberId} = groupMemberId
memberIncognito :: GroupMember -> IncognitoEnabled
memberIncognito GroupMember {memberProfile, memberContactProfileId} = localProfileId memberProfile /= memberContactProfileId
incognitoMembership :: GroupInfo -> IncognitoEnabled
incognitoMembership GroupInfo {membership} = memberIncognito membership
-- returns profile when membership is incognito, otherwise Nothing
incognitoMembershipProfile :: GroupInfo -> Maybe LocalProfile
incognitoMembershipProfile GroupInfo {membership = m@GroupMember {memberProfile}}
| memberIncognito m = Just memberProfile
| otherwise = Nothing
memberSecurityCode :: GroupMember -> Maybe SecurityCode
memberSecurityCode GroupMember {activeConn} = connectionCode =<< activeConn
+12 -13
View File
@@ -775,21 +775,21 @@ viewDirectMessagesProhibited MDSnd c = ["direct messages to indirect contact " <
viewDirectMessagesProhibited MDRcv c = ["received prohibited direct message from indirect contact " <> ttyContact' c <> " (discarded)"]
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"]
viewUserJoinedGroup g =
case incognitoMembershipProfile g of
Just mp -> [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile mp)]
Nothing -> [ttyGroup' g <> ": you joined the group"]
viewJoinedGroupMember :: GroupInfo -> GroupMember -> [StyledString]
viewJoinedGroupMember g m =
[ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString]
viewReceivedGroupInvitation g@GroupInfo {membership = membership@GroupMember {memberProfile}} c role =
viewReceivedGroupInvitation g 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"]
case incognitoMembershipProfile g of
Just mp -> ["use " <> highlight ("/j " <> groupName' g) <> " to join incognito as " <> incognitoProfile' (fromLocalProfile mp)]
Nothing -> ["use " <> highlight ("/j " <> groupName' g) <> " to accept"]
groupPreserved :: GroupInfo -> [StyledString]
groupPreserved g = ["use " <> highlight ("/d #" <> groupName' g) <> " to delete the group"]
@@ -879,7 +879,7 @@ viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs
memberCount = sShow currentMembers <> " member" <> if currentMembers == 1 then "" else "s"
groupInvitation' :: GroupInfo -> StyledString
groupInvitation' GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership = membership@GroupMember {memberProfile}} =
groupInvitation' g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} =
highlight ("#" <> ldn)
<> optFullName ldn fullName
<> " - you are invited ("
@@ -888,10 +888,9 @@ groupInvitation' GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile
<> highlight ("/d #" <> ldn)
<> " to delete invitation)"
where
joinText =
if memberIncognito membership
then " to join as " <> incognitoProfile' (fromLocalProfile memberProfile) <> ", "
else " to join, "
joinText = case incognitoMembershipProfile g of
Just mp -> " to join as " <> incognitoProfile' (fromLocalProfile mp) <> ", "
Nothing -> " to join, "
viewContactsMerged :: Contact -> Contact -> [StyledString]
viewContactsMerged _into@Contact {localDisplayName = c1} _merged@Contact {localDisplayName = c2} =