core: change user for prepared contact or group (#5985)

src/Simplex/Chat/Controller.hs

@@ -450,8 +450,8 @@ data ChatCommand
   | APIConnectPlan UserId AConnectionLink
   | APIPrepareContact UserId ACreatedConnLink ContactShortLinkData
   | APIPrepareGroup UserId ACreatedConnLink GroupShortLinkData
-  | APIChangeContactUser ContactId UserId
-  | APIChangeGroupUser GroupId UserId
+  | APIChangePreparedContactUser ContactId UserId
+  | APIChangePreparedGroupUser GroupId UserId
   | APIConnectPreparedContact {contactId :: ContactId, incognito :: IncognitoEnabled, msgContent_ :: Maybe MsgContent}
   | APIConnectPreparedGroup GroupId IncognitoEnabled
   | APIConnect UserId IncognitoEnabled (Maybe ACreatedConnLink) (Maybe MsgContent)
@@ -685,6 +685,8 @@ data ChatResponse
   | CRConnectionPlan {user :: User, connLink :: ACreatedConnLink, connectionPlan :: ConnectionPlan}
   | CRNewPreparedContact {user :: User, contact :: Contact}
   | CRNewPreparedGroup {user :: User, groupInfo :: GroupInfo}
+  | CRContactUserChanged {user :: User, fromContact :: Contact, newUser :: User, toContact :: Contact}
+  | CRGroupUserChanged {user :: User, fromGroup :: GroupInfo, newUser :: User, toGroup :: GroupInfo}
   | CRSentConfirmation {user :: User, connection :: PendingContactConnection}
   | CRSentInvitation {user :: User, connection :: PendingContactConnection, customUserProfile :: Maybe Profile}
   | CRStartedConnectionToContact {user :: User, contact :: Contact}

src/Simplex/Chat/Library/Commands.hs

@@ -1760,13 +1760,21 @@ processChatCommand' vr = \case
     let GroupShortLinkData {groupProfile} = groupSLinkData
     gInfo <- withStore $ \db -> createPreparedGroup db vr user groupProfile accLink
     pure $ CRNewPreparedGroup user gInfo
-  -- TODO [short links] change prepared entity user
-  -- TODO  - UI would call these APIs before APIConnectPrepared... APIs
-  -- TODO  - UI to transition to new user keeping chat opened
-  APIChangeContactUser _contactId _newUserId -> withUser $ \_user -> do
-    ok_
-  APIChangeGroupUser _groupId _newUserId -> withUser $ \_user -> do
-    ok_
+  APIChangePreparedContactUser contactId newUserId -> withUser $ \user -> do
+    ct@Contact {connLinkToConnect} <- withFastStore $ \db -> getContact db vr user contactId
+    when (isNothing connLinkToConnect) $ throwCmdError "contact doesn't have link to connect"
+    when (isJust $ contactConn ct) $ throwCmdError "contact already has connection"
+    newUser <- privateGetUser newUserId
+    ct' <- withFastStore $ \db -> updatePreparedContactUser db vr user ct newUser
+    pure $ CRContactUserChanged user ct newUser ct'
+  APIChangePreparedGroupUser groupId newUserId -> withUser $ \user -> do
+    (gInfo, hostMember) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getHostMember db vr user groupId
+    let GroupInfo {connLinkToConnect} = gInfo
+    when (isNothing connLinkToConnect) $ throwCmdError "group doesn't have link to connect"
+    when (isJust $ memberConn hostMember) $ throwCmdError "host member already has connection"
+    newUser <- privateGetUser newUserId
+    gInfo' <- withFastStore $ \db -> updatePreparedGroupUser db vr user gInfo hostMember newUser
+    pure $ CRGroupUserChanged user gInfo newUser gInfo'
   APIConnectPreparedContact contactId incognito msgContent_ -> withUser $ \user -> do
     Contact {connLinkToConnect} <- withFastStore $ \db -> getContact db vr user contactId
     case connLinkToConnect of
@@ -4424,8 +4432,8 @@ chatCommandP =
       "/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> strP),
       "/_prepare contact " *> (APIPrepareContact <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP),
       "/_prepare group " *> (APIPrepareGroup <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP),
-      "/_set contact user @" *> (APIChangeContactUser <$> A.decimal <* A.space <*> A.decimal),
-      "/_set group user #" *> (APIChangeGroupUser <$> A.decimal <* A.space <*> A.decimal),
+      "/_set contact user @" *> (APIChangePreparedContactUser <$> A.decimal <* A.space <*> A.decimal),
+      "/_set group user #" *> (APIChangePreparedGroupUser <$> A.decimal <* A.space <*> A.decimal),
       "/_connect contact @" *> (APIConnectPreparedContact <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)),
       "/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP),
       "/_connect " *> (APIAddContact <$> A.decimal <*> shortOnOffP <*> incognitoOnOffP),

src/Simplex/Chat/Store/Direct.hs

