core, ios: track "short link data set" state, interact with address accordingly (#5978)

2026-10-22 17:31:55 +00:00 · 2025-06-10 15:12:23 +00:00
1 parent 2bc4836338
commit 7f6bc30894
@@ -62,7 +62,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.AppVersion
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Stats (PresentedServersSummary)
-import Simplex.Chat.Store (AutoAccept, ChatLockEntity, StoreError (..), UserContactLink, GroupLinkInfo, UserMsgReceiptSettings)
+import Simplex.Chat.Store (AutoAccept, ChatLockEntity, GroupLink, GroupLinkInfo, StoreError (..), UserContactLink, UserMsgReceiptSettings)
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
@@ -723,8 +723,8 @@ data ChatResponse
  | CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
  | CRGroupProfile {user :: User, groupInfo :: GroupInfo}
  | CRGroupDescription {user :: User, groupInfo :: GroupInfo} -- only used in CLI
-  | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connLinkContact :: CreatedLinkContact, memberRole :: GroupMemberRole}
-  | CRGroupLink {user :: User, groupInfo :: GroupInfo, connLinkContact :: CreatedLinkContact, memberRole :: GroupMemberRole}
+  | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, groupLink :: GroupLink}
+  | CRGroupLink {user :: User, groupInfo :: GroupInfo, groupLink :: GroupLink}
  | CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
  | CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
  | CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
@@ -1144,19 +1144,17 @@ processChatCommand' vr = \case
      withFastStore' $ \db -> deleteNoteFolderCIs db user nf
      pure $ CRChatCleared user (AChatInfo SCTLocal $ LocalChat nf)
    _ -> throwCmdError "not supported"
-  -- TODO [short links] prohibit incognito if short link data is set for address
-  -- TODO  - add user_contact_links.short_link_data_set; UserContactLink.shortLinkDataSet
-  -- TODO  - same for auto-accept:
-  -- TODO    - set incognito to false on setting short link data
-  -- TODO    - ignore on accept (for foolproofing)
-  -- TODO    - hide in UI
-  APIAcceptContact incognito connReqId -> withUser $ \_ -> do
-    userContactLinkId <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId
-    withUserContactLock "acceptContact" userContactLinkId $ do
-      (user@User {userId}, cReq) <- withFastStore $ \db -> getContactRequest' db connReqId
+  APIAcceptContact incognito connReqId -> withUser $ \user@User {userId} -> do
+    (uclId, (ucl, gLinkInfo_)) <- withFastStore $ \db -> do
+      uclId <- getUserContactLinkIdByCReq db connReqId
+      uclGLinkInfo <- getUserContactLinkById db userId uclId
+      pure (uclId, uclGLinkInfo)
+    let UserContactLink {shortLinkDataSet} = ucl
+    when (shortLinkDataSet && incognito) $ throwCmdError "incognito not allowed for address with short link data"
+    withUserContactLock "acceptContact" uclId $ do
+      cReq <- withFastStore $ \db -> getContactRequest db user connReqId
      (ct, conn@Connection {connId}, sqSecured) <- acceptContactRequest user cReq incognito
-      ucl <- withFastStore $ \db -> getUserContactLinkById db userId userContactLinkId
-      let contactUsed = (\(_, gLinkInfo_) -> isNothing gLinkInfo_) ucl
+      let contactUsed = isNothing gLinkInfo_
      ct' <- withStore' $ \db -> do
        deleteContactRequestRec db user cReq
        updateContactAccepted db user ct contactUsed
@@ -1764,9 +1762,9 @@ processChatCommand' vr = \case
  -- 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
+  APIChangeContactUser _contactId _newUserId -> withUser $ \_user -> do
    ok_
-  APIChangeGroupUser groupId newUserId -> withUser $ \user -> do
+  APIChangeGroupUser _groupId _newUserId -> withUser $ \_user -> do
    ok_
  APIConnectPreparedContact contactId incognito msgContent_ -> withUser $ \user -> do
    Contact {connLinkToConnect} <- withFastStore $ \db -> getContact db vr user contactId
@@ -1837,37 +1835,13 @@ processChatCommand' vr = \case
    processChatCommand $ APIListContacts userId
  APICreateMyAddress userId short -> withUserId userId $ \user -> procCmd $ do
    subMode <- chatReadVar subscriptionMode
