checl contact, ldn

src/Simplex/Chat.hs

@@ -947,7 +947,7 @@ processChatCommand' vr = \case
         -- functions below are called in separate transactions to prevent crashes on android
         -- (possibly, race condition on integrity check?)
         withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct
-        withStore' $ \db -> deleteContact db user ct
+        withStore $ \db -> deleteContact db user ct
         pure $ CRContactDeleted user ct
     CTContactConnection -> withChatLock "deleteChat contactConnection" . procCmd $ do
       conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId
@@ -988,7 +988,7 @@ processChatCommand' vr = \case
                     Just _ -> pure []
                     Nothing -> do
                       conns <- withStore' $ \db -> getContactConnections db userId ct
-                      withStore' (\db -> setContactDeleted db user ct)
+                      withStore (\db -> setContactDeleted db user ct)
                         `catchChatError` (toView . CRChatError (Just user))
                       pure $ map aConnId conns
     CTLocal -> pure $ chatCmdError (Just user) "not supported"
@@ -3056,7 +3056,7 @@ cleanupManager = do
     cleanupDeletedContacts user = do
       contacts <- withStore' (`getDeletedContacts` user)
       forM_ contacts $ \ct ->
-        withStore' (\db -> deleteContactWithoutGroups db user ct)
+        withStore (\db -> deleteContactWithoutGroups db user ct)
           `catchChatError` (toView . CRChatError (Just user))
     cleanupMessages = do
       ts <- liftIO getCurrentTime
@@ -4836,7 +4836,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         else do
           contactConns <- withStore' $ \db -> getContactConnections db userId c
           deleteAgentConnectionsAsync user $ map aConnId contactConns
-          withStore' $ \db -> deleteContact db user c
+          withStore $ \db -> deleteContact db user c
       where
         brokerTs = metaBrokerTs msgMeta
 

src/Simplex/Chat/Store/Direct.hs

@@ -90,6 +90,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
+import Simplex.Messaging.Util (whenM)
 import Simplex.Messaging.Version
 
 getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection
@@ -229,37 +230,46 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do
     (userId, contactId)
   DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId)
 
-deleteContact :: DB.Connection -> User -> Contact -> IO ()
-deleteContact db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do
-  DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
-  ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
-  if isNothing ctMember
-    then do
-      deleteContactProfile_ db userId contactId
-      DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
-    else do
-      currentTs <- getCurrentTime
-      DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
-  DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
-  forM_ activeConn $ \Connection {customUserProfileId} ->
-    forM_ customUserProfileId $ \profileId ->
-      deleteUnusedIncognitoProfileById_ db user profileId
+deleteContact :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
+deleteContact db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
+  whenM (liftIO $ checkContactIsUser db user ct) $ throwError (SEProhibitedDeleteUserContact contactId)
+  whenM (liftIO $ checkLDNIsUser db localDisplayName) $ throwError (SEProhibitedDeleteUserName localDisplayName)
+  liftIO $ do
+    DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
+    ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
+    if isNothing ctMember
+      then do
+        deleteContactProfile_ db userId contactId
+        DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+      else do
+        currentTs <- getCurrentTime
+        DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
+    DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
+    forM_ activeConn $ \Connection {customUserProfileId} ->
+      forM_ customUserProfileId $ \profileId ->
+        deleteUnusedIncognitoProfileById_ db user profileId
 
 -- should only be used if contact is not member of any groups
-deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> IO ()
-deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do
-  DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
-  deleteContactProfile_ db userId contactId
-  DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
-  DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
-  forM_ activeConn $ \Connection {customUserProfileId} ->
-    forM_ customUserProfileId $ \profileId ->
-      deleteUnusedIncognitoProfileById_ db user profileId
+deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
+deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
+  whenM (liftIO $ checkContactIsUser db user ct) $ throwError (SEProhibitedDeleteUserContact contactId)
+  whenM (liftIO $ checkLDNIsUser db localDisplayName) $ throwError (SEProhibitedDeleteUserName localDisplayName)
+  liftIO $ do
+    DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
+    deleteContactProfile_ db userId contactId
+    DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+    DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
+    forM_ activeConn $ \Connection {customUserProfileId} ->
+      forM_ customUserProfileId $ \profileId ->
+        deleteUnusedIncognitoProfileById_ db user profileId
 