@@ -31,6 +31,7 @@ module Simplex.Chat.Store.Direct
     getConnReqContactXContactId,
     getContactByConnReqHash,
     createPreparedContact,
+    updatePreparedContactUser,
     createDirectContact,
     deleteContactConnections,
     deleteContactFiles,
@@ -281,6 +282,35 @@ createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToCo
         customData = Nothing
       }
 
+updatePreparedContactUser :: DB.Connection -> VersionRangeChat -> User -> Contact -> User -> ExceptT StoreError IO Contact
+updatePreparedContactUser
+  db
+  vr
+  user
+  Contact {contactId, localDisplayName = oldLDN, profile = LocalProfile {profileId, displayName}}
+  newUser@User {userId = newUserId} = do
+    ExceptT . withLocalDisplayName db newUserId displayName $ \newLDN -> runExceptT $ do
+      liftIO $ do
+        currentTs <- getCurrentTime
+        DB.execute
+          db
+          [sql|
+            UPDATE contacts
+            SET user_id = ?, local_display_name = ?, updated_at = ?
+            WHERE contact_id = ?
+          |]
+          (newUserId, newLDN, currentTs, contactId)
+        DB.execute
+          db
+          [sql|
+            UPDATE contact_profiles
+            SET user_id = ?, updated_at = ?
+            WHERE contact_profile_id = ?
+          |]
+          (newUserId, currentTs, profileId)
+        safeDeleteLDN db user oldLDN
+      getContact db vr newUser contactId
+
 createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
 createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
   currentTs <- liftIO getCurrentTime

src/Simplex/Chat/Store/Groups.hs

@@ -36,6 +36,7 @@ module Simplex.Chat.Store.Groups
     createGroupInvitation,
     deleteContactCardKeepConn,
     createPreparedGroup,
+    updatePreparedGroupUser,
     setGroupConnLinkStartedConnection,
     updatePreparedUserAndHostMembersInvited,
     updatePreparedUserAndHostMembersRejected,
@@ -607,6 +608,70 @@ createPreparedGroup db vr user@User {userId, userContactId} groupProfile connLin
           )
         insertedRowId db
 
