core: fix unused contact deletion (#2023)

* core: failing test for leaving and deleting the group joined via link

* fix test

* merge logic

* fix

* add condition

* refactor

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

* compiles

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

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

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

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

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 <name> 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 <message> 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 <message> 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 <message> 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 <message> 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)"