Merge branch 'master' into rcv-services

contributing/CODE.md

@@ -0,0 +1,79 @@
+# Coding and building
+
+This file provides guidance on coding style and approaches and on building the code.
+
+## Code Style and Formatting
+
+The project uses **fourmolu** for Haskell code formatting. Configuration is in `fourmolu.yaml`.
+
+**Key formatting rules:**
+- 2-space indentation
+- Trailing function arrows, commas, and import/export style
+- Record brace without space: `{field = value}`
+- Single newline between declarations
+- Never use unicode symbols
+- Inline `let` style with right-aligned `in`
+
+**Format code before committing:**
+
+```bash
+# Format a single file
+fourmolu -i src/Simplex/Messaging/Protocol.hs
+```
+
+Some files that use CPP language extension cannot be formatted as a whole, so individual code fragments need to be formatted.
+
+**Follow existing code patterns:**
+- Match the style of surrounding code
+- Use qualified imports with short aliases (e.g., `import qualified Data.ByteString.Char8 as B`)
+- Use record syntax for types with multiple fields
+- Prefer explicit pattern matching over partial functions
+
+**Comments policy:**
+- Avoid redundant comments that restate what the code already says
+- Only comment on non-obvious design decisions or tricky implementation details
+- Function names and type signatures should be self-documenting
+- Do not add comments like "wire format encoding" (Encoding class is always wire format) or "check if X" when the function name already says that
+- Assume a competent Haskell reader
+
+### Haskell Extensions
+- `StrictData` enabled by default
+- Use STM for safe concurrency
+- Assume concurrency in PostgreSQL queries
+- Comprehensive warning flags with strict pattern matching
+
+## Build Commands
+
+```bash
+# Standard build
+cabal build
+
+# Fast build
+cabal build --ghc-options -O0
+
+# Build specific executables
+cabal build exe:smp-server exe:xftp-server exe:ntf-server exe:xftp
+
+# Build with PostgreSQL server support
+cabal build -fserver_postgres
+
+# Client-only library build (no server code)
+cabal build -fclient_library
+
+# Find binary location
+cabal list-bin exe:smp-server
+```
+
+### Cabal Flags
+
+- `swift`: Enable Swift JSON format
+- `client_library`: Build without server code
+- `client_postgres`: Use PostgreSQL instead of SQLite for agent persistence
+- `server_postgres`: PostgreSQL support for server queue/notification store
+
+## External Dependencies
+
+Custom forks specified in `cabal.project`:
+- `aeson`, `hs-socks` (SimpleX forks)
+- `direct-sqlcipher`, `sqlcipher-simple` (encrypted SQLite)
+- `warp`, `warp-tls` (HTTP server)

contributing/PROJECT.md

@@ -0,0 +1,105 @@
+# SimpleXMQ repository
+
+This file provides guidance on the project structure to help working with code in this repository.
+
+## Project Overview
+
+SimpleXMQ is a Haskell message broker implementing unidirectional (simplex) queues for privacy-preserving messaging. 
+
+Key components:
+
+- **SimpleX Messaging Protocol**: SMP protocol definition and encodings ([code](../src/Simplex/Messaging/Protocol.hs), [transport code](../src/Simplex/Messaging/Transport.hs), [spec](../protocol/simplex-messaging.md)).
+- **SMP Server**: Message broker with TLS, in-memory queues, optional persistence ([main code](../src/Simplex/Messaging/Server.hs), [all code files](../src/Simplex/Messaging/Server/), [executable](../apps/smp-server/)). For proxying SMP commands the server uses [lightweight SMP client](../src/Simplex/Messaging/Client/Agent.hs).
+- **SMP Client**: Functional API with STM-based message delivery ([code](../src/Simplex/Messaging/Client.hs)).
+- **SMP Agent**: High-level duplex connections via multiple simplex queues with E2E encryption ([code](../src/Simplex/Messaging/Agent.hs)). Implements Agent-to-agent protocol ([code](../src/Simplex/Messaging/Agent/Protocol.hs), [spec](../protocol/agent-protocol.md)) via intermediary agent client ([code](../src/Simplex/Messaging/Agent/Client.hs)).
+- **XFTP**: SimpleX File Transfer Protocol, server and CLI client ([code](../src/Simplex/FileTransfer/), [spec](../protocol/xftp.md)).
+- **XRCP**: SimpleX Remote Control Protocol ([code](`../src/Simplex/RemoteControl/`), [spec](../protocol/xrcp.md)).
+- **Notifications**: Push notifications server requires PostgreSQL ([code](../src/Simplex/Messaging/Notifications), [executable](../apps/ntf-server/)). Client protocol is used for clients to communicate with the server ([code](../src/Simplex/Messaging/Notifications/Protocol.hs), [spec](../protocol/push-notifications.md)). For subscribing to SMP notifications the server uses [lightweight SMP client](../src/Simplex/Messaging/Client/Agent.hs).
+
+## Architecture
+
+For general overview see `../protocol/overview-tjr.md`.
+
+SMP Protocol Layers:
+
+```
+TLS Transport → SMP Protocol → Agent Protocol → Application protocol
+```
+
+XFTP Protocol Layers:
+
+```
+TLS Transport (HTTP2 encoding) → XFTP Protocol → Out-of-band file descriptions
+```
+
+## Key Patterns
+
+1. **Persistence**: All queue state managed via Software Transactional Memory or via PostgreSQL
+   - `Simplex.Messaging.Server.MsgStore.STM` - in-memory messages
+   - `Simplex.Messaging.Server.QueueStore.STM` - in-memory queue state
+   - `Simplex.Messaging.Server.MsgStore.Postgres` - message storage
+   - `Simplex.Messaging.Server.QueueStore.Postgres` - queue storage
+
+2. **Append-Only Store Log**: Optional persistence via journal for in-memory storage
+   - `Simplex.Messaging.Server.StoreLog` - queue creation log
+   - Compacted on restart
+
+3. **Agent Storage**:
+   - SQLite (default) or PostgreSQL
+   - Migrations in `src/Simplex/Messaging/Agent/Store/{SQLite,Postgres}/Migrations/`
+
+4. **Protocol Versioning**: All layers support version negotiation
+   - `Simplex.Messaging.Version` - version range utilities
+
+5. **Double Ratchet E2E**: Per-connection encryption
+   - `Simplex.Messaging.Crypto.Ratchet`
+   - SNTRUP761 post-quantum KEM (`src/Simplex/Messaging/Crypto/SNTRUP761/`)
+
+## Source Layout
+
+```
+src/Simplex/
+├── Messaging/
+│   ├── Agent.hs          # Main agent (~210KB)
+│   ├── Server.hs         # SMP server (~130KB)
+│   ├── Client.hs         # Client API (~65KB)
+│   ├── Protocol.hs       # Protocol types (~77KB)
+│   ├── Crypto.hs         # E2E encryption (~52KB)
+│   ├── Transport.hs      # Transport encoding over TLS
+│   ├── Agent/Store/      # SQLite/Postgres persistence
+│   ├── Server/           # Server internals (QueueStore, MsgStore, Control)
+│   └── Notifications/    # Push notification system
+├── FileTransfer/         # XFTP implementation for file transfers
+└── RemoteControl/        # XRCP implementation for device discovery & control
+```
+
+## Protocol Documentation
+
+- `protocol/overview-tjr.md`: SMP protocols stack overview
+- `protocol/simplex-messaging.md`: SMP protocol spec (v19)
+- `protocol/agent-protocol.md`: Agent protocol spec (v7)
+- `protocol/xftp.md`: File transfer protocol
+- `protocol/xrcp.md`: Remote control protocol
+- `rfcs/`: Design RFCs for features
+
+## Testing
+
+```bash
+# Run all tests
+cabal test --test-show-details=streaming
+
+# Run specific test group (uses HSpec)
+cabal test --test-option=--match="/Core tests/Encryption tests/"
+
+# Run single test
+cabal test --test-option=--match="/SMP client agent/functional API/"
+```
+
+Tests require PostgreSQL running on `localhost:5432` when using `-fserver_postgres` or `-fclient_postgres`.
+
+Test files are in `tests/` with structure:
+- `Test.hs`: Main runner
+- `AgentTests/`: Agent protocol and connection tests
+- `CoreTests/`: Crypto, encoding, storage tests
+- `ServerTests.hs`: SMP server tests
+- `XFTPServerTests.hs`: File transfer tests