-    -- TODO [short links] incognito interaction with contact address
-    -- TODO  - problems:
-    -- TODO    1 now that user profile is advertised in short link, giving an option to
-    -- TODO      share incognito profile on accept doesn't make sense.
-    -- TODO    2 even advertising a random incognito profile in short link is somewhat broken,
-    -- TODO      as it would be the same for all connecting clients, but then changed on accept (in current implementation),
-    -- TODO      so it would be clear it's incognito profile; it might as well be clearly a placeholder
-    -- TODO      (e.g. "Hidden profile" in profile name), and to avoid distinguishing incognito and main profiles,
-    -- TODO      it can be a setting that can be set for main profile too.
-    -- TODO    3 changing short link data from main to incognito profile also defeats the purpose of incognito profile,
-    -- TODO      as by scanning the short link in the past, connecting clients may know main profile (even if it's
-    -- TODO      currently set as incognito).
-    -- TODO  - some possibilities:
-    -- TODO    1 always base choice on autoAccept -> acceptIncognito choice, don't give option on user accept action
-    -- TODO    2 in this case, replace short link user data on change of this setting? (doesn't solve problem 3)
-    -- TODO    3 give setting to include "Hidden profile" in short link, even if autoAccept is not set to incognito
-    -- TODO    4 share same random profile on each accept, this way connecting clients technically
-    -- TODO      wouldn't be able to distinguish incognito profile (placeholder problem);
-    -- TODO    5 only give choice to accept with main or incognito profile if random profile or placeholder is shared
-    -- TODO      in short link user data; if main profile is shared, don't give choice
-    -- TODO    6 don't allow to change from main profile in short link to "Hidden profile" (or incognito autoAccept),
-    -- TODO      only allow to change vice versa, in one direction (solves problem 3)
-    -- TODO    7 remove incognito functionality from address altogether
-    -- TODO  - it seems measures 3, 5, 6 are the most reasonable, or removing incognito functionality for addresses altogether
    let userData =
          if short
            then Just $ encodeShortLinkData (ContactShortLinkData (userProfileToSend user Nothing Nothing False) Nothing)
            else Nothing
    (connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData Nothing IKPQOn subMode
    ccLink' <- shortenCreatedLink ccLink
-    withFastStore $ \db -> createUserContactLink db user connId ccLink' subMode
+    withFastStore $ \db -> createUserContactLink db user connId ccLink' short subMode
    pure $ CRUserContactLinkCreated user ccLink'
  CreateMyAddress short -> withUser $ \User {userId} ->
    processChatCommand $ APICreateMyAddress userId short
@@ -1889,10 +1863,8 @@ processChatCommand' vr = \case
  ShowMyAddress -> withUser' $ \User {userId} ->
    processChatCommand $ APIShowMyAddress userId
  APIAddMyAddressShortLink userId -> withUserId' userId $ \user -> do
-    (ucl@UserContactLink {connLinkContact = CCLink connFullLink sLnk_, autoAccept}, conn) <-
+    (ucl@UserContactLink {connLinkContact = CCLink connFullLink _sLnk_, autoAccept}, conn) <-
      withFastStore $ \db -> (,) <$> getUserAddress db user <*> getUserAddressConnection db vr user
-    when (isJust sLnk_) $ throwCmdError "address already has short link"
-    -- TODO [short links] allow to add short link without data if autoAccept was set to incognito?
    let shortLinkProfile = userProfileToSend user Nothing Nothing False
        shortLinkMsg = autoAccept >>= autoReply >>= (Just . msgContentText)
        userData = encodeShortLinkData (ContactShortLinkData shortLinkProfile shortLinkMsg)
@@ -1900,7 +1872,8 @@ processChatCommand' vr = \case
    case entityId conn of
      Just uclId -> do
        withFastStore' $ \db -> setUserContactLinkShortLink db uclId sLnk
-        let ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk)}
+        let autoAccept' = autoAccept >>= \aa -> Just aa {acceptIncognito = False}
+            ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, autoAccept = autoAccept'}
        pure $ CRUserContactLink user ucl'
      Nothing -> throwChatError $ CEException "no user contact link id"
  APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
@@ -1915,7 +1888,9 @@ processChatCommand' vr = \case
    processChatCommand $ APISetProfileAddress userId onOff
  APIAddressAutoAccept userId autoAccept_ -> withUserId userId $ \user -> do
    -- TODO [short links] update adress short link data if message changed
