From 9bf78214449b5dd2b63b8fd0dc2fce2733216d5e Mon Sep 17 00:00:00 2001
From: JRoberts <8711996+jr-simplex@users.noreply.github.com>
Date: Sat, 14 May 2022 21:00:46 +0400
Subject: [PATCH] core: delete profiles (#654)

---
 simplex-chat.cabal                            |  1 +
 .../Migrations/M20220514_profiles_user_id.hs  | 26 +++++++
 src/Simplex/Chat/Migrations/chat_schema.sql   |  4 +-
 src/Simplex/Chat/Store.hs                     | 67 +++++++++++++++----
 4 files changed, 82 insertions(+), 16 deletions(-)
 create mode 100644 src/Simplex/Chat/Migrations/M20220514_profiles_user_id.hs

diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 3039ea3ad5..b66ca61ca2 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -37,6 +37,7 @@ library
       Simplex.Chat.Migrations.M20220304_msg_quotes
       Simplex.Chat.Migrations.M20220321_chat_item_edited
       Simplex.Chat.Migrations.M20220404_files_status_fields
+      Simplex.Chat.Migrations.M20220514_profiles_user_id
       Simplex.Chat.Mobile
       Simplex.Chat.Options
       Simplex.Chat.Protocol
diff --git a/src/Simplex/Chat/Migrations/M20220514_profiles_user_id.hs b/src/Simplex/Chat/Migrations/M20220514_profiles_user_id.hs
new file mode 100644
index 0000000000..239f124576
--- /dev/null
+++ b/src/Simplex/Chat/Migrations/M20220514_profiles_user_id.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20220514_profiles_user_id where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220514_profiles_user_id :: Query
+m20220514_profiles_user_id =
+  [sql|
+ALTER TABLE contact_profiles ADD COLUMN user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE;
+UPDATE contact_profiles SET user_id = (
+  SELECT user_id
+  FROM users
+  WHERE active_user = 1
+  LIMIT 1
+);
+
+ALTER TABLE group_profiles ADD COLUMN user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE;
+UPDATE group_profiles SET user_id = (
+  SELECT user_id
+  FROM users
+  WHERE active_user = 1
+  LIMIT 1
+);
+|]
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index 6e1b0ff732..f3fa1f3b48 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -8,7 +8,7 @@ CREATE TABLE contact_profiles ( -- remote user profile
   display_name TEXT NOT NULL, -- contact name set by remote user (not unique), this name must not contain spaces
   full_name TEXT NOT NULL,
   properties TEXT NOT NULL DEFAULT '{}' -- JSON with contact profile properties
-, created_at TEXT CHECK (created_at NOT NULL), updated_at TEXT CHECK (updated_at NOT NULL), image TEXT);
+, created_at TEXT CHECK (created_at NOT NULL), updated_at TEXT CHECK (updated_at NOT NULL), image TEXT, user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE);
 CREATE INDEX contact_profiles_index ON contact_profiles (display_name, full_name);
 CREATE TABLE users (
   user_id INTEGER PRIMARY KEY,
@@ -79,7 +79,7 @@ CREATE TABLE group_profiles ( -- shared group profiles
   display_name TEXT NOT NULL, -- this name must not contain spaces
   full_name TEXT NOT NULL,
   properties TEXT NOT NULL DEFAULT '{}' -- JSON with user or contact profile
-, created_at TEXT CHECK (created_at NOT NULL), updated_at TEXT CHECK (updated_at NOT NULL), image TEXT);
+, created_at TEXT CHECK (created_at NOT NULL), updated_at TEXT CHECK (updated_at NOT NULL), image TEXT, user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE);
 CREATE TABLE groups (
   group_id INTEGER PRIMARY KEY, -- local group ID
   user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index f60fbecb31..98a2e440de 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/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