contributing/README.md

@@ -0,0 +1,22 @@
+# Contributing to SimpleX repositories
+
+## Focus on user problems
+
+We do not make code changes to improve code - any change must address a specific user problem or request.
+
+## Discuss the plans as early as possible
+
+Please discuss the problem you want to solve and your detailed implementation plan with the project team prior to contributing, to avoid wasted time and additional changes. Acceptance of your contribution depends on your willingness and ability to iterate the proposed contribution to achieve the required quality level, coding style, test coverage, and alignment with user requirements as they are understood by the project team.
+
+## Follow project structure, coding style and approaches
+
+./PROJECT.md has information about the structure of this `simplexmq` repository.
+
+./CODE.md has details about general requirements common for `simplexmq` and `simplex-chat` repositories.
+
+This files can be used with LLM prompts, e.g. if you use Claude Code you can create CLAUDE.md file in project root importing content from these files:
+
+```markdown
+@contributing/PROJECT.md
+@contributing/CODE.md
+```

src/Simplex/Messaging/Agent.hs

@@ -51,6 +51,7 @@ module Simplex.Messaging.Agent
     connRequestPQSupport,
     createConnectionAsync,
     setConnShortLinkAsync,
+    getConnShortLinkAsync,
     joinConnectionAsync,
     allowConnectionAsync,
     acceptContactAsync,
@@ -199,8 +200,8 @@ import Simplex.Messaging.Client (NetworkRequestMode (..), ProtocolClientError (.
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
 import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
-import qualified Simplex.Messaging.Crypto.ShortLink as SL
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
+import qualified Simplex.Messaging.Crypto.ShortLink as SL
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
@@ -223,8 +224,8 @@ import Simplex.Messaging.Protocol
     SParty (..),
     SProtocolType (..),
     ServiceSub (..),
-    ServiceSubResult (..),
     ServiceSubError (..),
+    ServiceSubResult (..),
     SndPublicAuthKey,
     SubscriptionMode (..),
     UserProtocol,
@@ -358,13 +359,19 @@ createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAs
 {-# INLINE createConnectionAsync #-}
 
 -- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response
-setConnShortLinkAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE ()
-setConnShortLinkAsync c = withAgentEnv c .::. setConnShortLinkAsync' c
+setConnShortLinkAsync :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AE ()
+setConnShortLinkAsync c = withAgentEnv c .:: setConnShortLinkAsync' c
 {-# INLINE setConnShortLinkAsync #-}
 
--- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id
-joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
-joinConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs
+-- | Get and verify data from short link (LGET/LKEY command) asynchronously, synchronous response is new connection id
+getConnShortLinkAsync :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AE ConnId
+getConnShortLinkAsync c = withAgentEnv c .:. getConnShortLinkAsync' c
+{-# INLINE getConnShortLinkAsync #-}
+
+-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id.
+-- If connId is provided (for contact URIs), it updates the existing connection record created by getConnShortLinkAsync.
+joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
+joinConnectionAsync c userId aCorrId connId_ enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId connId_ enableNtfs
 {-# INLINE joinConnectionAsync #-}
 
 -- | Allow connection to continue after CONF notification (LET command), no synchronous response
@@ -412,7 +419,7 @@ deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c
 {-# INLINE deleteConnShortLink #-}
 
 -- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries
-getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
+getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c)
 getConnShortLink c = withAgentEnv c .:. getConnShortLink' c
 {-# INLINE getConnShortLink #-}
 
@@ -824,8 +831,9 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do
 
 -- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection,
 -- and join should retry, the same as 1-time invitation joins.
-joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
-joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
+joinConnAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
+joinConnAsync c userId corrId connId_ enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
+  when (isJust connId_) $ throwE $ CMD PROHIBITED "joinConnAsync: connId not allowed for invitation URI"
   withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
     lift (compatibleInvitationUri cReqUri) >>= \case
       Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
@@ -836,8 +844,22 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup
         enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
         pure connId
       Nothing -> throwE $ AGENT A_VERSION
-joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption =
-  throwE $ CMD PROHIBITED "joinConnAsync"
+joinConnAsync c userId corrId connId_ enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = do
+  lift (compatibleContactUri cReqUri) >>= \case
+    Just (_, Compatible connAgentVersion) -> do
+      let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing
+      connId <- case connId_ of
+        Just cId -> do
+          -- update connection record created by getConnShortLinkAsync
+          withStore' c $ \db -> updateNewConnJoin db cId connAgentVersion pqSupport enableNtfs
+          pure cId
+        Nothing -> do
+          g <- asks random
+          let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
+          withStore c $ \db -> createNewConn db g cData SCMInvitation
+      enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
+      pure connId
+    Nothing -> throwE $ AGENT A_VERSION
 
 allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
 allowConnectionAsync' c corrId connId confId ownConnInfo =
@@ -856,7 +878,7 @@ acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId
 acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do
   Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId
   withStore' c $ \db -> acceptInvitation db invId ownConnInfo
-  joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
+  joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
     withStore' c (`unacceptInvitation` invId)
     throwE err
 
@@ -916,8 +938,9 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey
   srv <- getSMPServer c userId
   when (checkNotices && connMode cMode == CMContact) $ checkClientNotices c srv
   connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
-  (connId,) <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv
-    `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
+  (connId,)
+    <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv
+      `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
 
 checkClientNotices :: AgentClient -> SMPServerWithAuth -> AM ()
 checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAuth srv@(ProtocolServer {host}) _) = do
@@ -932,15 +955,41 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu
         when (maybe True (ts <) expires_) $
           throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_}
 
-setConnShortLinkAsync' :: forall c. ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM ()
-setConnShortLinkAsync' c corrId connId cMode userLinkData clientData =
+setConnShortLinkAsync' :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AM ()
+setConnShortLinkAsync' c corrId connId userLinkData clientData =
   withConnLock c connId "setConnShortLinkAsync" $ do
     SomeConn _ conn <- withStore c (`getConn` connId)
-    srv <- case (conn, cMode, userLinkData) of
-      (ContactConnection _ RcvQueue {server}, SCMContact, UserContactLinkData {}) -> pure server
-      (RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server
+    srv <- case (conn, userLinkData) of
+      (ContactConnection _ RcvQueue {server, shortLink}, UserContactLinkData d) -> do
+        liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <>)) $ validateOwners shortLink d
+        pure server
       _ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode"
-    enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AUCLD cMode userLinkData) clientData
+    enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET userLinkData clientData
+
+getConnShortLinkAsync' :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AM ConnId
+getConnShortLinkAsync' c userId corrId shortLink@(CSLContact _ _ srv _) = do
+  g <- asks random
+  connId <- withStore c $ \db -> do
+    -- server is created so the command is processed in server queue,
+    -- not blocking other "no server" commands
+    void $ createServer db srv
+    prepareNewConn db g
+  enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LGET shortLink
+  pure connId
+  where
+    prepareNewConn db g = do
+      let cData =
+            ConnData
+              { userId,
+                connId = "",
+                connAgentVersion = currentSMPAgentVersion,
+                enableNtfs = False,
+                lastExternalSndId = 0,
+                deleted = False,
+                ratchetSyncState = RSOk,
+                pqSupport = PQSupportOff
+              }
+      createNewConn db g cData SCMInvitation
 
 setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c)
 setConnShortLink' c nm connId cMode userLinkData clientData =
@@ -954,7 +1003,8 @@ setConnShortLink' c nm connId cMode userLinkData clientData =
     pure sl
   where
     prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData)
-    prepareContactLinkData rq@RcvQueue {shortLink} ud = do
+    prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do
+      liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d'
       g <- asks random
       AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
       let cslContact = CSLContact SLSServer CCTContact (qServer rq)
@@ -971,7 +1021,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData =
               (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq ud
               (linkId, k) = SL.contactShortLinkKdf linkKey
           srvData <- liftError id $ SL.encryptLinkData g k linkData
-          let slCreds = ShortLinkCreds linkId linkKey privSigKey (fst srvData)
+          let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData)
           withStore' c $ \db -> updateShortLinkCreds db rq slCreds
           pure (rq, linkId, cslContact linkKey, srvData)
     prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
@@ -995,7 +1045,7 @@ deleteConnShortLink' c nm connId cMode =
       _ -> throwE $ CMD PROHIBITED "deleteConnShortLink: not contact address"
 
 -- TODO [short links] remove 1-time invitation data and link ID from the server after the message is sent.
-getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnLinkData c)
+getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (FixedLinkData c, ConnLinkData c)
 getConnShortLink' c nm userId = \case
   CSLInvitation _ srv linkId linkKey -> do
     g <- asks random