+updatePreparedGroupUser :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> User -> ExceptT StoreError IO GroupInfo
+updatePreparedGroupUser db vr user gInfo@GroupInfo {groupId, membership} hostMember newUser@User {userId = newUserId} = do
+  currentTs <- liftIO getCurrentTime
+  updateGroup gInfo currentTs
+  liftIO $ updateMembership membership currentTs
+  updateHostMember hostMember currentTs
+  getGroupInfo db vr newUser groupId
+  where
+    updateGroup GroupInfo {localDisplayName = oldGroupLDN, groupProfile = GroupProfile {displayName = groupDisplayName}} currentTs =
+      ExceptT . withLocalDisplayName db newUserId groupDisplayName $ \newGroupLDN -> runExceptT $ do
+        liftIO $ do
+          DB.execute
+            db
+            [sql|
+              UPDATE groups
+              SET user_id = ?, local_display_name = ?, updated_at = ?
+              WHERE group_id = ?
+            |]
+            (newUserId, newGroupLDN, currentTs, groupId)
+          DB.execute
+            db
+            [sql|
+              UPDATE group_profiles
+              SET user_id = ?, updated_at = ?
+              WHERE group_profile_id IN (SELECT group_profile_id FROM groups WHERE group_id = ?)
+            |]
+            (newUserId, currentTs, groupId)
+          safeDeleteLDN db user oldGroupLDN
+    updateMembership GroupMember {groupMemberId = membershipId} currentTs =
+      DB.execute
+        db
+        [sql|
+          UPDATE group_members
+          SET user_id = ?, local_display_name = ?, contact_id = ?, contact_profile_id = ?, updated_at = ?
+          WHERE group_member_id = ?
+        |]
+        (newUserId, localDisplayName' newUser, contactId' newUser, localProfileId $ profile' newUser, currentTs, membershipId)
+    updateHostMember
+      GroupMember
+        { groupMemberId = hostId,
+          localDisplayName = oldHostLDN,
+          memberProfile = LocalProfile {profileId = hostProfileId, displayName = hostDisplayName}
+        }
+      currentTs =
+        ExceptT . withLocalDisplayName db newUserId hostDisplayName $ \newHostLDN -> runExceptT $ do
+          liftIO $ do
+            DB.execute
+              db
+              [sql|
+                UPDATE group_members
+                SET user_id = ?, local_display_name = ?, updated_at = ?
+                WHERE group_member_id = ?
+              |]
+              (newUserId, newHostLDN, currentTs, hostId)
+            DB.execute
+              db
+              [sql|
+                UPDATE contact_profiles
+                SET user_id = ?, updated_at = ?
+                WHERE contact_profile_id = ?
+              |]
+              (newUserId, currentTs, hostProfileId)
+            safeDeleteLDN db user oldHostLDN
+
 setGroupConnLinkStartedConnection :: DB.Connection -> GroupInfo -> Bool -> IO GroupInfo
 setGroupConnLinkStartedConnection db groupInfo@GroupInfo {groupId} connLinkStartedConnection = do
   currentTs <- getCurrentTime

src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt

@@ -86,6 +86,14 @@ SEARCH gp USING INTEGER PRIMARY KEY (rowid=?)
 SEARCH mu USING INDEX idx_group_members_contact_id (contact_id=?)
 SEARCH pu USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+                UPDATE contact_profiles
+                SET user_id = ?, updated_at = ?
+                WHERE contact_profile_id = ?
+              
+Plan:
+SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: 
                 UPDATE contact_requests
                 SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ?
@@ -136,6 +144,14 @@ Query:
 Plan:
 SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+                UPDATE group_members
+                SET user_id = ?, local_display_name = ?, updated_at = ?
+                WHERE group_member_id = ?
+              
+Plan:
+SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: 
               INSERT INTO contact_requests
                 (user_contact_link_id, agent_invitation_id, peer_chat_min_version, peer_chat_max_version, contact_profile_id, local_display_name, user_id,
@@ -273,6 +289,24 @@ Query:
 Plan:
 SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+              UPDATE group_profiles
+              SET user_id = ?, updated_at = ?
+              WHERE group_profile_id IN (SELECT group_profile_id FROM groups WHERE group_id = ?)
+            
+Plan:
+SEARCH group_profiles USING INTEGER PRIMARY KEY (rowid=?)
+LIST SUBQUERY 1
+SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
+
+Query: 
+              UPDATE groups
+              SET user_id = ?, local_display_name = ?, updated_at = ?
+              WHERE group_id = ?
+            
+Plan:
+SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: 
               UPDATE xftp_file_descriptions
               SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?
@@ -660,6 +694,22 @@ Query:
 Plan:
 SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+            UPDATE contact_profiles
+            SET user_id = ?, updated_at = ?
+            WHERE contact_profile_id = ?
+          
+Plan:
+SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
+
+Query: 
+            UPDATE contacts
+            SET user_id = ?, local_display_name = ?, updated_at = ?
+            WHERE contact_id = ?
+          
+Plan:
+SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: 
             UPDATE group_members
             SET member_id = ?,
@@ -1348,6 +1398,14 @@ Query:
 Plan:
 SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+          UPDATE group_members
+          SET user_id = ?, local_display_name = ?, contact_id = ?, contact_profile_id = ?, updated_at = ?
+          WHERE group_member_id = ?
+        
+Plan:
+SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: 
           UPDATE group_profiles
           SET display_name = ?, full_name = ?, description = ?, image = ?, preferences = ?, member_admission = ?, updated_at = ?

src/Simplex/Chat/View.hs

@@ -192,6 +192,8 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
   CRConnectionPlan u connLink connectionPlan -> ttyUser u $ viewConnectionPlan cfg connLink connectionPlan
   CRNewPreparedContact u c -> ttyUser u  [ttyContact' c <> ": contact is prepared"]
   CRNewPreparedGroup u g -> ttyUser u [ttyGroup' g <> ": group is prepared"]
+  CRContactUserChanged u c nu c' -> ttyUser u $ viewContactUserChanged u c nu c'
+  CRGroupUserChanged u g nu g' -> ttyUser u $ viewGroupUserChanged u g nu g'
   CRSentConfirmation u _ -> ttyUser u ["confirmation sent!"]
   CRSentInvitation u _ customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
   CRStartedConnectionToContact u c -> ttyUser u [ttyContact' c <> ": connection started"]
@@ -1831,6 +1833,28 @@ viewConnectionUserChanged User {localDisplayName = n} PendingContactConnection {
       where
         cReqStr = strEncode $ simplexChatInvitation cReq
 
+viewContactUserChanged :: User -> Contact -> User -> Contact -> [StyledString]
+viewContactUserChanged
+  User {localDisplayName = un}
+  ct@Contact {localDisplayName = cn}
+  User {localDisplayName = un'}
+  Contact {localDisplayName = cn'}
+    | cn' /= cn = [userChangedStr <> ", new local name: " <> ttyContact cn']
+    | otherwise = [userChangedStr]
+  where
+    userChangedStr = "contact " <> ttyContact' ct <> " changed from user " <> plain un <> " to user " <> plain un'
+
+viewGroupUserChanged :: User -> GroupInfo -> User -> GroupInfo -> [StyledString]
+viewGroupUserChanged
+  User {localDisplayName = un}
+  g@GroupInfo {localDisplayName = gn}
+  User {localDisplayName = un'}
+  GroupInfo {localDisplayName = gn'}
+    | gn' /= gn = [userChangedStr <> ", new local name: " <> ttyGroup gn']
+    | otherwise = [userChangedStr]
+  where
+    userChangedStr = "group " <> ttyGroup' g <> " changed from user " <> plain un <> " to user " <> plain un'
+
 viewConnectionPlan :: ChatConfig -> ACreatedConnLink -> ConnectionPlan -> [StyledString]
 viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
   CPInvitationLink ilp -> case ilp of