-    forM_ autoAccept_ $ \AutoAccept {businessAddress, acceptIncognito} ->
+    UserContactLink {shortLinkDataSet} <- withFastStore (`getUserAddress` user)
+    forM_ autoAccept_ $ \AutoAccept {businessAddress, acceptIncognito} -> do
+      when (shortLinkDataSet && acceptIncognito) $ throwCmdError "incognito not allowed for address with short link data"
      when (businessAddress && acceptIncognito) $ throwCmdError "requests to business address cannot be accepted incognito"
    contactLink <- withFastStore (\db -> updateUserAddressAutoAccept db user autoAccept_)
    pure $ CRUserContactLinkUpdated user contactLink
@@ -2482,37 +2457,39 @@ processChatCommand' vr = \case
        crClientData = encodeJSON $ CRDataGroup groupLinkId
    (connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData (Just crClientData) IKPQOff subMode
    ccLink' <- createdGroupLink <$> shortenCreatedLink ccLink
-    withFastStore $ \db -> createGroupLink db user gInfo connId ccLink' groupLinkId mRole subMode
-    pure $ CRGroupLinkCreated user gInfo ccLink' mRole
+    gLink <- withFastStore $ \db -> createGroupLink db user gInfo connId ccLink' groupLinkId mRole short subMode
+    pure $ CRGroupLinkCreated user gInfo gLink
  APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withGroupLock "groupLinkMemberRole" groupId $ do
    gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
-    (groupLinkId, groupLink, _, mRole) <- withFastStore $ \db -> getGroupLink db user gInfo
+    gLnk@GroupLink {acceptMemberRole} <- withFastStore $ \db -> getGroupLink db user gInfo
    assertUserGroupRole gInfo GRAdmin
    when (mRole' > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole'
-    when (mRole' /= mRole) $ withFastStore' $ \db -> setGroupLinkMemberRole db user groupLinkId mRole'
-    pure $ CRGroupLink user gInfo groupLink mRole'
+    gLnk' <-
+      if mRole' /= acceptMemberRole
+        then withFastStore' $ \db -> setGroupLinkMemberRole db user gLnk mRole'
+        else pure gLnk
+    pure $ CRGroupLink user gInfo gLnk'
  APIDeleteGroupLink groupId -> withUser $ \user -> withGroupLock "deleteGroupLink" groupId $ do
    gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
    deleteGroupLink' user gInfo
    pure $ CRGroupLinkDeleted user gInfo
  APIGetGroupLink groupId -> withUser $ \user -> do
    gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
-    (_, groupLink, _, mRole) <- withFastStore $ \db -> getGroupLink db user gInfo
-    pure $ CRGroupLink user gInfo groupLink mRole
+    gLnk <- withFastStore $ \db -> getGroupLink db user gInfo
+    pure $ CRGroupLink user gInfo gLnk
  APIAddGroupShortLink groupId -> withUser $ \user -> do
-    (gInfo, (uclId, _gLink@(CCLink connFullLink sLnk_), gLinkId, mRole), conn) <- withFastStore $ \db -> do
+    (gInfo, gLink, conn) <- withFastStore $ \db -> do
      gInfo <- getGroupInfo db vr user groupId
      gLink <- getGroupLink db user gInfo
      conn <- getGroupLinkConnection db vr user gInfo
      pure (gInfo, gLink, conn)
-    when (isJust sLnk_) $ throwCmdError "group link already has short link"
    let GroupInfo {groupProfile} = gInfo
        userData = encodeShortLinkData (GroupShortLinkData groupProfile)
-        crClientData = encodeJSON $ CRDataGroup gLinkId
+        GroupLink {groupLinkId} = gLink
+        crClientData = encodeJSON $ CRDataGroup groupLinkId
    sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData (Just crClientData))
-    withFastStore' $ \db -> setUserContactLinkShortLink db uclId sLnk
-    let groupLink' = CCLink connFullLink (Just sLnk)
-    pure $ CRGroupLink user gInfo groupLink' mRole
+    gLink' <- withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk
+    pure $ CRGroupLink user gInfo gLink'
  APICreateMemberContact gId gMemberId -> withUser $ \user -> do
    (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
    assertUserGroupRole g GRAuthor
@@ -3313,7 +3290,7 @@ processChatCommand' vr = \case
        case ct of
          CCTContact ->
            withFastStore' (\db -> getUserContactLinkViaShortLink db user l') >>= \case
-              Just (UserContactLink (CCLink cReq _) _) -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPContactAddress CAPOwnLink)
+              Just (UserContactLink (CCLink cReq _) _ _) -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPContactAddress CAPOwnLink)
              Nothing -> do
                (cReq, cData) <- getShortLinkConnReq user l'
                let contactSLinkData_ = decodeShortLinkData $ linkUserData cData