@@ -1016,18 +1066,19 @@ getConnShortLink' c nm userId = \case
     ld <- getQueueLink c nm userId srv linkId
     decryptData srv linkKey k ld
   where
-    decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnLinkData c)
+    decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c)
     decryptData srv linkKey k (sndId, d) = do
-      r@(cReq, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d
-      let (srv', sndId') = qAddress (connReqQueue cReq)
-      unless (srv `sameSrvHost` srv' && sndId == sndId') $
-        throwE $ AGENT $ A_LINK "different address"
-      pure $ if srv' == srv then r else (updateConnReqServer srv cReq, clData)
+      r@(fd, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d
+      let (srv', sndId') = qAddress (connReqQueue $ linkConnReq fd)
+      unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address"
+      pure $ if srv' == srv then r else (updateConnReqServer srv fd, clData)
     sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs
-    updateConnReqServer :: SMPServer -> ConnectionRequestUri c -> ConnectionRequestUri c
-    updateConnReqServer srv = \case
-      CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams
-      CRContactUri crData -> CRContactUri $ updateQueues crData
+    updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c
+    updateConnReqServer srv fd =
+      let connReq' = case linkConnReq fd of
+            CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams
+            CRContactUri crData -> CRContactUri $ updateQueues crData
+       in fd {linkConnReq = connReq'}
       where
         updateQueues crData@(ConnReqUriData {crSmpQueues = SMPQueueUri vr addr :| qs}) =
           crData {crSmpQueues = SMPQueueUri vr addr {smpServer = srv} :| qs}
@@ -1110,7 +1161,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
     connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c)
     connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of
       Just ShortLinkCreds {shortLinkId, shortLinkKey}
-        | qUri == qUri'  -> pure $ case cReq of
+        | qUri == qUri' -> pure $ case cReq of
             CRContactUri _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey
             CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) ->
               let cReq' = case pqInitKeys of
@@ -1371,7 +1422,7 @@ databaseDiff passed known =
   let passedSet = S.fromList passed
       knownSet = S.fromList known
       missingIds = S.toList $ passedSet `S.difference` knownSet
-      extraIds = S.toList $ knownSet  `S.difference` passedSet
+      extraIds = S.toList $ knownSet `S.difference` passedSet
    in DatabaseDiff {missingIds, extraIds}
 
 -- | Subscribe to receive connection messages (SUB command) in Reader monad
@@ -1405,7 +1456,8 @@ subscribeConnections_ c conns = do
   notifyResultError rs
   pure rs
   where
-    partitionResultsConns :: (ConnId, Either StoreError SomeConnSub) ->
+    partitionResultsConns ::
+      (ConnId, Either StoreError SomeConnSub) ->
       (Map ConnId (Either AgentErrorType ()), [(ConnId, SomeConnSub)]) ->
       (Map ConnId (Either AgentErrorType ()), [(ConnId, SomeConnSub)])
     partitionResultsConns (connId, conn_) (rs, cs) = case conn_ of
@@ -1499,29 +1551,32 @@ subscribeAllConnections' c onlyNeeded activeUserId_ = handleErr $ do
     handleErr = (`catchAllErrors` \e -> notifySub' c "" (ERR e) >> throwE e)
     getService :: DB.Connection -> Map UserId Bool -> (UserId, SMPServer) -> IO ((UserId, SMPServer), Maybe ServiceSub)
     getService db useServices us@(userId, srv) =
-      fmap (us,) $ getSubscriptionService db userId srv >>= \case
-        Just serviceSub -> case M.lookup userId useServices of
-          Just True -> pure $ Just serviceSub
-          _ -> Nothing <$ unassocUserServerRcvQueueSubs' db userId srv
-        _ -> pure Nothing
+      fmap (us,) $
+        getSubscriptionService db userId srv >>= \case
+          Just serviceSub -> case M.lookup userId useServices of
+            Just True -> pure $ Just serviceSub
+            _ -> Nothing <$ unassocUserServerRcvQueueSubs' db userId srv
+          _ -> pure Nothing
     subscribeService :: ((UserId, SMPServer), Maybe ServiceSub) -> AM' ((UserId, SMPServer), ServiceAssoc)
-    subscribeService (us@(userId, srv), serviceSub_) = fmap ((us,) . fromRight False) $ tryAllErrors' $
-      case serviceSub_ of
-        Just serviceSub -> tryAllErrors (subscribeClientService c True userId srv serviceSub) >>= \case
-          Right (ServiceSubResult e _) -> case e of
-            Just SSErrorServiceId {} -> unassocQueues
-            -- Possibly, we should always resubscribe all when expected is greater than subscribed
-            Just SSErrorQueueCount {expectedQueueCount = n, subscribedQueueCount = n'} | n > 0 && n' == 0 -> unassocQueues
-            _ -> pure True
-          Left e -> do
-            atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR e)
-            if clientServiceError e
-              then unassocQueues
-              else pure True
-          where
-            unassocQueues :: AM Bool
-            unassocQueues = False <$ withStore' c (\db -> unassocUserServerRcvQueueSubs' db userId srv)
-        _ -> pure False
+    subscribeService (us@(userId, srv), serviceSub_) = fmap ((us,) . fromRight False) $
+      tryAllErrors' $
+        case serviceSub_ of
+          Just serviceSub ->
+            tryAllErrors (subscribeClientService c True userId srv serviceSub) >>= \case
+              Right (ServiceSubResult e _) -> case e of
+                Just SSErrorServiceId {} -> unassocQueues
+                -- Possibly, we should always resubscribe all when expected is greater than subscribed
+                Just SSErrorQueueCount {expectedQueueCount = n, subscribedQueueCount = n'} | n > 0 && n' == 0 -> unassocQueues
+                _ -> pure True
+              Left e -> do
+                atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR e)
+                if clientServiceError e
+                  then unassocQueues
+                  else pure True
+            where
+              unassocQueues :: AM Bool
+              unassocQueues = False <$ withStore' c (\db -> unassocUserServerRcvQueueSubs' db userId srv)
+          _ -> pure False
     subscribeUserServer :: Int -> TVar Int -> ((UserId, SMPServer), ServiceAssoc) -> AM' (Either AgentErrorType Int)
     subscribeUserServer maxPending currPending ((userId, srv), hasService) = do
       atomically $ whenM ((maxPending <=) <$> readTVar currPending) retry
@@ -1746,15 +1801,26 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
           tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
             CCLink cReq _ <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv
             notify $ INV (ACR cMode cReq)
-        LSET auData@(AUCLD cMode userLinkData) clientData ->
+        LSET userLinkData clientData ->
           withServer' . tryCommand $ do
