refactor

src/Simplex/Chat/Store/Direct.hs

@@ -90,7 +90,6 @@ 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
@@ -231,42 +230,38 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do
   DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId)
 
 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 (SEProhibitedDeleteUser userId)
-  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
+deleteContact db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = assertNotUser db user ct $ 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
+      -- user's local display name already checked in assertNotUser
+      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 -> ExceptT StoreError IO ()
-deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
-  whenM (liftIO $ checkContactIsUser db user ct) $ throwError (SEProhibitedDeleteUser userId)
-  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
+deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = assertNotUser db user ct $ do
+  DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
+  deleteContactProfile_ db userId contactId
+  -- user's local display name already checked in assertNotUser
+  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 -> ExceptT StoreError IO ()
-setContactDeleted db user@User {userId} ct@Contact {contactId} = do
-  whenM (liftIO $ checkContactIsUser db user ct) $ throwError (SEProhibitedDeleteUser userId)
-  liftIO $ do
-    currentTs <- getCurrentTime
-    DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
+setContactDeleted db user@User {userId} ct@Contact {contactId} = assertNotUser db user ct $ 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
@@ -327,7 +322,7 @@ updateContactProfile db user@User {userId} c p'
       ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
         currentTs <- getCurrentTime
         updateContactProfile_' db userId profileId p' currentTs
-        updateContactLDN_ db userId contactId localDisplayName ldn currentTs
+        updateContactLDN_ db user contactId localDisplayName ldn currentTs
         pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
   where
     Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
@@ -498,8 +493,8 @@ updateMemberContactProfile_' db userId profileId Profile {displayName, fullName,
     |]
     (displayName, fullName, image, updatedAt, userId, profileId)
 
-updateContactLDN_ :: DB.Connection -> UserId -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
-updateContactLDN_ db userId contactId displayName newName updatedAt = do
+updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
+updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do
   DB.execute
     db
     "UPDATE contacts SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
@@ -508,14 +503,7 @@ 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
-    [sql|
-      DELETE FROM display_names
-      WHERE local_display_name = ? AND user_id = ?
-        AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
-    |]
-    (displayName, userId, userId)
+  safeDeleteLDN db user displayName
 
 getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact
 getContactByName db user localDisplayName = do
@@ -628,14 +616,7 @@ 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
-              [sql|
-                DELETE FROM display_names
-                WHERE local_display_name = ? AND user_id = ?
-                  AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
-              |]
-              (oldLdn, userId, userId)
+            safeDeleteLDN db user oldLdn
       where
         updateProfile currentTs =
           DB.execute

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, whenM, ($>>=), (<$$>))
+import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import UnliftIO.STM
 
@@ -587,7 +587,7 @@ 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)
-  deleteLDNCheckNotUser db user localDisplayName
+  safeDeleteLDN db user localDisplayName
   forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
 
 deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
@@ -1052,7 +1052,7 @@ cleanupMemberProfileAndName_ db user@User {userId} GroupMember {groupMemberId, m
     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)
-      deleteLDNCheckNotUser db user localDisplayName
+      safeDeleteLDN db user localDisplayName
 
 deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO ()
 deleteGroupMemberConnection db User {userId} GroupMember {groupMemberId} =
@@ -1362,7 +1362,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
         db
         "UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_id = ?"
         (ldn, currentTs, userId, groupId)
-      deleteLDNCheckNotUser db user localDisplayName
+      safeDeleteLDN db user localDisplayName
 
 getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo
 getGroupInfo db vr User {userId, userContactId} groupId =
@@ -1616,9 +1616,8 @@ 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 (SEProhibitedDeleteUser userId)
-  whenM (liftIO $ checkContactIsUser db user fromCt) $ throwError (SEProhibitedDeleteUser userId)
-  liftIO $ do
+  assertNotUser db user toCt $ pure ()
+  assertNotUser db user fromCt $ do
     currentTs <- getCurrentTime
     -- next query fixes incorrect unused contacts deletion
     when (contactDirect toCt && not (contactUsed toCt)) $
@@ -2033,7 +2032,7 @@ updateMemberProfile db user@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)
-        deleteLDNCheckNotUser db user localDisplayName
+        safeDeleteLDN db user localDisplayName
         pure $ Right m {localDisplayName = ldn, memberProfile = profile}
   where
     GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
@@ -2041,7 +2040,7 @@ updateMemberProfile db user@User {userId} m p'
     profile = toLocalProfile profileId p' localAlias
 
 updateContactMemberProfile :: DB.Connection -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
-updateContactMemberProfile db User {userId} m ct@Contact {contactId} p'
+updateContactMemberProfile db user@User {userId} m ct@Contact {contactId} p'
   | displayName == newName = do
       liftIO $ updateMemberContactProfile_ db userId profileId p'
       pure (m {memberProfile = profile}, ct {profile} :: Contact)
@@ -2049,7 +2048,7 @@ updateContactMemberProfile db User {userId} m ct@Contact {contactId} p'
       ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
         currentTs <- getCurrentTime
         updateMemberContactProfile_' db userId profileId p' currentTs
-        updateContactLDN_ db userId contactId localDisplayName ldn currentTs
+        updateContactLDN_ db user contactId localDisplayName ldn currentTs
         pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact)
   where
     GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m

src/Simplex/Chat/Store/Profiles.hs

@@ -267,7 +267,7 @@ updateUserProfile db user p'
           "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
           (newName, newName, userId, currentTs, currentTs)
         updateContactProfile_' db userId profileId p' currentTs
-        updateContactLDN_ db userId userContactId localDisplayName newName currentTs
+        updateContactLDN_ db user userContactId localDisplayName newName currentTs
         pure user {localDisplayName = newName, profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
   where
     updateUserMemberProfileUpdatedAt_ currentTs

src/Simplex/Chat/Store/Shared.hs

@@ -110,7 +110,7 @@ data StoreError
   | SERemoteHostDuplicateCA
   | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
   | SERemoteCtrlDuplicateCA
-  | SEProhibitedDeleteUser {userId :: UserId}
+  | SEProhibitedDeleteUser {userId :: UserId, contactId_ :: Maybe ContactId}
   deriving (Show, Exception)
 
 $(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
@@ -403,23 +403,28 @@ 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 {userId} Contact {contactId, localDisplayName} = do
+assertNotUser :: DB.Connection -> User -> Contact -> IO a -> ExceptT StoreError IO a
+assertNotUser db User {userId} Contact {contactId, localDisplayName} a = do
   r :: (Maybe Int64) <-
-    maybeFirstRow fromOnly $
+    -- This query checks that the foreign keys in the users table
+    -- are not referencing the contact about to be deleted.
+    -- With the current schema it would cause cascade delete of user,
+    -- with mofified schema (in v5.6.0-beta.0) it would cause foreign key violation error.
+    liftIO . maybeFirstRow fromOnly $
       DB.query
         db
         [sql|
           SELECT 1 FROM users
           WHERE (user_id = ? AND local_display_name = ?)
-             OR (contact_id = ?)
+             OR contact_id = ?
           LIMIT 1
         |]
         (userId, localDisplayName, contactId)
-  pure $ isJust r
+  when (isJust r) $ throwError $ SEProhibitedDeleteUser userId (Just contactId)
+  liftIO a
 
-deleteLDNCheckNotUser :: DB.Connection -> User -> ContactName -> IO ()
-deleteLDNCheckNotUser db User {userId} localDisplayName = do
+safeDeleteLDN :: DB.Connection -> User -> ContactName -> IO ()
+safeDeleteLDN db User {userId} localDisplayName = do
   DB.execute
     db
     [sql|