@@ -577,9 +577,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                probeMatchingContactsAndMembers ct' (contactConnIncognito ct') doProbeContacts
                withStore' $ \db -> resetContactConnInitiated db user conn'
              forM_ viaUserContactLink $ \userContactLinkId -> do
-                ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
-                let (UserContactLink {autoAccept}, gli_) = ucl
-                when (connChatVersion < batchSend2Version) $ sendAutoReply ct' autoAccept
+                (ucl, gli_) <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
+                when (connChatVersion < batchSend2Version) $ sendAutoReply ucl ct'
                -- TODO REMOVE LEGACY vvv
                forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
                  groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId
@@ -645,9 +644,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
              lift $ setContactNetworkStatus ct NSConnected
              toView $ CEvtContactSndReady user ct
              forM_ viaUserContactLink $ \userContactLinkId -> do
-                ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
-                let (UserContactLink {autoAccept}, _) = ucl
-                when (connChatVersion >= batchSend2Version) $ sendAutoReply ct autoAccept
+                (ucl, _) <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
+                when (connChatVersion >= batchSend2Version) $ sendAutoReply ucl ct
        QCONT ->
          void $ continueSending connEntity conn
        MWARN msgId err -> do
@@ -667,13 +665,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
        -- TODO add debugging output
        _ -> pure ()
      where
-        -- TODO [short links] don't send auto-reply message if it should have been created by connecting client
-        -- TODO   - based on version + whether address has short link data (shortLinkDataSet)
-        sendAutoReply ct = \case
-          Just AutoAccept {autoReply = Just mc} -> do
-            (msg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
-            ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
-            toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci]
+        sendAutoReply UserContactLink {shortLinkDataSet, autoAccept} ct = case autoAccept of
+          Just AutoAccept {autoReply = Just mc}
+            | not shortLinkDataSet || connChatVersion < shortLinkDataVersion -> do
+              (msg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
+              ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
+              toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci]
          _ -> pure ()

    processGroupMessage :: AEvent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> CM ()
@@ -1227,8 +1224,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
      where
        profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MsgContent -> PQSupport -> CM ()
        profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ mc_ reqPQSup = do
-          ucl <- withStore $ \db -> getUserContactLinkById db userId uclId
-          let (UserContactLink {connLinkContact = CCLink connReq _, autoAccept}, gLinkInfo_) = ucl
+          uclGLinkInfo <- withStore $ \db -> getUserContactLinkById db userId uclId
+          let (UserContactLink {connLinkContact = CCLink connReq _, shortLinkDataSet, autoAccept}, gLinkInfo_) = uclGLinkInfo
              isSimplexTeam = sameConnReqContact connReq adminContactReq
              v = maxVersion chatVRange
          case autoAccept of
@@ -1265,7 +1262,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                      Just ct -> toView $ CEvtContactRequestAlreadyAccepted user ct
                      Nothing -> do
                        -- [incognito] generate profile to send, create connection with incognito profile
-                        incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
+                        incognitoProfile <-
+                          if not shortLinkDataSet && acceptIncognito
+                            then Just . NewIncognito <$> liftIO generateRandomProfile
+                            else pure Nothing
                        ct <- acceptContactRequestAsync user uclId invId chatVRange p xContactId_ reqPQSup incognitoProfile
                        forM_ mc_ $ \mc ->
                          createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing
@@ -78,12 +78,13 @@ import Simplex.Messaging.Version hiding (version)
 -- 12 - support sending and receiving content reports (2025-01-03)
 -- 14 - support sending and receiving group join rejection (2025-02-24)
 -- 15 - support specifying message scopes for group messages (2025-03-12)
+-- 16 - support short link data (2025-06-10)

 -- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
 -- This indirection is needed for backward/forward compatibility testing.
 -- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
 currentChatVersion :: VersionChat
-currentChatVersion = VersionChat 15
+currentChatVersion = VersionChat 16

 -- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
 supportedChatVRange :: VersionRangeChat
@@ -142,6 +143,10 @@ groupJoinRejectVersion = VersionChat 14
 groupKnockingVersion :: VersionChat
 groupKnockingVersion = VersionChat 15