-            link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData
-            notify $ LINK (ACSL cMode link) auData
+            link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData
+            notify $ LINK link userLinkData
+        LGET shortLink ->
+          withServer' . tryCommand $ do
+            (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink
+            notify $ LDATA fixedData linkData
         JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
           triedHosts <- newTVarIO S.empty
           tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
             sqSecured <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
             notify $ JOINED sqSecured
+        -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously.
+        -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously.
+        JOIN enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc subMode connInfo -> noServer $ do
+          triedHosts <- newTVarIO S.empty
+          tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
+            sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv
+            notify $ JOINED sqSecured
         LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
         ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
         SWCH ->
@@ -1764,7 +1830,6 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                 switchDuplexConnection c NRMBackground conn replaced >>= notify . SWITCH QDRcv SPStarted
               _ -> throwE $ CMD PROHIBITED "SWCH: not duplex"
         DEL -> withServer' . tryCommand $ deleteConnection' c NRMBackground connId >> notify OK
-        _ -> notify $ ERR $ INTERNAL $ "unsupported async command " <> show (aCommandTag cmd)
       AInternalCommand cmd -> case cmd of
         ICAckDel rId srvMsgId msgId -> withServer $ \srv -> tryWithLock "ICAckDel" $ ack srv rId srvMsgId >> withStore' c (\db -> deleteMsg db connId msgId)
         ICAck rId srvMsgId -> withServer $ \srv -> tryWithLock "ICAck" $ ack srv rId srvMsgId
@@ -1928,7 +1993,7 @@ enqueueMessageB c reqs = do
     storeSentMsg db cfg aMessageIds = \case
       Left e -> pure (aMessageIds, Left e)
       Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of
-        VRValue i_ aMessage -> case  i_ >>= (`IM.lookup` aMessageIds) of
+        VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
           Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
           Nothing -> do
             (mbId_, r) <- case csqs_ of
@@ -1970,7 +2035,6 @@ enqueueMessageB c reqs = do
     handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
     handleInternal = pure . Left . INTERNAL . show
 
-
 encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString
 encodeAgentMsgStr aMessage internalSndId prevMsgHash = do
   let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
@@ -2391,7 +2455,8 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
   forM_ cIds_ $ \cIds -> notify ("", "", AEvt SAEConn $ DEL_CONNS cIds)
   pure res
   where
-    partitionResultsConns :: (ConnId, Either StoreError SomeConn) ->
+    partitionResultsConns ::
+      (ConnId, Either StoreError SomeConn) ->
       (Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId]) ->
       (Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId])
     partitionResultsConns (connId, conn_) (rs, rqs, cIds) = case conn_ of
@@ -2399,7 +2464,7 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do
       Right (SomeConn _ conn) -> case connRcvQueues conn of
         [] -> (M.insert connId (Right ()) rs, rqs, cIds)
         rqs' -> (rs, rqs' ++ rqs, connId : cIds)
-    unsubNtfConnIds :: NonEmpty ConnId ->  AM' ()
+    unsubNtfConnIds :: NonEmpty ConnId -> AM' ()
     unsubNtfConnIds connIds' = do
       ns <- asks ntfSupervisor
       atomically $ writeTBQueue (ntfSubQ ns) (NSCDeleteSub, connIds')

src/Simplex/Messaging/Agent/Client.hs

@@ -1503,12 +1503,12 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
       (CQRMessaging ld, Just QMMessaging) ->
         withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (sndId', d)} ->
           if sndId == sndId'
-            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d)
+            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d)
             else newErr "different sender ID"
       (CQRContact ld, Just QMContact) ->
         withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (lnkId', (sndId', d))} ->
           if sndId == sndId' && lnkId == lnkId'
-            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d)
+            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d)
             else newErr "different sender or link IDs"
       (_, Nothing) -> case linkId of
         Nothing | v < sndAuthKeySMPVersion -> pure Nothing

src/Simplex/Messaging/Agent/Protocol.hs

@@ -20,8 +20,8 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 -- |
 -- Module      : Simplex.Messaging.Agent.Protocol
@@ -107,10 +107,12 @@ module Simplex.Messaging.Agent.Protocol
     ConnectionModeI (..),
     ConnectionRequestUri (..),
     AConnectionRequestUri (..),
+    ShortLinkCreds (..),
     ConnReqUriData (..),
     CRClientData,
     ServiceScheme,
     FixedLinkData (..),
+    AConnLinkData (..),
     ConnLinkData (..),
     AUserConnLinkData (..),
     UserConnLinkData (..),
@@ -127,6 +129,8 @@ module Simplex.Messaging.Agent.Protocol
     ContactConnType (..),
     ShortLinkScheme (..),
     LinkKey (..),
+    validateOwners,
+    validateLinkOwners,
     sameConnReqContact,
     sameShortLinkContact,
     simplexChat,
@@ -195,7 +199,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -235,11 +239,11 @@ import Simplex.Messaging.Protocol
     NMsgMeta,
     ProtocolServer (..),
     QueueMode (..),
-    ServiceSub,
-    ServiceSubResult,
     SMPClientVersion,
     SMPServer,
     SMPServerWithAuth,
+    ServiceSub,
+    ServiceSubResult,
     SndPublicAuthKey,
     SubscriptionMode,
     VersionRangeSMPC,
@@ -250,10 +254,10 @@ import Simplex.Messaging.Protocol
     legacyStrEncodeServer,
     noAuthSrv,
     sameSrvAddr,
+    senderCanSecure,
+    shortLinksSMPClientVersion,
     sndAuthKeySMPClientVersion,
     srvHostnamesSMPClientVersion,
-    shortLinksSMPClientVersion,
-    senderCanSecure,
     pattern ProtoServerWithAuth,
     pattern SMPServer,
   )
@@ -381,7 +385,8 @@ type SndQueueSecured = Bool
 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
   INV :: AConnectionRequestUri -> AEvent AEConn
-  LINK :: AConnShortLink -> AUserConnLinkData -> AEvent AEConn
+  LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
+  LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn
   CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
   REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
   INFO :: PQSupport -> ConnInfo -> AEvent AEConn
@@ -439,7 +444,8 @@ deriving instance Show AEvtTag
 
 data ACommand
   = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
-  | LSET AUserConnLinkData (Maybe CRClientData) -- response LINK
+  | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK
+  | LGET (ConnShortLink 'CMContact) -- response LDATA
   | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
   | LET ConfirmationId ConnInfo -- ConnInfo is from client
   | ACK AgentMsgId (Maybe MsgReceiptInfo)
@@ -450,6 +456,7 @@ data ACommand
 data ACommandTag
   = NEW_
   | LSET_
+  | LGET_
   | JOIN_
   | LET_
   | ACK_
@@ -460,6 +467,7 @@ data ACommandTag
 data AEventTag (e :: AEntity) where
   INV_ :: AEventTag AEConn
   LINK_ :: AEventTag AEConn
+  LDATA_ :: AEventTag AEConn
   CONF_ :: AEventTag AEConn
   REQ_ :: AEventTag AEConn
   INFO_ :: AEventTag AEConn
@@ -511,6 +519,7 @@ aCommandTag :: ACommand -> ACommandTag
 aCommandTag = \case
   NEW {} -> NEW_
   LSET {} -> LSET_
+  LGET _ -> LGET_
   JOIN {} -> JOIN_
   LET {} -> LET_
   ACK {} -> ACK_
@@ -521,6 +530,7 @@ aEventTag :: AEvent e -> AEventTag e
 aEventTag = \case
   INV {} -> INV_
   LINK {} -> LINK_
+  LDATA {} -> LDATA_
   CONF {} -> CONF_
   REQ {} -> REQ_
   INFO {} -> INFO_
@@ -1449,6 +1459,15 @@ instance Eq AConnectionRequestUri where
 
 deriving instance Show AConnectionRequestUri
 
+data ShortLinkCreds = ShortLinkCreds
+  { shortLinkId :: SMP.LinkId,
+    shortLinkKey :: LinkKey,
+    linkPrivSigKey :: C.PrivateKeyEd25519,
+    linkRootSigKey :: Maybe C.PublicKeyEd25519, -- in case the current user is not the original owner, and the root key is different from linkPrivSigKey
+    linkEncFixedData :: SMP.EncFixedDataBytes
+  }
+  deriving (Show)
+
 data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show)
 
 data ConnShortLink (m :: ConnectionMode) where
@@ -1704,13 +1723,19 @@ type CRClientData = Text
 data FixedLinkData c = FixedLinkData
   { agentVRange :: VersionRangeSMPA,
     rootKey :: C.PublicKeyEd25519,
-    connReq :: ConnectionRequestUri c
+    linkConnReq :: ConnectionRequestUri c,
+    linkEntityId :: Maybe ByteString
   }
+  deriving (Eq, Show)
 
 data ConnLinkData c where
   InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
   ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact
 
