core: fix connecting to prepared group incognito; test connecting to prepared contact incognito (#5994)

2026-05-03 01:06:16 +00:00 · 2025-06-17 14:20:47 +00:00
parent e3e9ae2ffd
commit 94d866e2c0
9 changed files with 181 additions and 55 deletions
@@ -688,10 +688,10 @@ data ChatResponse
  | 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}
+  | CRSentConfirmation {user :: User, connection :: PendingContactConnection, customUserProfile :: Maybe Profile}
  | CRSentInvitation {user :: User, connection :: PendingContactConnection, customUserProfile :: Maybe Profile}
-  | CRStartedConnectionToContact {user :: User, contact :: Contact}
-  | CRStartedConnectionToGroup {user :: User, groupInfo :: GroupInfo}
+  | CRStartedConnectionToContact {user :: User, contact :: Contact, customUserProfile :: Maybe Profile}
+  | CRStartedConnectionToGroup {user :: User, groupInfo :: GroupInfo, customUserProfile :: Maybe Profile}
  | CRSentInvitationToContact {user :: User, contact :: Contact, customUserProfile :: Maybe Profile}
  | CRItemsReadForChat {user :: User, chatInfo :: AChatInfo}
  | CRContactDeleted {user :: User, contact :: Contact}
@@ -1763,7 +1763,7 @@ processChatCommand' vr = \case
      Nothing -> throwCmdError "contact doesn't have link to connect"
      Just (ACCL SCMInvitation ccLink) ->
        connectViaInvitation user incognito ccLink (Just contactId) >>= \case
-          CRSentConfirmation {} -> do
+          CRSentConfirmation {customUserProfile} -> do
            -- get updated contact with connection
            ct' <- withFastStore $ \db -> getContact db vr user contactId
            forM_ msgContent_ $ \mc -> do
@@ -1771,16 +1771,16 @@ processChatCommand' vr = \case
              (msg, _) <- sendDirectContactMessage user ct' evt
              ci <- saveSndChatItem user (CDDirectSnd ct') msg (CISndMsgContent mc)
              toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci]
-            pure $ CRStartedConnectionToContact user ct'
+            pure $ CRStartedConnectionToContact user ct' customUserProfile
          cr -> pure cr
      Just (ACCL SCMContact ccLink) ->