+-- support short link data in invitation, contact and group links
+shortLinkDataVersion :: VersionChat
+shortLinkDataVersion = VersionChat 16
+
 agentToChatVersion :: VersionSMPA -> VersionChat
 agentToChatVersion v
  | v < pqdrSMPAgentVersion = initialChatVersion
@@ -6,6 +6,7 @@ module Simplex.Chat.Store
    ChatLockEntity (..),
    UserMsgReceiptSettings (..),
    UserContactLink (..),
+    GroupLink (..),
    GroupLinkInfo (..),
    AutoAccept (..),
    createChatStore,
@@ -14,6 +15,7 @@ module Simplex.Chat.Store
  )
 where

+import Simplex.Chat.Store.Groups (GroupLink (..))
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Store.Shared
 import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
@@ -60,7 +60,6 @@ module Simplex.Chat.Store.Direct
    getAcceptedContactByXContactId,
    getAcceptedBusinessChatByXContactId,
    getUserContactLinkIdByCReq,
-    getContactRequest',
    getContactRequest,
    getContactRequestIdByName,
    deleteContactRequest,
@@ -830,11 +829,6 @@ getUserContactLinkIdByCReq db contactRequestId =
  ExceptT . firstRow fromOnly (SEContactRequestNotFound contactRequestId) $
    DB.query db "SELECT user_contact_link_id FROM contact_requests WHERE contact_request_id = ?" (Only contactRequestId)

-getContactRequest' :: DB.Connection -> Int64 -> ExceptT StoreError IO (User, UserContactRequest)
-getContactRequest' db contactRequestId = do
-  user <- getUserByContactRequestId db contactRequestId
-  (user,) <$> getContactRequest db user contactRequestId
-
 getContactRequest :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO UserContactRequest
 getContactRequest db User {userId} contactRequestId =
  ExceptT . firstRow toContactRequest (SEContactRequestNotFound contactRequestId) $
@@ -8,6 +8,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -17,6 +18,7 @@ module Simplex.Chat.Store.Groups
    GroupInfoRow,
    GroupMemberRow,
    MaybeGroupMemberRow,
+    GroupLink (..),
    toGroupInfo,
    toGroupMember,
    toMaybeGroupMember,
@@ -28,6 +30,7 @@ module Simplex.Chat.Store.Groups
    getGroupLink,
    getGroupLinkId,
    setGroupLinkMemberRole,
+    setGroupLinkShortLink,
    getGroupAndMember,
    createNewGroup,
    createGroupInvitation,
@@ -151,6 +154,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
+import qualified Data.Aeson.TH as J
 import Data.Bifunctor (second)
 import Data.Bitraversable (bitraverse)
 import Data.Either (rights)
@@ -175,6 +179,7 @@ import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff)
+import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
 import Simplex.Messaging.Util (eitherToMaybe, firstRow', ($>>=), (<$$>))
 import Simplex.Messaging.Version
@@ -194,16 +199,17 @@ toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just member
  Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs))
 toMaybeGroupMember _ _ = Nothing

-createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
-createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId (CCLink cReq shortLink) groupLinkId memberRole subMode =
+createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> Bool -> SubscriptionMode -> ExceptT StoreError IO GroupLink
+createGroupLink db user@User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId (CCLink cReq shortLink) groupLinkId memberRole shortLinkDataSet subMode = do
  checkConstraint (SEDuplicateGroupLink groupInfo) . liftIO $ do
    currentTs <- getCurrentTime
    DB.execute
      db
-      "INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, short_link_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
-      (userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, shortLink, memberRole, BI True, currentTs, currentTs)
+      "INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, short_link_contact, short_link_data_set, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
+      ((userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, shortLink, BI shortLinkDataSet) :. (memberRole, BI True, currentTs, currentTs))
    userContactLinkId <- insertedRowId db
    void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
+  getGroupLink db user groupInfo

 getGroupLinkConnection :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ExceptT StoreError IO Connection
 getGroupLinkConnection db vr User {userId} groupInfo@GroupInfo {groupId} =
@@ -262,21 +268,51 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do
    (userId, groupId)
  DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId)

-getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO (Int64, CreatedLinkContact, GroupLinkId, GroupMemberRole)
+data GroupLink = GroupLink
+  { userContactLinkId :: Int64, -- db id
+    connLinkContact :: CreatedLinkContact,
+    shortLinkDataSet :: Bool,
+    groupLinkId :: GroupLinkId,
+    acceptMemberRole :: GroupMemberRole
+  }
+  deriving (Show)
+
+getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
 getGroupLink db User {userId} gInfo@GroupInfo {groupId} =
