diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 6f93b314d..8d7b3dc44 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -15,7 +15,7 @@ module Simplex.Chat where import Control.Applicative (optional, (<|>)) -import Control.Concurrent.STM (retry, stateTVar) +import Control.Concurrent.STM (retry) import Control.Logger.Simple import Control.Monad.Except import Control.Monad.IO.Unlift @@ -3224,9 +3224,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do messageError $ eventName <> ": wrong call state " <> T.pack (show $ callStateTag callState) mergeContacts :: Contact -> Contact -> m () - mergeContacts to from = do - withStore' $ \db -> mergeContactRecords db userId to from - toView $ CRContactsMerged user to from + mergeContacts c1 c2 = do + withStore' $ \db -> mergeContactRecords db userId c1 c2 + toView $ CRContactsMerged user c1 c2 saveConnInfo :: Connection -> ConnInfo -> m () saveConnInfo activeConn connInfo = do diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index cbd733ac0..22f82721a 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -259,7 +259,6 @@ module Simplex.Chat.Store where import Control.Applicative ((<|>)) -import Control.Concurrent.STM (stateTVar) import Control.Exception (Exception) import qualified Control.Exception as E import Control.Monad.Except @@ -1592,8 +1591,17 @@ matchSentProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = d cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId) mergeContactRecords :: DB.Connection -> UserId -> Contact -> Contact -> IO () -mergeContactRecords db userId Contact {contactId = toContactId} Contact {contactId = fromContactId, localDisplayName} = do +mergeContactRecords db userId ct1 ct2 = do + let (toCt, fromCt) = toFromContacts ct1 ct2 + Contact {contactId = toContactId} = toCt + Contact {contactId = fromContactId, localDisplayName} = fromCt currentTs <- getCurrentTime + -- TODO next query fixes incorrect unused contacts deletion; consider more thorough fix + when (contactDirect toCt && not (contactUsed toCt)) $ + DB.execute + db + "UPDATE contacts SET contact_used = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" + (currentTs, userId, toContactId) DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?" @@ -1629,6 +1637,17 @@ mergeContactRecords db userId Contact {contactId = toContactId} Contact {contact deleteContactProfile_ db userId fromContactId DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId) DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId) + where + toFromContacts :: Contact -> Contact -> (Contact, Contact) + toFromContacts c1 c2 + | d1 && not d2 = (c1, c2) + | d2 && not d1 = (c2, c1) + | ctCreatedAt c1 <= ctCreatedAt c2 = (c1, c2) + | otherwise = (c2, c1) + where + d1 = directOrUsed c1 + d2 = directOrUsed c2 + ctCreatedAt Contact {createdAt} = createdAt getConnectionEntity :: DB.Connection -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity getConnectionEntity db user@User {userId, userContactId} agentConnId = do diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index e5a91e881..35582b895 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -160,9 +160,12 @@ contactConnId = aConnId . contactConn contactConnIncognito :: Contact -> Bool contactConnIncognito = connIncognito . contactConn +contactDirect :: Contact -> Bool +contactDirect Contact {activeConn = Connection {connLevel, viaGroupLink}} = connLevel == 0 && not viaGroupLink + directOrUsed :: Contact -> Bool -directOrUsed Contact {contactUsed, activeConn = Connection {connLevel, viaGroupLink}} = - (connLevel == 0 && not viaGroupLink) || contactUsed +directOrUsed ct@Contact {contactUsed} = + contactDirect ct || contactUsed anyDirectOrUsed :: Contact -> Bool anyDirectOrUsed Contact {contactUsed, activeConn = Connection {connLevel}} = connLevel == 0 || contactUsed diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 5b9048a62..a6b180266 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -47,6 +47,7 @@ chatGroupTests = do it "unused host contact is deleted after all groups with it are deleted" testGroupLinkUnusedHostContactDeleted it "leaving groups with unused host contacts deletes incognito profiles" testGroupLinkIncognitoUnusedHostContactsDeleted it "group link member role" testGroupLinkMemberRole + it "leaving and deleting the group joined via link should NOT delete previously existing direct contacts" testGroupLinkLeaveDelete testGroup :: HasCallStack => SpecWith FilePath testGroup = versionTestMatrix3 runTestGroup @@ -1916,3 +1917,72 @@ testGroupLinkMemberRole = concurrently_ (alice <# "#team bob> hey now") (cath <# "#team bob> hey now") + +testGroupLinkLeaveDelete :: HasCallStack => FilePath -> IO () +testGroupLinkLeaveDelete = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + connectUsers alice bob + connectUsers cath bob + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob_1 (Bob): accepting request to join group #team..." + concurrentlyN_ + [ alice + <### [ "bob_1 (Bob): contact is connected", + "contact bob_1 is merged into bob", + "use @bob to send messages", + EndsWith "invited to group #team via your group link", + EndsWith "joined the group" + ], + bob + <### [ "alice_1 (Alice): contact is connected", + "contact alice_1 is merged into alice", + "use @alice to send messages", + "#team: you joined the group" + ] + ] + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + alice <## "cath (Catherine): accepting request to join group #team..." + concurrentlyN_ + [ alice + <### [ "cath (Catherine): contact is connected", + "cath invited to group #team via your group link", + "#team: cath joined the group" + ], + cath + <### [ "alice (Alice): contact is connected", + "#team: you joined the group", + "#team: member bob_1 (Bob) is connected", + "contact bob_1 is merged into bob", + "use @bob to send messages" + ], + bob + <### [ "#team: alice added cath_1 (Catherine) to the group (connecting...)", + "#team: new member cath_1 is connected", + "contact cath_1 is merged into cath", + "use @cath to send messages" + ] + ] + bob ##> "/l team" + concurrentlyN_ + [ do + bob <## "#team: you left the group" + bob <## "use /d #team to delete the group", + alice <## "#team: bob left the group", + cath <## "#team: bob left the group" + ] + bob ##> "/contacts" + bob <## "alice (Alice)" + bob <## "cath (Catherine)" + bob ##> "/d #team" + bob <## "#team: you deleted the group" + bob ##> "/contacts" + bob <## "alice (Alice)" + bob <## "cath (Catherine)"