refactor2

src/Simplex/Chat/Store/Direct.hs

@@ -230,38 +230,44 @@ 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} = 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
+deleteContact db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
+  assertNotUser db user ct
+  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
+        -- 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} = 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
+deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
+  assertNotUser db user ct
+  liftIO $ 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} = 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)
+setContactDeleted db user@User {userId} ct@Contact {contactId} = do
+  assertNotUser db user ct
+  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

src/Simplex/Chat/Store/Groups.hs

@@ -1616,8 +1616,9 @@ 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
-  assertNotUser db user toCt $ pure ()
-  assertNotUser db user fromCt $ do
+  assertNotUser db user toCt
+  assertNotUser db user fromCt
+  liftIO $ do
     currentTs <- getCurrentTime
     -- next query fixes incorrect unused contacts deletion
     when (contactDirect toCt && not (contactUsed toCt)) $

src/Simplex/Chat/Store/Shared.hs

@@ -403,8 +403,8 @@ createWithRandomBytes' size gVar create = tryCreate 3
 encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
 encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar
 
-assertNotUser :: DB.Connection -> User -> Contact -> IO a -> ExceptT StoreError IO a
-assertNotUser db User {userId} Contact {contactId, localDisplayName} a = do
+assertNotUser :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
+assertNotUser db User {userId} Contact {contactId, localDisplayName} = do
   r :: (Maybe Int64) <-
     -- This query checks that the foreign keys in the users table
     -- are not referencing the contact about to be deleted.
@@ -421,7 +421,6 @@ assertNotUser db User {userId} Contact {contactId, localDisplayName} a = do
         |]
         (userId, localDisplayName, contactId)
   when (isJust r) $ throwError $ SEProhibitedDeleteUser userId (Just contactId)
-  liftIO a
 
 safeDeleteLDN :: DB.Connection -> User -> ContactName -> IO ()
 safeDeleteLDN db User {userId} localDisplayName = do