diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 32d59c9cc..296abf0e2 100644 --- a/src/Simplex/Chat.hs +++ b/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 diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 20b81def8..91243e231 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/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 ) ) diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index f6a4233c1..236031da9 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/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} = - ExceptT $ - firstRow (toContact user) (SEContactNotFoundByMemberId groupMemberId) $ - DB.query - db - [sql| - SELECT - -- Contact - 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, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, - -- Connection - 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, - 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 - FROM contacts ct - 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) +getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do + contactId <- + ExceptT $ + firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $ + DB.query + db + [sql| + SELECT ct.contact_id + FROM group_members m + JOIN contacts ct ON ct.contact_id = m.contact_id + WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0 + LIMIT 1 + |] + (userId, groupMemberId) + getContact db user contactId 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} = - maybeFirstRow toContact' $ - DB.query - db - [sql| - SELECT - 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, - p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, - 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, 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 - FROM contacts ct - JOIN contact_profiles p ON ct.contact_profile_id = p.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 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} +getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do + contactId_ <- + maybeFirstRow fromOnly $ + DB.query + db + [sql| + SELECT ct.contact_id + FROM group_members m + JOIN groups g ON g.group_id = m.group_id + JOIN contacts ct ON ct.contact_id = m.contact_id AND ct.via_group = g.group_id + WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0 + LIMIT 1 + |] + (userId, groupMemberId) + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_ 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, keepLDN is kept +-- if requested merge direction is overruled (toFromContacts), 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) - checkToFromContacts - | vrfFrom && not vrfTo = (from, to) - | dirFrom && not vrfTo && not dirTo = (from, to) - | otherwise = (to, from) + 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 - vrfTo = isJust $ contactSecurityCode to - vrfFrom = isJust $ contactSecurityCode from - dirTo = let Contact {activeConn = Connection {connLevel = clTo}} = to in clTo == 0 - dirFrom = let Contact {activeConn = Connection {connLevel = clFrom}} = from in clFrom == 0 + d1 = directOrUsed c1 + d2 = directOrUsed c2 + ctCreatedAt Contact {createdAt} = createdAt associateMemberWithContactRecord :: DB.Connection -> User -> Contact -> GroupMember -> IO () associateMemberWithContactRecord diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index b996f7626..9ad0e8edc 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/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 ) ) diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index a8f9fbf9c..a5fc7455c 100644 --- a/tests/ChatTests/Direct.hs +++ b/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 - it "merge duplicate contacts" testContactMerge - it "new contact should merge with multiple existing contacts" testMergeContactMultipleContacts + describe "duplicate contacts" $ do + it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate + 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 () -testContactMerge = +testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO () +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 to send messages" - ], - bob - <### [ "alice_1 (Alice): contact is connected", - "contact alice_1 is merged into alice", - "use @alice 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" - bob <## "ok" + alice ##> "/c" + 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_ - [ alice - <### [ "bob_2 (Bob): 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" - ] - ] + concurrently_ + (alice <## "bob_2 (Bob): contact is connected") + (bob <## "alice_2 (Alice): contact is connected") + 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)" - alice `hasContactProfiles` ["alice", "bob"] - bob `hasContactProfiles` ["bob", "alice"] + bob <### ["alice (Alice)", "alice_1 (Alice)", "alice_2 (Alice)"] + alice `hasContactProfiles` ["alice", "bob", "bob", "bob"] + bob `hasContactProfiles` ["bob", "alice", "alice", "alice"] testContactClear :: HasCallStack => FilePath -> IO () testContactClear = diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 083d2f85b..9fb6ac7f9 100644 --- a/tests/ChatTests/Groups.hs +++ b/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 member contact is merged with existing contact" testMergeMemberContact + it "new group link host contact should merge with single existing contact out of multiple" testMergeGroupLinkHostMultipleContacts 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 to send messages" - ], - cath - <### [ "bob_1 (Bob): contact is connected", - "contact bob_1 is merged into bob", - "use @bob 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 () -testMergeContactExistingMembersAndContacts = - testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - bob ##> "/contact_merge off" - 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 +testMergeGroupLinkHostMultipleContacts :: HasCallStack => FilePath -> IO () +testMergeGroupLinkHostMultipleContacts = + testChat2 bobProfile cathProfile $ + \bob cath -> do + connectUsers 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"] - cath `hasContactProfiles` ["cath", "alice", "bob", "bob"] + bob `hasContactProfiles` ["bob", "cath", "cath"] + cath `hasContactProfiles` ["cath", "bob", "bob"] - bob ##> "/contact_merge on" - bob <## "ok" - - -- bob and cath connect - bob ##> "/_create member contact #1 3" - bob <## "contact for member #team cath is created" - - bob ##> "/_invite member contact @4 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" - ] + bob ##> "/g party" + bob <## "group #party is created" + bob <## "to add members use /a party or /create link #party" + bob ##> "/create link #party" + gLink <- getGroupLink bob "party" GRMember True + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + bob <## "cath_2 (Catherine): accepting request to join group #party..." concurrentlyN_ [ bob - <### [ "cath (Catherine): contact is connected", - "contact cath_1 is merged into cath", - -- StartsWith "use @cath" - "use @cath to send messages" + <### [ "cath_2 (Catherine): contact is connected", + EndsWith "invited to group #party via your group link", + EndsWith "joined the group", + StartsWith "contact cath_2 is merged into cath", + StartsWith "use @cath" ], cath - <### [ "bob (Bob): contact is connected", - "contact bob_1 is merged into bob", - -- StartsWith "use @bob" - "use @bob to send messages" + <### [ "bob_2 (Bob): contact is connected", + "#party: you joined the group", + StartsWith "contact bob_2 is merged into bob", + 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)"] - bob `hasContactProfiles` ["alice", "bob", "cath"] - cath `hasContactProfiles` ["cath", "alice", "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") + cath <### ["bob (Bob)", "bob_1 (Bob)"] + bob `hasContactProfiles` ["bob", "cath", "cath"] + cath `hasContactProfiles` ["cath", "bob", "bob"] testMemberContactMessage :: HasCallStack => FilePath -> IO () testMemberContactMessage = diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index d7cf68256..da6cbd156 100644 --- a/tests/ChatTests/Profiles.hs +++ b/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 to send messages" - ], - bob - <### [ "alice_1 (Alice): contact is connected", - "contact alice_1 is merged into alice", - "use @alice to send messages" - ] - ] - threadDelay 100000 - alice @@@ [("@bob", lastChatFeature)] - alice <##> bob - testProfileLink :: HasCallStack => FilePath -> IO () testProfileLink = testChat3 aliceProfile bobProfile cathProfile $