+deriving instance Eq (ConnLinkData c)
+
+deriving instance Show (ConnLinkData c)
+
 data UserContactData = UserContactData
   { -- direct connection via connReq in fixed data is allowed.
     direct :: Bool,
@@ -1735,14 +1760,7 @@ deriving instance Eq (UserConnLinkData m)
 
 deriving instance Show (UserConnLinkData m)
 
-data AUserConnLinkData = forall m. ConnectionModeI m => AUCLD (SConnectionMode m) (UserConnLinkData m)
-
-instance Eq AUserConnLinkData where
-  AUCLD m d == AUCLD m' d' = case testEquality m m' of
-    Just Refl -> d == d'
-    Nothing -> False
-
-deriving instance Show AUserConnLinkData
+data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m)
 
 linkUserData :: ConnLinkData c -> UserLinkData
 linkUserData = \case
@@ -1759,32 +1777,55 @@ type OwnerId = ByteString
 data OwnerAuth = OwnerAuth
   { ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
     ownerKey :: C.PublicKeyEd25519,
-    -- sender ID signed with ownerKey,
-    -- confirms that the owner accepts being the owner.
-    -- sender ID is used here as it is immutable for the queue, link data can be removed.
-    ownerSig :: C.Signature 'C.Ed25519,
-    -- null for root key authorization
-    authOwnerId :: OwnerId,
-    -- owner authorization, sig(ownerId || ownerKey, key(authOwnerId)),
-    -- where authOwnerId is either null for a root key or some other owner authorized by root key, etc.
-    -- Owner validation should detect and reject loops.
+    -- owner authorization by root or any previous owner, sig(ownerId || ownerKey, prevOwnerKey),
     authOwnerSig :: C.Signature 'C.Ed25519
   }
   deriving (Eq, Show)
 
 instance Encoding OwnerAuth where
-  smpEncode OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} =
-    smpEncode (ownerId, ownerKey, C.signatureBytes ownerSig, authOwnerId, C.signatureBytes authOwnerSig)
+  smpEncode OwnerAuth {ownerId, ownerKey, authOwnerSig} =
+    -- It is additionally encoded as ByteString to have known length and allow OwnerAuth extension
+    smpEncode $ smpEncode (ownerId, ownerKey, C.signatureBytes authOwnerSig)
   smpP = do
-    (ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig) <- smpP
-    pure OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig}
+    -- parseOnly ignores any unused extension
+    (ownerId, ownerKey, authOwnerSig) <- A.parseOnly smpP <$?> smpP
+    pure OwnerAuth {ownerId, ownerKey, authOwnerSig}
+
+validateOwners :: Maybe ShortLinkCreds -> UserContactData -> Either String ()
+validateOwners shortLink_ UserContactData {owners} = case shortLink_ of
+  Nothing
+    | null owners -> Right ()
+    | otherwise -> Left "no link credentials with additional owners"
+  Just ShortLinkCreds {linkPrivSigKey, linkRootSigKey}
+    | hasOwner -> validateLinkOwners (fromMaybe k linkRootSigKey) owners
+    | otherwise -> Left "no current owner in link data"
+    where
+      hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners
+      k = C.publicKey linkPrivSigKey
+
+validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String ()
+validateLinkOwners rootKey = go []
+  where
+    go _ [] = Right ()
+    go prev (o : os) = validOwner o >> go (o : prev) os
+      where
+        validOwner OwnerAuth {ownerId = oId, ownerKey = k, authOwnerSig = sig}
+          | k == rootKey = Left $ "owner key for ID " <> idStr <> " matches root key"
+          | any duplicate prev = Left $ "duplicate owner key or ID " <> idStr
+          | signedBy rootKey || any (signedBy . ownerKey) prev = Right ()
+          | otherwise = Left $ "invalid authorization of owner ID " <> idStr
+          where
+            duplicate OwnerAuth {ownerId, ownerKey} = oId == ownerId || k == ownerKey
+            idStr = B.unpack $ B64.encodeUnpadded oId
+            signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k)
 
 instance ConnectionModeI c => Encoding (FixedLinkData c) where
-  smpEncode FixedLinkData {agentVRange, rootKey, connReq} =
-    smpEncode (agentVRange, rootKey, connReq)
+  smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} =
+    smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId
   smpP = do
-    (agentVRange, rootKey, connReq) <- smpP
-    pure FixedLinkData {agentVRange, rootKey, connReq}
+    (agentVRange, rootKey, linkConnReq) <- smpP
+    linkEntityId <- (smpP <|> pure Nothing) <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
+    pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId}
 
 instance ConnectionModeI c => Encoding (ConnLinkData c) where
   smpEncode = \case
@@ -1809,21 +1850,21 @@ instance ConnectionModeI c => Encoding (UserConnLinkData c) where
   smpEncode = \case
     UserInvLinkData userData -> smpEncode (CMInvitation, userData)
     UserContactLinkData cd -> smpEncode (CMContact, cd)
-  smpP = (\(AUCLD _ d) -> checkConnMode d) <$?> smpP
+  smpP = (\(AULD _ d) -> checkConnMode d) <$?> smpP
   {-# INLINE smpP #-}
 
 instance Encoding AUserConnLinkData where
-  smpEncode (AUCLD _ d) = smpEncode d
+  smpEncode (AULD _ d) = smpEncode d
   {-# INLINE smpEncode #-}
   smpP =
     smpP >>= \case
       CMInvitation -> do
         userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
-        pure $ AUCLD SCMInvitation $ UserInvLinkData userData
+        pure $ AULD SCMInvitation $ UserInvLinkData userData
       CMContact ->
-        AUCLD SCMContact . UserContactLinkData <$> smpP
+        AULD SCMContact . UserContactLinkData <$> smpP
 
-instance StrEncoding AUserConnLinkData where
+instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where
   strEncode = smpEncode
   {-# INLINE strEncode #-}
   strP = smpP
@@ -2029,6 +2070,7 @@ instance StrEncoding ACommandTag where
     A.takeTill (== ' ') >>= \case
       "NEW" -> pure NEW_
       "LSET" -> pure LSET_
+      "LGET" -> pure LGET_
       "JOIN" -> pure JOIN_
       "LET" -> pure LET_
       "ACK" -> pure ACK_
@@ -2038,6 +2080,7 @@ instance StrEncoding ACommandTag where
   strEncode = \case
     NEW_ -> "NEW"
     LSET_ -> "LSET"
+    LGET_ -> "LGET"
     JOIN_ -> "JOIN"
     LET_ -> "LET"
     ACK_ -> "ACK"
@@ -2050,6 +2093,7 @@ commandP binaryP =
     >>= \case
       NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
       LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP))
+      LGET_ -> s (LGET <$> strP)
       JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
       LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
       ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP))
@@ -2068,6 +2112,7 @@ serializeCommand :: ACommand -> ByteString
 serializeCommand = \case
   NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode)
   LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_
+  LGET sl -> s (LGET_, sl)
   JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo)
   LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo]
   ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_

src/Simplex/Messaging/Agent/Store.hs

@@ -29,9 +29,9 @@ import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State)
-import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Agent.Store.Common
 import Simplex.Messaging.Agent.Store.DB (SQLError)
+import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Agent.Store.Interface (createDBStore)
 import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..))
@@ -127,14 +127,6 @@ rcvQueueSub :: RcvQueue -> RcvQueueSub
 rcvQueueSub RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId = DBEntityId dbQueueId, primary, dbReplaceQueueId} =
   RcvQueueSub {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId}
 
-data ShortLinkCreds = ShortLinkCreds
-  { shortLinkId :: SMP.LinkId,
-    shortLinkKey :: LinkKey,
-    linkPrivSigKey :: C.PrivateKeyEd25519,
-    linkEncFixedData :: SMP.EncFixedDataBytes
-  }
-  deriving (Show)
-
 type ServiceAssoc = Bool
 
 rcvSMPQueueAddress :: RcvQueue -> SMPQueueAddress

src/Simplex/Messaging/Agent/Store/AgentStore.hs

@@ -45,6 +45,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     deleteClientServices,
 
     -- * Queues and connections
+    createServer,
     createNewConn,
     updateNewConnRcv,
     updateNewConnSnd,
