core: relax contact probing: don't send probe hashes to new contacts except group link hosts; still send probe hashes to group members (#3180)

src/Simplex/Chat.hs

@@ -39,7 +39,6 @@ import Data.Fixed (div')
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (find, foldl', isSuffixOf, partition, sortOn)
-import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
@@ -3106,7 +3105,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                 setActive $ ActiveC c
                 showToast (c <> "> ") "connected"
               when (contactConnInitiated conn) $ do
-                probeMatchingContactsAndMembers ct (contactConnIncognito ct)
+                let Connection {groupLinkId} = conn
+                    doProbeContacts = isJust groupLinkId
+                probeMatchingContactsAndMembers ct (contactConnIncognito ct) doProbeContacts
                 withStore' $ \db -> resetContactConnInitiated db user conn
               forM_ viaUserContactLink $ \userContactLinkId ->
                 withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
@@ -3125,7 +3126,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
                 notifyMemberConnected gInfo m $ Just ct
                 let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
-                when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito
+                when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
         SENT msgId -> do
           sentMsgDeliveryEvent conn msgId
           checkSndInlineFTComplete conn msgId
@@ -3143,8 +3144,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               withStore' $ \db -> setConnectionVerified db user connId Nothing
               let ct' = ct {activeConn = conn {connectionCode = Nothing}} :: Contact
               ratchetSyncEventItem ct'
-              toView $ CRContactVerificationReset user ct'
+              securityCodeChanged ct'
-              createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent RCEVerificationCodeReset) Nothing
             _ -> ratchetSyncEventItem ct
           where
             processErr cryptoErr = do
@@ -3298,7 +3298,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                 when (connStatus == ConnReady) $ do
                   notifyMemberConnected gInfo m $ Just ct
                   let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
-                  when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito
+                  when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
       MSG msgMeta _msgFlags msgBody -> do
         cmdId <- createAckCmd conn
         withAckMessage agentConnId cmdId msgMeta $ do
@@ -3691,8 +3691,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
         setActive $ ActiveG g
         showToast ("#" <> g) $ "member " <> c <> " is connected"
 
-    probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> m ()
+    probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m ()
-    probeMatchingContactsAndMembers ct connectedIncognito = do
+    probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do
       gVar <- asks idsDrg
       contactMerge <- readTVarIO =<< asks contactMergeEnabled
       if contactMerge && not connectedIncognito
@@ -3703,7 +3703,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           -- sendProbe -> sendProbeHashes (currently)
           -- sendProbeHashes -> sendProbe (reversed - change order in code, may add delay)
           sendProbe probe
-          cs <- map COMContact <$> withStore' (\db -> getMatchingContacts db user ct)
+          cs <- if doProbeContacts
+            then map COMContact <$> withStore' (\db -> getMatchingContacts db user ct)
+            else pure []
           ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db user ct)
           sendProbeHashes (cs <> ms) probe probeId
         else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
@@ -4363,32 +4365,18 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                 COMContact <$$> mergeContacts c1 c2
               | otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing
             COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId}
-              | profilesMatch p1 p2 -> case memberContactId of
+              | isNothing memberContactId && profilesMatch p1 p2 -> do
-                Nothing -> do
+                void . sendDirectContactMessage c1 $ XInfoProbeOk probe
-                  void . sendDirectContactMessage c1 $ XInfoProbeOk probe
+                COMContact <$$> associateMemberAndContact c1 m2
-                  COMContact <$$> associateMemberAndContact c1 m2
+              | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing
-                Just mCtId
-                  | mCtId /= cId1 -> do
-                    void . sendDirectContactMessage c1 $ XInfoProbeOk probe
-                    mCt <- withStore $ \db -> getContact db user mCtId
-                    COMContact <$$> mergeContacts c1 mCt
-                  | otherwise -> messageWarning "probeMatch ignored: same contact id" >> pure Nothing
-              | otherwise -> messageWarning "probeMatch ignored: profiles don't match" >> pure Nothing
         COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing
         COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} ->
           case cgm2 of
-            COMContact c2@Contact {contactId = cId2, profile = p2}
+            COMContact c2@Contact {profile = p2}
-              | memberCurrent m1 && profilesMatch p1 p2 -> case memberContactId of
+              | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do
-                Nothing -> do
+                void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
-                  void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
+                COMContact <$$> associateMemberAndContact c2 m1
-                  COMContact <$$> associateMemberAndContact c2 m1
+              | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing
-                Just mCtId
-                  | mCtId /= cId2 -> do
-                    void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
-                    mCt <- withStore $ \db -> getContact db user mCtId
-                    COMContact <$$> mergeContacts c2 mCt
-                  | otherwise -> messageWarning "probeMatch ignored: same contact id" >> pure Nothing
-              | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member not current" >> pure Nothing
             COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing
 
     xInfoProbeOk :: ContactOrMember -> Probe -> m ()