-        connectViaContact user incognito ccLink msgContent_ (Just $ CGMContactId contactId) >>= \case
-          CRSentInvitation {} -> do
+        connectViaContact user incognito ccLink msgContent_ (Just $ ACCGContact contactId) >>= \case
+          CRSentInvitation {customUserProfile} -> do
            -- get updated contact with connection
            ct' <- withFastStore $ \db -> getContact db vr user contactId
            forM_ msgContent_ $ \mc ->
              createInternalChatItem user (CDDirectSnd ct') (CISndMsgContent mc) Nothing
-            pure $ CRStartedConnectionToContact user ct'
+            pure $ CRStartedConnectionToContact user ct' customUserProfile
          cr -> pure cr
  APIConnectPreparedGroup groupId incognito -> withUser $ \user -> do
    (gInfo, hostMember) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getHostMember db vr user groupId
@@ -1788,12 +1788,11 @@ processChatCommand' vr = \case
    case connLinkToConnect of
      Nothing -> throwCmdError "group doesn't have link to connect"
      Just ccLink ->
-        connectViaContact user incognito ccLink Nothing (Just $ CGMGroupMemberId (groupMemberId' hostMember)) >>= \case
-          CRSentInvitation {connection = PendingContactConnection {pccConnId}} -> do
-            gInfo' <- withStore' $ \db -> do
-              setViaGroupLinkHash db groupId pccConnId
-              setGroupConnLinkStartedConnection db gInfo True
-            pure $ CRStartedConnectionToGroup user gInfo'
+        connectViaContact user incognito ccLink Nothing (Just $ ACCGGroup gInfo (groupMemberId' hostMember)) >>= \case
+          CRSentInvitation {customUserProfile} -> do
+            -- get updated group info (connLinkStartedConnection and incognito membership)
+            gInfo' <- withFastStore $ \db -> getGroupInfo db vr user groupId
+            pure $ CRStartedConnectionToGroup user gInfo' customUserProfile
          cr -> pure cr
  APIConnect userId incognito (Just (ACCL SCMInvitation ccLink)) mc_ -> withUserId userId $ \user -> do
    when (isJust mc_) $ throwChatError CEConnReqMessageProhibited
@@ -2874,13 +2873,13 @@ processChatCommand' vr = \case
                (sqSecured, _serviceId) <- withAgent $ \a -> joinConnection a (aUserId user) connId True cReq dm pqSup' subMode
                let newStatus = if sqSecured then ConnSndReady else ConnJoined
                withFastStore' $ \db -> updateConnectionStatusFromTo db pccConnId ConnPrepared newStatus
-                pure $ CRSentConfirmation user pcc {pccConnStatus = newStatus}
+                pure $ CRSentConfirmation user pcc {pccConnStatus = newStatus} incognitoProfile
              cReqs =
                ( CRInvitationUri crData {crScheme = SSSimplex} e2e,
                  CRInvitationUri crData {crScheme = simplexChat} e2e
                )
-    connectViaContact :: User -> IncognitoEnabled -> CreatedLinkContact -> Maybe MsgContent -> Maybe ContactOrGroupMemberId -> CM ChatResponse
-    connectViaContact user@User {userId} incognito (CCLink cReq@(CRContactUri ConnReqUriData {crClientData}) sLnk) mc_ comId_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
+    connectViaContact :: User -> IncognitoEnabled -> CreatedLinkContact -> Maybe MsgContent -> Maybe AttachConnToContactOrGroup -> CM ChatResponse
+    connectViaContact user@User {userId} incognito (CCLink cReq@(CRContactUri ConnReqUriData {crClientData}) sLnk) mc_ attachConnTo_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
      let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
          cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
      case groupLinkId of
@@ -2912,7 +2911,7 @@ processChatCommand' vr = \case
          incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
          subMode <- chatReadVar subscriptionMode
          let sLnk' = serverShortLink <$> sLnk
-          conn@PendingContactConnection {pccConnId} <- withFastStore' $ \db -> createConnReqConnection db userId connId cReqHash sLnk' comId_ xContactId incognitoProfile groupLinkId subMode chatV pqSup
+          conn@PendingContactConnection {pccConnId} <- withFastStore' $ \db -> createConnReqConnection db userId connId cReqHash sLnk' attachConnTo_ xContactId incognitoProfile groupLinkId subMode chatV pqSup
          joinContact user pccConnId connId cReq incognitoProfile xContactId mc_ inGroup pqSup chatV
          pure $ CRSentInvitation user conn incognitoProfile
    connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse
@@ -3314,7 +3313,7 @@ processChatCommand' vr = \case
                (cReq, cData) <- getShortLinkConnReq user l'
                let cl = ACCL SCMContact $ CCLink cReq (Just l')
                withFastStore' (\db -> getContactWithoutConnViaShortAddress db vr user l') >>= \case
-                  Just ct -> pure (cl, CPContactAddress (CAPContactViaAddress ct))
+                  Just ct' -> pure (cl, CPContactAddress (CAPContactViaAddress ct'))
                  Nothing -> do
                    let contactSLinkData_ = J.decodeStrict $ linkUserData' cData
                    plan <- contactRequestPlan user cReq contactSLinkData_
@@ -153,13 +153,13 @@ deletePendingContactConnection db userId connId =

 createAddressContactConnection :: DB.Connection -> VersionRangeChat -> User -> Contact -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO (Int64, Contact)
 createAddressContactConnection db vr user@User {userId} Contact {contactId} acId cReqHash sLnk xContactId incognitoProfile subMode chatV pqSup = do
-  PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash sLnk (Just $ CGMContactId contactId) xContactId incognitoProfile Nothing subMode chatV pqSup
+  PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash sLnk (Just $ ACCGContact contactId) xContactId incognitoProfile Nothing subMode chatV pqSup
  (pccConnId,) <$> getContact db vr user contactId

-createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> Maybe ContactOrGroupMemberId -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
-createConnReqConnection db userId acId cReqHash sLnk comId_ xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
-  createdAt <- getCurrentTime
-  customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
+createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> Maybe AttachConnToContactOrGroup -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
+createConnReqConnection db userId acId cReqHash sLnk attachConnTo_ xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
+  currentTs <- getCurrentTime
+  customUserProfileId <- mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile
  let pccConnStatus = ConnJoined
  DB.execute
    db
@@ -174,15 +174,29 @@ createConnReqConnection db userId acId cReqHash sLnk comId_ xContactId incognito
    ( (userId, acId, pccConnStatus, connType, BI True)
        :. (cReqHash, sLnk, contactId_, groupMemberId_)
        :. (xContactId, customUserProfileId, BI (isJust groupLinkId), groupLinkId)
-        :. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
+        :. (currentTs, currentTs, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
    )
  pccConnId <- insertedRowId db
-  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connLinkInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
+  case attachConnTo_ of
+    Just (ACCGGroup gInfo _gmId) -> updatePreparedGroup gInfo pccConnId customUserProfileId currentTs
+    _ -> pure ()
+  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connLinkInv = Nothing, localAlias = "", createdAt = currentTs, updatedAt = currentTs}
  where
-    (connType, contactId_, groupMemberId_) = case comId_ of
-      Just (CGMContactId ctId) -> (ConnContact, Just ctId, Nothing)
-      Just (CGMGroupMemberId gmId) -> (ConnMember, Nothing, Just gmId)
+    (connType, contactId_, groupMemberId_) = case attachConnTo_ of
+      Just (ACCGContact ctId) -> (ConnContact, Just ctId, Nothing)
+      Just (ACCGGroup _gInfo gmId) -> (ConnMember, Nothing, Just gmId)
      Nothing -> (ConnContact, Nothing, Nothing)
+    updatePreparedGroup GroupInfo {groupId, membership} pccConnId customUserProfileId currentTs = do
+      setViaGroupLinkHash db groupId pccConnId
+      DB.execute
+        db
+        "UPDATE groups SET conn_link_started_connection = ?, updated_at = ? WHERE group_id = ?"
+        (BI True, currentTs, groupId)
+      when (isJust customUserProfileId) $
+        DB.execute
+          db
+          "UPDATE group_members SET member_profile_id = ?, updated_at = ? WHERE group_member_id = ?"
+          (customUserProfileId, currentTs, groupMemberId' membership)

 getConnReqContactXContactId :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
 getConnReqContactXContactId db vr user@User {userId} cReqHash = do
@@ -37,12 +37,10 @@ module Simplex.Chat.Store.Groups
    deleteContactCardKeepConn,
    createPreparedGroup,
    updatePreparedGroupUser,
-    setGroupConnLinkStartedConnection,
    updatePreparedUserAndHostMembersInvited,
    updatePreparedUserAndHostMembersRejected,
    createGroupInvitedViaLink,
    createGroupRejectedViaLink,
-    setViaGroupLinkHash,
    setGroupInvitationChatItemId,
    getGroup,
    getGroupInfo,
@@ -672,15 +670,6 @@ updatePreparedGroupUser db vr user gInfo@GroupInfo {groupId, membership} hostMem
              (newUserId, currentTs, hostProfileId)
            safeDeleteLDN db user oldHostLDN

-setGroupConnLinkStartedConnection :: DB.Connection -> GroupInfo -> Bool -> IO GroupInfo
-setGroupConnLinkStartedConnection db groupInfo@GroupInfo {groupId} connLinkStartedConnection = do
-  currentTs <- getCurrentTime
-  DB.execute
-    db
-    "UPDATE groups SET conn_link_started_connection = ?, updated_at = ? WHERE group_id = ?"
-    (BI connLinkStartedConnection, currentTs, groupId)
-  pure groupInfo {connLinkStartedConnection = connLinkStartedConnection}
-
 updatePreparedUserAndHostMembersInvited :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
 updatePreparedUserAndHostMembersInvited db vr user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted} = do
  let fromMemberProfile = profileFromName fromMemberName
@@ -815,17 +804,6 @@ createGroup_ db userId groupProfile connLinkToConnect business currentTs = Excep
      groupId <- insertedRowId db
      pure (groupId, localDisplayName)

-setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
-setViaGroupLinkHash db groupId connId =
-  DB.execute
-    db
-    [sql|
-      UPDATE groups
-      SET via_group_link_uri_hash = (SELECT via_contact_uri_hash FROM connections WHERE connection_id = ?)
-      WHERE group_id = ?
-    |]
-    (connId, groupId)
-
 setGroupInvitationChatItemId :: DB.Connection -> User -> GroupId -> ChatItemId -> IO ()
 setGroupInvitationChatItemId db User {userId} groupId chatItemId = do
  currentTs <- getCurrentTime
@@ -6132,6 +6132,10 @@ Query: UPDATE group_members SET member_id = ?, member_role = ? WHERE group_membe
 Plan:
 SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)

+Query: UPDATE group_members SET member_profile_id = ?, updated_at = ? WHERE group_member_id = ?
+Plan:
+SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?
 Plan:
 SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
@@ -728,3 +728,14 @@ addGroupChatTags :: DB.Connection -> GroupInfo -> IO GroupInfo
 addGroupChatTags db g@GroupInfo {groupId} = do
  chatTags <- getGroupChatTags db groupId
  pure (g :: GroupInfo) {chatTags}
+
+setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
+setViaGroupLinkHash db groupId connId =
+  DB.execute
+    db
+    [sql|
+      UPDATE groups
+      SET via_group_link_uri_hash = (SELECT via_contact_uri_hash FROM connections WHERE connection_id = ?)
+      WHERE group_id = ?
+    |]
+    (connId, groupId)
@@ -459,7 +459,7 @@ data GroupSummary = GroupSummary

 data ContactOrGroup = CGContact Contact | CGGroup GroupInfo [GroupMember]

-data ContactOrGroupMemberId = CGMContactId ContactId | CGMGroupMemberId GroupMemberId
+data AttachConnToContactOrGroup = ACCGContact ContactId | ACCGGroup GroupInfo GroupMemberId

 contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
 contactAndGroupIds = \case
@@ -194,10 +194,10 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
  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!"]
+  CRSentConfirmation u _ _customUserProfile -> ttyUser u ["confirmation sent!"]
  CRSentInvitation u _ customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
-  CRStartedConnectionToContact u c -> ttyUser u [ttyContact' c <> ": connection started"]
-  CRStartedConnectionToGroup u g -> ttyUser u [ttyGroup' g <> ": connection started"]
+  CRStartedConnectionToContact u c customUserProfile -> ttyUser u $ viewStartedConnectionToContact c customUserProfile testView
+  CRStartedConnectionToGroup u g customUserProfile -> ttyUser u $ viewStartedConnectionToGroup g customUserProfile testView
  CRSentInvitationToContact u _c customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
  CRItemsReadForChat u _chatId -> ttyUser u ["items read for chat"]
  CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
@@ -1123,6 +1123,28 @@ viewSentInvitation incognitoProfile testView =
        message = ["connection request sent incognito!"]
    Nothing -> ["connection request sent!"]

+viewStartedConnectionToContact :: Contact -> Maybe Profile -> Bool -> [StyledString]
+viewStartedConnectionToContact ct incognitoProfile testView =
+  case incognitoProfile of
+    Just profile ->
+      if testView
+        then incognitoProfile' profile : message
+        else message
+      where
+        message = [ttyContact' ct <> ": connection started incognito"]
+    Nothing -> [ttyContact' ct <> ": connection started"]
+
+viewStartedConnectionToGroup :: GroupInfo -> Maybe Profile -> Bool -> [StyledString]
+viewStartedConnectionToGroup g incognitoProfile testView =
+  case incognitoProfile of
+    Just profile ->
+      if testView
+        then incognitoProfile' profile : message
+        else message
+      where
+        message = [ttyGroup' g <> ": connection started incognito"]
+    Nothing -> [ttyGroup' g <> ": connection started"]
+
 viewAcceptingContactRequest :: Contact -> [StyledString]
 viewAcceptingContactRequest ct
  | contactReady ct = [ttyFullContact ct <> ": accepting contact request, you can send messages to contact"]