-setContactDeleted :: DB.Connection -> User -> Contact -> IO ()
-setContactDeleted db User {userId} Contact {contactId} = do
-  currentTs <- getCurrentTime
-  DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
+setContactDeleted :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
+setContactDeleted db user@User {userId} ct@Contact {contactId, localDisplayName} = do
+  whenM (liftIO $ checkContactIsUser db user ct) $ throwError (SEProhibitedDeleteUserContact contactId)
+  whenM (liftIO $ checkLDNIsUser db localDisplayName) $ throwError (SEProhibitedDeleteUserName localDisplayName)
+  liftIO $ do
+    currentTs <- getCurrentTime
+    DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
 
 getDeletedContacts :: DB.Connection -> User -> IO [Contact]
 getDeletedContacts db user@User {userId} = do
@@ -501,7 +511,14 @@ updateContactLDN_ db userId contactId displayName newName updatedAt = do
     db
     "UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
     (newName, updatedAt, userId, contactId)
-  DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId)
+  DB.execute
+    db
+    [sql|
+      DELETE FROM display_names
+      WHERE local_display_name = ? AND user_id = ?
+        AND local_display_name NOT IN (SELECT local_display_name FROM users)
+    |]
+    (displayName, userId)
 
 getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact
 getContactByName db user localDisplayName = do
@@ -614,7 +631,14 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
                 WHERE user_id = ? AND contact_request_id = ?
               |]
               (invId, minV, maxV, ldn, currentTs, userId, cReqId)
-            DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (oldLdn, userId)
+            DB.execute
+              db
+              [sql|
+                DELETE FROM display_names
+                WHERE local_display_name = ? AND user_id = ?
+                  AND local_display_name NOT IN (SELECT local_display_name FROM users)
+              |]
+              (oldLdn, userId)
       where
         updateProfile currentTs =
           DB.execute
@@ -684,6 +708,7 @@ deleteContactRequest db User {userId} contactRequestId = do
         SELECT local_display_name FROM contact_requests
         WHERE user_id = ? AND contact_request_id = ?
       )
+      AND local_display_name NOT IN (SELECT local_display_name FROM users)
     |]
     (userId, userId, contactRequestId)
   DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)

src/Simplex/Chat/Store/Groups.hs

@@ -142,7 +142,7 @@ import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
-import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
+import Simplex.Messaging.Util (eitherToMaybe, unlessM, whenM, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import UnliftIO.STM
 
@@ -225,6 +225,7 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do
           JOIN user_contact_links uc USING (user_contact_link_id)
           WHERE uc.user_id = ? AND uc.group_id = ?
         )
+        AND local_display_name NOT IN (SELECT local_display_name FROM users)
     |]
     (userId, userId, groupId)
   DB.execute
@@ -586,7 +587,8 @@ deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
 deleteGroup db user@User {userId} g@GroupInfo {groupId, localDisplayName} = do
   deleteGroupProfile_ db userId groupId
   DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
-  DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+  unlessM (checkLDNIsUser db localDisplayName) $
+    DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
   forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
 
 deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