@@ -4400,24 +4388,15 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
             Just (COMContact c2@Contact {contactId = cId2})
               | cId1 /= cId2 -> void $ mergeContacts c1 c2
               | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
-            Just (COMGroupMember m2@GroupMember {memberContactId}) ->
+            Just (COMGroupMember m2@GroupMember {memberContactId})
-              case memberContactId of
+              | isNothing memberContactId -> void $ associateMemberAndContact c1 m2
-                Nothing -> void $ associateMemberAndContact c1 m2
+              | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
-                Just mCtId
-                  | mCtId /= cId1 -> do
-                    mCt <- withStore $ \db -> getContact db user mCtId
-                    void $ mergeContacts c1 mCt
-                  | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
             _ -> pure ()
         COMGroupMember m1@GroupMember {memberContactId} ->
           case cgm2 of
-            Just (COMContact c2@Contact {contactId = cId2}) -> case memberContactId of
+            Just (COMContact c2)
-              Nothing -> void $ associateMemberAndContact c2 m1
+              | isNothing memberContactId -> void $ associateMemberAndContact c2 m1
-              Just mCtId
+              | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
-                | mCtId /= cId2 -> do
-                  mCt <- withStore $ \db -> getContact db user mCtId
-                  void $ mergeContacts c2 mCt
-                | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
             Just (COMGroupMember _) -> messageWarning "xInfoProbeOk ignored: members are not matched with members"
             _ -> pure ()
 
@@ -4540,7 +4519,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
         merge c1' c2' = do
           c2'' <- withStore $ \db -> mergeContactRecords db user c1' c2'
           toView $ CRContactsMerged user c1' c2' c2''
+          when (directOrUsed c2'') $ showSecurityCodeChanged c2''
           pure $ Just c2''
+          where
+            showSecurityCodeChanged mergedCt = do
+              let sc1_ = contactSecurityCode c1'
+                  sc2_ = contactSecurityCode c2'
+                  scMerged_ = contactSecurityCode mergedCt
+              case (sc1_, sc2_) of
+                (Just sc1, Nothing)
+                  | scMerged_ /= Just sc1 -> securityCodeChanged mergedCt
+                  | otherwise -> pure ()
+                (Nothing, Just sc2)
+                  | scMerged_ /= Just sc2 -> securityCodeChanged mergedCt
+                  | otherwise -> pure ()
+                _ -> pure ()
 
     associateMemberAndContact :: Contact -> GroupMember -> m (Maybe Contact)
     associateMemberAndContact c m = do
@@ -4796,9 +4789,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           forM_ mContent_ $ \mc -> do
             ci <- saveRcvChatItem user (CDDirectRcv mCt') msg msgMeta (CIRcvMsgContent mc)
             toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat mCt') ci)
-        securityCodeChanged ct = do
+
-          toView $ CRContactVerificationReset user ct
+    securityCodeChanged :: Contact -> m ()
-          createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
+    securityCodeChanged ct = do
+      toView $ CRContactVerificationReset user ct
+      createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
 
     directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
     directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do

src/Simplex/Chat/Store/Direct.hs

@@ -159,7 +159,7 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
             JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
             JOIN connections c ON c.contact_id = ct.contact_id
             WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.deleted = 0
-            ORDER BY c.connection_id DESC
+            ORDER BY c.created_at DESC
             LIMIT 1
           |]
           (userId, cReqHash)
@@ -517,7 +517,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
             JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
             LEFT JOIN connections c ON c.contact_id = ct.contact_id
             WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
-            ORDER BY c.connection_id DESC
+            ORDER BY c.created_at DESC
             LIMIT 1
           |]
           (userId, xContactId)
@@ -667,7 +667,7 @@ getContact_ :: DB.Connection -> User -> Int64 -> Bool -> ExceptT StoreError IO C
 getContact_ db user@User {userId} contactId deleted =
   ExceptT . fmap join . firstRow (toContactOrError user) (SEContactNotFound contactId) $
     DB.query
