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'
-              createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent RCEVerificationCodeReset) Nothing
+              securityCodeChanged ct'
             _ -> 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 ct connectedIncognito = do
+    probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m ()
+    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
-                Nothing -> do
-                  void . sendDirectContactMessage c1 $ XInfoProbeOk probe
-                  COMContact <$$> associateMemberAndContact c1 m2
-                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
+              | isNothing memberContactId && profilesMatch p1 p2 -> do
+                void . sendDirectContactMessage c1 $ XInfoProbeOk probe
+                COMContact <$$> associateMemberAndContact c1 m2
+              | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> 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}
-              | memberCurrent m1 && profilesMatch p1 p2 -> case memberContactId of
-                Nothing -> do
-                  void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
-                  COMContact <$$> associateMemberAndContact c2 m1
-                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
+            COMContact c2@Contact {profile = p2}
+              | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do
+                void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
+                COMContact <$$> associateMemberAndContact c2 m1
+              | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact 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}) ->
-              case memberContactId of
-                Nothing -> void $ associateMemberAndContact c1 m2
-                Just mCtId
-                  | mCtId /= cId1 -> do
-                    mCt <- withStore $ \db -> getContact db user mCtId
-                    void $ mergeContacts c1 mCt
-                  | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
+            Just (COMGroupMember m2@GroupMember {memberContactId})
+              | isNothing memberContactId -> void $ associateMemberAndContact c1 m2
+              | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
             _ -> pure ()
         COMGroupMember m1@GroupMember {memberContactId} ->
           case cgm2 of
-            Just (COMContact c2@Contact {contactId = cId2}) -> case memberContactId of
-              Nothing -> void $ associateMemberAndContact c2 m1
-              Just mCtId
-                | mCtId /= cId2 -> do
-                  mCt <- withStore $ \db -> getContact db user mCtId
-                  void $ mergeContacts c2 mCt
-                | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
+            Just (COMContact c2)
+              | isNothing memberContactId -> void $ associateMemberAndContact c2 m1
+              | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
             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
-          createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
+
+    securityCodeChanged :: Contact -> m ()
+    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
             )
           )