core: update contact and member profiles for both sides when contact is created with member (WIP) (#3081)

* core: update contact and member profiles for both sides when contact is created with member (WIP)

* send both sides, correctly process update

* refactor

* revert diff

* comments

* test

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

src/Simplex/Chat.hs

@@ -3060,10 +3060,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               -- TODO update member profile
               -- [async agent commands] no continuation needed, but command should be asynchronous for stability
               allowAgentConnectionAsync user conn' confId XOk
-            XOk -> do
+            XInfo profile -> do
-              allowAgentConnectionAsync user conn' confId XOk
+              ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct)
-              void $ withStore' $ \db -> resetMemberContactFields db ct
+              -- [incognito] send incognito profile
-            _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.ok"
+              incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
+              let p = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct')
+              allowAgentConnectionAsync user conn' confId $ XInfo p
+              void $ withStore' $ \db -> resetMemberContactFields db ct'
+            _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info"
         INFO connInfo -> do
           ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
           _conn' <- updatePeerChatVRange conn chatVRange
@@ -3072,9 +3076,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               -- TODO check member ID
               -- TODO update member profile
               pure ()
-            XInfo _profile -> do
+            XInfo profile ->
-              -- TODO update contact profile
+              void $ processContactProfileUpdate ct profile False
-              pure ()
             XOk -> pure ()
             _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok"
         CON ->
@@ -4233,15 +4236,22 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       MsgError e -> createInternalChatItem user cd (CIRcvIntegrityError e) (Just brokerTs)
 
     xInfo :: Contact -> Profile -> m ()
-    xInfo c@Contact {profile = p} p' = unless (fromLocalProfile p == p') $ do
+    xInfo c p' = void $ processContactProfileUpdate c p' True
-      c' <- withStore $ \db ->
+
-        if userTTL == rcvTTL
+    processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact
-          then updateContactProfile db user c p'
+    processContactProfileUpdate c@Contact {profile = p} p' createItems
-          else do
+      | fromLocalProfile p /= p' = do
-            c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
+        c' <- withStore $ \db ->
-            updateContactProfile db user c' p'
+          if userTTL == rcvTTL
-      when (directOrUsed c') $ createRcvFeatureItems user c c'
+            then updateContactProfile db user c p'
-      toView $ CRContactUpdated user c c'
+            else do
+              c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
+              updateContactProfile db user c' p'
+        when (directOrUsed c' && createItems) $ createRcvFeatureItems user c c'
+        toView $ CRContactUpdated user c c'
+        pure c'
+      | otherwise =
+        pure c
       where
         Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c
         userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs
@@ -4639,8 +4649,9 @@ 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
+          -- [incognito] send membership incognito profile
-          dm <- directMessage XOk
+          let p = userProfileToSend user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing
+          dm <- directMessage $ XInfo p
           joinAgentConnectionAsync user True connReq dm subMode
         createItems mCt' m' = do
           checkIntegrityCreateItem (CDGroupRcv g m') msgMeta

tests/ChatTests/Groups.hs

@@ -81,6 +81,7 @@ chatGroupTests = do
     it "prohibited to repeat sending x.grp.direct.inv" testMemberContactProhibitedRepeatInv
     it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced
     it "share incognito profile" testMemberContactIncognito
+    it "sends and updates profile when creating contact" testMemberContactProfileUpdate
   where
     _0 = supportedChatVRange -- don't create direct connections
     _1 = groupCreateDirectVRange
@@ -3047,3 +3048,75 @@ testMemberContactIncognito =
         [ alice <# ("#team " <> cathIncognito <> "> hey"),
           bob ?<# ("#team " <> cathIncognito <> "> hey")
         ]
+
+testMemberContactProfileUpdate :: HasCallStack => FilePath -> IO ()
+testMemberContactProfileUpdate =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup3 "team" alice bob cath
+
+      bob ##> "/p rob Rob"
+      bob <## "user profile is changed to rob (Rob) (your 1 contacts are notified)"
+      alice <## "contact bob changed to rob (Rob)"
+      alice <## "use @rob <message> to send messages"
+
+      cath ##> "/p kate Kate"
+      cath <## "user profile is changed to kate (Kate) (your 1 contacts are notified)"
+      alice <## "contact cath changed to kate (Kate)"
+      alice <## "use @kate <message> to send messages"
+
+      alice #> "#team hello"
+      bob <# "#team alice> hello"
+      cath <# "#team alice> hello"
+
+      bob #> "#team hello too"
+      alice <# "#team rob> hello too"
+      cath <# "#team bob> hello too" -- not updated profile
+
+      cath #> "#team hello there"
+      alice <# "#team kate> hello there"
+      bob <# "#team cath> hello there" -- not updated profile
+
+      bob `send` "@cath hi"
+      bob
+        <### [ "member #team cath does not have direct connection, creating",
+               "contact for member #team cath is created",
+               "sent invitation to connect directly to member #team cath",
+               WithTime "@cath hi"
+             ]
+      cath
+        <### [ "#team bob is creating direct contact bob with you",
+               WithTime "bob> hi"
+             ]
+      concurrentlyN_
+        [ do
+            bob <## "contact cath changed to kate (Kate)"
+            bob <## "use @kate <message> to send messages"
+            bob <## "kate (Kate): contact is connected",
+          do
+            cath <## "contact bob changed to rob (Rob)"
+            cath <## "use @rob <message> to send messages"
+            cath <## "rob (Rob): contact is connected"
+        ]
+
+      bob ##> "/contacts"
+      bob
+        <### [ "alice (Alice)",
+               "kate (Kate)"
+             ]
+      cath ##> "/contacts"
+      cath
+        <### [ "alice (Alice)",
+               "rob (Rob)"
+             ]
+      alice `hasContactProfiles` ["alice", "rob", "kate"]
+      bob `hasContactProfiles` ["rob", "alice", "kate"]
+      cath `hasContactProfiles` ["kate", "alice", "rob"]
+
+      bob #> "#team hello too"
+      alice <# "#team rob> hello too"
+      cath <# "#team rob> hello too" -- updated profile
+
+      cath #> "#team hello there"
+      alice <# "#team kate> hello there"
+      bob <# "#team kate> hello there" -- updated profile