-      db 
+      db
       [sql|
         SELECT
           -- Contact
@@ -686,10 +686,11 @@ getContact_ db user@User {userId} contactId deleted =
             SELECT cc_connection_id FROM (
               SELECT
                 cc.connection_id AS cc_connection_id,
+                cc.created_at AS cc_created_at,
                 (CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
               FROM connections cc
               WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
-              ORDER BY cc_conn_status_ord DESC, cc_connection_id DESC
+              ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
               LIMIT 1
             )
           )

src/Simplex/Chat/Store/Groups.hs

@@ -107,7 +107,7 @@ import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
 import Data.Either (rights)
 import Data.Int (Int64)
-import Data.List (sortOn)
+import Data.List (partition, sortOn)
 import Data.Maybe (fromMaybe, isNothing, catMaybes, isJust)
 import Data.Ord (Down (..))
 import Data.Text (Text)
@@ -695,31 +695,21 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
         )
 
 getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact
-getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
+getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do
-  ExceptT $
+  contactId <-
-    firstRow (toContact user) (SEContactNotFoundByMemberId groupMemberId) $
+    ExceptT $
-      DB.query
+      firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $
-        db
+        DB.query
-        [sql|
+          db
-          SELECT
+          [sql|
-            -- Contact
+            SELECT ct.contact_id
-            ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
+            FROM group_members m
-            cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
+            JOIN contacts ct ON ct.contact_id = m.contact_id
-            -- Connection
+            WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
-            c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
+            LIMIT 1
-            c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
+          |]
-            c.peer_chat_min_version, c.peer_chat_max_version
+          (userId, groupMemberId)
-          FROM contacts ct
+  getContact db user contactId
-          JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
-          JOIN connections c ON c.connection_id = (
-            SELECT max(cc.connection_id)
-            FROM connections cc
-            where cc.contact_id = ct.contact_id
-          )
-          JOIN group_members m ON m.contact_id = ct.contact_id
-          WHERE ct.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
-        |]
-        (userId, groupMemberId)
 
 setNewContactMemberConnRequest :: DB.Connection -> User -> GroupMember -> ConnReqInvitation -> IO ()
 setNewContactMemberConnRequest db User {userId} GroupMember {groupMemberId} connRequest = do
@@ -1041,37 +1031,21 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
        in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
 
 getViaGroupContact :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact)
-getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
+getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do
-  maybeFirstRow toContact' $
+  contactId_ <-
-    DB.query
+    maybeFirstRow fromOnly $
-      db
+      DB.query
-      [sql|
+        db
-        SELECT
+        [sql|
-          ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
+          SELECT ct.contact_id
-          p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
+          FROM group_members m
-          c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
+          JOIN groups g ON g.group_id = m.group_id
-          c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
+          JOIN contacts ct ON ct.contact_id = m.contact_id AND ct.via_group = g.group_id
-          c.peer_chat_min_version, c.peer_chat_max_version
+          WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
-        FROM contacts ct
+          LIMIT 1
-        JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
+        |]
-        JOIN connections c ON c.connection_id = (
+        (userId, groupMemberId)
-          SELECT max(cc.connection_id)
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_
-          FROM connections cc
-          where cc.contact_id = ct.contact_id
-        )
-        JOIN groups g ON g.group_id = ct.via_group
-        JOIN group_members m ON m.group_id = g.group_id AND m.contact_id = ct.contact_id
-        WHERE ct.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
-      |]
-      (userId, groupMemberId)
-  where
-    toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)) :. ConnectionRow -> Contact
-    toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
-      let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
-          chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
-          activeConn = toConnection connRow
-          mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
-       in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
 
 updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
 updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences}
@@ -1258,7 +1232,16 @@ matchReceivedProbe db user@User {userId} from (Probe probe) = do
     db
     "INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
     (ctId, gmId, probe, probeHash, userId, currentTs, currentTs)
-  catMaybes <$> mapM (getContactOrMember_ db user) cgmIds
+  let cgmIds' = filterFirstContactId cgmIds
+  catMaybes <$> mapM (getContactOrMember_ db user) cgmIds'
+  where
+    filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)]
+    filterFirstContactId cgmIds = do
+      let (ctIds, memIds) = partition (\(ctId, _, _) -> isJust ctId) cgmIds
+          ctIds' = case ctIds of
+            [] -> []
+            (x : _) -> [x]
+      ctIds' <> memIds
 
 matchReceivedProbeHash :: DB.Connection -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
 matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
@@ -1284,7 +1267,7 @@ matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
   pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db user cgmIds
 
 matchSentProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
-matchSentProbe db user@User {userId} _from (Probe probe) =
+matchSentProbe db user@User {userId} _from (Probe probe) = do
   cgmIds $>>= getContactOrMember_ db user
   where
     (ctId, gmId) = contactOrMemberIds _from