@@ -70,6 +71,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     setConnUserId,
     setConnAgentVersion,
     setConnPQSupport,
+    updateNewConnJoin,
     getDeletedConnIds,
     getDeletedWaitingDeliveryConnIds,
     setConnRatchetSync,
@@ -410,7 +412,7 @@ deleteUsersWithoutConns db = do
 
 createClientService :: DB.Connection -> UserId -> SMPServer -> (C.KeyHash, TLS.Credential) -> IO ()
 createClientService db userId srv (kh, (cert, pk)) = do
-  serverKeyHash_ <- createServer_ db srv
+  serverKeyHash_ <- createServer db srv
   DB.execute
     db
     [sql|
@@ -550,7 +552,7 @@ createSndConn db gVar cData q@SndQueue {server} =
   -- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_
   ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $
     createConn_ db gVar cData $ \connId -> do
-      serverKeyHash_ <- createServer_ db server
+      serverKeyHash_ <- createServer db server
       createConnRecord db connId cData SCMInvitation
       insertSndQueue_ db connId q serverKeyHash_
 
@@ -635,7 +637,7 @@ addConnRcvQueue db connId rq subMode =
 
 addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
 addConnRcvQueue_ db connId rq@RcvQueue {server} subMode = do
-  serverKeyHash_ <- createServer_ db server
+  serverKeyHash_ <- createServer db server
   insertRcvQueue_ db connId rq subMode serverKeyHash_
 
 addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
@@ -647,7 +649,7 @@ addConnSndQueue db connId sq =
 
 addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue
 addConnSndQueue_ db connId sq@SndQueue {server} = do
-  serverKeyHash_ <- createServer_ db server
+  serverKeyHash_ <- createServer db server
   insertSndQueue_ db connId sq serverKeyHash_
 
 setRcvQueueStatus :: DB.Connection -> RcvQueue -> QueueStatus -> IO ()
@@ -945,7 +947,7 @@ deleteInvShortLink db srv lnkId =
 
 createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
 createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do
-  serverKeyHash_ <- createServer_ db server
+  serverKeyHash_ <- createServer db server
   DB.execute
     db
     [sql|
@@ -2149,8 +2151,8 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
 -- * Server helper
 
 -- | Creates a new server, if it doesn't exist, and returns the passed key hash if it is different from stored.
-createServer_ :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
-createServer_ db newSrv@ProtocolServer {host, port, keyHash} = do
+createServer :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
+createServer db newSrv@ProtocolServer {host, port, keyHash} = do
   r <- insertNewServer_
   if null r
     then getServerKeyHash_ db newSrv >>= either E.throwIO pure
@@ -2593,6 +2595,10 @@ setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO ()
 setConnPQSupport db connId pqSupport =
   DB.execute db "UPDATE connections SET pq_support = ? WHERE conn_id = ?" (pqSupport, connId)
 
+updateNewConnJoin :: DB.Connection -> ConnId -> VersionSMPA -> PQSupport -> Bool -> IO ()
+updateNewConnJoin db connId aVersion pqSupport enableNtfs =
+  DB.execute db "UPDATE connections SET smp_agent_version = ?, pq_support = ?, enable_ntfs = ? WHERE conn_id = ?" (aVersion, pqSupport, BI enableNtfs, connId)
+
 getDeletedConnIds :: DB.Connection -> IO [ConnId]
 getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only (BI True))
 
@@ -2678,7 +2684,7 @@ toRcvQueue
         (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
         _ -> Nothing
       shortLink = case (shortLinkId_, shortLinkKey_, linkPrivSigKey_, linkEncFixedData_) of
-        (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}
+        (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkRootSigKey = Nothing, linkEncFixedData} -- TODO linkRootSigKey should be stored in a separate field
         _ -> Nothing
       enableNtfs = maybe True unBI enableNtfs_
    in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, queueMode, shortLink, rcvServiceAssoc, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}

src/Simplex/Messaging/Agent/Store/Postgres/Common.hs

@@ -19,6 +19,7 @@ module Simplex.Messaging.Agent.Store.Postgres.Common
   )
 where
 
+import Control.Monad (void)
 import Control.Concurrent.MVar
 import Control.Concurrent.STM
 import qualified Control.Exception as E
@@ -100,7 +101,7 @@ withTransactionPriority st priority action = withConnectionPriority st priority
 -- to restore the transaction to a usable state before returning the error.
 withSavepoint :: PSQL.Connection -> PSQL.Query -> IO a -> IO (Either PSQL.SqlError a)
 withSavepoint db name action = do
-  PSQL.execute_ db $ "SAVEPOINT " <> name
+  void $ PSQL.execute_ db $ "SAVEPOINT " <> name
   E.try action
     >>= bimapM
       (PSQL.execute_ db ("ROLLBACK TO SAVEPOINT " <> name) $>)

src/Simplex/Messaging/Crypto/ShortLink.hs

@@ -21,6 +21,7 @@ module Simplex.Messaging.Crypto.ShortLink
 where
 
 import Control.Concurrent.STM
+import Control.Monad (unless)
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
@@ -32,7 +33,7 @@ import Simplex.Messaging.Agent.Client (cryptoError)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Protocol (EntityId (..), LinkId, EncDataBytes (..), QueueLinkData)
+import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), LinkId, QueueLinkData)
 import Simplex.Messaging.Util (liftEitherWith)
 
 fixedDataPaddedLength :: Int
@@ -50,8 +51,8 @@ invShortLinkKdf :: LinkKey -> C.SbKey
 invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
 
 encodeSignLinkData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString))
-encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
-  let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq}
+encodeSignLinkData (rootKey, pk) agentVRange linkConnReq userData =
+  let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId = Nothing}
       md = smpEncode $ connLinkData agentVRange userData
    in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
 
@@ -81,17 +82,22 @@ encryptData g k len s = do
   ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len
   pure $ EncDataBytes $ smpEncode nonce <> ct
 
-decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c)
+decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (FixedLinkData c, ConnLinkData c)
 decryptLinkData linkKey k (encFD, encMD) = do
   (sig1, fd) <- decrypt encFD
   (sig2, md) <- decrypt encMD
-  FixedLinkData {rootKey, connReq} <- decode fd
+  fd'@FixedLinkData {rootKey} <- decode fd
   md' <- decode @(ConnLinkData c) md
+  let signedBy k' = C.verify' k' sig2 md
   if
     | LinkKey (C.sha3_256 fd) /= linkKey -> linkErr "link data hash"
     | not (C.verify' rootKey sig1 fd) -> linkErr "link data signature"
-    | not (C.verify' rootKey sig2 md) -> linkErr "user data signature"
-    | otherwise -> Right (connReq, md')
+    | otherwise -> case md' of
+        InvitationLinkData {} -> unless (signedBy rootKey) $ linkErr "user data signature"
+        ContactLinkData _ UserContactData {owners} -> do
+          first (AGENT . A_LINK) $ validateLinkOwners rootKey owners
+          unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature"
+  Right (fd', md')
   where
     decrypt (EncDataBytes d) = do
       (nonce, Tail ct) <- decode d
@@ -100,4 +106,5 @@ decryptLinkData linkKey k (encFD, encMD) = do
     decode :: Encoding a => ByteString -> Either AgentErrorType a
     decode = msgErr . smpDecode
     msgErr = first (const $ AGENT A_MESSAGE)
+    linkErr :: String -> Either AgentErrorType ()
     linkErr = Left . AGENT . A_LINK

tests/AgentTests/EqInstances.hs

@@ -5,7 +5,7 @@
 module AgentTests.EqInstances where
 
 import Data.Type.Equality
-import Simplex.Messaging.Agent.Protocol (ConnLinkData (..))
+import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..))
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client (ProxiedRelay (..))
 
@@ -28,10 +28,6 @@ deriving instance Eq ClientNtfCreds
 
 deriving instance Eq ShortLinkCreds
 
-deriving instance Show (ConnLinkData c)
-
-deriving instance Eq (ConnLinkData c)
-
 deriving instance Show ProxiedRelay
 
 deriving instance Eq ProxiedRelay

tests/AgentTests/FunctionalAPITests.hs

@@ -310,7 +310,7 @@ deleteConnection c = A.deleteConnection c NRMInteractive
 deleteConnections :: AgentClient -> [ConnId] -> AE (M.Map ConnId (Either AgentErrorType ()))
 deleteConnections c = A.deleteConnections c NRMInteractive
 
-getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
+getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c)
 getConnShortLink c = A.getConnShortLink c NRMInteractive
 
 setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c)
