From 7b7926a73e126ac129eb8a3b030ec82a462b92bf Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 24 Jul 2025 14:52:48 +0000 Subject: [PATCH] core, ui: allow to choose disappearing messages ttl in user profile (#6097) --- .../Views/UserSettings/PreferencesView.swift | 31 +++++-- apps/ios/SimpleXChat/ChatTypes.swift | 4 + .../chat/simplex/common/model/SimpleXAPI.kt | 3 + .../common/views/usersettings/Preferences.kt | 38 ++++++++- .../commonMain/resources/MR/base/strings.xml | 1 + src/Simplex/Chat/Library/Commands.hs | 35 +++++--- src/Simplex/Chat/Library/Internal.hs | 19 ++++- src/Simplex/Chat/Library/Subscriber.hs | 17 ++-- src/Simplex/Chat/Store/ContactRequest.hs | 7 +- src/Simplex/Chat/Store/Direct.hs | 81 ++++--------------- src/Simplex/Chat/Store/Profiles.hs | 2 +- .../SQLite/Migrations/chat_query_plans.txt | 12 +-- src/Simplex/Chat/Store/Shared.hs | 37 +++++++-- src/Simplex/Chat/Types.hs | 40 +++++---- src/Simplex/Chat/Types/Preferences.hs | 33 ++++++-- src/Simplex/Chat/View.hs | 2 +- 16 files changed, 219 insertions(+), 143 deletions(-) diff --git a/apps/ios/Shared/Views/UserSettings/PreferencesView.swift b/apps/ios/Shared/Views/UserSettings/PreferencesView.swift index bd8171623a..eced372124 100644 --- a/apps/ios/Shared/Views/UserSettings/PreferencesView.swift +++ b/apps/ios/Shared/Views/UserSettings/PreferencesView.swift @@ -19,7 +19,7 @@ struct PreferencesView: View { var body: some View { VStack { List { - timedMessagesFeatureSection($preferences.timedMessages.allow) + timedMessagesFeatureSection($preferences.timedMessages.allow, $preferences.timedMessages.ttl) featureSection(.fullDelete, $preferences.fullDelete.allow) featureSection(.reactions, $preferences.reactions.allow) featureSection(.voice, $preferences.voice.allow) @@ -60,20 +60,35 @@ struct PreferencesView: View { } - private func timedMessagesFeatureSection(_ allowFeature: Binding) -> some View { + @ViewBuilder private func timedMessagesFeatureSection(_ allowFeature: Binding, _ ttl: Binding) -> some View { + let allow = Binding( + get: { allowFeature.wrappedValue == .always || allowFeature.wrappedValue == .yes }, + set: { yes, _ in allowFeature.wrappedValue = yes ? .yes : .no } + ) Section { - let allow = Binding( - get: { allowFeature.wrappedValue == .always || allowFeature.wrappedValue == .yes }, - set: { yes, _ in allowFeature.wrappedValue = yes ? .yes : .no } - ) settingsRow(ChatFeature.timedMessages.icon, color: theme.colors.secondary) { Toggle(ChatFeature.timedMessages.text, isOn: allow) } + if allow.wrappedValue { + Picker("Delete after", selection: ttl) { + ForEach(TimedMessagesPreference.profileLevelTTLValues, id: \.self) { value in + Text(timeText(value)).tag(value) + } + } + .frame(height: 36) + } + } + footer: { + let featureFooterText = featureFooter(.timedMessages, allowFeature).foregroundColor(theme.colors.secondary) + if allow.wrappedValue && ttl.wrappedValue != nil { + featureFooterText + textNewLine + Text("Time to disappear is set only for new contacts.") + } else { + featureFooterText + } } - footer: { featureFooter(.timedMessages, allowFeature).foregroundColor(theme.colors.secondary) } } - private func featureFooter(_ feature: ChatFeature, _ allowFeature: Binding) -> some View { + private func featureFooter(_ feature: ChatFeature, _ allowFeature: Binding) -> Text { Text(feature.allowDescription(allowFeature.wrappedValue)) } diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index 5107ddf45d..4e73795546 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -372,6 +372,10 @@ public struct TimedMessagesPreference: Preference, Hashable { public static var ttlValues: [Int?] { [600, 3600, 86400, 7 * 86400, 30 * 86400, 3 * 30 * 86400, nil] } + + public static var profileLevelTTLValues: [Int?] { + [7 * 86400, 30 * 86400, 3 * 30 * 86400, nil] + } } public enum CustomTimeUnit: Hashable { diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 4a01c019f7..38707db991 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -4925,6 +4925,9 @@ data class TimedMessagesPreference( companion object { val ttlValues: List get() = listOf(600, 3600, 86400, 7 * 86400, 30 * 86400, 3 * 30 * 86400, null) + + val profileLevelTTLValues: List + get() = listOf(7 * 86400, 30 * 86400, 3 * 30 * 86400, null) } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt index 72fa45b936..fe9137ee35 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/Preferences.kt @@ -69,9 +69,18 @@ private fun PreferencesLayout( ColumnWithScrollBar { AppBarTitle(stringResource(MR.strings.your_preferences)) val timedMessages = remember(preferences) { mutableStateOf(preferences.timedMessages.allow) } - TimedMessagesFeatureSection(timedMessages) { - applyPrefs(preferences.copy(timedMessages = TimedMessagesPreference(allow = if (it) FeatureAllowed.YES else FeatureAllowed.NO))) + val onTTLUpdated = { ttl: Int? -> + applyPrefs(preferences.copy(timedMessages = preferences.timedMessages.copy(ttl = ttl))) } + TimedMessagesFeatureSection( + preferences, + timedMessages, + onSelected = { + applyPrefs(preferences.copy(timedMessages = TimedMessagesPreference(allow = if (it) FeatureAllowed.YES else FeatureAllowed.NO))) + }, + onTTLUpdated = onTTLUpdated + ) + SectionDividerSpaced(true, maxBottomPadding = false) val allowFullDeletion = remember(preferences) { mutableStateOf(preferences.fullDelete.allow) } FeatureSection(ChatFeature.FullDelete, allowFullDeletion) { @@ -117,7 +126,13 @@ private fun FeatureSection(feature: ChatFeature, allowFeature: State, onSelected: (Boolean) -> Unit) { +private fun TimedMessagesFeatureSection( + preferences: FullChatPreferences, + allowFeature: State, + onSelected: (Boolean) -> Unit, + onTTLUpdated: (Int?) -> Unit +) { + val ttl = rememberSaveable(preferences) { mutableStateOf(preferences.timedMessages.ttl) } SectionView { PreferenceToggleWithIcon( ChatFeature.TimedMessages.text, @@ -127,8 +142,23 @@ private fun TimedMessagesFeatureSection(allowFeature: State, onS extraPadding = false, onChange = onSelected ) + if (allowFeature.value == FeatureAllowed.ALWAYS || allowFeature.value == FeatureAllowed.YES) { + ExposedDropDownSettingRow( + generalGetString(MR.strings.delete_after), + TimedMessagesPreference.profileLevelTTLValues.map { v -> v to timeText(v) }, + ttl, + icon = null, + onSelected = onTTLUpdated + ) + } } - SectionTextFooter(ChatFeature.TimedMessages.allowDescription(allowFeature.value)) + SectionTextFooter( + if ((allowFeature.value == FeatureAllowed.ALWAYS || allowFeature.value == FeatureAllowed.YES) && ttl.value != null) { + ChatFeature.TimedMessages.allowDescription(allowFeature.value) + "\n" + generalGetString(MR.strings.time_to_disappear_is_set_only_for_new_contacts) + } else { + ChatFeature.TimedMessages.allowDescription(allowFeature.value) + } + ) } @Composable diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml index 389f48b5d1..af51bd5ba6 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml @@ -2138,6 +2138,7 @@ Set 1 day Allow your contacts to send disappearing messages. Allow disappearing messages only if your contact allows them. + Time to disappear is set only for new contacts. Prohibit sending disappearing messages. Allow your contacts to irreversibly delete sent messages. (24 hours) Allow irreversible message deletion only if your contact allows it to you. (24 hours) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index d3ad8535ac..0066bc1ee9 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1701,7 +1701,7 @@ processChatCommand vr nm = \case -- [incognito] generate profile for connection incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode - userData <- contactShortLinkData (userProfileToSend user incognitoProfile Nothing False) Nothing + userData <- contactShortLinkData (userProfileDirect user incognitoProfile Nothing True) Nothing -- TODO [certs rcv] (connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId user) True SCMInvitation (Just userData) Nothing IKPQOn subMode ccLink' <- shortenCreatedLink ccLink @@ -1716,13 +1716,13 @@ processChatCommand vr nm = \case case (pccConnStatus, customUserProfileId, incognito) of (ConnNew, Nothing, True) -> do incognitoProfile <- liftIO generateRandomProfile - sLnk <- updatePCCShortLinkData conn $ userProfileToSend user (Just incognitoProfile) Nothing False + sLnk <- updatePCCShortLinkData conn $ userProfileDirect user (Just incognitoProfile) Nothing True conn' <- withFastStore' $ \db -> do pId <- createIncognitoProfile db user incognitoProfile updatePCCIncognito db user conn (Just pId) sLnk pure $ CRConnectionIncognitoUpdated user conn' (Just incognitoProfile) (ConnNew, Just pId, False) -> do - sLnk <- updatePCCShortLinkData conn $ userProfileToSend user Nothing Nothing False + sLnk <- updatePCCShortLinkData conn $ userProfileDirect user Nothing Nothing True conn' <- withFastStore' $ \db -> do deletePCCIncognitoProfile db user pId updatePCCIncognito db user conn Nothing sLnk @@ -1743,7 +1743,7 @@ processChatCommand vr nm = \case let short = isJust $ connShortLink =<< connLinkInv userData_ <- if short - then Just <$> contactShortLinkData (userProfileToSend newUser Nothing Nothing False) Nothing + then Just <$> contactShortLinkData (userProfileDirect newUser Nothing Nothing True) Nothing else pure Nothing -- TODO [certs rcv] (agConnId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId newUser) True SCMInvitation userData_ Nothing IKPQOn subMode @@ -1779,7 +1779,7 @@ processChatCommand vr nm = \case _ -> Chat cInfo [] emptyChatStats pure $ CRNewPreparedChat user $ AChat SCTGroup chat ACCL _ (CCLink cReq _) -> do - ct <- withStore $ \db -> createPreparedContact db user profile accLink welcomeSharedMsgId + ct <- withStore $ \db -> createPreparedContact db vr user profile accLink welcomeSharedMsgId void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing (Just epochStart) let cd = CDDirectRcv ct createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing @@ -1810,6 +1810,8 @@ processChatCommand vr nm = \case when (isJust $ contactConn ct) $ throwCmdError "contact already has connection" newUser <- privateGetUser newUserId ct' <- withFastStore $ \db -> updatePreparedContactUser db vr user ct newUser + -- create changed feature items (new user may have different preferences) + lift $ createContactChangedFeatureItems user ct ct' pure $ CRContactUserChanged user ct newUser ct' APIChangePreparedGroupUser groupId newUserId -> withUser $ \user -> do (gInfo, hostMember) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getHostMember db vr user groupId @@ -1831,6 +1833,8 @@ processChatCommand vr nm = \case throwError e -- get updated contact with connection ct' <- withFastStore $ \db -> getContact db vr user contactId + -- create changed feature items (connecting incognito sends default preferences, instead of user preferences) + lift . when incognito $ createContactChangedFeatureItems user ct ct' forM_ msgContent_ $ \mc -> do let evt = XMsgNew $ MCSimple (extMsgContent mc Nothing) (msg, _) <- sendDirectContactMessage user ct' evt @@ -1854,6 +1858,8 @@ processChatCommand vr nm = \case CVRSentInvitation _conn customUserProfile -> do -- get updated contact with connection ct' <- withFastStore $ \db -> getContact db vr user contactId + -- create changed feature items (connecting incognito sends default preferences, instead of user preferences) + lift . when incognito $ createContactChangedFeatureItems user ct ct' forM_ msg_ $ \(sharedMsgId, mc) -> do ci <- createChatItem user (CDDirectSnd ct') False (CISndMsgContent mc) (Just sharedMsgId) Nothing toView $ CEvtNewChatItems user [ci] @@ -1926,7 +1932,7 @@ processChatCommand vr nm = \case Left e -> throwError $ ChatErrorStore e Right _ -> throwError $ ChatErrorStore SEDuplicateContactLink subMode <- chatReadVar subscriptionMode - userData <- contactShortLinkData (userProfileToSend user Nothing Nothing False) Nothing + userData <- contactShortLinkData (userProfileDirect user Nothing Nothing True) Nothing -- TODO [certs rcv] (connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId user) True SCMContact (Just userData) Nothing IKPQOn subMode ccLink' <- shortenCreatedLink ccLink @@ -2962,7 +2968,7 @@ processChatCommand vr nm = \case conn <- withFastStore' $ \db -> createDirectConnection' db userId connId ccLink contactId_ ConnPrepared incognitoProfile subMode chatV pqSup' joinPreparedConn conn incognitoProfile chatV joinPreparedConn conn incognitoProfile chatV = do - let profileToSend = userProfileToSend user incognitoProfile Nothing False + let profileToSend = userProfileDirect user incognitoProfile Nothing True dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend (sqSecured, _serviceId) <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup' subMode let newStatus = if sqSecured then ConnSndReady else ConnJoined @@ -3055,7 +3061,10 @@ processChatCommand vr nm = \case pure (connId, chatV) 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 = userProfileToSend user incognitoProfile Nothing inGroup + let profileToSend = + if inGroup + then userProfileInGroup user incognitoProfile + else 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 @@ -3120,9 +3129,9 @@ processChatCommand vr nm = \case ChangedProfileContact ct ct' mergedProfile' conn : changedCts _ -> changedCts where - mergedProfile = userProfileToSend user Nothing (Just ct) False + mergedProfile = userProfileDirect user Nothing (Just ct) False ct' = updateMergedPreferences user' ct - mergedProfile' = userProfileToSend user' Nothing (Just ct') False + mergedProfile' = userProfileDirect user' Nothing (Just ct') False ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json) ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile') ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq @@ -3132,7 +3141,7 @@ processChatCommand vr nm = \case setMyAddressData :: User -> UserContactLink -> CM UserContactLink setMyAddressData user ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _sLnk_, addressSettings} = do conn <- withFastStore $ \db -> getUserAddressConnection db vr user - let shortLinkProfile = userProfileToSend user Nothing Nothing False + let shortLinkProfile = userProfileDirect user Nothing Nothing True -- TODO [short links] do not save address to server if data did not change, spinners, error handling userData <- contactShortLinkData shortLinkProfile $ Just addressSettings sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userData Nothing) @@ -3148,8 +3157,8 @@ processChatCommand vr nm = \case assertDirectAllowed user MDSnd ct XInfo_ ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs' incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId - let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) False - mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False + let mergedProfile = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct) False + mergedProfile' = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') False when (mergedProfile' /= mergedProfile) $ withContactLock "updateContactPrefs" (contactId' ct) $ do void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` eToView diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index b38c1ebbf3..d37a8a70d9 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -910,7 +910,7 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId Just conn@Connection {customUserProfileId} -> do incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId pure (ct, conn, ExistingIncognito <$> incognitoProfile) - let profileToSend = userProfileToSend' user incognitoProfile (Just ct) False + let profileToSend = userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend -- TODO [certs rcv] (ct,conn,) . fst <$> withAgent (\a -> acceptContact a nm (aUserId user) (aConnId conn) True invId dm pqSup' subMode) @@ -923,7 +923,7 @@ acceptContactRequestAsync UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange, xContactId, pqSupport = cReqPQSup} incognitoProfile = do subMode <- chatReadVar subscriptionMode - let profileToSend = userProfileToSend' user incognitoProfile (Just ct) False + let profileToSend = userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True vr <- chatVersionRange let chatV = vr `peerConnChatVersion` cReqChatVRange (cmdId, acId) <- agentAcceptContactAsync user True cReqInvId (XInfo profileToSend) subMode cReqPQSup chatV @@ -952,7 +952,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} = userProfileToSend' user incognitoProfile Nothing True + let Profile {displayName} = userProfileInGroup user (fromIncognitoProfile <$> incognitoProfile) GroupMember {memberRole = userRole, memberId = userMemberId} = membership msg = XGrpLinkInv $ @@ -1011,7 +1011,7 @@ acceptBusinessJoinRequestAsync clientMember@GroupMember {groupMemberId, memberId} UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange, xContactId} = do vr <- chatVersionRange - let userProfile@Profile {displayName, preferences} = userProfileToSend' user Nothing Nothing True + let userProfile@Profile {displayName, preferences} = userProfileInGroup user Nothing -- TODO [short links] take groupPreferences from group info groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences msg = @@ -2288,6 +2288,17 @@ createSndFeatureItems user ct ct' = CUPContact {preference} -> preference CUPUser {preference} -> preference +-- Used when contact is changed after creating initial feature items via createFeatureEnabledItems_ +-- (APIChangePreparedContactUser, APIConnectPreparedContact with incognito = True); +-- creates feature items with CDDirectRcv direction so that changed feature items stay in the same place in chat view +createContactChangedFeatureItems :: User -> Contact -> Contact -> CM' () +createContactChangedFeatureItems user ct ct' = + createFeatureItems user ct ct' CDDirectRcv CIRcvChatFeature CIRcvChatPreference getPref + where + getPref ContactUserPreference {userPreference} = case userPreference of + CUPContact {preference} -> preference + CUPUser {preference} -> preference + type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d createFeatureEnabledItems :: User -> Contact -> CM () diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 68791c5cae..5c90554e53 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -416,7 +416,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- [incognito] send saved profile (conn'', inGroup) <- saveConnInfo conn' connInfo incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing inGroup + let profileToSend = + if inGroup + then userProfileInGroup user (fromLocalProfile <$> incognitoProfile) + else 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 @@ -535,7 +538,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct) -- [incognito] send incognito profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId - let p = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False + let p = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True allowAgentConnectionAsync user conn'' confId $ XInfo p void $ withStore' $ \db -> resetMemberContactFields db ct' XGrpLinkInv glInv -> do @@ -545,7 +548,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = createGroupInvitedViaLink db vr user conn'' glInv -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) - let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing True + let profileToSend = userProfileInGroup user (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" @@ -759,7 +762,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 = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing True + let profileToSend = userProfileInGroup user (fromLocalProfile <$> incognitoProfile) allowAgentConnectionAsync user conn' confId $ XInfo profileToSend toView $ CEvtGroupLinkConnecting user gInfo' m' XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do @@ -852,7 +855,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where sendXGrpLinkMem gInfo'' = do let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo'' - profileToSend = userProfileToSend' user incognitoProfile Nothing True + profileToSend = userProfileInGroup user (fromIncognitoProfile <$> incognitoProfile) void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId _ -> do unless (memberPending m) $ withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected @@ -2713,7 +2716,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = conn' <- updatePeerChatVRange activeConn chatVRange case chatMsgEvent of XInfo p -> do - ct <- withStore $ \db -> createDirectContact db user conn' p + ct <- withStore $ \db -> createDirectContact db vr user conn' p toView $ CEvtContactConnecting user ct pure (conn', False) XGrpLinkInv glInv -> do @@ -3088,7 +3091,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = createItems mCt' m' joinConn subMode = do -- [incognito] send membership incognito profile - let p = userProfileToSend user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing False + let p = userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True -- TODO PQ should negotitate contact connection with PQSupportOn? (use encodeConnInfoPQ) dm <- encodeConnInfo $ XInfo p joinAgentConnectionAsync user True connReq dm subMode diff --git a/src/Simplex/Chat/Store/ContactRequest.hs b/src/Simplex/Chat/Store/ContactRequest.hs index 4836e30116..4de4a300f2 100644 --- a/src/Simplex/Chat/Store/ContactRequest.hs +++ b/src/Simplex/Chat/Store/ContactRequest.hs @@ -187,11 +187,12 @@ createOrUpdateContactRequest | otherwise = createContact' where createContact' = do + let ctUserPreferences = newContactUserPrefs user profile liftIO $ DB.execute db - "INSERT INTO contacts (contact_profile_id, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?)" - (profileId, ldn, userId, currentTs, currentTs, currentTs, BI True, contactRequestId) + "INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?,?)" + (profileId, ctUserPreferences, ldn, userId, currentTs, currentTs, currentTs, BI True, contactRequestId) contactId <- liftIO $ insertedRowId db liftIO $ DB.execute @@ -202,7 +203,7 @@ createOrUpdateContactRequest ct <- getContact db vr user contactId pure $ RSCurrentRequest Nothing ucr (Just $ REContact ct) createBusinessChat = do - let Profile {preferences = userPreferences} = userProfileToSend' user Nothing Nothing True + let Profile {preferences = userPreferences} = userProfileInGroup user Nothing groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs userPreferences (gInfo@GroupInfo {groupId}, clientMember) <- createBusinessRequestGroup db vr gVar user cReqChatVRange profile profileId ldn groupPreferences diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index e6db6bf90e..08dc2f09c3 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -107,7 +107,7 @@ import Simplex.Chat.Store.Shared import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.UITheme -import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), UserId, connMode) +import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), UserId) import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow) import Simplex.Messaging.Agent.Store.DB (BoolInt (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB @@ -343,58 +343,33 @@ createIncognitoProfile db User {userId} p = do createdAt <- getCurrentTime createIncognitoProfile_ db userId createdAt p -createPreparedContact :: DB.Connection -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact -createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToConnect@(ACCL m _) welcomeSharedMsgId = do +createPreparedContact :: DB.Connection -> VersionRangeChat -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact +createPreparedContact db vr user p connLinkToConnect welcomeSharedMsgId = do currentTs <- liftIO getCurrentTime let prepared = Just (connLinkToConnect, welcomeSharedMsgId) - (localDisplayName, contactId, profileId) <- createContact_ db userId p prepared "" Nothing currentTs - let profile = toLocalProfile profileId p "" - userPreferences = emptyChatPrefs - mergedPreferences = contactUserPreferences user userPreferences preferences False - pure $ - Contact - { contactId, - localDisplayName, - profile, - activeConn = Nothing, - viaGroup = Nothing, - contactUsed = True, - contactStatus = CSActive, - chatSettings = defaultChatSettings, - userPreferences, - mergedPreferences, - createdAt = currentTs, - updatedAt = currentTs, - chatTs = Just currentTs, - preparedContact = Just PreparedContact {connLinkToConnect, uiConnLinkType = connMode m, welcomeSharedMsgId, requestSharedMsgId = Nothing}, - contactRequestId = Nothing, - contactGroupMemberId = Nothing, - contactGrpInvSent = False, - chatTags = [], - chatItemTTL = Nothing, - uiThemes = Nothing, - chatDeleted = False, - customData = Nothing - } + ctUserPreferences = newContactUserPrefs user p + contactId <- createContact_ db user p ctUserPreferences prepared "" Nothing currentTs + getContact db vr user contactId updatePreparedContactUser :: DB.Connection -> VersionRangeChat -> User -> Contact -> User -> ExceptT StoreError IO Contact updatePreparedContactUser db vr user - Contact {contactId, localDisplayName = oldLDN, profile = LocalProfile {profileId, displayName}} + Contact {contactId, localDisplayName = oldLDN, profile = profile@LocalProfile {profileId, displayName}} newUser@User {userId = newUserId} = do ExceptT . withLocalDisplayName db newUserId displayName $ \newLDN -> runExceptT $ do liftIO $ do currentTs <- getCurrentTime + let ctUserPreferences = newContactUserPrefs newUser (fromLocalProfile profile) DB.execute db [sql| UPDATE contacts - SET user_id = ?, local_display_name = ?, updated_at = ? + SET user_id = ?, local_display_name = ?, user_preferences = ?, updated_at = ? WHERE contact_id = ? |] - (newUserId, newLDN, currentTs, contactId) + (newUserId, newLDN, ctUserPreferences, currentTs, contactId) DB.execute db [sql| @@ -406,39 +381,13 @@ updatePreparedContactUser safeDeleteLDN db user oldLDN getContact db vr newUser contactId -createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact -createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do +createDirectContact :: DB.Connection -> VersionRangeChat -> User -> Connection -> Profile -> ExceptT StoreError IO Contact +createDirectContact db vr user Connection {connId, localAlias} p = do currentTs <- liftIO getCurrentTime - (localDisplayName, contactId, profileId) <- createContact_ db userId p Nothing localAlias Nothing currentTs + let ctUserPreferences = newContactUserPrefs user p + contactId <- createContact_ db user p ctUserPreferences Nothing localAlias Nothing currentTs liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId) - let profile = toLocalProfile profileId p localAlias - userPreferences = emptyChatPrefs - mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn - pure $ - Contact - { contactId, - localDisplayName, - profile, - activeConn = Just conn, - viaGroup = Nothing, - contactUsed = True, - contactStatus = CSActive, - chatSettings = defaultChatSettings, - userPreferences, - mergedPreferences, - createdAt = currentTs, - updatedAt = currentTs, - chatTs = Just currentTs, - preparedContact = Nothing, - contactRequestId = Nothing, - contactGroupMemberId = Nothing, - contactGrpInvSent = False, - chatTags = [], - chatItemTTL = Nothing, - uiThemes = Nothing, - chatDeleted = False, - customData = Nothing - } + getContact db vr user contactId deleteContactConnections :: DB.Connection -> User -> Contact -> IO () deleteContactConnections db User {userId} Contact {contactId} = do diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index b1bd94edf0..eebb21798c 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -320,7 +320,7 @@ updateUserProfile db user p' User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, image, localAlias}, userMemberProfileUpdatedAt} = user Profile {displayName = newName, fullName = newFullName, image = newImage, preferences} = p' profile = toLocalProfile profileId p' localAlias - fullPreferences = mergePreferences Nothing preferences + fullPreferences = fullPreferences' preferences setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 339d05b325..f985852d7a 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -745,7 +745,7 @@ SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?) Query: UPDATE contacts - SET user_id = ?, local_display_name = ?, updated_at = ? + SET user_id = ?, local_display_name = ?, user_preferences = ?, updated_at = ? WHERE contact_id = ? Plan: @@ -5715,15 +5715,15 @@ Query: INSERT INTO contact_profiles (display_name, full_name, short_descr, image Plan: SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?) -Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?) -Plan: -SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?) - Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?) Plan: SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?) -Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?) +Query: INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?,?) +Plan: +SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?) + +Query: INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?,?) Plan: SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?) diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 96ae329b5b..72282c8436 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -382,12 +382,12 @@ setCommandConnId db User {userId} cmdId connId = do (connId, updatedAt, userId, cmdId) createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO () -createContact db User {userId} profile = do +createContact db user profile = do currentTs <- liftIO getCurrentTime - void $ createContact_ db userId profile Nothing "" Nothing currentTs + void $ createContact_ db user profile emptyChatPrefs Nothing "" Nothing currentTs -createContact_ :: DB.Connection -> UserId -> Profile -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId) -createContact_ db userId Profile {displayName, fullName, shortDescr, image, contactLink, preferences} prepared localAlias viaGroup currentTs = +createContact_ :: DB.Connection -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO ContactId +createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, preferences} ctUserPreferences prepared localAlias viaGroup currentTs = ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do DB.execute db @@ -396,10 +396,31 @@ createContact_ db userId Profile {displayName, fullName, shortDescr, image, cont profileId <- insertedRowId db DB.execute db - "INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?)" - ((profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) :. toPreparedContactRow prepared) + "INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)" + ((profileId, ctUserPreferences, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) :. toPreparedContactRow prepared) contactId <- insertedRowId db - pure $ Right (ldn, contactId, profileId) + pure $ Right contactId + +newContactUserPrefs :: User -> Profile -> Preferences +newContactUserPrefs User {fullPreferences = FullPreferences {timedMessages = userTM}} Profile {preferences} = + let ctTM_ = chatPrefSel SCFTimedMessages =<< preferences + ctUserTM' = newContactUserTMPref userTM ctTM_ + in emptyChatPrefs {timedMessages = ctUserTM'} + where + newContactUserTMPref :: TimedMessagesPreference -> Maybe TimedMessagesPreference -> Maybe TimedMessagesPreference + newContactUserTMPref userTMPref ctTMPref_ = + case (userTMPref, ctTMPref_) of + (TimedMessagesPreference {allow = FANo}, _) -> Nothing + (_, Nothing) -> Nothing + (_, Just TimedMessagesPreference {allow = FANo}) -> Nothing + (TimedMessagesPreference {allow = userAllow, ttl = userTTL_}, Just TimedMessagesPreference {ttl = ctTTL_}) -> + case (userTTL_, ctTTL_) of + (Just userTTL, Just ctTTL) -> Just $ override (max userTTL ctTTL) + (Just userTTL, Nothing) -> Just $ override userTTL + (Nothing, Just ctTTL) -> Just $ override ctTTL + (Nothing, Nothing) -> Nothing + where + override overrideTTL = TimedMessagesPreference {allow = userAllow, ttl = Just overrideTTL} type NewPreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe SharedMsgId) @@ -496,7 +517,7 @@ toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder, dis User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt, uiThemes} where profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences = userPreferences, localAlias = ""} - fullPreferences = mergePreferences Nothing userPreferences + fullPreferences = fullPreferences' userPreferences viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_ toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation, Maybe ShortLinkInvitation, LocalAlias, UTCTime, UTCTime) -> PendingContactConnection diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 87e2ee1b8f..0a00ac5814 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -39,7 +39,7 @@ import Data.ByteString.Char8 (ByteString, pack, unpack) import qualified Data.ByteString.Lazy as LB import Data.Functor (($>)) import Data.Int (Int64) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) @@ -585,7 +585,7 @@ mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) mergeUserChatPrefs' :: User -> Bool -> Preferences -> FullPreferences mergeUserChatPrefs' user connectedIncognito userPreferences = let userPrefs = if connectedIncognito then Nothing else preferences' user - in mergePreferences (Just userPreferences) userPrefs + in mergePreferences (Just userPreferences) userPrefs False updateMergedPreferences :: User -> Contact -> Contact updateMergedPreferences user ct = @@ -616,9 +616,8 @@ contactUserPreferences user userPreferences contactPreferences connectedIncognit ctUserPref = getPreference f userPreferences ctUserPref_ = chatPrefSel f userPreferences userPref = getPreference f ctUserPrefs - ctPref = getPreference f ctPrefs + ctPref = getPreference f contactPreferences ctUserPrefs = mergeUserChatPrefs' user connectedIncognito userPreferences - ctPrefs = mergePreferences contactPreferences Nothing data Profile = Profile { displayName :: ContactName, @@ -651,21 +650,28 @@ redactedMemberProfile Profile {displayName, fullName, shortDescr, image} = data IncognitoProfile = NewIncognito Profile | ExistingIncognito LocalProfile -userProfileToSend' :: User -> Maybe IncognitoProfile -> Maybe Contact -> Bool -> Profile -userProfileToSend' user ip = userProfileToSend user (fromIncognitoProfile <$> ip) - where - fromIncognitoProfile = \case - NewIncognito p -> p - ExistingIncognito lp -> fromLocalProfile lp +fromIncognitoProfile :: IncognitoProfile -> Profile +fromIncognitoProfile = \case + NewIncognito p -> p + ExistingIncognito lp -> fromLocalProfile lp -userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Bool -> Profile -userProfileToSend user@User {profile = p} incognitoProfile ct inGroup = do +userProfileInGroup :: User -> Maybe Profile -> Profile +userProfileInGroup User {profile = p} incognitoProfile = let p' = fromMaybe (fromLocalProfile p) incognitoProfile - if inGroup - then redactedMemberProfile p' - else - let userPrefs = maybe (preferences' user) (const Nothing) incognitoProfile - in (p' :: Profile) {preferences = Just . toChatPrefs $ mergePreferences (userPreferences <$> ct) userPrefs} + 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 + fullPrefs = mergePreferences (userPreferences <$> ct) userPrefs canFallbackToUserTTL + in (p' :: Profile) {preferences = Just $ toChatPrefs fullPrefs} + where + userPrefs + | isNothing incognitoProfile = preferences' user + | otherwise = -- supplement user level TTL to incognito (default) preferences so that it can serve as fallback + let FullPreferences {timedMessages = TimedMessagesPreference {allow}} = defaultChatPrefs + userLevelTTL = preferences' user >>= chatPrefSel SCFTimedMessages >>= (\TimedMessagesPreference {ttl} -> ttl) + in Just $ toChatPrefs (defaultChatPrefs :: FullPreferences) {timedMessages = TimedMessagesPreference {allow, ttl = userLevelTTL}} type LocalAlias = Text diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs index 63d80657dc..e036f43a0e 100644 --- a/src/Simplex/Chat/Types/Preferences.hs +++ b/src/Simplex/Chat/Types/Preferences.hs @@ -117,8 +117,7 @@ setPreference f allow_ prefs_ = setPreference_ f pref $ fromMaybe emptyChatPrefs where pref = setAllow <$> allow_ setAllow :: FeatureAllowed -> FeaturePreference f - setAllow = setField @"allow" (getPreference f prefs) - prefs = mergePreferences Nothing prefs_ + setAllow = setField @"allow" (getPreference f prefs_) setPreference' :: SChatFeature f -> Maybe (FeaturePreference f) -> Maybe Preferences -> Preferences setPreference' f pref_ prefs_ = setPreference_ f pref_ $ fromMaybe emptyChatPrefs prefs_ @@ -764,8 +763,32 @@ groupFeatureState p = | otherwise = (Nothing, Nothing) in (enable, param, role) -mergePreferences :: Maybe Preferences -> Maybe Preferences -> FullPreferences -mergePreferences contactPrefs userPreferences = +mergePreferences :: Maybe Preferences -> Maybe Preferences -> Bool -> FullPreferences +mergePreferences contactPrefs userPreferences canFallbackToUserTTL = + FullPreferences + { timedMessages = if canFallbackToUserTTL then pref SCFTimedMessages else timedPrefNoTTLFallback, + fullDelete = pref SCFFullDelete, + reactions = pref SCFReactions, + voice = pref SCFVoice, + calls = pref SCFCalls + } + where + timedPrefNoTTLFallback :: TimedMessagesPreference + timedPrefNoTTLFallback = + let allow = getField @"allow" $ pref SCFTimedMessages + -- this is to avoid fallback to user level timed messages TTL even if there is no contact level override + -- (specifically to avoid sending user level TTL to contacts without override on profile updates, + -- to make it "consistently not work" for all contacts, as we're using override mechanism to track TTL + -- for new and updated contacts, even though it's not really user's override) + ttlOverride = contactPrefs >>= chatPrefSel SCFTimedMessages >>= (\TimedMessagesPreference {ttl} -> ttl) + in TimedMessagesPreference {allow, ttl = ttlOverride} + pref :: SChatFeature f -> FeaturePreference f + pref f = + let sel = chatPrefSel f + in fromMaybe (getPreference f defaultChatPrefs) $ (contactPrefs >>= sel) <|> (userPreferences >>= sel) + +fullPreferences' :: Maybe Preferences -> FullPreferences +fullPreferences' userPreferences = FullPreferences { timedMessages = pref SCFTimedMessages, fullDelete = pref SCFFullDelete, @@ -777,7 +800,7 @@ mergePreferences contactPrefs userPreferences = pref :: SChatFeature f -> FeaturePreference f pref f = let sel = chatPrefSel f - in fromMaybe (getPreference f defaultChatPrefs) $ (contactPrefs >>= sel) <|> (userPreferences >>= sel) + in fromMaybe (getPreference f defaultChatPrefs) $ (userPreferences >>= sel) mergeGroupPreferences :: Maybe GroupPreferences -> FullGroupPreferences mergeGroupPreferences groupPreferences = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 2b54bb554c..c3072662da 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1760,7 +1760,7 @@ viewPrefsUpdated ps ps' | pref ps == pref ps' = Nothing | otherwise = Just . plain $ chatFeatureNameText' f <> " allowed: " <> preferenceText (pref ps') where - pref pss = getPreference f $ mergePreferences pss Nothing + pref pss = getPreference f pss countactUserPrefText :: FeatureI f => ContactUserPref (FeaturePreference f) -> Text countactUserPrefText cup = case cup of