diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 33660dc801..3f7738656e 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2118,7 +2118,7 @@ processChatCommand vr nm = \case case memberContactId m of Nothing -> do g <- withFastStore $ \db -> getGroupInfo db vr user gId - unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwCmdError "direct messages not allowed" + unless (groupFeatureUserAllowed SGFDirectMessages g) $ throwCmdError "direct messages not allowed" toView $ CEvtNoMemberContactCreating user g m processChatCommand vr nm (APICreateMemberContact gId mId) >>= \case CRNewMemberContact _ ct@Contact {contactId} _ _ -> do @@ -2543,7 +2543,7 @@ processChatCommand vr nm = \case void $ deleteOrUpdateMemberRecordIO db user gInfo m pure m {memberStatus = GSMemRemoved} deleteMessages user gInfo@GroupInfo {membership} ms - | groupFeatureMemberAllowed SGFFullDelete membership gInfo = deleteGroupMembersCIs user gInfo ms membership + | groupFeatureUserAllowed SGFFullDelete gInfo = deleteGroupMembersCIs user gInfo ms membership | otherwise = markGroupMembersCIsDeleted user gInfo ms membership APILeaveGroup groupId -> withUser $ \user@User {userId} -> do gInfo@GroupInfo {membership} <- withFastStore $ \db -> getGroupInfo db vr user groupId @@ -2668,7 +2668,7 @@ processChatCommand vr nm = \case APICreateMemberContact gId gMemberId -> withUser $ \user -> do (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId assertUserGroupRole g GRAuthor - unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwCmdError "direct messages not allowed" + unless (groupFeatureUserAllowed SGFDirectMessages g) $ throwCmdError "direct messages not allowed" case memberConn m of Just mConn@Connection {peerChatVRange} -> do unless (maxVersion peerChatVRange >= groupDirectInvVersion) $ throwChatError CEPeerChatVRangeIncompatible @@ -3128,25 +3128,25 @@ processChatCommand vr nm = \case Just (PCEContact ct@Contact {activeConn}) -> case activeConn of Nothing -> connect' Nothing Nothing Just conn@Connection {connStatus, xContactId} -> case connStatus of - ConnPrepared -> joinPreparedConn' xContactId conn False + ConnPrepared -> joinPreparedConn' xContactId conn Nothing _ -> pure $ CVRConnectedContact ct - Just (PCEGroup _gInfo GroupMember {activeConn}) -> case activeConn of + Just (PCEGroup gInfo GroupMember {activeConn}) -> case activeConn of Nothing -> connect' groupLinkId Nothing Just conn@Connection {connStatus, xContactId} -> case connStatus of - ConnPrepared -> joinPreparedConn' xContactId conn $ isJust groupLinkId + ConnPrepared -> joinPreparedConn' xContactId conn $ Just (Just gInfo) _ -> connect' groupLinkId xContactId -- why not "already connected" for host member? Nothing -> withFastStore' (\db -> getConnReqContactXContactId db vr user cReqHash1 cReqHash2) >>= \case Right ct@Contact {activeConn} -> case groupLinkId of Nothing -> case activeConn of - Just conn@Connection {connStatus = ConnPrepared, xContactId} -> joinPreparedConn' xContactId conn False + Just conn@Connection {connStatus = ConnPrepared, xContactId} -> joinPreparedConn' xContactId conn Nothing _ -> pure $ CVRConnectedContact ct Just gLinkId -> -- allow repeat contact request -- TODO [short links] is this branch needed? it probably remained from the time we created host contact connect' (Just gLinkId) Nothing Left conn_ -> case conn_ of - Just conn@Connection {connStatus = ConnPrepared, xContactId} -> joinPreparedConn' xContactId conn $ isJust groupLinkId + Just conn@Connection {connStatus = ConnPrepared, xContactId} -> joinPreparedConn' xContactId conn $ groupLinkId $> Nothing -- TODO [short links] this is executed on repeat request after success -- it probably should send the second message without creating the second connection? Just Connection {xContactId} -> connect' groupLinkId xContactId @@ -3155,12 +3155,12 @@ processChatCommand vr nm = \case cReqHash = ConnReqUriHash . C.sha256Hash . strEncode cReqHash1 = cReqHash $ CRContactUri crData {crScheme = SSSimplex} cReqHash2 = cReqHash $ CRContactUri crData {crScheme = simplexChat} - joinPreparedConn' xContactId_ conn@Connection {customUserProfileId} inGroup = do + joinPreparedConn' xContactId_ conn@Connection {customUserProfileId} gInfo_ = do when (incognito /= isJust customUserProfileId) $ throwCmdError "incognito mode is different from prepared connection" xContactId <- mkXContactId xContactId_ localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId let incognitoProfile = fromLocalProfile <$> localIncognitoProfile - conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ inGroup PQSupportOn + conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ PQSupportOn pure $ CVRSentInvitation conn' incognitoProfile connect' groupLinkId xContactId_ = do let inGroup = isJust groupLinkId @@ -3172,7 +3172,7 @@ processChatCommand vr nm = \case subMode <- chatReadVar subscriptionMode let sLnk' = serverShortLink <$> sLnk conn <- withFastStore' $ \db -> createConnReqConnection db userId connId preparedEntity_ cReq cReqHash1 sLnk' xContactId incognitoProfile groupLinkId subMode chatV pqSup - conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ inGroup pqSup + conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ (groupLinkId $> Nothing) pqSup pure $ CVRSentInvitation conn' incognitoProfile connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse connectContactViaAddress user@User {userId} incognito ct@Contact {contactId, activeConn} (CCLink cReq shortLink) = @@ -3187,7 +3187,7 @@ processChatCommand vr nm = \case subMode <- chatReadVar subscriptionMode let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq cReqHash shortLink newXContactId incognitoProfile Nothing subMode chatV pqSup - void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing False pqSup + void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing pqSup ct' <- withStore $ \db -> getContact db vr user contactId pure $ CRSentInvitationToContact user ct' incognitoProfile Just conn@Connection {connStatus, xContactId = xContactId_, customUserProfileId} -> case connStatus of @@ -3196,7 +3196,7 @@ processChatCommand vr nm = \case xContactId <- mkXContactId xContactId_ localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId let incognitoProfile = fromLocalProfile <$> localIncognitoProfile - void $ joinContact user conn cReq incognitoProfile xContactId Nothing Nothing False PQSupportOn + void $ joinContact user conn cReq incognitoProfile xContactId Nothing Nothing Nothing PQSupportOn ct' <- withStore $ \db -> getContact db vr user contactId pure $ CRSentInvitationToContact user ct' incognitoProfile _ -> throwCmdError "contact already has connection" @@ -3213,12 +3213,14 @@ processChatCommand vr nm = \case pure (connId, chatV) mkXContactId :: Maybe XContactId -> CM XContactId mkXContactId = maybe (XContactId <$> drgRandomBytes 16) pure - joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Bool -> PQSupport -> CM Connection - joinContact user conn@Connection {connChatVersion = chatV} cReq incognitoProfile xContactId welcomeSharedMsgId msg_ inGroup pqSup = do - let profileToSend = - if inGroup - then userProfileInGroup user incognitoProfile - else userProfileDirect user incognitoProfile Nothing True + joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfo) -> PQSupport -> CM Connection + joinContact user conn@Connection {connChatVersion = chatV} cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ pqSup = do + -- gInfo_ is Maybe (Maybe GroupInfo), where Just Nothing means "some unknown group", e.g. when joining via link without profile + let profileToSend = case gInfo_ of + Just gInfo_' -> + let allowSimplexLinks = maybe True (groupFeatureUserAllowed SGFSimplexLinks) gInfo_' + in userProfileInGroup' user allowSimplexLinks incognitoProfile + Nothing -> userProfileDirect user incognitoProfile Nothing True dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_) subMode <- chatReadVar subscriptionMode void $ withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup subMode @@ -3399,7 +3401,7 @@ processChatCommand vr nm = \case ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci membership deletedTs) unless (null ciIds) $ toView $ CEvtGroupChatItemsDeleted user gInfo ciIds True (Just membership) let m = if moderation then Just membership else Nothing - if groupFeatureMemberAllowed SGFFullDelete membership gInfo + if groupFeatureUserAllowed SGFFullDelete gInfo then deleteGroupCIs user gInfo chatScopeInfo items m deletedTs else markGroupCIsDeleted user gInfo chatScopeInfo items m deletedTs updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 74cd0e0d47..9ebdd00b81 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -349,9 +349,9 @@ prohibitedSimplexLinks :: GroupInfo -> GroupMember -> Maybe MarkdownList -> Bool prohibitedSimplexLinks gInfo m ft = not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo) && maybe False (any ftIsSimplexLink) ft - where - ftIsSimplexLink :: FormattedText -> Bool - ftIsSimplexLink FormattedText {format} = maybe False isSimplexLink format + +ftIsSimplexLink :: FormattedText -> Bool +ftIsSimplexLink FormattedText {format} = maybe False isSimplexLink format roundedFDCount :: Int -> Int roundedFDCount n @@ -927,7 +927,7 @@ acceptGroupJoinRequestAsync (groupMemberId, memberId) <- withStore $ \db -> createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ welcomeMsgId_ gLinkMemRole initialStatus currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo - let Profile {displayName} = userProfileInGroup user (fromIncognitoProfile <$> incognitoProfile) + let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile) GroupMember {memberRole = userRole, memberId = userMemberId} = membership msg = XGrpLinkInv $ @@ -1053,7 +1053,7 @@ introduceToRemaining vr user gInfo m = do introduceMember :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> [GroupMember] -> Maybe MsgScope -> CM () introduceMember _ _ _ GroupMember {activeConn = Nothing} _ _ = throwChatError $ CEInternalError "member connection not active" introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Just conn} introduceToMembers msgScope = do - void . sendGroupMessage' user gInfo introduceToMembers $ XGrpMemNew (memberInfo m) msgScope + void . sendGroupMessage' user gInfo introduceToMembers $ XGrpMemNew (memberInfo gInfo m) msgScope sendIntroductions introduceToMembers where sendIntroductions members = do @@ -1068,7 +1068,7 @@ introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Ju processIntro intro `catchAllErrors` eToView memberIntro :: GroupMember -> ChatMsgEvent 'Json memberIntro reMember = - let mInfo = memberInfo reMember + let mInfo = memberInfo gInfo reMember mRestrictions = memberRestrictions reMember in XGrpMemIntro mInfo mRestrictions shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro] @@ -1084,6 +1084,34 @@ introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Ju void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId withStore' $ \db -> updateIntroStatus db introId GMIntroSent +userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile +userProfileInGroup user = userProfileInGroup' user . groupFeatureUserAllowed SGFSimplexLinks +{-# INLINE userProfileInGroup #-} + +userProfileInGroup' :: User -> Bool -> Maybe Profile -> Profile +userProfileInGroup' User {profile = p} allowSimplexLinks incognitoProfile = + let p' = fromMaybe (fromLocalProfile p) incognitoProfile + in redactedMemberProfile allowSimplexLinks p' + +memberInfo :: GroupInfo -> GroupMember -> MemberInfo +memberInfo g m@GroupMember {memberId, memberRole, memberProfile, activeConn} = + MemberInfo + { memberId, + memberRole, + v = ChatVersionRange . peerChatVRange <$> activeConn, + profile = redactedMemberProfile allowSimplexLinks $ fromLocalProfile memberProfile + } + where + allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m g + +redactedMemberProfile :: Bool -> Profile -> Profile +redactedMemberProfile allowSimplexLinks Profile {displayName, fullName, shortDescr, image, peerType} = + Profile {displayName, fullName, shortDescr = removeSimplexLink =<< shortDescr, image, contactLink = Nothing, preferences = Nothing, peerType} + where + removeSimplexLink s + | allowSimplexLinks = Just s + | otherwise = maybe (Just s) (\fts -> if any ftIsSimplexLink fts then Nothing else Just s) $ parseMaybeMarkdownList s + sendHistory :: User -> GroupInfo -> GroupMember -> CM () sendHistory _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active" sendHistory user gInfo@GroupInfo {groupId, membership} m@GroupMember {activeConn = Just conn} = @@ -1858,7 +1886,8 @@ sendGroupMessages user gInfo scope members events = do _ -> False sendProfileUpdate = do let members' = filter (`supportsVersion` memberProfileUpdateVersion) members - profileUpdateEvent = XInfo $ redactedMemberProfile $ fromLocalProfile p + allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo + profileUpdateEvent = XInfo $ redactedMemberProfile allowSimplexLinks $ fromLocalProfile p void $ sendGroupMessage' user gInfo members' profileUpdateEvent currentTs <- liftIO getCurrentTime withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 4b71c23fb9..06f71fcaca 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -404,12 +404,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = CONF confId pqSupport _ connInfo -> do conn' <- processCONFpqSupport conn pqSupport -- [incognito] send saved profile - (conn'', inGroup) <- saveConnInfo conn' connInfo + (conn'', gInfo_) <- saveConnInfo conn' connInfo incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - let profileToSend = - if inGroup - then userProfileInGroup user (fromLocalProfile <$> incognitoProfile) - else userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True + let profileToSend = case gInfo_ of + Just gInfo -> userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) + Nothing -> userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True -- [async agent commands] no continuation needed, but command should be asynchronous for stability allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend INFO pqSupport connInfo -> do @@ -536,7 +535,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) - let profileToSend = userProfileInGroup user (fromLocalProfile <$> incognitoProfile) + let profileToSend = userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend toView $ CEvtBusinessLinkConnecting user gInfo host ct _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" @@ -742,7 +741,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = (gInfo', m') <- withStore $ \db -> updatePreparedUserAndHostMembersInvited db vr user gInfo m glInv -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) - let profileToSend = userProfileInGroup user (fromLocalProfile <$> incognitoProfile) + let profileToSend = userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) allowAgentConnectionAsync user conn' confId $ XInfo profileToSend toView $ CEvtGroupLinkConnecting user gInfo' m' XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do @@ -755,7 +754,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XGrpMemInfo memId _memProfile | sameMemberId memId m -> do let GroupMember {memberId = membershipMemId} = membership - membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership + allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo + membershipProfile = redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membershipMemId membershipProfile @@ -835,7 +835,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where sendXGrpLinkMem gInfo'' = do let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo'' - profileToSend = userProfileInGroup user (fromIncognitoProfile <$> incognitoProfile) + profileToSend = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile) void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId _ -> do unless (memberPending m) $ withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected @@ -2261,7 +2261,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_ - | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' = do + | redactedMemberProfile allowSimplexLinks (fromLocalProfile p) /= redactedMemberProfile allowSimplexLinks p' = do updateBusinessChatProfile gInfo case memberContactId of Nothing -> do @@ -2288,6 +2288,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | otherwise = pure m where + allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m gInfo updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of Just bc | isMainBusinessMember bc m -> do g' <- withStore $ \db -> updateGroupProfileFromMember db user g p' @@ -2512,7 +2513,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toView $ CEvtContactAndMemberAssociated user c2 g m1 c2' pure c2' - saveConnInfo :: Connection -> ConnInfo -> CM (Connection, Bool) + saveConnInfo :: Connection -> ConnInfo -> CM (Connection, Maybe GroupInfo) saveConnInfo activeConn connInfo = do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo conn' <- updatePeerChatVRange activeConn chatVRange @@ -2520,18 +2521,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XInfo p -> do ct <- withStore $ \db -> createDirectContact db vr user conn' p toView $ CEvtContactConnecting user ct - pure (conn', False) + pure (conn', Nothing) XGrpLinkInv glInv -> do (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db vr user conn' glInv toView $ CEvtGroupLinkConnecting user gInfo host - pure (conn', True) + pure (conn', Just gInfo) XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do (gInfo, host) <- withStore $ \db -> createGroupRejectedViaLink db vr user conn' glRjct toView $ CEvtGroupLinkConnecting user gInfo host toViewTE $ TEGroupLinkRejected user gInfo rejectionReason - pure (conn', True) + pure (conn', Just gInfo) -- TODO show/log error, other events in SMP confirmation - _ -> pure (conn', False) + _ -> pure (conn', Nothing) xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MsgScope -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _) msgScope_ msg brokerTs = do @@ -2624,7 +2625,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = GroupMemberIntro {introId} <- getIntroduction db reMember m liftIO $ updateIntroStatus db introId GMIntroInvReceived pure introId - sendGroupMemberMessage gInfo reMember (XGrpMemFwd (memberInfo m) introInv) (Just introId) $ + sendGroupMemberMessage gInfo reMember (XGrpMemFwd (memberInfo gInfo m) introInv) (Just introId) $ withStore' $ \db -> updateIntroStatus db introId GMIntroInvForwarded _ -> messageError "x.grp.mem.inv can be only sent by invitee member" @@ -2648,7 +2649,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> updateGroupMemberStatus db userId toMember newMemberStatus subMode <- chatReadVar subscriptionMode -- [incognito] send membership incognito profile, create direct connection as incognito - let membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership + let membershipProfile = redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership + allowSimplexLinks = groupFeatureUserAllowed SGFSimplexLinks gInfo dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile -- [async agent commands] no continuation needed, but commands should be asynchronous for stability groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index e6316e2666..af46c14b83 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -321,9 +321,9 @@ updateUserProfile db user p' DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (currentTs, userId) pure $ Just currentTs | otherwise = pure userMemberProfileUpdatedAt - userMemberProfileChanged = newName /= displayName || newFullName /= fullName || newImage /= image - User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, image, localAlias}, userMemberProfileUpdatedAt} = user - Profile {displayName = newName, fullName = newFullName, image = newImage, preferences} = p' + userMemberProfileChanged = newName /= displayName || fn' /= fullName || d' /= shortDescr || img' /= image + User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, localAlias}, userMemberProfileUpdatedAt} = user + Profile {displayName = newName, fullName = fn', shortDescr = d', image = img', preferences} = p' profile = toLocalProfile profileId p' localAlias fullPreferences = fullPreferences' preferences diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index c137ad5154..2f4fd058e3 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -581,6 +581,10 @@ groupFeatureMemberAllowed :: GroupFeatureRoleI f => SGroupFeature f -> GroupMemb groupFeatureMemberAllowed feature GroupMember {memberRole} = groupFeatureMemberAllowed' feature memberRole . fullGroupPreferences +groupFeatureUserAllowed :: GroupFeatureRoleI f => SGroupFeature f -> GroupInfo -> Bool +groupFeatureUserAllowed feature GroupInfo {membership = GroupMember {memberRole}, fullGroupPreferences} = + groupFeatureMemberAllowed' feature memberRole fullGroupPreferences + mergeUserChatPrefs :: User -> Contact -> FullPreferences mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) (userPreferences ct) @@ -673,10 +677,6 @@ profilesMatch LocalProfile {displayName = n2, fullName = fn2, image = i2} = n1 == n2 && fn1 == fn2 && i1 == i2 -redactedMemberProfile :: Profile -> Profile -redactedMemberProfile Profile {displayName, fullName, shortDescr, image, peerType} = - Profile {displayName, fullName, shortDescr, image, contactLink = Nothing, preferences = Nothing, peerType} - data IncognitoProfile = NewIncognito Profile | ExistingIncognito LocalProfile fromIncognitoProfile :: IncognitoProfile -> Profile @@ -684,11 +684,6 @@ fromIncognitoProfile = \case NewIncognito p -> p ExistingIncognito lp -> fromLocalProfile lp -userProfileInGroup :: User -> Maybe Profile -> Profile -userProfileInGroup User {profile = p} incognitoProfile = - let p' = fromMaybe (fromLocalProfile p) incognitoProfile - in redactedMemberProfile p' - userProfileDirect :: User -> Maybe Profile -> Maybe Contact -> Bool -> Profile userProfileDirect user@User {profile = p} incognitoProfile ct canFallbackToUserTTL = let p' = fromMaybe (fromLocalProfile p) incognitoProfile @@ -870,15 +865,6 @@ data BusinessChatInfo = BusinessChatInfo } deriving (Eq, Show) -memberInfo :: GroupMember -> MemberInfo -memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} = - MemberInfo - { memberId, - memberRole, - v = ChatVersionRange . peerChatVRange <$> activeConn, - profile = redactedMemberProfile $ fromLocalProfile memberProfile - } - data MemberRestrictionStatus = MRSBlocked | MRSUnrestricted