@@ -455,6 +455,8 @@ functionalAPITests ps = do
       testBasicMatrix2 ps testAsyncCommands
     it "should add short link data using async agent command" $
       testSetConnShortLinkAsync ps
+    it "should get short link data and join connection using async agent commands" $
+      testGetConnShortLinkAsync ps
     it "should restore and complete async commands on restart" $
       testAsyncCommandsRestore ps
     describe "accept connection using async command" $
@@ -1369,12 +1371,12 @@ testInvitationShortLink viaProxy a b =
     let userData = UserLinkData "some user data"
         newLinkData = UserInvLinkData userData
     (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
-    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
     linkUserData connData' `shouldBe` userData
     -- same user can get invitation link again
-    (connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq2}, connData2) <- runRight $ getConnShortLink b 1 shortLink
     connReq2 `shouldBe` connReq
     linkUserData connData2 `shouldBe` userData
     -- another user cannot get the same invitation link
@@ -1412,12 +1414,12 @@ testInvitationShortLinkAsync viaProxy a b = do
   let userData = UserLinkData "some user data"
       newLinkData = UserInvLinkData userData
   (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
-  (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
+  (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
   strDecode (strEncode shortLink) `shouldBe` Right shortLink
   connReq' `shouldBe` connReq
   linkUserData connData' `shouldBe` userData
   runRight $ do
-    aId <- A.joinConnectionAsync b 1 "123" True connReq "bob's connInfo" PQSupportOn SMSubscribe
+    aId <- A.joinConnectionAsync b 1 "123" Nothing True connReq "bob's connInfo" PQSupportOn SMSubscribe
     get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False
     ("", _, CONF confId _ "bob's connInfo") <- get a
     allowConnection a bId confId "alice's connInfo"
@@ -1440,16 +1442,16 @@ testContactShortLink viaProxy a b =
         newLinkData = UserContactLinkData userCtData
     (contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe
     Right connReq <- pure $ smpDecode (smpEncode connReq0)
-    (connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
     userCtData' `shouldBe` userCtData
     -- same user can get contact link again
-    (connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
     connReq2 `shouldBe` connReq
     userCtData2 `shouldBe` userCtData
     -- another user can get the same contact link
-    (connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
+    (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
     connReq3 `shouldBe` connReq
     userCtData3 `shouldBe` userCtData
     runRight $ do
@@ -1471,7 +1473,7 @@ testContactShortLink viaProxy a b =
         userLinkData' = UserContactLinkData updatedCtData
     shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
     shortLink' `shouldBe` shortLink
-    (connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
+    (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
     connReq4 `shouldBe` connReq
     updatedCtData' `shouldBe` updatedCtData
     -- one more time
@@ -1491,16 +1493,16 @@ testAddContactShortLink viaProxy a b =
         userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
         newLinkData = UserContactLinkData userCtData
     shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing
-    (connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
     userCtData' `shouldBe` userCtData
     -- same user can get contact link again
-    (connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
     connReq2 `shouldBe` connReq
     userCtData2 `shouldBe` userCtData
     -- another user can get the same contact link
-    (connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
+    (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
     connReq3 `shouldBe` connReq
     userCtData3 `shouldBe` userCtData
     runRight $ do
@@ -1522,7 +1524,7 @@ testAddContactShortLink viaProxy a b =
         userLinkData' = UserContactLinkData updatedCtData
     shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
     shortLink' `shouldBe` shortLink
-    (connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
+    (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
     connReq4 `shouldBe` connReq
     updatedCtData' `shouldBe` updatedCtData
 
@@ -1534,7 +1536,7 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
     runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMOnlyCreate
   withSmpServer ps $ do
     runRight_ $ subscribeConnection a bId
-    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
     linkUserData connData' `shouldBe` userData
@@ -1623,7 +1625,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
         userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
         userLinkData = UserContactLinkData userCtData
     shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing
-    (connReq', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
     userCtData' `shouldBe` userCtData
@@ -1634,7 +1636,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
     shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
     shortLink' `shouldBe` shortLink
     -- check updated
-    (connReq'', ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
+    (FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
     connReq'' `shouldBe` connReq
     updatedCtData' `shouldBe` updatedCtData
 
@@ -2617,7 +2619,7 @@ testAsyncCommands sqSecured alice bob baseId =
     bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
     ("1", bobId', INV (ACR _ qInfo)) <- get alice
     liftIO $ bobId' `shouldBe` bobId
-    aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+    aliceId <- joinConnectionAsync bob 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     ("2", aliceId', JOINED sqSecured') <- get bob
     liftIO $ do
       aliceId' `shouldBe` aliceId
@@ -2675,8 +2677,8 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
     -- update link data async
     let updatedData = UserLinkData "updated user data"
         updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData}
-    setConnShortLinkAsync alice "1" cId SCMContact (UserContactLinkData updatedCtData) Nothing
-    ("1", cId', LINK (ACSL SCMContact shortLink') (AUCLD SCMContact (UserContactLinkData updatedCtData'))) <- get alice
+    setConnShortLinkAsync alice "1" cId (UserContactLinkData updatedCtData) Nothing
+    ("1", cId', LINK shortLink' (UserContactLinkData updatedCtData')) <- get alice
     liftIO $ cId' `shouldBe` cId
     liftIO $ shortLink' `shouldBe` shortLink
     liftIO $ updatedCtData' `shouldBe` updatedCtData
@@ -2694,6 +2696,34 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
 
+testGetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
+testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
+  withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
+    let userData = UserLinkData "test user data"
+        userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
+        newLinkData = UserContactLinkData userCtData
+    (_, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe
+    -- get link data async - creates new connection for bob
+    newId <- getConnShortLinkAsync bob 1 "1" shortLink
+    ("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData')) <- get bob
+    liftIO $ newId' `shouldBe` newId
+    liftIO $ qInfo' `shouldBe` qInfo
+    liftIO $ userCtData' `shouldBe` userCtData
+    -- join connection async using connId from getConnShortLinkAsync
+    aliceId <- joinConnectionAsync bob 1 "2" (Just newId) True qInfo' "bob's connInfo" PQSupportOn SMSubscribe
+    liftIO $ aliceId `shouldBe` newId
+    ("2", aliceId', JOINED False) <- get bob
+    liftIO $ aliceId' `shouldBe` aliceId
+    -- complete connection
+    ("", _, REQ invId _ "bob's connInfo") <- get alice
+    bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
+    _ <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
+    ("", _, CONF confId _ "alice's connInfo") <- get bob
+    allowConnection bob aliceId confId "bob's connInfo"
+    get alice ##> ("", bobId, INFO "bob's connInfo")
+    get alice ##> ("", bobId, CON)
+    get bob ##> ("", aliceId, CON)
+
 testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO ()
 testAsyncCommandsRestore ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
@@ -2987,7 +3017,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do
         bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
         ("1", bId', INV (ACR _ qInfo)) <- get a
         liftIO $ bId' `shouldBe` bId
-        aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+        aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
         liftIO $ threadDelay 500000
         ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
         pure (aId, bId)
@@ -3032,7 +3062,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
         bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe
         ("1", bId', INV (ACR _ qInfo)) <- get a
         liftIO $ bId' `shouldBe` bId
-        aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+        aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
         liftIO $ threadDelay 500000
         ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
         pure (aId, bId)

tests/AgentTests/ShortLinkTests.hs

@@ -11,10 +11,14 @@ import AgentTests.ConnectionRequestTests (contactConnRequest, invConnRequest)
 import AgentTests.EqInstances ()
 import Control.Concurrent.STM
 import Control.Monad.Except
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnLinkData (..), ConnectionMode (..), ConnShortLink (..), LinkKey (..), UserConnLinkData (..), SConnectionMode (..), SMPAgentError (..), UserContactData (..), UserLinkData (..), linkUserData, supportedSMPAgentVRange)
+import Crypto.Random (ChaChaDRG)
+import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.ByteString.Char8 as B
+import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.ShortLink as SL
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (EncFixedDataBytes)
 import Test.Hspec hiding (fit, it)
 import Util
 
@@ -28,6 +32,10 @@ shortLinkTests = do
     it "should encrypt updated user data" testUpdateContactShortLink
     it "should fail to decrypt contact data with bad hash" testContactShortLinkBadDataHash
     it "should fail to decrypt contact data with bad signature" testContactShortLinkBadSignature
+  describe "contact link with additional owners" $ do
+    it "should encrypt and decrypt data with additional owner" testContactShortLinkOwner
+    it "should encrypt and decrypt data with many additional owners" testContactShortLinkManyOwners
+    it "should fail to decrypt contact data with invalid or unauthorized owners" testContactShortLinkInvalidOwners
 
 testInvShortLink :: IO ()
 testInvShortLink = do
@@ -40,7 +48,7 @@ testInvShortLink = do
       k = SL.invShortLinkKdf linkKey
   Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
   -- decrypt
-  Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData
+  Right (FixedLinkData {linkConnReq = connReq}, connData') <- pure $ SL.decryptLinkData linkKey k srvData
   connReq `shouldBe` invConnRequest
   linkUserData connData' `shouldBe` userData
 
@@ -78,7 +86,7 @@ testContactShortLink = do
       (_linkId, k) = SL.contactShortLinkKdf linkKey
   Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
   -- decrypt
-  Right (connReq, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
+  Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
   connReq `shouldBe` contactConnRequest
   userCtData' `shouldBe` userCtData
 
@@ -100,7 +108,7 @@ testUpdateContactShortLink = do
       signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData'
   Right ud' <- runExceptT $ SL.encryptUserData g k signed
   -- decrypt
-  Right (connReq, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
+  Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
   connReq `shouldBe` contactConnRequest
   userCtData'' `shouldBe` userCtData'
 
@@ -140,3 +148,113 @@ testContactShortLinkBadSignature = do
   -- decryption fails
   SL.decryptLinkData @'CMContact linkKey k (fd, ud')
     `shouldBe` Left (AGENT (A_LINK "user data signature"))
+
+testContactShortLinkOwner :: IO ()
+testContactShortLinkOwner = do
+  -- encrypt
+  g <- C.newRandom
+  (pk, lnk) <- encryptLink g
+  -- encrypt updated user data
+  (ownerPK, owner) <- authNewOwner g pk
+  let ud = UserContactData {direct = True, owners = [owner], relays = [], userData = UserLinkData "updated user data"}
+  testEncDec g pk lnk ud
+  testEncDec g ownerPK lnk ud
+  (_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
+  testEncDecFail g wrongKey lnk ud $ A_LINK "user data signature"
+
+encryptLink :: TVar ChaChaDRG -> IO (C.PrivateKeyEd25519, (EncFixedDataBytes, LinkKey, C.SbKey))
+encryptLink g = do
+  sigKeys@(_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g
+  let userData = UserLinkData "some user data"
+      userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
+      (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest userLinkData
+      (_linkId, k) = SL.contactShortLinkKdf linkKey
+  Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
+  pure (pk, (fd, linkKey, k))
+
+authNewOwner :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> IO (C.PrivateKeyEd25519, OwnerAuth)
+authNewOwner g pk = do
+  (ownerKey, ownerPK) <- atomically $ C.generateKeyPair @'C.Ed25519 g
+  ownerId <- atomically $ C.randomBytes 16 g
+  let authOwnerSig = C.sign' pk $ ownerId <> C.encodePubKey ownerKey
+  pure (ownerPK, OwnerAuth {ownerId, ownerKey, authOwnerSig})
+
+testEncDec :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkKey, C.SbKey) -> UserContactData -> IO ()
+testEncDec g pk (fd, linkKey, k) ctData = do
+  let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData
+  Right ud <- runExceptT $ SL.encryptUserData g k signed
+  Right (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud)
+  connReq' `shouldBe` contactConnRequest
+  ctData' `shouldBe` ctData
+
+testContactShortLinkManyOwners :: IO ()
+testContactShortLinkManyOwners = do
+  -- encrypt
+  g <- C.newRandom
+  (pk, lnk) <- encryptLink g
+  -- encrypt updated user data
+  (ownerPK1, owner1) <- authNewOwner g pk
+  (ownerPK2, owner2) <- authNewOwner g pk
+  (ownerPK3, owner3) <- authNewOwner g ownerPK1
+  (ownerPK4, owner4) <- authNewOwner g ownerPK1
+  (ownerPK5, owner5) <- authNewOwner g ownerPK3
+  let owners = [owner1, owner2, owner3, owner4, owner5]
+      ud = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"}
+  testEncDec g pk lnk ud
+  testEncDec g ownerPK1 lnk ud
+  testEncDec g ownerPK2 lnk ud
+  testEncDec g ownerPK3 lnk ud
+  testEncDec g ownerPK4 lnk ud
+  testEncDec g ownerPK5 lnk ud
+  (_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
+  testEncDecFail g wrongKey lnk ud $ A_LINK "user data signature"
+
+testContactShortLinkInvalidOwners :: IO ()
+testContactShortLinkInvalidOwners = do
+  -- encrypt
+  g <- C.newRandom
+  (pk, lnk) <- encryptLink g
+  -- encrypt updated user data
+  (ownerPK, owner) <- authNewOwner g pk
+  let mkCtData owners = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"}
+  -- decryption fails: owner uses root key
+  let ud = mkCtData [owner {ownerKey = C.publicKey pk}]
+      err = A_LINK $ "owner key for ID " <> ownerIdStr owner <> " matches root key"
+  testEncDecFail g pk lnk ud err
+  testEncDecFail g ownerPK lnk ud err
+  -- decryption fails: duplicate owner ID or key
+  (ownerPK1, owner1) <- authNewOwner g pk
+  let ud1 = mkCtData [owner, owner1 {ownerId = ownerId owner}]
+      ud1' = mkCtData [owner, owner1 {ownerKey = ownerKey owner}]
+      err1 o = A_LINK $ "duplicate owner key or ID " <> ownerIdStr o
+  testEncDecFail g pk lnk ud1 $ err1 owner
+  testEncDecFail g pk lnk ud1' $ err1 owner1
+  -- decryption fails: wrong order
+  (ownerPK2, owner2) <- authNewOwner g ownerPK
+  let ud2 = mkCtData [owner, owner1, owner2]
+      ud2' = mkCtData [owner, owner2, owner1]
+  testEncDec g pk lnk ud2
+  testEncDec g pk lnk ud2'
+  testEncDec g ownerPK lnk ud2
+  testEncDec g ownerPK1 lnk ud2
+  testEncDec g ownerPK2 lnk ud2
+  let ud2'' = mkCtData [owner2, owner, owner1]
+      err2 = A_LINK $ "invalid authorization of owner ID " <> ownerIdStr owner2
+  testEncDecFail g pk lnk ud2'' err2
+  -- decryption fails: authorized with wrong key
+  (_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
+  (_, owner3) <- authNewOwner g wrongKey
+  let ud3 = mkCtData [owner3]
+      ud3' = mkCtData [owner, owner1, owner2, owner3]
+      err3 = A_LINK $ "invalid authorization of owner ID " <> ownerIdStr owner3
+  testEncDecFail g pk lnk ud3 err3
+  testEncDecFail g pk lnk ud3' err3
+
+testEncDecFail :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkKey, C.SbKey) -> UserContactData -> SMPAgentError -> IO ()
+testEncDecFail g pk (fd, linkKey, k) ctData err = do
+  let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData
+  Right ud <- runExceptT $ SL.encryptUserData g k signed
+  SL.decryptLinkData @'CMContact linkKey k (fd, ud) `shouldBe` Left (AGENT err)
+
+ownerIdStr :: OwnerAuth -> String
+ownerIdStr OwnerAuth {ownerId} = B.unpack $ B64.encodeUnpadded ownerId