core: don't keep connection of the merged contact (#2507)

src/Simplex/Chat.hs

@@ -2656,7 +2656,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       _ -> Nothing
 
     processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> m ()
-    processDirectMessage agentMsg connEntity conn@Connection {connId, viaUserContactLink, groupLinkId, customUserProfileId} = \case
+    processDirectMessage agentMsg connEntity conn@Connection {connId, viaUserContactLink, customUserProfileId} = \case
       Nothing -> case agentMsg of
         CONF confId _ connInfo -> do
           -- [incognito] send saved profile
@@ -2758,7 +2758,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               whenUserNtfs user $ do
                 setActive $ ActiveC c
                 showToast (c <> "> ") "connected"
-              forM_ groupLinkId $ \_ -> probeMatchingContacts ct $ contactConnIncognito ct
               forM_ viaUserContactLink $ \userContactLinkId ->
                 withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
                   Just (UserContactLink {autoAccept = Just AutoAccept {autoReply = mc_}}, groupId_, gLinkMemRole) -> do
@@ -2903,6 +2902,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
             whenUserNtfs user $ do
               setActive $ ActiveG gName
               showToast ("#" <> gName) "you are connected to group"
+            withStore' (\db -> getContactViaMember db user m) >>= \case
+              Nothing -> messageWarning "connected host does not have contact"
+              Just ct@Contact {activeConn = Connection {groupLinkId}} -> do
+                let connectedIncognito = contactConnIncognito ct || memberIncognito membership
+                forM_ groupLinkId $ \_ -> probeMatchingContacts ct connectedIncognito
           GCInviteeMember -> do
             memberConnectedChatItem gInfo m
             toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
@@ -3825,8 +3829,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     probeMatch c1@Contact {contactId = cId1, profile = p1} c2@Contact {contactId = cId2, profile = p2} probe =
       if profilesMatch (fromLocalProfile p1) (fromLocalProfile p2) && cId1 /= cId2
         then do
-          void . sendDirectContactMessage c1 $ XInfoProbeOk probe
-          mergeContacts c1 c2
+          let (toCt, fromCt) = mergeToFromContacts c1 c2
+          void . sendDirectContactMessage toCt $ XInfoProbeOk probe
+          mergeContacts toCt fromCt
         else messageWarning "probeMatch ignored: profiles don't match or same contact id"
 
     xInfoProbeOk :: Contact -> Probe -> m ()
@@ -3834,9 +3839,22 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       r <- withStore' $ \db -> matchSentProbe db user c1 probe
       forM_ r $ \c2@Contact {contactId = cId2} ->
         if cId1 /= cId2
-          then mergeContacts c1 c2
+          then do
+            let (toCt, fromCt) = mergeToFromContacts c1 c2
+            mergeContacts toCt fromCt
           else messageWarning "xInfoProbeOk ignored: same contact id"
 
+    mergeToFromContacts :: Contact -> Contact -> (Contact, Contact)
+    mergeToFromContacts c1 c2
+      | d1 && not d2 = (c1, c2)
+      | d2 && not d1 = (c2, c1)
+      | ctCreatedAt c1 <= ctCreatedAt c2 = (c1, c2)
+      | otherwise = (c2, c1)
+      where
+        d1 = directOrUsed c1
+        d2 = directOrUsed c2
+        ctCreatedAt Contact {createdAt} = createdAt
+
     -- to party accepting call
     xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> m ()
     xCallInv ct@Contact {contactId} callId CallInvitation {callType, callDhPubKey} msg@RcvMessage {sharedMsgId_} msgMeta = do
@@ -3943,9 +3961,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       messageError $ eventName <> ": wrong call state " <> T.pack (show $ callStateTag callState)
 
     mergeContacts :: Contact -> Contact -> m ()
-    mergeContacts c1 c2 = do
-      withStore' $ \db -> mergeContactRecords db userId c1 c2
-      toView $ CRContactsMerged user c1 c2
+    mergeContacts toCt fromCt = do
+      deleteAgentConnectionAsync user $ aConnId $ contactConn fromCt
+      withStore' $ \db -> mergeContactRecords db userId toCt fromCt
+      toView $ CRContactsMerged user toCt fromCt
 
     saveConnInfo :: Connection -> ConnInfo -> m ()
     saveConnInfo activeConn connInfo = do

src/Simplex/Chat/Store.hs

@@ -1708,9 +1708,8 @@ matchSentProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = d
     cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId)
 
 mergeContactRecords :: DB.Connection -> UserId -> Contact -> Contact -> IO ()
-mergeContactRecords db userId ct1 ct2 = do
-  let (toCt, fromCt) = toFromContacts ct1 ct2
-      Contact {contactId = toContactId} = toCt
+mergeContactRecords db userId toCt fromCt = do
+  let Contact {contactId = toContactId} = toCt
       Contact {contactId = fromContactId, localDisplayName} = fromCt
   currentTs <- getCurrentTime
   -- TODO next query fixes incorrect unused contacts deletion; consider more thorough fix
@@ -1719,10 +1718,6 @@ mergeContactRecords db userId ct1 ct2 = do
       db
       "UPDATE contacts SET contact_used = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?"
       (currentTs, userId, toContactId)
-  DB.execute
-    db
-    "UPDATE connections SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
-    (toContactId, currentTs, fromContactId, userId)
   DB.execute
     db
     "UPDATE connections SET via_contact = ?, updated_at = ? WHERE via_contact = ? AND user_id = ?"
@@ -1735,6 +1730,10 @@ mergeContactRecords db userId ct1 ct2 = do
     db
     "UPDATE chat_items SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
     (toContactId, currentTs, fromContactId, userId)
+  DB.execute
+    db
+    "UPDATE chat_item_reactions SET contact_id = ?, updated_at = ? WHERE contact_id = ?"
+    (toContactId, currentTs, fromContactId)
   DB.executeNamed
     db
     [sql|
@@ -1754,17 +1753,6 @@ mergeContactRecords db userId ct1 ct2 = do
   deleteContactProfile_ db userId fromContactId
   DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId)
   DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
-  where
-    toFromContacts :: Contact -> Contact -> (Contact, Contact)
-    toFromContacts c1 c2
-      | d1 && not d2 = (c1, c2)
-      | d2 && not d1 = (c2, c1)
-      | ctCreatedAt c1 <= ctCreatedAt c2 = (c1, c2)
-      | otherwise = (c2, c1)
-      where
-        d1 = directOrUsed c1
-        d2 = directOrUsed c2
-        ctCreatedAt Contact {createdAt} = createdAt
 
 getConnectionEntity :: DB.Connection -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
 getConnectionEntity db user@User {userId, userContactId} agentConnId = do
@@ -2364,6 +2352,7 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
             :. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt)
         )
 
+-- this method differs from getViaGroupContact in that it does not join with groups on contacts.via_group
 getContactViaMember :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact)
 getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
   maybeFirstRow (toContact user) $

src/Simplex/Chat/View.hs

@@ -116,11 +116,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
   CRGroupCreated u g -> ttyUser u $ viewGroupCreated g
   CRGroupMembers u g -> ttyUser u $ viewGroupMembers g
   CRGroupsList u gs -> ttyUser u $ viewGroupsList gs
-  CRSentGroupInvitation u g c _ ->
-    ttyUser u $
-      if viaGroupLink . contactConn $ c
-        then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
-        else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
+  CRSentGroupInvitation u g c _ -> ttyUser u ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
   CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
   CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci
   CRUserProfile u p -> ttyUser u $ viewUserProfile p