@@ -1311,11 +1294,10 @@ getContactOrMember_ db user ids =
     (_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db user gId gmId
     _ -> throwError $ SEInternalError ""
 
--- connection being verified and connection level 0 have priority over requested merge direction;
+-- if requested merge direction is overruled (toFromContacts), keepLDN is kept
--- if requested merge direction is overruled, keepLDN is kept
 mergeContactRecords :: DB.Connection -> User -> Contact -> Contact -> ExceptT StoreError IO Contact
 mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN} from = do
-  let (toCt, fromCt) = checkToFromContacts
+  let (toCt, fromCt) = toFromContacts to from
       Contact {contactId = toContactId, localDisplayName = toLDN} = toCt
       Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt
   liftIO $ do
@@ -1342,18 +1324,6 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN
       db
       "UPDATE chat_items SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
       (toContactId, currentTs, fromContactId, userId)
-    DB.execute
-      db
-      "UPDATE sent_probes SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
-      (toContactId, currentTs, fromContactId, userId)
-    DB.execute
-      db
-      "UPDATE sent_probe_hashes SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
-      (toContactId, currentTs, fromContactId, userId)
-    DB.execute
-      db
-      "UPDATE received_probes SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
-      (toContactId, currentTs, fromContactId, userId)
     DB.executeNamed
       db
       [sql|
@@ -1384,16 +1354,16 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN
         (keepLDN, currentTs, userId, toLDN)
   getContact db user toContactId
   where
-    checkToFromContacts :: (Contact, Contact)
+    toFromContacts :: Contact -> Contact -> (Contact, Contact)
-    checkToFromContacts
+    toFromContacts c1 c2
-      | vrfFrom && not vrfTo = (from, to)
+      | d1 && not d2 = (c1, c2)
-      | dirFrom && not vrfTo && not dirTo = (from, to)
+      | d2 && not d1 = (c2, c1)
-      | otherwise = (to, from)
+      | ctCreatedAt c1 <= ctCreatedAt c2 = (c1, c2)
+      | otherwise = (c2, c1)
       where
-        vrfTo = isJust $ contactSecurityCode to
+        d1 = directOrUsed c1
-        vrfFrom = isJust $ contactSecurityCode from
+        d2 = directOrUsed c2
-        dirTo = let Contact {activeConn = Connection {connLevel = clTo}} = to in clTo == 0
+        ctCreatedAt Contact {createdAt} = createdAt
-        dirFrom = let Contact {activeConn = Connection {connLevel = clFrom}} = from in clFrom == 0
 
 associateMemberWithContactRecord :: DB.Connection -> User -> Contact -> GroupMember -> IO ()
 associateMemberWithContactRecord

src/Simplex/Chat/Store/Messages.hs

@@ -517,10 +517,11 @@ getDirectChatPreviews_ db user@User {userId} = do
             SELECT cc_connection_id FROM (
               SELECT
                 cc.connection_id AS cc_connection_id,
+                cc.created_at AS cc_created_at,
                 (CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
               FROM connections cc
               WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
-              ORDER BY cc_conn_status_ord DESC, cc_connection_id DESC
+              ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
               LIMIT 1
             )
           )

tests/ChatTests/Direct.hs

@@ -41,9 +41,9 @@ chatDirectTests = do
     it "direct timed message" testDirectTimedMessage
     it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
     it "should send multiline message" testMultilineMessage
-  describe "contact merge" $ do
+  describe "duplicate contacts" $ do
-    it "merge duplicate contacts" testContactMerge
+    it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate
-    it "new contact should merge with multiple existing contacts" testMergeContactMultipleContacts
+    it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate
   describe "SMP servers" $ do
     it "get and set SMP servers" testGetSetSMPServers
     it "test SMP server connection" testTestSMPServerConnection
@@ -170,44 +170,13 @@ testAddContact = versionTestMatrix2 runTestAddContact
       alice #$> ("/_read chat @2", id, "ok")
       bob #$> ("/_read chat @2", id, "ok")
 
-testContactMerge :: HasCallStack => FilePath -> IO ()
+testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO ()
-testContactMerge =
+testDuplicateContactsSeparate =
   testChat2 aliceProfile bobProfile $
     \alice bob -> do
       connectUsers alice bob
       alice <##> bob
 
-      alice ##> "/c"
-      inv' <- getInvitation alice
-      bob ##> ("/c " <> inv')
-      bob <## "confirmation sent!"
-      concurrentlyN_
-        [ alice
-            <### [ "bob_1 (Bob): contact is connected",
-                   "contact bob_1 is merged into bob",
-                   "use @bob <message> to send messages"
-                 ],
-          bob
-            <### [ "alice_1 (Alice): contact is connected",
-                   "contact alice_1 is merged into alice",
-                   "use @alice <message> to send messages"
-                 ]
-        ]
-      alice <##> bob
-      alice @@@ [("@bob", "hey")]
-      alice `hasContactProfiles` ["alice", "bob"]
-      bob @@@ [("@alice", "hey")]
-      bob `hasContactProfiles` ["bob", "alice"]
-
-testMergeContactMultipleContacts :: HasCallStack => FilePath -> IO ()
-testMergeContactMultipleContacts =
-  testChat2 aliceProfile bobProfile $
-    \alice bob -> do
-      bob ##> "/contact_merge off"
-      bob <## "ok"
-
-      connectUsers alice bob
-
       alice ##> "/c"
       inv' <- getInvitation alice
       bob ##> ("/c " <> inv')
