core: delete profiles (#654)

src/Simplex/Chat/Store.hs

@@ -199,6 +199,7 @@ import Simplex.Chat.Migrations.M20220302_profile_images
 import Simplex.Chat.Migrations.M20220304_msg_quotes
 import Simplex.Chat.Migrations.M20220321_chat_item_edited
 import Simplex.Chat.Migrations.M20220404_files_status_fields
+import Simplex.Chat.Migrations.M20220514_profiles_user_id
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Util (eitherToMaybe)
@@ -223,7 +224,8 @@ schemaMigrations =
     ("20220302_profile_images", m20220302_profile_images),
     ("20220304_msg_quotes", m20220304_msg_quotes),
     ("20220321_chat_item_edited", m20220321_chat_item_edited),
-    ("20220404_files_status_fields", m20220404_files_status_fields)
+    ("20220404_files_status_fields", m20220404_files_status_fields),
+    ("20220514_profiles_user_id", m20220514_profiles_user_id)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -266,8 +268,8 @@ createUser st Profile {displayName, fullName, image} activeUser =
       (displayName, displayName, userId, currentTs, currentTs)
     DB.execute
       db
-      "INSERT INTO contact_profiles (display_name, full_name, image, created_at, updated_at) VALUES (?,?,?,?,?)"
-      (displayName, fullName, image, currentTs, currentTs)
+      "INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+      (displayName, fullName, image, userId, currentTs, currentTs)
     profileId <- insertedRowId db
     DB.execute
       db
@@ -400,8 +402,8 @@ createContact_ db userId connId Profile {displayName, fullName, image} viaGroup
   withLocalDisplayName db userId displayName $ \ldn -> do
     DB.execute
       db
-      "INSERT INTO contact_profiles (display_name, full_name, image, created_at, updated_at) VALUES (?,?,?,?,?)"
-      (displayName, fullName, image, currentTs, currentTs)
+      "INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+      (displayName, fullName, image, userId, currentTs, currentTs)
     profileId <- insertedRowId db
     DB.execute
       db
@@ -443,9 +445,24 @@ deleteContact st userId Contact {contactId, localDisplayName} = do
   -- in separate transaction to prevent crashes on android (race condition on integrity check?)
   liftIO . withTransaction st $ \db -> 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 contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
     DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
 
+deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO ()
+deleteContactProfile_ db userId contactId =
+  DB.execute
+    db
+    [sql|
+      DELETE FROM contact_profiles
+      WHERE contact_profile_id in (
+        SELECT contact_profile_id
+        FROM contacts
+        WHERE user_id = ? AND contact_id = ?
+      )
+    |]
+    (userId, contactId)
+
 updateUserProfile :: StoreMonad m => SQLiteStore -> User -> Profile -> m ()
 updateUserProfile st User {userId, userContactId, localDisplayName, profile = Profile {displayName}} p'@Profile {displayName = newName}
   | displayName == newName =
@@ -687,8 +704,8 @@ createOrUpdateContactRequest_ db userId userContactLinkId invId Profile {display
         createContactRequest_ currentTs ldn = do
           DB.execute
             db
-            "INSERT INTO contact_profiles (display_name, full_name, image, created_at, updated_at) VALUES (?,?,?,?,?)"
-            (displayName, fullName, image, currentTs, currentTs)
+            "INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+            (displayName, fullName, image, userId, currentTs, currentTs)
           profileId <- insertedRowId db
           DB.execute
             db
@@ -802,6 +819,17 @@ getContactRequestIdByName st userId cName =
 deleteContactRequest :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> m ()
 deleteContactRequest st userId contactRequestId =
   liftIO . withTransaction st $ \db -> do
+    DB.execute
+      db
+      [sql|
+        DELETE FROM contact_profiles
+        WHERE contact_profile_id in (
+          SELECT contact_profile_id
+          FROM contact_requests
+          WHERE user_id = ? AND contact_request_id = ?
+        )
+      |]
+      (userId, contactRequestId)
     DB.execute
       db
       [sql|
@@ -1073,6 +1101,7 @@ mergeContactRecords st userId Contact {contactId = toContactId} Contact {contact
         ":user_id" := userId,
         ":updated_at" := currentTs
       ]
+    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)
 
@@ -1275,8 +1304,8 @@ createNewGroup st gVar user groupProfile =
       (displayName, displayName, uId, currentTs, currentTs)
     DB.execute
       db
-      "INSERT INTO group_profiles (display_name, full_name, image, created_at, updated_at) VALUES (?,?,?,?,?)"
-      (displayName, fullName, image, currentTs, currentTs)
+      "INSERT INTO group_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+      (displayName, fullName, image, uId, currentTs, currentTs)
     profileId <- insertedRowId db
     DB.execute
       db
@@ -1308,8 +1337,8 @@ createGroupInvitation st user@User {userId} contact@Contact {contactId} GroupInv
         currentTs <- getCurrentTime
         DB.execute
           db
-          "INSERT INTO group_profiles (display_name, full_name, image, created_at, updated_at) VALUES (?,?,?,?,?)"
-          (displayName, fullName, image, currentTs, currentTs)
+          "INSERT INTO group_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+          (displayName, fullName, image, userId, currentTs, currentTs)
         profileId <- insertedRowId db
         DB.execute
           db
@@ -1343,8 +1372,18 @@ deleteGroup st User {userId} (Group GroupInfo {groupId, localDisplayName} member
   liftIO . withTransaction st $ \db -> do
     forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId m)
     DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
+    DB.execute
+      db
+      [sql|
+        DELETE FROM group_profiles
+        WHERE group_profile_id in (
+          SELECT group_profile_id
+          FROM groups
+          WHERE user_id = ? AND group_id = ?
+        )
+      |]
+      (userId, groupId)
     DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
-    -- TODO ? delete group profile
     DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
 
 getUserGroups :: MonadUnliftIO m => SQLiteStore -> User -> m [Group]
@@ -1497,8 +1536,8 @@ createNewGroupMember st user@User {userId} gInfo memInfo@(MemberInfo _ _ Profile
       currentTs <- getCurrentTime
       DB.execute
         db
-        "INSERT INTO contact_profiles (display_name, full_name, image, created_at, updated_at) VALUES (?,?,?,?,?)"
-        (displayName, fullName, image, currentTs, currentTs)
+        "INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+        (displayName, fullName, image, userId, currentTs, currentTs)
       memProfileId <- insertedRowId db
       let newMember =
             NewGroupMember