@@ -1051,7 +1053,8 @@ cleanupMemberProfileAndName_ db User {userId} GroupMember {groupMemberId, member
     sameProfileMember :: (Maybe GroupMemberId) <- maybeFirstRow fromOnly $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1" (userId, memberContactProfileId, groupMemberId)
     when (isNothing sameProfileMember) $ do
       DB.execute db "DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?" (userId, memberContactProfileId)
-      DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+      unlessM (checkLDNIsUser db localDisplayName) $
+        DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
 
 deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO ()
 deleteGroupMemberConnection db User {userId} GroupMember {groupMemberId} =
@@ -1361,7 +1364,8 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
         db
         "UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_id = ?"
         (ldn, currentTs, userId, groupId)
-      DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
+      unlessM (checkLDNIsUser db localDisplayName) $
+        DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
 
 getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo
 getGroupInfo db vr User {userId, userContactId} groupId =
@@ -1615,6 +1619,10 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN
   let (toCt, fromCt) = toFromContacts to from
       Contact {contactId = toContactId, localDisplayName = toLDN} = toCt
       Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt
+  whenM (liftIO $ checkContactIsUser db user toCt) $ throwError (SEProhibitedDeleteUserContact toContactId)
+  whenM (liftIO $ checkLDNIsUser db toLDN) $ throwError (SEProhibitedDeleteUserName toLDN)
+  whenM (liftIO $ checkContactIsUser db user fromCt) $ throwError (SEProhibitedDeleteUserContact fromContactId)
+  whenM (liftIO $ checkLDNIsUser db fromLDN) $ throwError (SEProhibitedDeleteUserName fromLDN)
   liftIO $ do
     currentTs <- getCurrentTime
     -- next query fixes incorrect unused contacts deletion
@@ -2030,7 +2038,8 @@ updateMemberProfile db User {userId} m p'
           db
           "UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?"
           (ldn, currentTs, userId, groupMemberId)
-        DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
+        unlessM (checkLDNIsUser db localDisplayName) $
+          DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
         pure $ Right m {localDisplayName = ldn, memberProfile = profile}
   where
     GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m

src/Simplex/Chat/Store/Profiles.hs

@@ -388,6 +388,7 @@ deleteUserAddress db user@User {userId} = do
           JOIN user_contact_links uc USING (user_contact_link_id)
           WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
         )
+        AND local_display_name NOT IN (SELECT local_display_name FROM users)
     |]
     [":user_id" := userId]
   DB.executeNamed

src/Simplex/Chat/Store/Shared.hs

@@ -110,6 +110,8 @@ data StoreError
   | SERemoteHostDuplicateCA
   | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
   | SERemoteCtrlDuplicateCA
+  | SEProhibitedDeleteUserContact {contactId :: ContactId}
+  | SEProhibitedDeleteUserName {localDisplayName :: ContactName}
   deriving (Show, Exception)
 
 $(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
@@ -401,3 +403,17 @@ createWithRandomBytes' size gVar create = tryCreate 3
 
 encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
 encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar
+
+checkContactIsUser :: DB.Connection -> User -> Contact -> IO Bool
+checkContactIsUser db User {userContactId} Contact {contactId} = do
+  isUser_ <-
+    maybeFirstRow fromOnly $
+      DB.query db "SELECT is_user FROM contacts WHERE contact_id = ?" (Only contactId)
+  pure $ fromMaybe False isUser_ || contactId == userContactId
+
+checkLDNIsUser :: DB.Connection -> ContactName -> IO Bool
+checkLDNIsUser db ldn = do
+  r :: (Maybe Int64) <-
+    maybeFirstRow fromOnly $
+      DB.query db "SELECT 1 FROM users WHERE local_display_name = ? LIMIT 1" (Only ldn)
+  pure $ isJust r

tests/ChatClient.hs

@@ -318,7 +318,8 @@ getTermLine cc =
     _ -> error "no output for 5 seconds"
 
 userName :: TestCC -> IO [Char]
-userName (TestCC ChatController {currentUser} _ _ _ _ _) = maybe "no current user" (T.unpack . localDisplayName) <$> readTVarIO currentUser
+userName (TestCC ChatController {currentUser} _ _ _ _ _) = do
+  maybe "no current user" (\User {localDisplayName = ldn} -> T.unpack ldn) <$> readTVarIO currentUser
 
 testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
 testChat2 = testChatCfgOpts2 testCfg testOpts