-  ExceptT . firstRow groupLink (SEGroupLinkNotFound gInfo) $
-    DB.query db "SELECT user_contact_link_id, conn_req_contact, short_link_contact, group_link_id, group_link_member_role FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)
+  ExceptT . firstRow toGroupLink (SEGroupLinkNotFound gInfo) $
+    DB.query db "SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, group_link_id, group_link_member_role FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)
  where
-    groupLink (linkId, cReq, shortLink, gLinkId, mRole_) = (linkId, CCLink cReq shortLink, gLinkId, fromMaybe GRMember mRole_)
+    toGroupLink (userContactLinkId, cReq, shortLink, BI shortLinkDataSet, groupLinkId, mRole_) =
+      GroupLink {
+        userContactLinkId,
+        connLinkContact = CCLink cReq shortLink,
+        shortLinkDataSet,
+        groupLinkId,
+        acceptMemberRole = fromMaybe GRMember mRole_
+      }

 getGroupLinkId :: DB.Connection -> User -> GroupInfo -> IO (Maybe GroupLinkId)
 getGroupLinkId db User {userId} GroupInfo {groupId} =
  fmap join . maybeFirstRow fromOnly $
    DB.query db "SELECT group_link_id FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)

-setGroupLinkMemberRole :: DB.Connection -> User -> Int64 -> GroupMemberRole -> IO ()
-setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
+setGroupLinkMemberRole :: DB.Connection -> User -> GroupLink -> GroupMemberRole -> IO GroupLink
+setGroupLinkMemberRole db User {userId} gLnk@GroupLink{userContactLinkId} memberRole = do
  DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId)
+  pure gLnk {acceptMemberRole = memberRole}
+
+setGroupLinkShortLink :: DB.Connection -> GroupLink -> ShortLinkContact -> IO GroupLink
+setGroupLinkShortLink db gLnk@GroupLink {userContactLinkId, connLinkContact = CCLink connFullLink _sLnk_} shortLink = do
+  DB.execute
+    db
+    [sql|
+      UPDATE user_contact_links
+      SET short_link_contact = ?,
+          short_link_data_set = ?
+      WHERE user_contact_link_id = ?
+    |]
+    (shortLink, BI True, userContactLinkId)
+  pure gLnk {connLinkContact = CCLink connFullLink (Just shortLink), shortLinkDataSet = True}

 getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRangeChat -> ExceptT StoreError IO (GroupInfo, GroupMember)
 getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
@@ -2747,3 +2783,5 @@ updateGroupAlias db userId g@GroupInfo {groupId} localAlias = do
  updatedAt <- getCurrentTime
  DB.execute db "UPDATE groups SET local_alias = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (localAlias, updatedAt, userId, groupId)
  pure (g :: GroupInfo) {localAlias = localAlias}
+
+$(J.deriveJSON defaultJSON ''GroupLink)
@@ -354,14 +354,14 @@ getUserContactProfiles db User {userId} =
    toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, Maybe Preferences) -> Profile
    toContactProfile (displayName, fullName, image, contactLink, preferences) = Profile {displayName, fullName, image, contactLink, preferences}

-createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> ExceptT StoreError IO ()
-createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode =
+createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> Bool -> SubscriptionMode -> ExceptT StoreError IO ()
+createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) shortLinkDataSet subMode =
  checkConstraint SEDuplicateContactLink . liftIO $ do
    currentTs <- getCurrentTime
    DB.execute
      db
-      "INSERT INTO user_contact_links (user_id, conn_req_contact, short_link_contact, created_at, updated_at) VALUES (?,?,?,?,?)"
-      (userId, cReq, shortLink, currentTs, currentTs)
+      "INSERT INTO user_contact_links (user_id, conn_req_contact, short_link_contact, short_link_data_set, created_at, updated_at) VALUES (?,?,?,?,?,?)"
+      (userId, cReq, shortLink, BI shortLinkDataSet, currentTs, currentTs)
    userContactLinkId <- insertedRowId db
    void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff

@@ -451,6 +451,7 @@ data UserMsgReceiptSettings = UserMsgReceiptSettings

 data UserContactLink = UserContactLink
  { connLinkContact :: CreatedLinkContact,
+    shortLinkDataSet :: Bool,
    autoAccept :: Maybe AutoAccept
  }
  deriving (Show)