@@ -216,42 +185,56 @@ testMergeContactMultipleContacts =
         (alice <## "bob_1 (Bob): contact is connected")
         (bob <## "alice_1 (Alice): contact is connected")
 
+      alice <##> bob
+      alice #> "@bob_1 1"
+      bob <# "alice_1> 1"
+      bob #> "@alice_1 2"
+      alice <# "bob_1> 2"
+
+      alice @@@ [("@bob", "hey"), ("@bob_1", "2")]
       alice `hasContactProfiles` ["alice", "bob", "bob"]
+      bob @@@ [("@alice", "hey"), ("@alice_1", "2")]
       bob `hasContactProfiles` ["bob", "alice", "alice"]
 
-      threadDelay 500000
+testDuplicateContactsMultipleSeparate :: HasCallStack => FilePath -> IO ()
+testDuplicateContactsMultipleSeparate =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      alice <##> bob
 
-      bob ##> "/contact_merge on"
+      alice ##> "/c"
-      bob <## "ok"
+      inv' <- getInvitation alice
+      bob ##> ("/c " <> inv')
+      bob <## "confirmation sent!"
+      concurrently_
+        (alice <## "bob_1 (Bob): contact is connected")
+        (bob <## "alice_1 (Alice): contact is connected")
 
       alice ##> "/c"
       inv'' <- getInvitation alice
       bob ##> ("/c " <> inv'')
       bob <## "confirmation sent!"
-      concurrentlyN_
+      concurrently_
-        [ alice
+        (alice <## "bob_2 (Bob): contact is connected")
-            <### [ "bob_2 (Bob): contact is connected",
+        (bob <## "alice_2 (Alice): contact is connected")
-                   StartsWith "contact bob_2 is merged into bob",
+
-                   StartsWith "use @bob",
-                   StartsWith "contact bob_1 is merged into bob",
-                   StartsWith "use @bob"
-                 ],
-          bob
-            <### [ "alice_2 (Alice): contact is connected",
-                   StartsWith "contact alice_2 is merged into alice",
-                   StartsWith "use @alice",
-                   StartsWith "contact alice_1 is merged into alice",
-                   StartsWith "use @alice"
-                 ]
-        ]
       alice <##> bob
+      alice #> "@bob_1 1"
+      bob <# "alice_1> 1"
+      bob #> "@alice_1 2"
+      alice <# "bob_1> 2"
+      alice #> "@bob_2 3"
+      bob <# "alice_2> 3"
+      bob #> "@alice_2 4"
+      alice <# "bob_2> 4"
 
       alice ##> "/contacts"
-      alice <## "bob (Bob)"
+      alice <### ["bob (Bob)", "bob_1 (Bob)", "bob_2 (Bob)"]
       bob ##> "/contacts"
-      bob <## "alice (Alice)"
+      bob <### ["alice (Alice)", "alice_1 (Alice)", "alice_2 (Alice)"]
-      alice `hasContactProfiles` ["alice", "bob"]
+      alice `hasContactProfiles` ["alice", "bob", "bob", "bob"]
-      bob `hasContactProfiles` ["bob", "alice"]
+      bob `hasContactProfiles` ["bob", "alice", "alice", "alice"]
 
 testContactClear :: HasCallStack => FilePath -> IO ()
 testContactClear =

tests/ChatTests/Groups.hs

@@ -75,12 +75,9 @@ chatGroupTests = do
     it "members have different local display names in different groups" testNoDirectDifferentLDNs
   describe "merge members and contacts" $ do
     it "new member should merge with existing contact" testMergeMemberExistingContact
-    it "new member should merge with multiple existing contacts" testMergeMemberMultipleContacts
     it "new contact should merge with existing member" testMergeContactExistingMember
-    it "new contact should merge with existing member with associated contact" testMergeContactExistingMemberWithContact
     it "new contact should merge with multiple existing members" testMergeContactMultipleMembers
-    it "new contact should merge with both existing members and contacts" testMergeContactExistingMembersAndContacts
+    it "new group link host contact should merge with single existing contact out of multiple" testMergeGroupLinkHostMultipleContacts
-    it "new member contact is merged with existing contact" testMergeMemberContact
   describe "create member contact" $ do
     it "create contact with group member with invitation message" testMemberContactMessage
     it "create contact with group member without invitation message" testMemberContactNoMessage
@@ -2788,76 +2785,6 @@ testMergeMemberExistingContact =
       alice `hasContactProfiles` ["alice", "bob", "cath"]
       cath `hasContactProfiles` ["cath", "alice", "bob"]
 
-testMergeMemberMultipleContacts :: HasCallStack => FilePath -> IO ()
-testMergeMemberMultipleContacts =
-  testChat3 aliceProfile bobProfile cathProfile $
-    \alice bob cath -> do
-      alice ##> "/contact_merge off"
-      alice <## "ok"
-
-      connectUsers alice bob
-      connectUsers alice cath
-
-      alice ##> "/c"
-      inv' <- getInvitation alice
-      cath ##> ("/c " <> inv')
-      cath <## "confirmation sent!"
-      concurrently_
-        (alice <## "cath_1 (Catherine): contact is connected")
-        (cath <## "alice_1 (Alice): contact is connected")
-
-      alice `hasContactProfiles` ["alice", "bob", "cath", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "alice"]
-
-      alice ##> "/contact_merge on"
-      alice <## "ok"
-
-      createGroup2 "team" bob cath
-      bob ##> "/a #team alice"
-      bob <## "invitation to join the group #team sent to alice"
-      alice <## "#team: bob invites you to join the group as member"
-      alice <## "use /j team to accept"
-      alice ##> "/j team"
-      concurrentlyN_
-        [ alice
-            <### [ "#team: you joined the group",
-                   "#team: member cath_2 (Catherine) is connected",
-                   StartsWith "contact and member are merged: cath",
-                   StartsWith "use @cath",
-                   StartsWith "contact cath_",
-                   StartsWith "use @cath"
-                 ],
-          bob <## "#team: alice joined the group",
-          cath
-            <### [ "#team: bob added alice_2 (Alice) to the group (connecting...)",
-                   "#team: new member alice_2 is connected",
-                   StartsWith "contact and member are merged: alice",
-                   StartsWith "use @alice",
-                   StartsWith "contact alice_",
-                   StartsWith "use @alice"
-                 ]
-        ]
-      alice <##> cath
-      alice #> "#team hello"
-      bob <# "#team alice> hello"
-      cath <# "#team alice> hello"
-      cath #> "#team hello too"
-      bob <# "#team cath> hello too"
-      alice <# "#team cath> hello too"
-
-      alice ##> "/contacts"
-      alice
-        <### [ "bob (Bob)",
-               "cath (Catherine)"
-             ]
-      cath ##> "/contacts"
-      cath
-        <### [ "alice (Alice)",
-               "bob (Bob)"
-             ]
-      alice `hasContactProfiles` ["alice", "bob", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "bob"]
-
 testMergeContactExistingMember :: HasCallStack => FilePath -> IO ()
 testMergeContactExistingMember =
   testChat3 aliceProfile bobProfile cathProfile $
@@ -2889,66 +2816,6 @@ testMergeContactExistingMember =
       bob `hasContactProfiles` ["alice", "bob", "cath"]
       cath `hasContactProfiles` ["cath", "alice", "bob"]
 
-testMergeContactExistingMemberWithContact :: HasCallStack => FilePath -> IO ()
-testMergeContactExistingMemberWithContact =
-  testChat3 aliceProfile bobProfile cathProfile $
-    \alice bob cath -> do
-      createGroup3 "team" alice bob cath
-
-      -- create contact, delete only for bob so he would send probe hash to member
-      bob ##> "/_create member contact #1 3"
-      bob <## "contact for member #team cath is created"
-
-      bob ##> "/_invite member contact @3 text hi"
-      bob
-        <### [ "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"
-             ]
-      concurrently_
-        (bob <## "cath (Catherine): contact is connected")
-        (cath <## "bob (Bob): contact is connected")
-      bob <##> cath
-
-      bob ##> "/_delete @3 notify=off"
-      bob <## "cath: contact is deleted"
-
-      bob ##> "/contacts"
-      bob <### ["alice (Alice)"]
-      cath ##> "/contacts"
-      cath <### ["alice (Alice)", "bob (Bob)"]
-      bob `hasContactProfiles` ["alice", "bob", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "bob"]
-
-      -- contact connects, member is merged
-      bob ##> "/c"
-      inv' <- getInvitation bob
-      cath ##> ("/c " <> inv')
-      cath <## "confirmation sent!"
-      concurrentlyN_
-        [ bob
-            <### [ "cath_1 (Catherine): contact is connected",
-                   "contact and member are merged: cath_1, #team cath",
-                   "use @cath <message> to send messages"
-                 ],
-          cath
-            <### [ "bob_1 (Bob): contact is connected",
-                   "contact bob_1 is merged into bob",
-                   "use @bob <message> to send messages"
-                 ]
-        ]
-      bob <##> cath
-
-      bob ##> "/contacts"
-      bob <### ["alice (Alice)", "cath (Catherine)"]
-      cath ##> "/contacts"
-      cath <### ["alice (Alice)", "bob (Bob)"]
-      bob `hasContactProfiles` ["alice", "bob", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "bob"]
-
 testMergeContactMultipleMembers :: HasCallStack => FilePath -> IO ()
 testMergeContactMultipleMembers =
   testChat3 aliceProfile bobProfile cathProfile $
@@ -2987,70 +2854,11 @@ testMergeContactMultipleMembers =
       bob `hasContactProfiles` ["alice", "bob", "cath"]
       cath `hasContactProfiles` ["cath", "alice", "bob"]
 
-testMergeContactExistingMembersAndContacts :: HasCallStack => FilePath -> IO ()
+testMergeGroupLinkHostMultipleContacts :: HasCallStack => FilePath -> IO ()
-testMergeContactExistingMembersAndContacts =
+testMergeGroupLinkHostMultipleContacts =
-  testChat3 aliceProfile bobProfile cathProfile $
+  testChat2 bobProfile cathProfile $
-    \alice bob cath -> do
+    \bob cath -> do
-      bob ##> "/contact_merge off"
+      connectUsers bob cath
-      bob <## "ok"
-
-      create2Groups3 "team" "club" alice bob cath
-
-      bob ##> "/c"
-      inv' <- getInvitation bob
-      cath ##> ("/c " <> inv')
-      cath <## "confirmation sent!"
-      concurrently_
-        (bob <## "cath_2 (Catherine): contact is connected")
-        (cath <## "bob_2 (Bob): contact is connected")
-
-      bob `hasContactProfiles` ["alice", "bob", "cath", "cath", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "bob", "bob", "bob"]
-
-      bob ##> "/contact_merge on"
-      bob <## "ok"
-
-      bob ##> "/c"
-      inv'' <- getInvitation bob
-      cath ##> ("/c " <> inv'')
-      cath <## "confirmation sent!"
-      concurrentlyN_
-        [ bob
-            <### [ "cath_3 (Catherine): contact is connected",
-                   StartsWith "contact and member are merged: cath",
-                   StartsWith "use @cath",
-                   StartsWith "contact and member are merged: cath",
-                   StartsWith "use @cath",
-                   StartsWith "contact cath_3 is merged into cath",
-                   StartsWith "use @cath"
-                 ],
-          cath
-            <### [ "bob_3 (Bob): contact is connected",
-                   StartsWith "contact and member are merged: bob",
-                   StartsWith "use @bob",
-                   StartsWith "contact and member are merged: bob",
-                   StartsWith "use @bob",
-                   StartsWith "contact bob_3 is merged into bob",
-                   StartsWith "use @bob"
-                 ]
-        ]
-      bob <##> cath
-
-      bob ##> "/contacts"
-      bob <### ["alice (Alice)", "cath (Catherine)"]
-      cath ##> "/contacts"
-      cath <### ["alice (Alice)", "bob (Bob)"]
-      bob `hasContactProfiles` ["alice", "bob", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "bob"]
-
-testMergeMemberContact :: HasCallStack => FilePath -> IO ()
-testMergeMemberContact =
-  testChat3 aliceProfile bobProfile cathProfile $
-    \alice bob cath -> do
-      bob ##> "/contact_merge off"
-      bob <## "ok"
-
-      createGroup3 "team" alice bob cath
 
       bob ##> "/c"
       inv' <- getInvitation bob
@@ -3060,61 +2868,40 @@ testMergeMemberContact =
         (bob <## "cath_1 (Catherine): contact is connected")
         (cath <## "bob_1 (Bob): contact is connected")
 
-      bob `hasContactProfiles` ["alice", "bob", "cath", "cath"]
+      bob `hasContactProfiles` ["bob", "cath", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "bob", "bob"]
+      cath `hasContactProfiles` ["cath", "bob", "bob"]
 
-      bob ##> "/contact_merge on"
+      bob ##> "/g party"
-      bob <## "ok"
+      bob <## "group #party is created"
-
+      bob <## "to add members use /a party <name> or /create link #party"
-      -- bob and cath connect
+      bob ##> "/create link #party"
-      bob ##> "/_create member contact #1 3"
+      gLink <- getGroupLink bob "party" GRMember True
-      bob <## "contact for member #team cath is created"
+      cath ##> ("/c " <> gLink)
-
+      cath <## "connection request sent!"
-      bob ##> "/_invite member contact @4 text hi"
+      bob <## "cath_2 (Catherine): accepting request to join group #party..."
-      bob
-        <### [ "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_
         [ bob
-            <### [ "cath (Catherine): contact is connected",
+            <### [ "cath_2 (Catherine): contact is connected",
-                   "contact cath_1 is merged into cath",
+                   EndsWith "invited to group #party via your group link",
-                   -- StartsWith "use @cath"
+                   EndsWith "joined the group",
-                   "use @cath <message> to send messages"
+                   StartsWith "contact cath_2 is merged into cath",
+                   StartsWith "use @cath"
                  ],
           cath
-            <### [ "bob (Bob): contact is connected",
+            <### [ "bob_2 (Bob): contact is connected",
-                   "contact bob_1 is merged into bob",
+                   "#party: you joined the group",
-                   -- StartsWith "use @bob"
+                   StartsWith "contact bob_2 is merged into bob",
-                   "use @bob <message> to send messages"
+                   StartsWith "use @bob"
                  ]
         ]
       bob <##> cath
 
       bob ##> "/contacts"
-      bob <### ["alice (Alice)", "cath (Catherine)"]
+      bob <### ["cath (Catherine)", "cath_1 (Catherine)"]
       cath ##> "/contacts"
-      cath <### ["alice (Alice)", "bob (Bob)"]
+      cath <### ["bob (Bob)", "bob_1 (Bob)"]
-      bob `hasContactProfiles` ["alice", "bob", "cath"]
+      bob `hasContactProfiles` ["bob", "cath", "cath"]
-      cath `hasContactProfiles` ["cath", "alice", "bob"]
+      cath `hasContactProfiles` ["cath", "bob", "bob"]
-
-      -- group messages work
-      alice #> "#team hello"
-      concurrently_
-        (bob <# "#team alice> hello")
-        (cath <# "#team alice> hello")
-      bob #> "#team hi there"
-      concurrently_
-        (alice <# "#team bob> hi there")
-        (cath <# "#team bob> hi there")
-      cath #> "#team hey team"
-      concurrently_
-        (alice <# "#team cath> hey team")
-        (bob <# "#team cath> hey team")
 
 testMemberContactMessage :: HasCallStack => FilePath -> IO ()
 testMemberContactMessage =

tests/ChatTests/Profiles.hs

@@ -20,7 +20,6 @@ chatProfileTests = do
     it "use multiword profile names" testMultiWordProfileNames
   describe "user contact link" $ do
     it "create and connect via contact link" testUserContactLink
-    it "merge existing contact when connecting via contact link" testUserContactLinkMerge
     it "add contact link to profile" testProfileLink
     it "auto accept contact requests" testUserContactLinkAutoAccept
     it "deduplicate contact requests" testDeduplicateContactRequests
@@ -219,39 +218,6 @@ testUserContactLink =
       alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
       alice <##> cath
 
-testUserContactLinkMerge :: HasCallStack => FilePath -> IO ()
-testUserContactLinkMerge =
-  testChat2 aliceProfile bobProfile $
-    \alice bob -> do
-      connectUsers alice bob
-      alice <##> bob
-
-      alice ##> "/ad"
-      cLink <- getContactLink alice True
-      bob ##> ("/c " <> cLink)
-      bob <## "connection request sent!"
-      alice <## "bob_1 (Bob) wants to connect to you!"
-      alice <## "to accept: /ac bob_1"
-      alice <## "to reject: /rc bob_1 (the sender will NOT be notified)"
-      alice @@@ [("@bob", "hey"), ("<@bob_1", "")]
-      alice ##> "/ac bob_1"
-      alice <## "bob_1 (Bob): accepting contact request..."
-      concurrentlyN_
-        [ alice
-            <### [ "bob_1 (Bob): contact is connected",
-                   "contact bob_1 is merged into bob",
-                   "use @bob <message> to send messages"
-                 ],
-          bob
-            <### [ "alice_1 (Alice): contact is connected",
-                   "contact alice_1 is merged into alice",
-                   "use @alice <message> to send messages"
-                 ]
-        ]
-      threadDelay 100000
-      alice @@@ [("@bob", lastChatFeature)]
-      alice <##> bob
-
 testProfileLink :: HasCallStack => FilePath -> IO ()
 testProfileLink =
   testChat3 aliceProfile bobProfile cathProfile $