core, ui: allow to choose disappearing messages ttl in user profile (#6097)

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

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

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