@@ -472,9 +473,9 @@ $(J.deriveJSON defaultJSON ''AutoAccept)

 $(J.deriveJSON defaultJSON ''UserContactLink)

-toUserContactLink :: (ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink
-toUserContactLink (connReq, shortLink, BI autoAccept, BI businessAddress, BI acceptIncognito, autoReply) =
-  UserContactLink (CCLink connReq shortLink) $
+toUserContactLink :: (ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink
+toUserContactLink (connReq, shortLink, BI shortLinkDataSet, BI autoAccept, BI businessAddress, BI acceptIncognito, autoReply) =
+  UserContactLink (CCLink connReq shortLink) shortLinkDataSet $
    if autoAccept then Just AutoAccept {businessAddress, acceptIncognito, autoReply} else Nothing

 getUserAddress :: DB.Connection -> User -> ExceptT StoreError IO UserContactLink
@@ -488,7 +489,7 @@ getUserContactLinkById db userId userContactLinkId =
    DB.query
      db
      [sql|
-        SELECT conn_req_contact, short_link_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
+        SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
        FROM user_contact_links
        WHERE user_id = ? AND user_contact_link_id = ?
      |]
@@ -524,7 +525,7 @@ getUserContactLinkViaShortLink db User {userId} shortLink =
 userContactLinkQuery :: Query
 userContactLinkQuery =
  [sql|
-    SELECT conn_req_contact, short_link_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
+    SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
    FROM user_contact_links
  |]

@@ -534,10 +535,12 @@ setUserContactLinkShortLink db userContactLinkId shortLink =
    db
    [sql|
      UPDATE user_contact_links
-      SET short_link_contact = ?
+      SET short_link_contact = ?,
+          short_link_data_set = ?,
+          auto_accept_incognito = ?
      WHERE user_contact_link_id = ?
    |]
-    (shortLink, userContactLinkId)
+    (shortLink, BI True, BI False, userContactLinkId)

 getContactWithoutConnViaAddress :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
 getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
@@ -14,6 +14,8 @@ ALTER TABLE contacts ADD COLUMN conn_short_link_to_connect BLOB;
 ALTER TABLE contacts ADD COLUMN contact_request_id INTEGER REFERENCES contact_requests ON DELETE SET NULL;
 CREATE INDEX idx_contacts_contact_request_id ON contacts(contact_request_id);

+ALTER TABLE user_contact_links ADD COLUMN short_link_data_set INTEGER NOT NULL DEFAULT 0;
+
 ALTER TABLE groups ADD COLUMN conn_full_link_to_connect BLOB;
 ALTER TABLE groups ADD COLUMN conn_short_link_to_connect BLOB;
 ALTER TABLE groups ADD COLUMN conn_link_started_connection INTEGER NOT NULL DEFAULT 0;
@@ -28,6 +30,8 @@ ALTER TABLE contacts DROP COLUMN conn_short_link_to_connect;
 DROP INDEX idx_contacts_contact_request_id;
 ALTER TABLE contacts DROP COLUMN contact_request_id;

+ALTER TABLE user_contact_links DROP COLUMN short_link_data_set;
+
 ALTER TABLE groups DROP COLUMN conn_full_link_to_connect;
 ALTER TABLE groups DROP COLUMN conn_short_link_to_connect;
 ALTER TABLE groups DROP COLUMN conn_link_started_connection;
@@ -3062,7 +3062,7 @@ Plan:
 SEARCH commands USING INTEGER PRIMARY KEY (rowid=?)

 Query: 
-        SELECT conn_req_contact, short_link_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
+        SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
        FROM user_contact_links
        WHERE user_id = ? AND user_contact_link_id = ?
      
@@ -4854,21 +4854,21 @@ CORRELATED SCALAR SUBQUERY 1
 SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group_member_id=?)

 Query: 
-    SELECT conn_req_contact, short_link_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
+    SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
    FROM user_contact_links
   WHERE user_id = ? AND conn_req_contact IN (?,?)
 Plan:
 SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)

 Query: 
-    SELECT conn_req_contact, short_link_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
+    SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
    FROM user_contact_links
   WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
 Plan:
 SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?)

 Query: 
-    SELECT conn_req_contact, short_link_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
+    SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content
    FROM user_contact_links
   WHERE user_id = ? AND short_link_contact = ?
 Plan:
@@ -5022,19 +5022,6 @@ SEARCH u USING INTEGER PRIMARY KEY (rowid=?)
 SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
 SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)

-Query: 
-    SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences,
-      u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
-    FROM users u
-    JOIN contacts uct ON uct.contact_id = u.contact_id
-    JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
-   JOIN contact_requests cr ON cr.user_id = u.user_id WHERE cr.contact_request_id = ?
-Plan:
-SEARCH cr USING INTEGER PRIMARY KEY (rowid=?)
-SEARCH u USING INTEGER PRIMARY KEY (rowid=?)
-SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
-SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
-
 Query: 
    SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences,
      u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
@@ -5648,10 +5635,10 @@ SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
 Query: INSERT INTO temp_conn_ids (conn_id) VALUES (?)
 Plan:

-Query: INSERT INTO user_contact_links (user_id, conn_req_contact, short_link_contact, created_at, updated_at) VALUES (?,?,?,?,?)
+Query: INSERT INTO user_contact_links (user_id, conn_req_contact, short_link_contact, short_link_data_set, created_at, updated_at) VALUES (?,?,?,?,?,?)
 Plan:

-Query: INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, short_link_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)
+Query: INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, short_link_contact, short_link_data_set, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)
 Plan:

 Query: INSERT INTO users (agent_user_id, local_display_name, active_user, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,?,0,?,?,?,?,?)
@@ -5880,7 +5867,7 @@ Query: SELECT user_contact_link_id FROM contact_requests WHERE contact_request_i
 Plan:
 SEARCH contact_requests USING INTEGER PRIMARY KEY (rowid=?)

-Query: SELECT user_contact_link_id, conn_req_contact, short_link_contact, group_link_id, group_link_member_role FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1
+Query: SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, group_link_id, group_link_member_role FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1
 Plan:
 SEARCH user_contact_links USING INDEX idx_user_contact_links_group_id (group_id=?)

@@ -332,6 +332,7 @@ CREATE TABLE user_contact_links(
  group_link_member_role TEXT NULL,
  business_address INTEGER DEFAULT 0,
  short_link_contact BLOB,
+  short_link_data_set INTEGER NOT NULL DEFAULT 0,
  UNIQUE(user_id, local_display_name)
 );
 CREATE TABLE contact_requests(
@@ -50,7 +50,7 @@ import Simplex.Chat.Operators
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.AppVersion (AppVersion (..), pattern AppVersionRange)
 import Simplex.Chat.Remote.Types
-import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..))
+import Simplex.Chat.Store (AutoAccept (..), GroupLink (..), StoreError (..), UserContactLink (..))
 import Simplex.Chat.Styled
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
@@ -233,8 +233,8 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
  CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
  CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
  CRGroupDescription u g -> ttyUser u $ viewGroupDescription g
-  CRGroupLinkCreated u g ccLink mRole -> ttyUser u $ groupLink_ "Group link is created!" g ccLink mRole
-  CRGroupLink u g ccLink mRole -> ttyUser u $ groupLink_ "Group link:" g ccLink mRole
+  CRGroupLinkCreated u g gLink -> ttyUser u $ groupLink_ "Group link is created!" g gLink
+  CRGroupLink u g gLink -> ttyUser u $ groupLink_ "Group link:" g gLink
  CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
  CRNewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"]
  CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m]
@@ -1090,13 +1090,13 @@ autoAcceptStatus_ = \case
        | otherwise = ""
  _ -> ["auto_accept off"]

-groupLink_ :: StyledString -> GroupInfo -> CreatedLinkContact -> GroupMemberRole -> [StyledString]
-groupLink_ intro g (CCLink cReq shortLink) mRole =
+groupLink_ :: StyledString -> GroupInfo -> GroupLink -> [StyledString]
+groupLink_ intro g GroupLink {connLinkContact = CCLink cReq shortLink, acceptMemberRole} =
  [ intro,
    "",
    plain $ maybe cReqStr strEncode shortLink,
    "",
-    "Anybody can connect to you and join group as " <> showRole mRole <> " with: " <> highlight' "/c <group_link_above>",
+    "Anybody can connect to you and join group as " <> showRole acceptMemberRole <> " with: " <> highlight' "/c <group_link_above>",
    "to show it again: " <> highlight ("/show link #" <> viewGroupName g),
    "to delete it: " <> highlight ("/delete link #" <> viewGroupName g) <> " (joined members will remain connected to you)"
  ]