smp server: short links and owners for channels (#1506)

* smp server: short links and owners for channels

* types

* support mutliple rcv keys

* fix down migration, test/create server schema dump

* reduce schema dump

* parameterize type for link data by connection type

* return full connection link data

* test version

* change short link encoding

* test: print pg_dump output

* server pages, link encoding

* fix connection request when queue data and sender ID are created for old servers

* test, change pattern

* ci: install postgresql tools in runner (#1507)

* ci: install postgresql tools in runner

* ci: docker shell abort on error

* fix pattern for ghc 8.10.7

* patch ConnReqUriData SMP encoding to preserve queue mode after decoding

* test for RKEY

* fix/test store log with RKEY

---------

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>

.github/workflows/build.yml

@@ -48,6 +48,19 @@ jobs:
       - name: Set up Docker Buildx
         uses: simplex-chat/docker-setup-buildx-action@v3
 
+      - name: Install PostgreSQL 15 client tools
+        if: matrix.os == '22.04'
+        shell: bash
+        run: |
+          # Import the repository signing key
+          sudo install -d /usr/share/postgresql-common/pgdg
+          sudo curl -o /usr/share/postgresql-common/pgdg/apt.postgresql.org.asc --fail https://www.postgresql.org/media/keys/ACCC4CF8.asc
+          # Add the PostgreSQL APT repository
+          sudo sh -c 'echo "deb [signed-by=/usr/share/postgresql-common/pgdg/apt.postgresql.org.asc] https://apt.postgresql.org/pub/repos/apt $(lsb_release -cs)-pgdg main" > /etc/apt/sources.list.d/pgdg.list'
+          # Update repository and install postgresql tools
+          sudo apt update
+          sudo apt -y install postgresql-client-15
+
       - name: Build and cache Docker image
         uses: simplex-chat/docker-build-push-action@v6
         with:
@@ -82,7 +95,7 @@ jobs:
             build/${{ matrix.platform_name }}:latest
 
       - name: Build smp-server (postgresql) and tests
-        shell: docker exec -t builder sh {0}
+        shell: docker exec -t builder sh -eu {0}
         run: |
           cabal update
           cabal build --jobs=$(nproc) --enable-tests -fserver_postgres
@@ -106,7 +119,7 @@ jobs:
           docker cp builder:/out/smp-server ./smp-server-postgres-ubuntu-${{ matrix.platform_name }}
 
       - name: Build everything else (standard)
-        shell: docker exec -t builder sh {0}
+        shell: docker exec -t builder sh -eu {0}
         run: |
           cabal build --jobs=$(nproc)
           mkdir -p /out

apps/smp-server/static/a/index.html

@@ -0,0 +1 @@
+./apps/smp-server/static/link.html

apps/smp-server/static/c/index.html

@@ -0,0 +1 @@
+./apps/smp-server/static/link.html

apps/smp-server/static/i/index.html

@@ -0,0 +1 @@
+./apps/smp-server/static/link.html

apps/smp-server/web/Static.hs

@@ -84,11 +84,16 @@ generateSite si onionHost sitePath = do
   B.writeFile (sitePath </> "index.html") $ serverInformation si onionHost
   createDirectoryIfMissing True $ sitePath </> "media"
   forM_ E.mediaContent $ \(path, bs) -> B.writeFile (sitePath </> "media" </> path) bs
-  createDirectoryIfMissing True $ sitePath </> "contact"
-  B.writeFile (sitePath </> "contact" </> "index.html") E.linkHtml
-  createDirectoryIfMissing True $ sitePath </> "invitation"
-  B.writeFile (sitePath </> "invitation" </> "index.html") E.linkHtml
+  createLinkPage "contact"
+  createLinkPage "invitation"
+  createLinkPage "a"
+  createLinkPage "c"
+  createLinkPage "i"
   logInfo $ "Generated static site contents at " <> tshow sitePath
+  where
+    createLinkPage path = do
+      createDirectoryIfMissing True $ sitePath </> path
+      B.writeFile (sitePath </> path </> "index.html") E.linkHtml
 
 serverInformation :: ServerInformation -> Maybe TransportHost -> ByteString
 serverInformation ServerInformation {config, information} onionHost = render E.indexHtml substs

rfcs/2025-04-04-short-links-for-groups.md

@@ -59,45 +59,101 @@ While the server domain would be used as the hostname in group link, it may cont
 Pros: separates additional complexity to where it is needed, allowing reliability and redundancy for group ownership.
 Cons: complexity, coupling between SMP and chat protocol.
 
-## Design ideas for group as a separate entity type
+## Design for channel/group as a separate queue mode
 
-The last solution approach seems both the most long-term and also provides the best functionality, so maybe it could be an extensible base.
+Option 1.
 
-Its advantage is that it does not require e2e encryption between owners, as only public keys are shared (although MITM is still possible without verification, mitigated by using multiple chat relays).
+A queue mode "channel" when owners are represented by their individual queues (either a separate mode, or a submode of "channel", or just normal contact address queues). In this case sending message to channel queue would broadcast message to queue owners, without exposing even the number of owners.
 
-The proposal is to have a new entity "asset", and a queue mode "asset". This entity represents a reference to some kind of digital asset, not part of SMP spec. Each link is managed by multiple owners, each represented with "asset" queue.
+Pros:
+- allows chat relays to send messages to all owners (e.g., channel can be secured with the list of snd keys, one per relay).
+- quite easy to evolve from the current design.
+- extensible.
+Cons:
+- close to "solution in search of a problem".
+- does not require data model changes - channel queue would simply have a list of owner "recipient IDs", and each owner queue would also point to channel.
 
-The change from the current design is simple - splitting the link and data from the queue table/record into a separate table, so that the same link can be referenced by multiple queues with different owner IDs. Any of the linked asset queue recipients can modify link data and delete link. The protocol encoding could support multisig, but it can be added later with a separate protocol version. But it would alread allow having multiple owners for link.
+Option 2.
 
-It is also probably correct to require that Ed25519 is used for recipient/owner authorization (and not X25519 authenticators that are used for senders).
+Also a separate queue mode "channel", but instead of having a linked owner queues, it would simply maintain a list of owner keys to maintain the data. In this case, messages cannot be sent to this "queue" at all.
 
-Question 1: should the same signature key be used for signing server commands and owner-owner comms? There may be a benefit in having two different keys, and in contexts visible to both server and owners use server key, and in contexts visible to owners only use signature key inside data.
+Pros:
+- simpler design.
+- we could allow sending messages to it too, with the "main" owner receiving them. This could be negotiated in the protocol.
+- it may be easier to migrate the current groups, as the admin link would be this queue (although for public groups in directory it would have to be recreated anyway).
+- Possibly, when queue is created there should be a flag whether it should accept unsigned messages - then contact addresses would be created with unsigned messages ON, messages queues, once SKEY is universally supported, with unsigned messages OFF, and channel queues with unsigned messages OFF too for new public queues.
+Cons:
+- if no messages are accepted, this is not even a queue.
+- no way to directly contact owners (maybe it is not a downside, as for relays there would be a communication channel anyway as part of the group).
 
-Question 2: should non-owners see server keys of owners? If not, does it suggest a third owner-only data blob? Or should the server simply maintain the currently signed ownership agreement? Or even the history of the agreement changes?
+Option 2 looks more simple and attractive, implementing server broadcast for SMP seems unnecessary, as while it could have been used for simple groups, it does not solve such problems as spam and pre-moderation anyway - it requires a higher level protocol.
 
-Question 3: how would the owner validate the correctness of ownership changes - where this chain will be maintained? Should it maybe be replicated to all owners' "asset" queues? Or will it be a separate "chain" that will be truncated once all owners acknowledge the change? Almost like a separate queue?
+The command to update owner keys would be `RKEY` with the list of keys, and we can make `NEW` accept multiple keys too, although the use case here is less clear.
 
-The protocol change required would be to make sender ID optional in LNK response. Alternatively, link could have its own sender ID and broadcast messages to link owners, and a rule whether messages can be sent without key, and whether this link can be secured with SKEY. Depending on queue type it would be:
+## Multiple owners managing queue data.
 
-- "messaging" queue: can secure, can send messages.
-- "contact" queue: cannot secure (only owner can secure), can send unsigned messages.
-- "asset" queue: cannot secure, cannot send unsigned messages.
+Option 1: Use the same keys in SMP as when signing queue data.
 
-To allow multiple delegates the queue could allow multiple send keys. In case of delegates (chat relays), we could require that only Ed25519 keys are used (for non-repudiation).
+Option 2: Use different keys.
 
-The additional commands required would be to add, get and delete link owners:
-- invite owner (OADD): adds some random server-generated new owner ID to link - this token with the current owner's signature will be included in NEW command (the signed token to be passed out of band). Separate table?
-- remove owner (ODEL): remove owner from link by owner ID (both before and after new owner accepted ownership).
-- get owners (OGET): get current owner IDs and their public keys.
-- how would notification be delivered to the owner when s/he is removed? Some event? Possibly all changes are delivered as messages to each "owner's" asset queue, probably with longer expiration periods?
+The value here could be that the server could validate these signatures too, and also maintain the chain of key changes. While tempting, it is probably unnecessary, and this chain of ownership is better to be maintained on chat relay level, as there are no size constraints on the size of this chain. Also, it is better for metadata privacy to not couple transport and chat protocol keys.
 
-While initially we don't need to build support for multisig in UX, it can be easily added later with this design.
+We still need to bind the mutable data updates to the "genesis" signature key (the one included in the immutable data).
 
-The flow then would be, for new "asset" queue with link - it is created as usual, with "NEW" command, and queueMode QMAsset that is passed linkId and link data.
+The proposed design:
 
-When additional owners want to be added to the group, they would have to create "link" type queue without link ID (thus preventing non-consensual ownership transfer). The flow would be this:
-- group owner(s) offer to become additional owner with the specific new multisig rule, this is sent as a message in chat with signed ID from `OADD` command.
-- the proposed owner will validate that this offer is signed according to the current multisig rule, by loading queue data and current owners (possibly via its ID from `OADD` command, that would also secure this owner ID).
-- if the proposed owner accepts it, s/he will create a new "asset" queue linking it with the same link ID - the server would also accept signed owner ID as a confirmation.
+- when mutable data is signed by genesis key, then it is bound, and no changes is needed.
+- mutable data may be signed by the key of the new owner, in which case mutable part itself must contain the binding. We could also use ring signature to sign the mutable data, concealing which owner signed the data - that would increase the signature size from 64 bytes to `32 * (n + 1)` bytes.
 
-Alternatively, it could be an out-of-band exchange first, when existing owner sends an offer, the new owner accepts it and returns the key (and signed offer), and then this key is sent to the server by the old owner, returning owner ID to the new owner.
+Current mutable data:
+
+```haskell
+data UserLinkData = UserLinkData
+  { agentVRange :: VersionRangeSMPA,
+    userData :: ConnInfo
+  }
+```
+
+Proposed mutable data:
+
+```haskell
+data UserLinkData = UserLinkData
+  { agentVRange :: VersionRangeSMPA,
+    owners :: [OwnerInfo]
+    userData :: ConnInfo
+  }
+
+type OwnerId = ByteString
+
+data OwnerInfo = OwnerInfo
+  { ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
+    ownerKey :: PublicKeyEd25519,
+    -- owner signature of sender ID,
+    -- confirms that the owner agreed with being the owner,
+    -- prevents a member being added as an owner without consent.
+    ownerSig :: SignatureEd25519,
+    -- owner authorization, sig(ownerId || ownerKey, prevKey), where prevKey is either a "genesis key" or some other key previously signed by the genesis key.
+    authOwnerId :: OwnerId, -- null for "genesis"
+    authOwnerSig :: SignatureEd25519
+  }
+```
+
+The size of the OwnerInfo record encoding is:
+- ownerId: 1 + 12
+- ownerKey: 1 + 32
+- ownerSig: 1 + 64
+- ownerAuthId: 1 + 12
+- ownerAuthSig: 1 + 64
+
+~189 bytes, so we should practically limit the number of owners to say 8 - 1 original + 7 addiitonal. Original creator could use a different key as a "genesis" key, to conceal creator identity from other members, and it needs to include the record with memberId anyway.
+
+The structure is simplified, and it does not allow arbitrary ownership changes. Its purpose is not to comprehensively manage ownership changes - while it is possible with a generic blockchain, it seems not appropriate at this stage, - but rather to ensure access continuity and that the server cannot modify the data (although nothing prevents the server from removing the data completely or from serving the previous version of the data).
+
+For example it would only allow any given owner to remove subsequenty added owners, preserving the group link and identity, but it won't allow removing owners that signed this owner authorization. So owners are not equal, with the creator having the highest rank and being able to remove all additional owners, and owners authorise by creator can remove all other owners but themselves and creator, and so on - they have to maintain the chain that authorized themselves, at least. We could explicitely include owner rank into OwnerInfo, or we could require that they are sorted by rank, or the rank can be simply derived from signatures.
+
+When additional owners want to be added to the group, they would have to provide any of the current owners:
+- the key for SMP commands authorization - this will be passed to SMP server together with other keys. There could be either RKEY to pass all keys (some risk to miss some, or of race conditions), or RADD/RGET/RDEL to add and remove recipient keys, which has no risk of race conditions.
+- the signature of the immutable data by their member key included in their profile.
+- the current owner would then include their member key into the queue data, and update it with LSET command. In any case there should be some simple consensus protocol between owners for owner changes, and it has to be maintained as a blockchain by owners and by chat relays, as otherwise it may lead to race conditions with LSET command.
+
+Potentially, there could be one command to update keys and link data, so that they are consistent.

simplexmq.cabal

@@ -482,6 +482,9 @@ test-suite simplexmq-test
       other-modules:
           AgentTests.SchemaDump
           AgentTests.SQLiteTests
+  if flag(server_postgres)
+      other-modules:
+          ServerTests.SchemaDump  
   hs-source-dirs:
       tests
       apps/smp-server/web
@@ -538,10 +541,12 @@ test-suite simplexmq-test
     cpp-options: -DdbPostgres
   else
     build-depends:
-        deepseq ==1.4.*
-      , memory
-      , process
+        memory
       , sqlcipher-simple
+  if !flag(client_postgres) || flag(server_postgres)
+    build-depends:
+        deepseq ==1.4.*
+      , process
   if flag(client_postgres) || flag(server_postgres)
     build-depends:
         postgresql-simple ==0.7.*

src/Simplex/Messaging/Agent.hs

@@ -200,6 +200,7 @@ import Simplex.Messaging.Protocol
     MsgFlags (..),
     NtfServer,
     ProtoServerWithAuth (..),
+    ProtocolServer (..),
     ProtocolType (..),
     ProtocolTypeI (..),
     QueueLinkData,
@@ -379,7 +380,7 @@ deleteContactShortLink c = withAgentEnv c . deleteContactShortLink' c
 {-# INLINE deleteContactShortLink #-}
 
 -- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries
-getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnInfo)
+getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c)
 getConnShortLink c = withAgentEnv c .: getConnShortLink' c
 {-# INLINE getConnShortLink #-}
 
@@ -838,7 +839,7 @@ setContactShortLink' c connId userData =
       SomeConn _ (ContactConnection _ rq) -> do
         (lnkId, linkKey, d) <- prepareLinkData rq
         addQueueLink c rq lnkId d
-        pure $ CSLContact (qServer rq) CCTContact linkKey
+        pure $ CSLContact SLSServer CCTContact (qServer rq) linkKey
       _ -> throwE $ CMD PROHIBITED "setContactShortLink: not contact address"
   where
     prepareLinkData :: RcvQueue -> AM (SMP.LinkId, LinkKey, QueueLinkData)
@@ -870,9 +871,9 @@ deleteContactShortLink' c connId =
       _ -> throwE $ CMD PROHIBITED "deleteContactShortLink: 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 -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnInfo)
+getConnShortLink' :: forall c. AgentClient -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnLinkData c)
 getConnShortLink' c userId = \case
-  CSLInvitation srv linkId linkKey -> do
+  CSLInvitation _ srv linkId linkKey -> do
     g <- asks random
     invLink <- withStore' c $ \db -> do
       getInvShortLink db srv linkId >>= \case
@@ -886,20 +887,22 @@ getConnShortLink' c userId = \case
     ld@(sndId, _) <- secureGetQueueLink c userId invLink
     withStore' c $ \db -> setInvShortLinkSndId db invLink sndId
     decryptData srv linkKey k ld
-  CSLContact srv _ linkKey -> do
+  CSLContact _ _ srv linkKey -> do
     let (linkId, k) = SL.contactShortLinkKdf linkKey
     ld <- getQueueLink c userId srv linkId
     decryptData srv linkKey k ld
   where
-    decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnInfo)
+    decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnLinkData c)
     decryptData srv linkKey k (sndId, d) = do
       r@(cReq, _) <- liftEither $ SL.decryptLinkData @c linkKey k d
-      unless ((srv, sndId) `sameQAddress` qAddress (connReqQueue cReq)) $
+      let (srv', sndId') = qAddress (connReqQueue cReq)
+      unless (srv `sameSrvHost` srv' && sndId == sndId') $
         throwE $ AGENT $ A_LINK "different address"
       pure r
+    sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs
 
 deleteLocalInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM ()
-deleteLocalInvShortLink' c (CSLInvitation srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId
+deleteLocalInvShortLink' c (CSLInvitation _ srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId
 
 changeConnectionUser' :: AgentClient -> UserId -> ConnId -> UserId -> AM ()
 changeConnectionUser' c oldUserId connId newUserId = do
@@ -978,12 +981,12 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s
       Just ShortLinkCreds {shortLinkId, shortLinkKey}
         | qUri == qUri'  ->
             let link = case cReq of
-                  CRContactUri _ -> CSLContact srv CCTContact shortLinkKey
-                  CRInvitationUri {} -> CSLInvitation srv shortLinkId shortLinkKey
+                  CRContactUri _ -> CSLContact SLSServer CCTContact srv shortLinkKey
+                  CRInvitationUri {} -> CSLInvitation SLSServer srv shortLinkId shortLinkKey
              in pure $ CCLink cReq (Just link)
         | otherwise -> throwE $ INTERNAL "different rcv queue address"
       Nothing ->
-        let updated (ConnReqUriData _ vr _ _) = (ConnReqUriData SSSimplex vr [qUri] clientData)
+        let updated (ConnReqUriData _ vr _ _) = (ConnReqUriData SSSimplex vr [qUri'] clientData)
             cReq' = case cReq of
               CRContactUri crData -> CRContactUri (updated crData)
               CRInvitationUri crData e2eParams -> CRInvitationUri (updated crData) e2eParams

src/Simplex/Messaging/Agent/Protocol.hs

@@ -102,8 +102,6 @@ module Simplex.Messaging.Agent.Protocol
     ConnectionMode (..),
     SConnectionMode (..),
     AConnectionMode (..),
-    cmInvitation,
-    cmContact,
     ConnectionModeI (..),
     ConnectionRequestUri (..),
     AConnectionRequestUri (..),
@@ -111,17 +109,22 @@ module Simplex.Messaging.Agent.Protocol
     CRClientData,
     ServiceScheme,
     FixedLinkData (..),
-    UserLinkData (..),
+    ConnLinkData (..),
+    OwnerAuth (..),
+    OwnerId,
     ConnectionLink (..),
     AConnectionLink (..),
     ConnShortLink (..),
     AConnShortLink (..),
     CreatedConnLink (..),
     ContactConnType (..),
+    ShortLinkScheme (..),
     LinkKey (..),
     sameConnReqContact,
     simplexChat,
     connReqUriP',
+    simplexConnReqUri,
+    simplexShortLink,
     AgentErrorType (..),
     CommandErrorType (..),
     ConnectionErrorType (..),
@@ -156,6 +159,7 @@ module Simplex.Messaging.Agent.Protocol
     updateSMPServerHosts,
     shortenShortLink,
     restoreShortLink,
+    linkUserData,
   )
 where
 
@@ -167,7 +171,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (isDigit)
+import Data.Char (toLower, toUpper)
 import Data.Foldable (find)
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -251,6 +255,7 @@ import UnliftIO.Exception (Exception)
 -- 4 - delivery receipts (7/13/2023)
 -- 5 - post-quantum double ratchet (3/14/2024)
 -- 6 - secure reply queues with provided keys (6/14/2024)
+-- 7 - initialize ratchet on processing confirmation (7/18/2024)
 
 data SMPAgentVersion
 
@@ -695,14 +700,6 @@ data AConnectionMode = forall m. ConnectionModeI m => ACM (SConnectionMode m)
 instance Eq AConnectionMode where
   ACM m == ACM m' = isJust $ testEquality m m'
 
-cmInvitation :: AConnectionMode
-cmInvitation = ACM SCMInvitation
-{-# INLINE cmInvitation #-}
-
-cmContact :: AConnectionMode
-cmContact = ACM SCMContact
-{-# INLINE cmContact #-}
-
 deriving instance Show AConnectionMode
 
 connMode :: SConnectionMode m -> ConnectionMode
@@ -711,8 +708,8 @@ connMode SCMContact = CMContact
 {-# INLINE connMode #-}
 
 connMode' :: ConnectionMode -> AConnectionMode
-connMode' CMInvitation = cmInvitation
-connMode' CMContact = cmContact
+connMode' CMInvitation = ACM SCMInvitation
+connMode' CMContact = ACM SCMContact
 {-# INLINE connMode' #-}
 
 class ConnectionModeI (m :: ConnectionMode) where sConnectionMode :: SConnectionMode m
@@ -1084,8 +1081,16 @@ instance Encoding ConnReqUriData where
   smpEncode ConnReqUriData {crAgentVRange, crSmpQueues, crClientData} =
     smpEncode (crAgentVRange, crSmpQueues, Large . encodeUtf8 <$> crClientData)
   smpP = do
-    (crAgentVRange, crSmpQueues, clientData) <- smpP
+    (crAgentVRange, smpQueues, clientData) <- smpP
+    -- This patch to compensate for the fact that queueMode QMContact won't be included in queue encoding,
+    -- until min SMP client version is >= 3 (sndAuthKeySMPClientVersion).
+    -- This is possible because SMP encoding of ConnReqUriData was not used prior to SMP client version 4.
+    let crSmpQueues = L.map patchQueueMode smpQueues
     pure ConnReqUriData {crScheme = SSSimplex, crAgentVRange, crSmpQueues, crClientData = safeDecodeUtf8 . unLarge <$> clientData}
+    where
+      patchQueueMode q@SMPQueueUri {queueAddress = a} = case a of
+        SMPQueueAddress {queueMode = Nothing} -> q {queueAddress = a {queueMode = Just QMContact}} :: SMPQueueUri
+        _ -> q
 
 connReqUriP' :: forall m. ConnectionModeI m => Maybe ServiceScheme -> Parser (ConnectionRequestUri m)
 connReqUriP' overrideScheme = do
@@ -1342,6 +1347,11 @@ data ConnectionRequestUri (m :: ConnectionMode) where
   -- they are passed in AgentInvitation message
   CRContactUri :: ConnReqUriData -> ConnectionRequestUri CMContact
 
+simplexConnReqUri :: ConnectionRequestUri m -> ConnectionRequestUri m
+simplexConnReqUri = \case
+  CRInvitationUri crData e2eParams -> CRInvitationUri crData {crScheme = SSSimplex} e2eParams
+  CRContactUri crData -> CRContactUri crData {crScheme = SSSimplex}
+
 deriving instance Eq (ConnectionRequestUri m)
 
 deriving instance Show (ConnectionRequestUri m)
@@ -1355,14 +1365,21 @@ instance Eq AConnectionRequestUri where
 
 deriving instance Show AConnectionRequestUri
 
+data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show)
+
 data ConnShortLink (m :: ConnectionMode) where
-  CSLInvitation :: SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
-  CSLContact :: SMPServer -> ContactConnType -> LinkKey -> ConnShortLink 'CMContact
+  CSLInvitation :: ShortLinkScheme -> SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
+  CSLContact :: ShortLinkScheme -> ContactConnType -> SMPServer -> LinkKey -> ConnShortLink 'CMContact
 
 deriving instance Eq (ConnShortLink m)
 
 deriving instance Show (ConnShortLink m)
 
+simplexShortLink :: ConnShortLink m -> ConnShortLink m
+simplexShortLink = \case
+  CSLInvitation _ srv lnkId k -> CSLInvitation SLSSimplex srv lnkId k
+  CSLContact _ ct srv k -> CSLContact SLSSimplex ct srv k
+
 newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
   deriving (Eq, Show)
   deriving newtype (FromField, StrEncoding)
@@ -1377,7 +1394,7 @@ instance ConnectionModeI c => ToField (ConnShortLink c) where toField = toField
 
 instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fromField = blobFieldDecoder strDecode
 
-data ContactConnType = CCTContact | CCTGroup deriving (Eq, Show)
+data ContactConnType = CCTContact | CCTChannel | CCTGroup deriving (Eq, Show)
 
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
 
@@ -1414,53 +1431,103 @@ instance ConnectionModeI m => FromJSON (ConnectionLink m) where
 
 instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
   strEncode = \case
-    CSLInvitation srv (SMP.EntityId lnkId) (LinkKey k) -> encLink srv (lnkId <> k) "i"
-    CSLContact srv ct (LinkKey k) -> encLink srv k $ case ct of CCTContact -> "c"; CCTGroup -> "g"
+    CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k) -> slEncode sch srv 'i' lnkId k
+    CSLContact sch ct srv (LinkKey k) -> slEncode sch srv (toLower $ ctTypeChar ct) "" k
     where
-      encLink (SMPServer (h :| hs) port (C.KeyHash kh)) linkUri linkType =
-        "https://" <> strEncode h <> port' <> "/" <> linkType <> "#" <> khStr <> hosts <> B64.encodeUnpadded linkUri
+      slEncode sch (SMPServer (h :| hs) port (C.KeyHash kh)) linkType lnkId k =
+        B.concat [authority, "/", B.singleton linkType, "#", lnkIdStr, B64.encodeUnpadded k, queryStr]
         where
-          port' = if null port then "" else B.pack (':' : port)
-          hosts = if null hs then "" else strEncode (TransportHosts_ hs) <> "/"
-          khStr = if B.null kh then "" else B64.encodeUnpadded kh <> "@"
-  strP = do
-    ACSL m l <- strP
-    case testEquality m $ sConnectionMode @m of
-      Just Refl -> pure l
-      _ -> fail "bad short link mode"
+          (authority, paramHosts) = case sch of
+            SLSSimplex -> ("simplex:", h : hs)
+            SLSServer -> ("https://" <> strEncode h, hs)
+          lnkIdStr = if B.null lnkId then "" else B64.encodeUnpadded lnkId <> "/"
+          queryStr = if B.null query then "" else "?" <> query
+          query =
+            strEncode . QSP QEscape $
+              [("h", strEncode (TransportHosts_ paramHosts)) | not (null paramHosts)]
+                <> [("p", B.pack port) | not (null port)]
+                <> [("c", B64.encodeUnpadded kh) | not (B.null kh)]
+  strP = (\(ACSL _ l) -> checkConnMode l) <$?> strP
+  {-# INLINE strP #-}
 
 instance StrEncoding AConnShortLink where
   strEncode (ACSL _ l) = strEncode l
+  {-# INLINE strEncode #-}
   strP = do
-    h <- "https://" *> strP
-    port <- A.char ':' *> (B.unpack <$> A.takeWhile1 isDigit) <|> pure ""
-    linkType <- A.char '/' *> A.anyChar
-    keyHash <- optional (A.char '/') *> A.char '#' *> (strP <* A.char '@' <|> pure (C.KeyHash ""))
-    TransportHosts_ hs <- strP <* "/" <|> pure (TransportHosts_ [])
-    linkUri <- strP
-    let srv = SMPServer (h :| hs) port keyHash
-    case linkType of
-      'i'
-        | B.length linkUri == 56 ->
-            let (lnkId, k) = B.splitAt 24 linkUri
-             in pure $ ACSL SCMInvitation $ CSLInvitation srv (SMP.EntityId lnkId) (LinkKey k)
-        | otherwise -> fail "bad ConnShortLink: incorrect linkID and key length"
-      'c' -> contactP srv CCTContact linkUri
-      'g' -> contactP srv CCTGroup linkUri
-      _ -> fail "bad ConnShortLink: unknown link type"
+    (sch, h_) <- authorityP <* A.char '/'
+    ct_ <- contactTypeP <* optional (A.char '/') <* A.char '#'
+    case ct_ of
+      Nothing -> do
+        lnkId <- strP <* A.char '/'
+        k <- strP
+        srv <- serverQueryP h_
+        pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k)
+      Just ct -> do
+        k <- strP
+        srv <- serverQueryP h_
+        pure $ ACSL SCMContact $ CSLContact sch ct srv (LinkKey k)
     where
-      contactP srv ct k
-        | B.length k == 32 = pure $ ACSL SCMContact $ CSLContact srv ct (LinkKey k)
-        | otherwise = fail "bad ConnShortLink: incorrect key length"
+      authorityP =
+        "simplex:" $> (SLSSimplex, Nothing)
+          <|> "https://" *> ((SLSServer,) . Just <$> strP)
+          <|> fail "bad short link scheme"
+      contactTypeP = do
+        Just <$> (A.anyChar >>= ctTypeP . toUpper)        
+          <|> A.char 'i' $> Nothing
+          <|> fail "unknown short link type"
+      serverQueryP h_ =
+        optional (A.char '?' *> strP) >>= \case
+          Nothing -> maybe noServer (pure . SMPServerOnlyHost) h_
+          Just query -> do
+            hs <- maybe noServer pure . L.nonEmpty . maybe id (:) h_ . maybe [] thList_ =<< queryParam_ "h" query
+            p <- maybe "" show <$> queryParam_ @Word16 "p" query
+            kh <- fromMaybe (C.KeyHash "") <$> queryParam_ "c" query
+            pure $ SMPServer hs p kh
+      noServer = fail "short link without server"
+
+instance ConnectionModeI m => Encoding (ConnShortLink m) where
+  smpEncode = \case
+    CSLInvitation _ srv lnkId (LinkKey k) -> smpEncode (CMInvitation, srv, lnkId, k)
+    CSLContact _ ct srv (LinkKey k) -> smpEncode (CMContact, ctTypeChar ct, srv, k)
+  smpP = (\(ACSL _ l) -> checkConnMode l) <$?> smpP
+  {-# INLINE smpP #-}
+
+instance Encoding AConnShortLink where
+  smpEncode (ACSL _ l) = smpEncode l
+  {-# INLINE smpEncode #-}
+  smpP =
+    smpP >>= \case
+      CMInvitation -> do
+        (srv, lnkId, k) <- smpP
+        pure $ ACSL SCMInvitation $ CSLInvitation SLSServer srv lnkId (LinkKey k)
+      CMContact -> do
+        ct <- ctTypeP =<< A.anyChar
+        (srv, k) <- smpP
+        pure $ ACSL SCMContact $ CSLContact SLSServer ct srv (LinkKey k)
+
+ctTypeP :: Char -> Parser ContactConnType
+ctTypeP = \case
+  'A' -> pure CCTContact
+  'C' -> pure CCTChannel
+  'G' -> pure CCTGroup 
+  _ -> fail "unknown contact address type"
+{-# INLINE ctTypeP #-}
+
+ctTypeChar :: ContactConnType -> Char
+ctTypeChar = \case
+  CCTContact -> 'A'
+  CCTChannel -> 'C'
+  CCTGroup -> 'G'
+{-# INLINE ctTypeChar #-}
 
 -- the servers passed to this function should be all preset servers, not servers configured by the user.
 shortenShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
 shortenShortLink presetSrvs = \case
-  CSLInvitation srv lnkId linkKey -> CSLInvitation (shortServer srv) lnkId linkKey
-  CSLContact srv ct linkKey -> CSLContact (shortServer srv) ct linkKey
+  CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (shortServer srv) lnkId linkKey
+  CSLContact sch ct srv linkKey -> CSLContact sch ct (shortServer srv) linkKey
   where
     shortServer srv@(SMPServer hs@(h :| _) p kh) =
-      if isPresetServer then SMPServer [h] "" (C.KeyHash "") else srv
+      if isPresetServer then SMPServerOnlyHost h else srv
       where
         isPresetServer = case findPresetServer srv presetSrvs of
           Just (SMPServer hs' p' kh') ->
@@ -1469,14 +1536,20 @@ shortenShortLink presetSrvs = \case
               && kh == kh'
           Nothing -> False
 
+-- explicit bidirectional is used for ghc 8.10.7 compatibility, [h]/[] patterns are not reversible.
+pattern SMPServerOnlyHost :: TransportHost -> SMPServer
+pattern SMPServerOnlyHost h <- SMPServer [h] "" (C.KeyHash "")
+  where
+    SMPServerOnlyHost h = SMPServer [h] "" (C.KeyHash "")
+
 -- the servers passed to this function should be all preset servers, not servers configured by the user.
 restoreShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
 restoreShortLink presetSrvs = \case
-  CSLInvitation srv lnkId linkKey -> CSLInvitation (fullServer srv) lnkId linkKey
-  CSLContact srv ct linkKey -> CSLContact (fullServer srv) ct linkKey
+  CSLInvitation sch srv lnkId linkKey -> CSLInvitation sch (fullServer srv) lnkId linkKey
+  CSLContact sch ct srv linkKey -> CSLContact sch ct (fullServer srv) linkKey
   where
     fullServer = \case
-      s@(SMPServer [_] "" (C.KeyHash "")) -> fromMaybe s $ findPresetServer s presetSrvs
+      s@(SMPServerOnlyHost _) -> fromMaybe s $ findPresetServer s presetSrvs
       s -> s
 
 findPresetServer :: SMPServer -> NonEmpty SMPServer -> Maybe SMPServer
@@ -1507,28 +1580,83 @@ type CRClientData = Text
 
 data FixedLinkData c = FixedLinkData
   { agentVRange :: VersionRangeSMPA,
-    sigKey :: C.PublicKeyEd25519,
+    rootKey :: C.PublicKeyEd25519,
     connReq :: ConnectionRequestUri c
   }
 
-data UserLinkData = UserLinkData
-  { agentVRange :: VersionRangeSMPA,
-    userData :: ConnInfo
+data ConnLinkData c where
+  InvitationLinkData :: VersionRangeSMPA -> ConnInfo -> ConnLinkData 'CMInvitation
+  ContactLinkData ::
+    { agentVRange :: VersionRangeSMPA,
+      -- direct connection via connReq in fixed data is allowed.
+      direct :: Bool,
+      -- additional owner keys to sign changes of mutable data.
+      owners :: [OwnerAuth],
+      -- alternative addresses of chat relays that receive requests for this contact address.
+      relays :: [ConnShortLink 'CMContact],
+      userData :: ConnInfo
+    } -> ConnLinkData 'CMContact
+
+data AConnLinkData = forall m. ConnectionModeI m => ACLD (SConnectionMode m) (ConnLinkData m)
+
+linkUserData :: ConnLinkData c -> ConnInfo
+linkUserData = \case
+  InvitationLinkData _ d -> d
+  ContactLinkData {userData} -> userData
+
+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.
+    authOwnerSig :: C.Signature 'C.Ed25519
   }
 
-instance ConnectionModeI c => Encoding (FixedLinkData c) where
-  smpEncode FixedLinkData {agentVRange, sigKey, connReq} =
-    smpEncode (agentVRange, sigKey, connReq)
+instance Encoding OwnerAuth where
+  smpEncode OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} =
+    smpEncode (ownerId, ownerKey, C.signatureBytes ownerSig, authOwnerId, C.signatureBytes authOwnerSig)
   smpP = do
-    (agentVRange, sigKey, connReq) <- smpP
-    pure FixedLinkData {agentVRange, sigKey, connReq}
+    (ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig) <- smpP
+    pure OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig}
 
-instance Encoding UserLinkData where
-  smpEncode UserLinkData {agentVRange, userData} =
-    smpEncode (agentVRange, Large userData)
+instance ConnectionModeI c => Encoding (FixedLinkData c) where
+  smpEncode FixedLinkData {agentVRange, rootKey, connReq} =
+    smpEncode (agentVRange, rootKey, connReq)
   smpP = do
-    (agentVRange, Large userData) <- smpP
-    pure UserLinkData {agentVRange, userData}
+    (agentVRange, rootKey, connReq) <- smpP
+    pure FixedLinkData {agentVRange, rootKey, connReq}
+
+instance ConnectionModeI c => Encoding (ConnLinkData c) where
+  smpEncode = \case
+    InvitationLinkData vr userData -> smpEncode (CMInvitation, vr, userData)
+    ContactLinkData {agentVRange, direct, owners, relays, userData} ->
+      B.concat [smpEncode (CMContact, agentVRange, direct), smpEncodeList owners, smpEncodeList relays, smpEncode userData]
+  smpP = (\(ACLD _ d) -> checkConnMode d) <$?> smpP
+  {-# INLINE smpP #-}
+
+instance Encoding AConnLinkData where
+  smpEncode (ACLD _ d) = smpEncode d
+  {-# INLINE smpEncode #-}
+  smpP =
+    smpP >>= \case
+      CMInvitation -> do
+        (vr, userData) <- smpP
+        pure $ ACLD SCMInvitation $ InvitationLinkData vr userData
+      CMContact -> do
+        (agentVRange, direct) <- smpP
+        owners <- smpListP
+        relays <- smpListP
+        userData <- smpP
+        pure $ ACLD SCMContact ContactLinkData {agentVRange, direct, owners, relays, userData}
 
 -- | SMP queue status.
 data QueueStatus

src/Simplex/Messaging/Crypto.hs

@@ -791,10 +791,19 @@ class CryptoSignature s where
 
 instance CryptoSignature (Signature s) => StrEncoding (Signature s) where
   strEncode = serializeSignature
+  {-# INLINE strEncode #-}
   strDecode = decodeSignature
+  {-# INLINE strDecode #-}
+
+instance CryptoSignature (Signature s) => Encoding (Signature s) where
+  smpEncode = smpEncode . signatureBytes
+  {-# INLINE smpEncode #-}
+  smpP = decodeSignature <$?> smpP
+  {-# INLINE smpP #-}
 
 instance CryptoSignature ASignature where
   signatureBytes (ASignature _ sig) = signatureBytes sig
+  {-# INLINE signatureBytes #-}
   decodeSignature s
     | B.length s == Ed25519.signatureSize =
         ASignature SEd25519 . SignatureEd25519 <$> ed Ed25519.signature s
@@ -806,6 +815,7 @@ instance CryptoSignature ASignature where
 
 instance CryptoSignature (Maybe ASignature) where
   signatureBytes = maybe "" signatureBytes
+  {-# INLINE signatureBytes #-}
   decodeSignature s
     | B.null s = Right Nothing
     | otherwise = Just <$> decodeSignature s
@@ -814,6 +824,7 @@ instance AlgorithmI a => CryptoSignature (Signature a) where
   signatureBytes = \case
     SignatureEd25519 s -> BA.convert s
     SignatureEd448 s -> BA.convert s
+  {-# INLINE signatureBytes #-}
   decodeSignature s = do
     ASignature _ sig <- decodeSignature s
     checkAlgorithm sig
@@ -824,25 +835,31 @@ instance SignatureSize (Signature a) where
   signatureSize = \case
     SignatureEd25519 _ -> Ed25519.signatureSize
     SignatureEd448 _ -> Ed448.signatureSize
+  {-# INLINE signatureSize #-}
 
 instance SignatureSize ASignature where
   signatureSize (ASignature _ s) = signatureSize s
+  {-# INLINE signatureSize #-}
 
 instance SignatureSize APrivateSignKey where
   signatureSize (APrivateSignKey _ k) = signatureSize k
+  {-# INLINE signatureSize #-}
 
 instance SignatureSize APublicVerifyKey where
   signatureSize (APublicVerifyKey _ k) = signatureSize k
+  {-# INLINE signatureSize #-}
 
 instance SignatureAlgorithm a => SignatureSize (PrivateKey a) where
   signatureSize = \case
     PrivateKeyEd25519 _ _ -> Ed25519.signatureSize
     PrivateKeyEd448 _ _ -> Ed448.signatureSize
+  {-# INLINE signatureSize #-}
 
 instance SignatureAlgorithm a => SignatureSize (PublicKey a) where
   signatureSize = \case
     PublicKeyEd25519 _ -> Ed25519.signatureSize
     PublicKeyEd448 _ -> Ed448.signatureSize
+  {-# INLINE signatureSize #-}
 
 -- | Various cryptographic or related errors.
 data CryptoError

src/Simplex/Messaging/Crypto/ShortLink.hs

@@ -1,9 +1,12 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Crypto.ShortLink
   ( contactShortLinkKdf,
@@ -45,18 +48,23 @@ contactShortLinkKdf (LinkKey k) =
 invShortLinkKdf :: LinkKey -> C.SbKey
 invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
 
-encodeSignLinkData :: ConnectionModeI c => C.KeyPair 'C.Ed25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> ConnInfo -> (LinkKey, (ByteString, ByteString))
-encodeSignLinkData (sigKey, pk) agentVRange connReq userData =
-  let fd = smpEncode FixedLinkData {agentVRange, sigKey, connReq}
-      ud = smpEncode UserLinkData {agentVRange, userData}
-   in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk ud))
+encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPair 'C.Ed25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> ConnInfo -> (LinkKey, (ByteString, ByteString))
+encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
+  let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq}
+      md = smpEncode $ connLinkData @c agentVRange userData
+   in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
 
 encodeSignUserData :: C.PrivateKeyEd25519 -> VersionRangeSMPA -> ConnInfo -> ByteString
 encodeSignUserData pk agentVRange userData =
-  encodeSign pk $ smpEncode UserLinkData {agentVRange, userData}
+  encodeSign pk $ smpEncode $ connLinkData @'CMContact agentVRange userData
+
+connLinkData :: forall c. ConnectionModeI c => VersionRangeSMPA -> ConnInfo -> ConnLinkData c
+connLinkData agentVRange userData = case sConnectionMode @c of
+  SCMInvitation -> InvitationLinkData agentVRange userData
+  SCMContact -> ContactLinkData {agentVRange, direct = True, owners = [], relays = [], userData}
 
 encodeSign :: C.PrivateKeyEd25519 -> ByteString -> ByteString
-encodeSign pk s = smpEncode (C.signatureBytes $ C.sign' pk s) <> s
+encodeSign pk s = smpEncode (C.sign' pk s) <> s
 
 encryptLinkData :: TVar ChaChaDRG -> C.SbKey -> (ByteString, ByteString) -> ExceptT AgentErrorType IO QueueLinkData
 encryptLinkData g k = bimapM (encrypt fixedDataPaddedLength) (encrypt userDataPaddedLength)
@@ -72,22 +80,22 @@ encryptData g k len s = do
   ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len
   pure $ EncDataBytes $ smpEncode nonce <> ct
 
-decryptLinkData :: ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnInfo)
-decryptLinkData linkKey k (encFD, encUD) = do
+decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c)
+decryptLinkData linkKey k (encFD, encMD) = do
   (sig1, fd) <- decrypt encFD
-  (sig2, ud) <- decrypt encUD
-  FixedLinkData {sigKey, connReq} <- decode fd
-  UserLinkData {userData} <- decode ud
+  (sig2, md) <- decrypt encMD
+  FixedLinkData {rootKey, connReq} <- decode fd
+  md' <- decode @(ConnLinkData c) md
   if
     | LinkKey (C.sha3_256 fd) /= linkKey -> linkErr "link data hash"
-    | not (C.verify' sigKey sig1 fd) -> linkErr "link data signature"
-    | not (C.verify' sigKey sig2 ud) -> linkErr "user data signature"
-    | otherwise -> Right (connReq, userData)
+    | not (C.verify' rootKey sig1 fd) -> linkErr "link data signature"
+    | not (C.verify' rootKey sig2 md) -> linkErr "user data signature"
+    | otherwise -> Right (connReq, md')
   where
     decrypt (EncDataBytes d) = do
       (nonce, Tail ct) <- decode d
-      (sigBytes, Tail s) <- decode =<< first cryptoError (C.sbDecrypt k nonce ct)
-      (,s) <$> msgErr (C.decodeSignature sigBytes)
+      (sig, Tail s) <- decode =<< first cryptoError (C.sbDecrypt k nonce ct)
+      pure (sig, s)
     decode :: Encoding a => ByteString -> Either AgentErrorType a
     decode = msgErr . smpDecode
     msgErr = first (const $ AGENT A_MESSAGE)

src/Simplex/Messaging/Protocol.hs

@@ -241,6 +241,8 @@ import Simplex.Messaging.Version.Internal
 -- SMP client protocol version history:
 -- 1 - binary protocol encoding (1/1/2022)
 -- 2 - multiple server hostnames and versioned queue addresses (8/12/2022)
+-- 3 - faster handshake: SKEY command for sender to secure queue (6/30/2024, SMP protocol version 9)
+-- 4 - short connection links with stored data (3/30/2025, SMP protocol version 15)
 
 data SMPClientVersion
 
@@ -419,6 +421,7 @@ data Command (p :: Party) where
   NEW :: NewQueueReq -> Command Recipient
   SUB :: Command Recipient
   KEY :: SndPublicAuthKey -> Command Recipient
+  RKEY :: NonEmpty RcvPublicAuthKey -> Command Recipient
   LSET :: LinkId -> QueueLinkData -> Command Recipient
   LDEL :: Command Recipient
   NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
@@ -770,6 +773,7 @@ data CommandTag (p :: Party) where
   NEW_ :: CommandTag Recipient
   SUB_ :: CommandTag Recipient
   KEY_ :: CommandTag Recipient
+  RKEY_ :: CommandTag Recipient
   LSET_ :: CommandTag Recipient
   LDEL_ :: CommandTag Recipient
   NKEY_ :: CommandTag Recipient
@@ -825,6 +829,7 @@ instance PartyI p => Encoding (CommandTag p) where
     NEW_ -> "NEW"
     SUB_ -> "SUB"
     KEY_ -> "KEY"
+    RKEY_ -> "RKEY"
     LSET_ -> "LSET"
     LDEL_ -> "LDEL"
     NKEY_ -> "NKEY"
@@ -850,6 +855,7 @@ instance ProtocolMsgTag CmdTag where
     "NEW" -> Just $ CT SRecipient NEW_
     "SUB" -> Just $ CT SRecipient SUB_
     "KEY" -> Just $ CT SRecipient KEY_
+    "RKEY" -> Just $ CT SRecipient RKEY_
     "LSET" -> Just $ CT SRecipient LSET_
     "LDEL" -> Just $ CT SRecipient LDEL_
     "NKEY" -> Just $ CT SRecipient NKEY_
@@ -1494,6 +1500,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
         auth = maybe "" (e . ('A',)) auth_
     SUB -> e SUB_
     KEY k -> e (KEY_, ' ', k)
+    RKEY ks -> e (RKEY_, ' ', ks)
     LSET lnkId d -> e (LSET_, ' ', lnkId, d)
     LDEL -> e LDEL_
     NKEY k dhKey -> e (NKEY_, ' ', k, dhKey)
@@ -1577,6 +1584,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
             qReq sndSecure = Just $ if sndSecure then QRMessaging Nothing else QRContact Nothing
         SUB_ -> pure SUB
         KEY_ -> KEY <$> _smpP
+        RKEY_ -> RKEY <$> _smpP
         LSET_ -> LSET <$> _smpP <*> smpP
         LDEL_ -> pure LDEL
         NKEY_ -> NKEY <$> _smpP <*> smpP

src/Simplex/Messaging/Server.hs

@@ -1062,7 +1062,7 @@ verifyTransmission :: forall s. MsgStoreClass s => s -> Maybe (THandleAuth 'TSer
 verifyTransmission ms auth_ tAuth authorized queueId cmd =
   case cmd of
     Cmd SRecipient (NEW NewQueueReq {rcvAuthKey = k}) -> pure $ Nothing `verifiedWith` k
-    Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWith` recipientKey (snd q)) <$> get SRecipient
+    Cmd SRecipient _ -> verifyQueue (\q -> Just q `verifiedWithKeys` recipientKeys (snd q)) <$> get SRecipient
     Cmd SSender (SKEY k) -> verifySecure SSender k
     -- SEND will be accepted without authorization before the queue is secured with KEY, SKEY or LSKEY command
     Cmd SSender SEND {} -> verifyQueue (\q -> if maybe (isNothing tAuth) verify (senderKey $ snd q) then VRVerified (Just q) else VRFailed) <$> get SSender
@@ -1082,6 +1082,8 @@ verifyTransmission ms auth_ tAuth authorized queueId cmd =
     verifySecure p k = verifyQueue (\q -> if k `allowedKey` snd q then Just q `verifiedWith` k else dummyVerify) <$> get p
     verifiedWith :: Maybe (StoreQueue s, QueueRec) -> C.APublicAuthKey -> VerificationResult s
     verifiedWith q_ k = if verify k then VRVerified q_ else VRFailed
+    verifiedWithKeys :: Maybe (StoreQueue s, QueueRec) -> NonEmpty C.APublicAuthKey -> VerificationResult s
+    verifiedWithKeys q_ ks = if any verify ks then VRVerified q_ else VRFailed
     allowedKey k = \case
       QueueRec {queueMode = Just QMMessaging, senderKey} -> maybe True (k ==) senderKey
       _ -> False
@@ -1262,7 +1264,8 @@ client
           SUB -> withQueue subscribeQueue
           GET -> withQueue getMessage
           ACK msgId -> withQueue $ acknowledgeMsg msgId
-          KEY sKey -> withQueue $ \q _ -> (corrId,entId,) . either ERR id <$> secureQueue_ q sKey
+          KEY sKey -> withQueue $ \q _ -> either err (corrId,entId,) <$> secureQueue_ q sKey
+          RKEY rKeys -> withQueue $ \q qr -> checkMode QMContact qr $ OK <$$ liftIO (updateKeys (queueStore ms) q rKeys)
           LSET lnkId d ->
             withQueue $ \q qr -> checkMode QMContact qr $ liftIO $ case queueData qr of
               Just (lnkId', _) | lnkId' /= lnkId -> pure $ Left AUTH
@@ -1311,7 +1314,7 @@ client
                         qr =
                           QueueRec
                             { senderId = sndId,
-                              recipientKey = rcvAuthKey,
+                              recipientKeys = [rcvAuthKey],
                               rcvDhSecret = C.dh' rcvDhKey privDhKey,
                               senderKey = Nothing,
                               queueMode,
@@ -1340,7 +1343,7 @@ client
 
         checkMode :: QueueMode -> QueueRec -> M (Either ErrorType BrokerMsg) -> M (Transmission BrokerMsg)
         checkMode qm QueueRec {queueMode} a =
-          (corrId,entId,) . either ERR id
+          either err (corrId,entId,)
             <$> if queueMode == Just qm then a else pure $ Left AUTH
 
         secureQueue_ :: StoreQueue s -> SndPublicAuthKey -> M (Either ErrorType BrokerMsg)

src/Simplex/Messaging/Server/MsgStore/Journal.hs

@@ -331,6 +331,8 @@ instance QueueStoreClass (JournalQueue s) (QStore s) where
   {-# INLINE deleteQueueLinkData #-}
   secureQueue = withQS secureQueue
   {-# INLINE secureQueue #-}
+  updateKeys = withQS updateKeys
+  {-# INLINE updateKeys #-}
   addQueueNotifier = withQS addQueueNotifier
   {-# INLINE addQueueNotifier #-}
   deleteQueueNotifier = withQS deleteQueueNotifier

src/Simplex/Messaging/Server/QueueStore.hs

@@ -13,6 +13,7 @@ module Simplex.Messaging.Server.QueueStore where
 import Control.Applicative ((<|>))
 import Data.Functor (($>))
 import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
@@ -25,7 +26,7 @@ import Simplex.Messaging.Util (eitherToMaybe)
 #endif
 
 data QueueRec = QueueRec
-  { recipientKey :: RcvPublicAuthKey,
+  { recipientKeys :: NonEmpty RcvPublicAuthKey,
     rcvDhSecret :: RcvDhSecret,
     senderId :: SenderId,
     senderKey :: Maybe SndPublicAuthKey,

src/Simplex/Messaging/Server/QueueStore/Postgres.hs

@@ -41,10 +41,10 @@ import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (intersperse)
+import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Text as T
-import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Database.PostgreSQL.Simple (Binary (..), Only (..), Query, SqlError, (:.) (..))
 import qualified Database.PostgreSQL.Simple as DB
@@ -58,6 +58,8 @@ import Simplex.Messaging.Agent.Client (withLockMap)
 import Simplex.Messaging.Agent.Lock (Lock)
 import Simplex.Messaging.Agent.Store.Postgres (createDBStore, closeDBStore)
 import Simplex.Messaging.Agent.Store.Postgres.Common
+import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder)
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
@@ -74,8 +76,8 @@ import System.IO (IOMode (..), hFlush, stdout)
 import UnliftIO.STM
 
 #if !defined(dbPostgres)
-import Simplex.Messaging.Agent.Store.Postgres.DB (blobFieldDecoder, fromTextField_)
-import qualified Simplex.Messaging.Crypto as C
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import Simplex.Messaging.Agent.Store.Postgres.DB (fromTextField_)
 import Simplex.Messaging.Encoding.String
 #endif
 
@@ -257,6 +259,16 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
         Just k | sKey /= k -> throwE AUTH
         _ -> pure ()
 
+  updateKeys :: PostgresQueueStore q -> q -> NonEmpty RcvPublicAuthKey -> IO (Either ErrorType ())
+  updateKeys st sq rKeys =
+    withQueueRec sq "updateKeys" $ \q -> do
+      assertUpdated $ withDB' "updateKeys" st $ \db ->
+        DB.execute db "UPDATE msg_queues SET recipient_keys = ? WHERE recipient_id = ? AND deleted_at IS NULL" (rKeys, rId)
+      atomically $ writeTVar (queueRec sq) $ Just q {recipientKeys = rKeys}
+      withLog "updateKeys" st $ \s -> logUpdateKeys s rId rKeys
+    where
+      rId = recipientId sq
+
   addQueueNotifier :: PostgresQueueStore q -> q -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
   addQueueNotifier st sq ntfCreds@NtfCreds {notifierId = nId, notifierKey, rcvNtfDhSecret} =
     withQueueRec sq "addQueueNotifier" $ \q ->
@@ -362,7 +374,7 @@ batchInsertQueues tty queues toStore = do
   let st = dbStore toStore
   count <-
     withConnection st $ \db -> do
-      DB.copy_ db "COPY msg_queues (recipient_id, recipient_key, rcv_dh_secret, sender_id, sender_key, snd_secure, notifier_id, notifier_key, rcv_ntf_dh_secret, status, updated_at) FROM STDIN WITH (FORMAT CSV)"
+      DB.copy_ db "COPY msg_queues (recipient_id, recipient_keys, rcv_dh_secret, sender_id, sender_key, snd_secure, notifier_id, notifier_key, rcv_ntf_dh_secret, status, updated_at) FROM STDIN WITH (FORMAT CSV)"
       mapM_ (putQueue db) (zip [1..] qs)
       DB.putCopyEnd db
   Only qCnt : _ <- withConnection st (`DB.query_` "SELECT count(*) FROM msg_queues")
@@ -378,7 +390,7 @@ insertQueueQuery :: Query
 insertQueueQuery =
   [sql|
     INSERT INTO msg_queues
-      (recipient_id, recipient_key, rcv_dh_secret, sender_id, sender_key, queue_mode, notifier_id, notifier_key, rcv_ntf_dh_secret, status, updated_at, link_id, fixed_data, user_data)
+      (recipient_id, recipient_keys, rcv_dh_secret, sender_id, sender_key, queue_mode, notifier_id, notifier_key, rcv_ntf_dh_secret, status, updated_at, link_id, fixed_data, user_data)
     VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
   |]
 
@@ -407,7 +419,7 @@ foldQueueRecs tty withData st skipOld_ f = do
 queueRecQuery :: Query
 queueRecQuery =
   [sql|
-    SELECT recipient_id, recipient_key, rcv_dh_secret,
+    SELECT recipient_id, recipient_keys, rcv_dh_secret,
       sender_id, sender_key, queue_mode,
       notifier_id, notifier_key, rcv_ntf_dh_secret,
       status, updated_at,
@@ -418,7 +430,7 @@ queueRecQuery =
 queueRecQueryWithData :: Query
 queueRecQueryWithData =
   [sql|
-    SELECT recipient_id, recipient_key, rcv_dh_secret,
+    SELECT recipient_id, recipient_keys, rcv_dh_secret,
       sender_id, sender_key, queue_mode,
       notifier_id, notifier_key, rcv_ntf_dh_secret,
       status, updated_at,
@@ -426,23 +438,23 @@ queueRecQueryWithData =
     FROM msg_queues
   |]
 
-type QueueRecRow = (RecipientId, RcvPublicAuthKey, RcvDhSecret, SenderId, Maybe SndPublicAuthKey, Maybe QueueMode, Maybe NotifierId, Maybe NtfPublicAuthKey, Maybe RcvNtfDhSecret, ServerEntityStatus, Maybe RoundedSystemTime, Maybe LinkId)
+type QueueRecRow = (RecipientId, NonEmpty RcvPublicAuthKey, RcvDhSecret, SenderId, Maybe SndPublicAuthKey, Maybe QueueMode, Maybe NotifierId, Maybe NtfPublicAuthKey, Maybe RcvNtfDhSecret, ServerEntityStatus, Maybe RoundedSystemTime, Maybe LinkId)
 
 queueRecToRow :: (RecipientId, QueueRec) -> QueueRecRow :. (Maybe EncDataBytes, Maybe EncDataBytes)
-queueRecToRow (rId, QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier = n, status, updatedAt}) =
-  (rId, recipientKey, rcvDhSecret, senderId, senderKey, queueMode, notifierId <$> n, notifierKey <$> n, rcvNtfDhSecret <$> n, status, updatedAt, linkId_)
+queueRecToRow (rId, QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier = n, status, updatedAt}) =
+  (rId, recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, notifierId <$> n, notifierKey <$> n, rcvNtfDhSecret <$> n, status, updatedAt, linkId_)
     :. (fst <$> queueData_, snd <$> queueData_)
   where
     (linkId_, queueData_) = queueDataColumns queueData
 
 queueRecToText :: (RecipientId, QueueRec) -> ByteString
-queueRecToText (rId, QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier = n, status, updatedAt}) =
+queueRecToText (rId, QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier = n, status, updatedAt}) =
   LB.toStrict $ BB.toLazyByteString $ mconcat tabFields <> BB.char7 '\n'
   where
     tabFields = BB.char7 ',' `intersperse` fields
     fields =
       [ renderField (toField rId),
-        renderField (toField recipientKey),
+        renderField (toField recipientKeys),
         renderField (toField rcvDhSecret),
         renderField (toField senderId),
         nullable senderKey,
@@ -473,17 +485,17 @@ queueDataColumns = \case
   Nothing -> (Nothing, Nothing)
 
 rowToQueueRec :: QueueRecRow -> (RecipientId, QueueRec)
-rowToQueueRec (rId, recipientKey, rcvDhSecret, senderId, senderKey, queueMode, notifierId_, notifierKey_, rcvNtfDhSecret_, status, updatedAt, linkId_) =
+rowToQueueRec (rId, recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, notifierId_, notifierKey_, rcvNtfDhSecret_, status, updatedAt, linkId_) =
   let notifier = NtfCreds <$> notifierId_ <*> notifierKey_ <*> rcvNtfDhSecret_
       queueData = (,(EncDataBytes "", EncDataBytes "")) <$> linkId_
-   in (rId, QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt})
+   in (rId, QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt})
 
 rowToQueueRecWithData :: QueueRecRow :. (Maybe EncDataBytes, Maybe EncDataBytes) -> (RecipientId, QueueRec)
-rowToQueueRecWithData ((rId, recipientKey, rcvDhSecret, senderId, senderKey, queueMode, notifierId_, notifierKey_, rcvNtfDhSecret_, status, updatedAt, linkId_) :. (immutableData_, userData_)) =
+rowToQueueRecWithData ((rId, recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, notifierId_, notifierKey_, rcvNtfDhSecret_, status, updatedAt, linkId_) :. (immutableData_, userData_)) =
   let notifier = NtfCreds <$> notifierId_ <*> notifierKey_ <*> rcvNtfDhSecret_
       encData =  fromMaybe (EncDataBytes "")
       queueData = (,(encData immutableData_, encData userData_)) <$> linkId_
-   in (rId, QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt})
+   in (rId, QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt})
 
 setStatusDB :: StoreQueueClass q => String -> PostgresQueueStore q -> q -> ServerEntityStatus -> ExceptT ErrorType IO () -> IO (Either ErrorType ())
 setStatusDB op st sq status writeLog =
@@ -528,6 +540,10 @@ instance ToField EntityId where toField (EntityId s) = toField $ Binary s
 
 deriving newtype instance FromField EntityId
 
+instance ToField (NonEmpty C.APublicAuthKey) where toField = toField . Binary . smpEncode
+
+instance FromField (NonEmpty C.APublicAuthKey) where fromField = blobFieldDecoder smpDecode
+
 #if !defined(dbPostgres)
 instance FromField QueueMode where fromField = fromTextField_ $ eitherToMaybe . smpDecode . encodeUtf8
 

src/Simplex/Messaging/Server/QueueStore/Postgres/Migrations.hs

@@ -77,6 +77,10 @@ UPDATE msg_queues SET queue_mode = 'M' WHERE snd_secure IS TRUE;
 
 ALTER TABLE msg_queues DROP COLUMN snd_secure;
 
+UPDATE msg_queues SET recipient_key = ('\x01'::BYTEA || chr(length(recipient_key))::BYTEA || recipient_key);
+
+ALTER TABLE msg_queues RENAME COLUMN recipient_key TO recipient_keys;
+
 CREATE UNIQUE INDEX idx_msg_queues_link_id ON msg_queues(link_id);
     |]
 
@@ -88,11 +92,30 @@ ALTER TABLE msg_queues ADD COLUMN snd_secure BOOLEAN NOT NULL DEFAULT FALSE;
 
 UPDATE msg_queues SET snd_secure = TRUE WHERE queue_mode = 'M';
 
-ALTER TABLE
+DROP INDEX idx_msg_queues_link_id;
+
+ALTER TABLE msg_queues
   DROP COLUMN queue_mode,
   DROP COLUMN link_id,
   DROP COLUMN fixed_data,
   DROP COLUMN user_data;
 
-DROP INDEX idx_msg_queues_link_id;
+DO $$
+  DECLARE bad_id BYTEA;
+  BEGIN
+    SELECT recipient_id INTO bad_id
+    FROM msg_queues
+    WHERE get_byte(recipient_keys, 0) != 1
+      OR get_byte(recipient_keys, 1) != length(recipient_keys) - 2
+    LIMIT 1;
+
+    IF bad_id IS NOT NULL
+    THEN RAISE EXCEPTION 'Cannot downgrade: many keys or incorrect length in recipient_keys for %', encode(bad_id, 'base64');
+    END IF;
+  END;
+$$;
+
+UPDATE msg_queues SET recipient_keys = substring(recipient_keys from 3);
+
+ALTER TABLE msg_queues RENAME COLUMN recipient_keys TO recipient_key;
     |]

src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql

@@ -0,0 +1,74 @@
+
+
+SET statement_timeout = 0;
+SET lock_timeout = 0;
+SET idle_in_transaction_session_timeout = 0;
+SET client_encoding = 'UTF8';
+SET standard_conforming_strings = on;
+SELECT pg_catalog.set_config('search_path', '', false);
+SET check_function_bodies = false;
+SET xmloption = content;
+SET client_min_messages = warning;
+SET row_security = off;
+
+
+CREATE SCHEMA smp_server;
+
+
+SET default_table_access_method = heap;
+
+
+CREATE TABLE smp_server.migrations (
+    name text NOT NULL,
+    ts timestamp without time zone NOT NULL,
+    down text
+);
+
+
+
+CREATE TABLE smp_server.msg_queues (
+    recipient_id bytea NOT NULL,
+    recipient_keys bytea NOT NULL,
+    rcv_dh_secret bytea NOT NULL,
+    sender_id bytea NOT NULL,
+    sender_key bytea,
+    notifier_id bytea,
+    notifier_key bytea,
+    rcv_ntf_dh_secret bytea,
+    status text NOT NULL,
+    updated_at bigint,
+    deleted_at bigint,
+    queue_mode text,
+    link_id bytea,
+    fixed_data bytea,
+    user_data bytea
+);
+
+
+
+ALTER TABLE ONLY smp_server.migrations
+    ADD CONSTRAINT migrations_pkey PRIMARY KEY (name);
+
+
+
+ALTER TABLE ONLY smp_server.msg_queues
+    ADD CONSTRAINT msg_queues_pkey PRIMARY KEY (recipient_id);
+
+
+
+CREATE UNIQUE INDEX idx_msg_queues_link_id ON smp_server.msg_queues USING btree (link_id);
+
+
+
+CREATE UNIQUE INDEX idx_msg_queues_notifier_id ON smp_server.msg_queues USING btree (notifier_id);
+
+
+
+CREATE UNIQUE INDEX idx_msg_queues_sender_id ON smp_server.msg_queues USING btree (sender_id);
+
+
+
+CREATE INDEX idx_msg_queues_updated_at ON smp_server.msg_queues USING btree (deleted_at, updated_at);
+
+
+

src/Simplex/Messaging/Server/QueueStore/STM.hs

@@ -28,6 +28,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Data.Bitraversable (bimapM)
 import Data.Functor (($>))
+import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as M
 import qualified Data.Text as T
 import Simplex.Messaging.Protocol
@@ -141,6 +142,14 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
         TM.delete lnkId $ links st
         writeTVar qr $ Just q {queueData = Nothing}
 
+  updateKeys :: STMQueueStore q -> q -> NonEmpty RcvPublicAuthKey -> IO (Either ErrorType ())
+  updateKeys st sq rKeys =
+    withQueueRec qr update
+      $>> withLog "updateKeys" st (\s -> logUpdateKeys s (recipientId sq) rKeys)
+    where
+      qr = queueRec sq
+      update q = writeTVar qr $ Just q {recipientKeys = rKeys}
+
   secureQueue :: STMQueueStore q -> q -> SndPublicAuthKey -> IO (Either ErrorType ())
   secureQueue st sq sKey =
     atomically (readQueueRec qr $>>= secure)

src/Simplex/Messaging/Server/QueueStore/Types.hs

@@ -10,6 +10,7 @@ module Simplex.Messaging.Server.QueueStore.Types where
 import Control.Concurrent.STM
 import Control.Monad
 import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.TMap (TMap)
@@ -34,6 +35,7 @@ class StoreQueueClass q => QueueStoreClass q s where
   addQueueLinkData :: s -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
   deleteQueueLinkData :: s -> q -> IO (Either ErrorType ())
   secureQueue :: s -> q -> SndPublicAuthKey -> IO (Either ErrorType ())
+  updateKeys :: s -> q -> NonEmpty RcvPublicAuthKey -> IO (Either ErrorType ())
   addQueueNotifier :: s -> q -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
   deleteQueueNotifier :: s -> q -> IO (Either ErrorType (Maybe NotifierId))
   suspendQueue :: s -> q -> IO (Either ErrorType ())

src/Simplex/Messaging/Server/StoreLog.hs

@@ -21,6 +21,7 @@ module Simplex.Messaging.Server.StoreLog
     logCreateLink,
     logDeleteLink,
     logSecureQueue,
+    logUpdateKeys,
     logAddNotifier,
     logSuspendQueue,
     logBlockQueue,
@@ -43,6 +44,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.List (sort, stripPrefix)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (mapMaybe)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime, nominalDay)
@@ -64,6 +66,7 @@ data StoreLogRecord
   | CreateLink RecipientId LinkId QueueLinkData
   | DeleteLink RecipientId
   | SecureQueue QueueId SndPublicAuthKey
+  | UpdateKeys RecipientId (NonEmpty RcvPublicAuthKey)
   | AddNotifier QueueId NtfCreds
   | SuspendQueue QueueId
   | BlockQueue QueueId BlockingInfo
@@ -78,6 +81,7 @@ data SLRTag
   | CreateLink_
   | DeleteLink_
   | SecureQueue_
+  | UpdateKeys_
   | AddNotifier_
   | SuspendQueue_
   | BlockQueue_
@@ -87,9 +91,9 @@ data SLRTag
   | UpdateTime_
 
 instance StrEncoding QueueRec where
-  strEncode QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt} =
+  strEncode QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt} =
     B.unwords
-      [ "rk=" <> strEncode recipientKey,
+      [ "rk=" <> strEncode recipientKeys,
         "rdh=" <> strEncode rcvDhSecret,
         "sid=" <> strEncode senderId,
         "sk=" <> strEncode senderKey
@@ -108,7 +112,7 @@ instance StrEncoding QueueRec where
         _ -> " status=" <> strEncode status
 
   strP = do
-    recipientKey <- "rk=" *> strP_
+    recipientKeys <- "rk=" *> strP_
     rcvDhSecret <- "rdh=" *> strP_
     senderId <- "sid=" *> strP_
     senderKey <- "sk=" *> strP
@@ -120,7 +124,7 @@ instance StrEncoding QueueRec where
     notifier <- optional $ " notifier=" *> strP
     updatedAt <- optional $ " updated_at=" *> strP
     status <- (" status=" *> strP) <|> pure EntityActive
-    pure QueueRec {recipientKey, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt}
+    pure QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, queueMode, queueData, notifier, status, updatedAt}
     where
       toQueueMode sndSecure = Just $ if sndSecure then QMMessaging else QMContact
 
@@ -130,6 +134,7 @@ instance StrEncoding SLRTag where
     CreateLink_ -> "LINK"
     DeleteLink_ -> "LDELETE"
     SecureQueue_ -> "SECURE"
+    UpdateKeys_ -> "KEYS"
     AddNotifier_ -> "NOTIFIER"
     SuspendQueue_ -> "SUSPEND"
     BlockQueue_ -> "BLOCK"
@@ -144,6 +149,7 @@ instance StrEncoding SLRTag where
         "LINK" $> CreateLink_,
         "LDELETE" $> DeleteLink_,
         "SECURE" $> SecureQueue_,
+        "KEYS" $> UpdateKeys_,
         "NOTIFIER" $> AddNotifier_,
         "SUSPEND" $> SuspendQueue_,
         "BLOCK" $> BlockQueue_,
@@ -159,6 +165,7 @@ instance StrEncoding StoreLogRecord where
     CreateLink rId lnkId d -> strEncode (CreateLink_, rId, lnkId, d)
     DeleteLink rId -> strEncode (DeleteLink_, rId)
     SecureQueue rId sKey -> strEncode (SecureQueue_, rId, sKey)
+    UpdateKeys rId rKeys -> strEncode (UpdateKeys_, rId, rKeys)
     AddNotifier rId ntfCreds -> strEncode (AddNotifier_, rId, ntfCreds)
     SuspendQueue rId -> strEncode (SuspendQueue_, rId)
     BlockQueue rId info -> strEncode (BlockQueue_, rId, info)
@@ -173,6 +180,7 @@ instance StrEncoding StoreLogRecord where
       CreateLink_ -> CreateLink <$> strP_ <*> strP_ <*> strP
       DeleteLink_ -> DeleteLink <$> strP
       SecureQueue_ -> SecureQueue <$> strP_ <*> strP
+      UpdateKeys_ -> UpdateKeys <$> strP_ <*> strP
       AddNotifier_ -> AddNotifier <$> strP_ <*> strP
       SuspendQueue_ -> SuspendQueue <$> strP
       BlockQueue_ -> BlockQueue <$> strP_ <*> strP
@@ -221,6 +229,9 @@ logDeleteLink s = writeStoreLogRecord s . DeleteLink
 logSecureQueue :: StoreLog 'WriteMode -> QueueId -> SndPublicAuthKey -> IO ()
 logSecureQueue s qId sKey = writeStoreLogRecord s $ SecureQueue qId sKey
 
+logUpdateKeys :: StoreLog 'WriteMode -> QueueId -> NonEmpty RcvPublicAuthKey -> IO ()
+logUpdateKeys s rId rKeys = writeStoreLogRecord s $ UpdateKeys rId rKeys
+
 logAddNotifier :: StoreLog 'WriteMode -> QueueId -> NtfCreds -> IO ()
 logAddNotifier s qId ntfCreds = writeStoreLogRecord s $ AddNotifier qId ntfCreds
 

src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs

@@ -45,6 +45,7 @@ readQueueStore tty mkQ f st = readLogLines tty f $ \_ -> processLine
           CreateLink rId lnkId d -> withQueue rId "CreateLink" $ \q -> addQueueLinkData st q lnkId d
           DeleteLink rId -> withQueue rId "DeleteLink" $ \q -> deleteQueueLinkData st q
           SecureQueue qId sKey -> withQueue qId "SecureQueue" $ \q -> secureQueue st q sKey
+          UpdateKeys rId rKeys -> withQueue rId "UpdateKeys" $ \q -> updateKeys st q rKeys
           AddNotifier qId ntfCreds -> withQueue qId "AddNotifier" $ \q -> addQueueNotifier st q ntfCreds
           SuspendQueue qId -> withQueue qId "SuspendQueue" $ suspendQueue st
           BlockQueue qId info -> withQueue qId "BlockQueue" $ \q -> blockQueue st q info

tests/AgentTests/ConnectionRequestTests.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
@@ -40,11 +41,14 @@ queueAddr =
     { smpServer = srv,
       senderId = EntityId "\223\142z\251",
       dhPublicKey = testDhKey,
-      queueMode = Nothing
+      queueMode = Just QMMessaging
     }
 
-queueAddrSK :: SMPQueueAddress
-queueAddrSK = queueAddr {queueMode = Just QMMessaging}
+queueAddrNoQM :: SMPQueueAddress
+queueAddrNoQM = queueAddr {queueMode = Nothing}
+
+queueAddrContact :: SMPQueueAddress
+queueAddrContact = queueAddr {queueMode = Just QMContact}
 
 queueAddr1 :: SMPQueueAddress
 queueAddr1 = queueAddr {smpServer = srv1}
@@ -52,6 +56,9 @@ queueAddr1 = queueAddr {smpServer = srv1}
 queueAddrNoPort :: SMPQueueAddress
 queueAddrNoPort = queueAddr {smpServer = srv {port = ""}}
 
+queueAddrNoPortNoQM :: SMPQueueAddress
+queueAddrNoPortNoQM = queueAddrNoQM {smpServer = srv {port = ""}}
+
 queueAddrNoPort1 :: SMPQueueAddress
 queueAddrNoPort1 = queueAddr {smpServer = srv1 {port = ""}}
 
@@ -59,26 +66,32 @@ queueAddrNoPort1 = queueAddr {smpServer = srv1 {port = ""}}
 queue :: SMPQueueUri
 queue = SMPQueueUri supportedSMPClientVRange queueAddr
 
-queueSK :: SMPQueueUri
-queueSK = SMPQueueUri supportedSMPClientVRange queueAddrSK
+queueNoQM :: SMPQueueUri
+queueNoQM = SMPQueueUri supportedSMPClientVRange queueAddrNoQM
+
+queueContact :: SMPQueueUri
+queueContact = SMPQueueUri supportedSMPClientVRange queueAddrContact
 
 queueStr :: ByteString
-queueStr = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-4&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
+queueStr = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-4&dh=" <> url testDhKeyStr <> "&q=m&k=s" <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
 
-queueStrSK :: ByteString
-queueStrSK = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-4&dh=" <> url testDhKeyStr <> "&q=m&k=s" <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
+queueStrNoQM :: ByteString
+queueStrNoQM = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-4&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
+
+queueStrContact :: ByteString
+queueStrContact = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-4&dh=" <> url testDhKeyStr <> "&q=c" <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"
 
 queue1 :: SMPQueueUri
 queue1 = SMPQueueUri supportedSMPClientVRange queueAddr1
 
 queue1Str :: ByteString
-queue1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-4&dh=" <> url testDhKeyStr
+queue1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1-4&dh=" <> url testDhKeyStr <> "&q=m&k=s"
 
 queueV1 :: SMPQueueUri
-queueV1 = SMPQueueUri (mkVersionRange (VersionSMPC 1) (VersionSMPC 1)) queueAddr
+queueV1 = SMPQueueUri (mkVersionRange (VersionSMPC 1) (VersionSMPC 1)) queueAddrNoQM
 
 queueV1NoPort :: SMPQueueUri
-queueV1NoPort = (queueV1 :: SMPQueueUri) {queueAddress = queueAddrNoPort}
+queueV1NoPort = (queueV1 :: SMPQueueUri) {queueAddress = queueAddrNoPortNoQM}
 
 -- version range 2-3 uses new encoding
 -- it is fixed/changed in v5.8.2.
@@ -86,10 +99,10 @@ queueNew :: SMPQueueUri
 queueNew = SMPQueueUri (mkVersionRange (VersionSMPC 2) currentSMPClientVersion) queueAddr
 
 queueNewStr :: ByteString
-queueNewStr = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr
+queueNewStr = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr <> "&q=m&k=s"
 
 queueNewStr' :: ByteString
-queueNewStr' = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-4&dh=" <> testDhKeyStr
+queueNewStr' = "smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#/?v=2-4&dh=" <> testDhKeyStr <> "&q=m&k=s"
 
 queueNewNoPort :: SMPQueueUri
 queueNewNoPort = (queueNew :: SMPQueueUri) {queueAddress = queueAddrNoPort}
@@ -98,7 +111,7 @@ queueNew1 :: SMPQueueUri
 queueNew1 = SMPQueueUri (mkVersionRange (VersionSMPC 2) currentSMPClientVersion) queueAddr1
 
 queueNew1Str :: ByteString
-queueNew1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr
+queueNew1Str = "smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr <> "&q=m&k=s"
 
 queueNew1NoPort :: SMPQueueUri
 queueNew1NoPort = (queueNew1 :: SMPQueueUri) {queueAddress = queueAddrNoPort1}
@@ -118,8 +131,11 @@ connReqData =
       crClientData = Nothing
     }
 
-connReqDataSK :: ConnReqUriData
-connReqDataSK = connReqData {crSmpQueues = [queueSK]}
+connReqDataNoQM :: ConnReqUriData
+connReqDataNoQM = connReqData {crSmpQueues = [queueNoQM]}
+
+connReqDataContact :: ConnReqUriData
+connReqDataContact = connReqData {crSmpQueues = [queueContact]}
 
 connReqData1 :: ConnReqUriData
 connReqData1 = connReqData {crSmpQueues = [queue1]}
@@ -154,8 +170,11 @@ connectionRequest = ACR SCMInvitation invConnRequest
 invConnRequest :: ConnectionRequestUri 'CMInvitation
 invConnRequest = CRInvitationUri connReqData testE2ERatchetParams
 
-connectionRequestSK :: AConnectionRequestUri
-connectionRequestSK = ACR SCMInvitation $ CRInvitationUri connReqDataSK testE2ERatchetParams
+connectionRequestNoQM :: AConnectionRequestUri
+connectionRequestNoQM = ACR SCMInvitation $ CRInvitationUri connReqDataNoQM testE2ERatchetParams
+
+connectionRequestContact :: AConnectionRequestUri
+connectionRequestContact = ACR SCMContact $ CRContactUri connReqDataContact
 
 connectionRequestV1 :: AConnectionRequestUri
 connectionRequestV1 = ACR SCMInvitation $ CRInvitationUri connReqDataV1 testE2ERatchetParams
@@ -218,14 +237,15 @@ connectionRequestTests =
   describe "connection request parsing / serializing" $ do
     it "should serialize and parse SMP queue URIs" $ do
       queue #==# queueStr
-      queue #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-4&extra_param=abc&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
-      queueSK #==# queueStrSK
+      queue #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1-4&extra_param=abc&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&q=m&k=s")
+      queueNoQM #==# queueStrNoQM
+      queueContact #==# queueStrContact
       queue1 #==# queue1Str
       queueNew #==# queueNewStr
       queueNew #== queueNewStr'
       queueNew1 #==# queueNew1Str
-      queueNewNoPort #==# ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr)
-      queueNew1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr)
+      queueNewNoPort #==# ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr <> "&q=m&k=s")
+      queueNew1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=2-4&dh=" <> url testDhKeyStr <> "&q=m&k=s")
       queueV1 #==# ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
       queueV1 #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion:5223/3456-w==#" <> testDhKeyStr)
       queueV1 #== ("smp://1234-w==@smp.simplex.im:5223/3456-w==#/?extra_param=abc&v=1&dh=" <> testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion")
@@ -236,7 +256,7 @@ connectionRequestTests =
     it "should serialize and parse connection invitations and contact addresses" $ do
       connectionRequest #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
       connectionRequest #== ("https://simplex.chat/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
-      connectionRequestSK #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri)
+      connectionRequestNoQM #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStrNoQM <> "&e2e=" <> testE2ERatchetParamsStrUri)
       connectionRequest1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri)
       connectionRequest2queues #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri)
       connectionRequestNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
@@ -256,7 +276,8 @@ connectionRequestTests =
       contactAddressClientData #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}")
     it "should serialize / parse queue address, connection invitations and contact addresses as binary" $ do
       smpEncodingTest queue
-      smpEncodingTest queueSK
+      smpEncodingTest queueNoQM -- this passes, no queue mode patch in SMPQueueUri encoding
+      -- smpEncodingTest queueContact -- this fails until SMP client min version is >= sndAuthKeySMPClientVersion
       smpEncodingTest queue1
       smpEncodingTest queueNew
       smpEncodingTest queueNew1
@@ -265,7 +286,8 @@ connectionRequestTests =
       smpEncodingTest queueV1
       smpEncodingTest queueV1NoPort
       smpEncodingTest connectionRequest
-      smpEncodingTest connectionRequestSK
+      -- smpEncodingTest connectionRequestNoQM -- this fails, because of queue mode patch
+      smpEncodingTest connectionRequestContact  -- this passes because of queue mode patch in ConnReqUriData encoding
       smpEncodingTest connectionRequest1
       smpEncodingTest connectionRequest2queues
       smpEncodingTest connectionRequestNew
@@ -279,27 +301,46 @@ connectionRequestTests =
       smpEncodingTest contactAddressV2
       smpEncodingTest contactAddressClientData
     it "should serialize / parse short links" $ do
-      CSLContact srv CCTContact (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im:5223/c#1234-w@jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY"
-      CSLContact srv CCTGroup (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im:5223/g#1234-w@jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY"
-      CSLContact shortSrv CCTContact (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/c#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY"
-      CSLInvitation srv (EntityId "0123456789abcdef01234567") (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im:5223/i#1234-w@jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY"
-      CSLInvitation shortSrv (EntityId "0123456789abcdef01234567") (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY"
+      CSLContact SLSServer CCTContact srv (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
+      CSLContact SLSServer CCTGroup srv (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/g#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
+      CSLContact SLSServer CCTContact shortSrv (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY"
+      CSLInvitation SLSServer srv (EntityId "0123456789abcdef01234567") (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
+      CSLInvitation SLSServer shortSrv (EntityId "0123456789abcdef01234567") (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY"
+      CSLContact SLSSimplex CCTContact srv (LinkKey "0123456789abcdef0123456789abcdef") #==# "simplex:/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im%2Cjjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
+      CSLContact SLSSimplex CCTGroup srv (LinkKey "0123456789abcdef0123456789abcdef") #==# "simplex:/g#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im%2Cjjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
+      CSLContact SLSSimplex CCTContact shortSrv (LinkKey "0123456789abcdef0123456789abcdef") #==# "simplex:/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im"
+      CSLInvitation SLSSimplex srv (EntityId "0123456789abcdef01234567") (LinkKey "0123456789abcdef0123456789abcdef") #==# "simplex:/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im%2Cjjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
+      CSLInvitation SLSSimplex shortSrv (EntityId "0123456789abcdef01234567") (LinkKey "0123456789abcdef0123456789abcdef") #==# "simplex:/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3/MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im"
     it "should shorten / restore short links" $ do
-      shortenShortLink [srv] (CSLContact srv CCTContact (LinkKey "0123456789abcdef0123456789abcdef"))
-        `shouldBe` CSLContact shortSrv CCTContact (LinkKey "0123456789abcdef0123456789abcdef")
-      shortenShortLink [srv] (CSLContact srv2 CCTContact (LinkKey "0123456789abcdef0123456789abcdef"))
-        `shouldBe` CSLContact srv2 CCTContact (LinkKey "0123456789abcdef0123456789abcdef")
-      restoreShortLink [srv] (CSLContact shortSrv CCTContact (LinkKey "0123456789abcdef0123456789abcdef"))
-        `shouldBe` CSLContact srv CCTContact (LinkKey "0123456789abcdef0123456789abcdef")
-      restoreShortLink [srv2] (CSLContact shortSrv CCTContact (LinkKey "0123456789abcdef0123456789abcdef"))
-        `shouldBe` CSLContact shortSrv CCTContact (LinkKey "0123456789abcdef0123456789abcdef")
-      restoreShortLink [srv] (CSLContact srv2 CCTContact (LinkKey "0123456789abcdef0123456789abcdef"))
-        `shouldBe` CSLContact srv2 CCTContact (LinkKey "0123456789abcdef0123456789abcdef")
+      let contact = CSLContact SLSServer CCTContact
+      shortenShortLink [srv] (contact srv (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact shortSrv (LinkKey "0123456789abcdef0123456789abcdef")
+      -- won't shorten link that uses only onion host from preset server
+      shortenShortLink [srv] (contact srvOnion (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact srvOnion (LinkKey "0123456789abcdef0123456789abcdef")
+      -- will shorten link that uses only public host from preset server
+      shortenShortLink [srv] (contact srv1 (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact shortSrv (LinkKey "0123456789abcdef0123456789abcdef")
+      shortenShortLink [srv] (contact srv2 (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact srv2 (LinkKey "0123456789abcdef0123456789abcdef")
+      restoreShortLink [srv] (contact shortSrv (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact srv (LinkKey "0123456789abcdef0123456789abcdef")
+      -- won't change link that has only public host of preset server with keyhash
+      restoreShortLink [srv] (contact srv1 (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact srv1 (LinkKey "0123456789abcdef0123456789abcdef")
+      restoreShortLink [srv2] (contact shortSrv (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact shortSrv (LinkKey "0123456789abcdef0123456789abcdef")
+      restoreShortLink [srv] (contact srv2 (LinkKey "0123456789abcdef0123456789abcdef"))
+        `shouldBe` contact srv2 (LinkKey "0123456789abcdef0123456789abcdef")
   where
+    smpEncodingTest :: (Encoding a, Eq a, Show a, HasCallStack) => a -> Expectation
     smpEncodingTest a = smpDecode (smpEncode a) `shouldBe` Right a
 
 shortSrv :: SMPServer
 shortSrv = SMPServer "smp.simplex.im" "" (C.KeyHash "")
 
+srvOnion :: SMPServer
+srvOnion = SMPServer "jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion" "" (C.KeyHash "\215m\248\251")
+
 srv2 :: SMPServer
 srv2 = SMPServer "smp2.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion" "" (C.KeyHash "\215m\248\251")

tests/AgentTests/EqInstances.hs

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

tests/AgentTests/FunctionalAPITests.hs

@@ -78,7 +78,7 @@ import Data.Type.Equality (testEquality, (:~:) (Refl))
 import Data.Word (Word16)
 import GHC.Stack (withFrozenCallStack)
 import SMPAgentClient
-import SMPClient (cfgMS, cfgJ2QS, prevRange, prevVersion, testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServers2, withSmpServerConfigOn, withSmpServerProxy, withSmpServersProxy2, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
+import SMPClient (cfgJ2QS, cfgMS, prevRange, prevVersion, proxyCfgJ2QS, proxyCfgMS, testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServers2, withSmpServerConfigOn, withSmpServerProxy, withSmpServersProxy2, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
@@ -102,7 +102,7 @@ import Simplex.Messaging.Server.Env.STM (AServerStoreCfg (..), AStoreType (..),
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore.Types (SMSType (..), SQSType (..))
 import Simplex.Messaging.Server.QueueStore.QueueInfo
-import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, currentServerSMPRelayVersion, minClientSMPRelayVersion, minServerSMPRelayVersion, sendingProxySMPVersion, sndAuthKeySMPVersion, supportedSMPHandshakes)
+import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, currentServerSMPRelayVersion, minClientSMPRelayVersion, minServerSMPRelayVersion, sendingProxySMPVersion, sndAuthKeySMPVersion, supportedSMPHandshakes, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds)
 import Simplex.Messaging.Version (VersionRange (..))
 import qualified Simplex.Messaging.Version as V
@@ -315,6 +315,7 @@ functionalAPITests ps = do
     describe "should connect via 1-time short link with async join" $ testProxyMatrix ps testInviationShortLinkAsync
     describe "should connect via contact short link" $ testProxyMatrix ps testContactShortLink
     describe "should add short link to existing contact and connect" $ testProxyMatrix ps testAddContactShortLink
+    describe "try to create 1-time short link with prev versions" $ testProxyMatrixWithPrev ps testInviationShortLinkPrev
     describe "server restart" $ do
       it "should get 1-time link data after restart" $ testInviationShortLinkRestart ps
       it "should connect via contact short link after restart" $ testContactShortLinkRestart ps
@@ -547,8 +548,21 @@ testServerMatrix2 ps runTest = do
 
 testProxyMatrix :: HasCallStack => (ATransport, AStoreType) -> (Bool -> AgentClient -> AgentClient -> IO ()) -> Spec
 testProxyMatrix ps runTest = do
-  it "2 servers, directly" $ withSmpServers2 ps $ withAgentClientsServers2 initAgentServers initAgentServers2 $ runTest False
-  it "2 servers, via proxy" $ withSmpServersProxy2 ps $ withAgentClientsServers2 initAgentServersProxy initAgentServersProxy2 $ runTest True
+  it "2 servers, directly" $ withSmpServers2 ps $ withAgentClientsServers2 (agentCfg, initAgentServers) (agentCfg, initAgentServers2) $ runTest False
+  it "2 servers, via proxy" $ withSmpServersProxy2 ps $ withAgentClientsServers2 (agentCfg, initAgentServersProxy) (agentCfg, initAgentServersProxy2) $ runTest True
+
+testProxyMatrixWithPrev :: HasCallStack => (ATransport, AStoreType) -> (Bool -> Bool -> AgentClient -> AgentClient -> IO ()) -> Spec
+testProxyMatrixWithPrev ps@(t, msType@(ASType qs _ms)) runTest = do
+  it "2 servers, directly, curr clients, prev servers" $ withSmpServers2Prev $ withAgentClientsServers2 (agentCfg, initAgentServers) (agentCfg, initAgentServers2) $ runTest False True
+  it "2 servers, via proxy, curr clients, prev servers" $ withSmpServersProxy2Prev $ withAgentClientsServers2 (agentCfg, initAgentServersProxy) (agentCfg, initAgentServersProxy2) $ runTest True True
+  it "2 servers, directly, prev clients, curr servers" $ withSmpServers2 ps $ withAgentClientsServers2 (agentCfgVPrevPQ, initAgentServers) (agentCfgVPrevPQ, initAgentServers2) $ runTest False False
+  it "2 servers, via proxy, prev clients, curr servers" $ withSmpServersProxy2 ps $ withAgentClientsServers2 (agentCfgVPrevPQ, initAgentServersProxy) (agentCfgVPrevPQ, initAgentServersProxy2) $ runTest True False
+  where
+    prev cfg' = cfg' {smpServerVRange = prevRange supportedServerSMPRelayVRange}
+    withSmpServers2Prev a = withServers2 (prev $ cfgMS msType) (prev $ cfgJ2QS qs) a
+    withSmpServersProxy2Prev a = withServers2 (prev $ proxyCfgMS msType) (prev $ proxyCfgJ2QS qs) a
+    withServers2 cfg1 cfg2 a =
+      withSmpServerConfigOn t cfg1 testPort $ \_ -> withSmpServerConfigOn t cfg2 testPort2 $ \_ -> a
 
 testPQMatrix2 :: HasCallStack => (ATransport, AStoreType) -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
 testPQMatrix2 = pqMatrix2_ True
@@ -604,10 +618,10 @@ withAgentClientsCfgServers2 aCfg bCfg servers runTest =
     withAgent 2 bCfg servers testDB2 $ \b ->
       runTest a b
 
-withAgentClientsServers2 :: HasCallStack => InitialAgentServers -> InitialAgentServers -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
-withAgentClientsServers2 aServers bServers runTest =
-  withAgent 1 agentCfg aServers testDB $ \a ->
-    withAgent 2 agentCfg bServers testDB2 $ \b ->
+withAgentClientsServers2 :: HasCallStack => (AgentConfig, InitialAgentServers) -> (AgentConfig, InitialAgentServers) -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
+withAgentClientsServers2 (aCfg, aServers) (bCfg, bServers) runTest =
+  withAgent 1 aCfg aServers testDB $ \a ->
+    withAgent 2 bCfg bServers testDB2 $ \b ->
       runTest a b
 
 withAgentClientsCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
@@ -1102,37 +1116,47 @@ testInviationShortLink viaProxy a b =
   withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
     let userData = "some user data"
     (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
-    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
-    userData' `shouldBe` userData
+    linkUserData connData' `shouldBe` userData
     -- same user can get invitation link again
-    (connReq2, userData2) <- runRight $ getConnShortLink b 1 shortLink
+    (connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
     connReq2 `shouldBe` connReq
-    userData2 `shouldBe` userData
+    linkUserData connData2 `shouldBe` userData
     -- another user cannot get the same invitation link
     runExceptT (getConnShortLink c 1 shortLink) >>= \case
       Left (SMP _ AUTH) -> pure ()
       r -> liftIO $ expectationFailure ("unexpected result " <> show r)
-    runRight $ do
-      aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
-      sndSecure <- A.joinConnection b 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
-      liftIO $ sndSecure `shouldBe` True
-      ("", _, CONF confId _ "bob's connInfo") <- get a
-      allowConnection a bId confId "alice's connInfo"
-      get a ##> ("", bId, CON)
-      get b ##> ("", aId, INFO "alice's connInfo")
-      get b ##> ("", aId, CON)
-      exchangeGreetingsViaProxy viaProxy a bId b aId
+    runRight $ testJoinConn_ viaProxy True a bId b connReq
+
+testJoinConn_ :: Bool -> Bool -> AgentClient -> ConnId -> AgentClient -> ConnectionRequestUri c -> ExceptT AgentErrorType IO ()
+testJoinConn_ viaProxy sndSecure a bId b connReq = do
+  aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
+  sndSecure' <- A.joinConnection b 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
+  liftIO $ sndSecure' `shouldBe` sndSecure
+  ("", _, CONF confId _ "bob's connInfo") <- get a
+  allowConnection a bId confId "alice's connInfo"
+  get a ##> ("", bId, CON)
+  get b ##> ("", aId, INFO "alice's connInfo")
+  get b ##> ("", aId, CON)
+  exchangeGreetingsViaProxy viaProxy a bId b aId
+
+testInviationShortLinkPrev :: HasCallStack => Bool -> Bool -> AgentClient -> AgentClient -> IO ()
+testInviationShortLinkPrev viaProxy sndSecure a b = runRight_ $ do
+  let userData = "some user data"
+  -- can't create short link with previous version
+  (bId, CCLink connReq Nothing) <- A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKPQOn SMSubscribe
+  testJoinConn_ viaProxy sndSecure a bId b connReq
 
 testInviationShortLinkAsync :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
 testInviationShortLinkAsync viaProxy a b = do
   let userData = "some user data"
   (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
-  (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+  (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
   strDecode (strEncode shortLink) `shouldBe` Right shortLink
   connReq' `shouldBe` connReq
-  userData' `shouldBe` userData
+  linkUserData connData' `shouldBe` userData
   runRight $ do
     aId <- A.joinConnectionAsync b 1 "123" True connReq "bob's connInfo" PQSupportOn SMSubscribe
     get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False
@@ -1149,18 +1173,18 @@ testContactShortLink viaProxy a b =
     let userData = "some user data"
     (contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
     Right connReq <- pure $ smpDecode (smpEncode connReq0)
-    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
-    userData' `shouldBe` userData
+    linkUserData connData' `shouldBe` userData
     -- same user can get contact link again
-    (connReq2, userData2) <- runRight $ getConnShortLink b 1 shortLink
+    (connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
     connReq2 `shouldBe` connReq
-    userData2 `shouldBe` userData
+    linkUserData connData2 `shouldBe` userData
     -- another user can get the same contact link
-    (connReq3, userData3) <- runRight $ getConnShortLink c 1 shortLink
+    (connReq3, connData3) <- runRight $ getConnShortLink c 1 shortLink
     connReq3 `shouldBe` connReq
-    userData3 `shouldBe` userData
+    linkUserData connData3 `shouldBe` userData
     runRight $ do
       (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
       liftIO $ sndSecure `shouldBe` False
@@ -1178,9 +1202,9 @@ testContactShortLink viaProxy a b =
     let updatedData = "updated user data"
     shortLink' <- runRight $ setContactShortLink a contactId updatedData
     shortLink' `shouldBe` shortLink
-    (connReq4, updatedData') <- runRight $ getConnShortLink c 1 shortLink
+    (connReq4, updatedConnData') <- runRight $ getConnShortLink c 1 shortLink
     connReq4 `shouldBe` connReq
-    updatedData' `shouldBe` updatedData
+    linkUserData updatedConnData' `shouldBe` updatedData
     -- one more time
     shortLink2 <- runRight $ setContactShortLink a contactId updatedData
     shortLink2 `shouldBe` shortLink
@@ -1196,18 +1220,18 @@ testAddContactShortLink viaProxy a b =
     Right connReq <- pure $ smpDecode (smpEncode connReq0) --
     let userData = "some user data"
     shortLink <- runRight $ setContactShortLink a contactId userData
-    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
-    userData' `shouldBe` userData
+    linkUserData connData' `shouldBe` userData
     -- same user can get contact link again
-    (connReq2, userData2) <- runRight $ getConnShortLink b 1 shortLink
+    (connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink
     connReq2 `shouldBe` connReq
-    userData2 `shouldBe` userData
+    linkUserData connData2 `shouldBe` userData
     -- another user can get the same contact link
-    (connReq3, userData3) <- runRight $ getConnShortLink c 1 shortLink
+    (connReq3, connData3) <- runRight $ getConnShortLink c 1 shortLink
     connReq3 `shouldBe` connReq
-    userData3 `shouldBe` userData
+    linkUserData connData3 `shouldBe` userData
     runRight $ do
       (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
       liftIO $ sndSecure `shouldBe` False
@@ -1225,9 +1249,9 @@ testAddContactShortLink viaProxy a b =
     let updatedData = "updated user data"
     shortLink' <- runRight $ setContactShortLink a contactId updatedData
     shortLink' `shouldBe` shortLink
-    (connReq4, updatedData') <- runRight $ getConnShortLink c 1 shortLink
+    (connReq4, updatedConnData') <- runRight $ getConnShortLink c 1 shortLink
     connReq4 `shouldBe` connReq
-    updatedData' `shouldBe` updatedData
+    linkUserData updatedConnData' `shouldBe` updatedData
 
 testInviationShortLinkRestart :: HasCallStack => (ATransport, AStoreType) -> IO ()
 testInviationShortLinkRestart ps = withAgentClients2 $ \a b -> do
@@ -1236,10 +1260,10 @@ testInviationShortLinkRestart ps = withAgentClients2 $ \a b -> do
     runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMOnlyCreate
   withSmpServer ps $ do
     runRight_ $ subscribeConnection a bId
-    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
-    userData' `shouldBe` userData
+    linkUserData connData' `shouldBe` userData
 
 testContactShortLinkRestart :: HasCallStack => (ATransport, AStoreType) -> IO ()
 testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
@@ -1249,17 +1273,17 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
   Right connReq <- pure $ smpDecode (smpEncode connReq0)
   let updatedData = "updated user data"
   withSmpServer ps $ do
-    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
-    userData' `shouldBe` userData
+    linkUserData connData' `shouldBe` userData
     -- update user data
     shortLink' <- runRight $ setContactShortLink a contactId updatedData
     shortLink' `shouldBe` shortLink
   withSmpServer ps $ do
-    (connReq4, updatedData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq4, updatedConnData') <- runRight $ getConnShortLink b 1 shortLink
     connReq4 `shouldBe` connReq
-    updatedData' `shouldBe` updatedData
+    linkUserData updatedConnData' `shouldBe` updatedData
 
 testAddContactShortLinkRestart :: HasCallStack => (ATransport, AStoreType) -> IO ()
 testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
@@ -1270,17 +1294,17 @@ testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
   Right connReq <- pure $ smpDecode (smpEncode connReq0)
   let updatedData = "updated user data"
   withSmpServer ps $ do
-    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink
     strDecode (strEncode shortLink) `shouldBe` Right shortLink
     connReq' `shouldBe` connReq
-    userData' `shouldBe` userData
+    linkUserData connData' `shouldBe` userData
     -- update user data
     shortLink' <- runRight $ setContactShortLink a contactId updatedData
     shortLink' `shouldBe` shortLink
   withSmpServer ps $ do
-    (connReq4, updatedData') <- runRight $ getConnShortLink b 1 shortLink
+    (connReq4, updatedConnData') <- runRight $ getConnShortLink b 1 shortLink
     connReq4 `shouldBe` connReq
-    updatedData' `shouldBe` updatedData
+    linkUserData updatedConnData' `shouldBe` updatedData
 
 testIncreaseConnAgentVersion :: HasCallStack => (ATransport, AStoreType) -> IO ()
 testIncreaseConnAgentVersion ps = do

tests/AgentTests/SchemaDump.hs

@@ -63,12 +63,6 @@ testVerifyLintFKeyIndexes = do
   getLintFKeyIndexes testDB "tests/tmp/agent_lint.sql" `shouldReturn` savedLint
   removeFile testDB
 
-withTmpFiles :: IO () -> IO ()
-withTmpFiles =
-  bracket_
-    (createDirectoryIfMissing False "tests/tmp")
-    (removeDirectoryRecursive "tests/tmp")
-
 testSchemaMigrations :: IO ()
 testSchemaMigrations = do
   let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) appMigrations

tests/AgentTests/ShortLinkTests.hs

@@ -5,9 +5,10 @@
 module AgentTests.ShortLinkTests (shortLinkTests) where
 
 import AgentTests.ConnectionRequestTests (contactConnRequest, invConnRequest)
+import AgentTests.EqInstances ()
 import Control.Concurrent.STM
 import Control.Monad.Except
-import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnectionMode (..), LinkKey (..), SMPAgentError (..), supportedSMPAgentVRange)
+import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), ConnectionMode (..), LinkKey (..), SMPAgentError (..), linkUserData, supportedSMPAgentVRange)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.ShortLink as SL
 import Test.Hspec
@@ -33,9 +34,9 @@ testInvShortLink = do
       k = SL.invShortLinkKdf linkKey
   Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
   -- decrypt
-  Right (connReq, userData') <- pure $ SL.decryptLinkData linkKey k srvData
+  Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData
   connReq `shouldBe` invConnRequest
-  userData' `shouldBe` userData
+  linkUserData connData' `shouldBe` userData
 
 testInvShortLinkBadDataHash :: IO ()
 testInvShortLinkBadDataHash = do
@@ -62,9 +63,9 @@ testContactShortLink = do
       (_linkId, k) = SL.contactShortLinkKdf linkKey
   Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
   -- decrypt
-  Right (connReq, userData') <- pure $ SL.decryptLinkData linkKey k srvData
+  Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData
   connReq `shouldBe` contactConnRequest
-  userData' `shouldBe` userData
+  linkUserData connData' `shouldBe` userData
 
 testUpdateContactShortLink :: IO ()
 testUpdateContactShortLink = do
@@ -80,9 +81,9 @@ testUpdateContactShortLink = do
       signed = SL.encodeSignUserData (snd sigKeys) supportedSMPAgentVRange updatedUserData
   Right ud' <- runExceptT $ SL.encryptUserData g k signed
   -- decrypt
-  Right (connReq, userData') <- pure $ SL.decryptLinkData linkKey k (fd, ud')
+  Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k (fd, ud')
   connReq `shouldBe` contactConnRequest
-  userData' `shouldBe` updatedUserData
+  linkUserData connData' `shouldBe` updatedUserData
 
 testContactShortLinkBadDataHash :: IO ()
 testContactShortLinkBadDataHash = do

tests/CoreTests/MsgStoreTests.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -117,11 +118,11 @@ testNewQueueRecData :: TVar ChaChaDRG -> QueueMode -> Maybe (LinkId, QueueLinkDa
 testNewQueueRecData g qm queueData = do
   rId <- rndId
   senderId <- rndId
-  (recipientKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
+  (rKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   (k, pk) <- atomically $ C.generateKeyPair @'C.X25519 g
   let qr =
         QueueRec
-          { recipientKey,
+          { recipientKeys = [rKey],
             rcvDhSecret = C.dh' k pk,
             senderId,
             senderKey = Nothing,

tests/CoreTests/StoreLogTests.hs

@@ -14,6 +14,7 @@ import CoreTests.MsgStoreTests
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (partitionEithers)
+import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import SMPClient
 import qualified Simplex.Messaging.Crypto as C
@@ -56,15 +57,16 @@ deriving instance Eq NtfCreds
 storeLogTests :: Spec
 storeLogTests =
   forM_ [QMMessaging, QMContact] $ \qm -> do
-    ((rId, qr), ntfCreds, date) <- runIO $ do
-      g <- C.newRandom
+    g <- runIO C.newRandom
+    ((rId, qr), ntfCreds, date) <- runIO $
       (,,) <$> testNewQueueRec g qm <*> testNtfCreds g <*> getSystemDate
     ((rId', qr'), lnkId, qd) <- runIO $ do
-      g <- C.newRandom
       lnkId <- atomically $ EntityId <$> C.randomBytes 24 g
       let qd = (EncDataBytes "fixed data", EncDataBytes "user data")
       q <- testNewQueueRecData g qm (Just (lnkId, qd))
       pure (q, lnkId, qd)
+    let pubKey = fst <$> atomically (C.generateAuthKeyPair C.SEd25519 g)
+    newKeys <- runIO $ L.fromList <$> sequence [pubKey, pubKey]
     testSMPStoreLog
       ("SMP server store log, queueMode = " <> show qm)
       [ SLTC
@@ -120,6 +122,12 @@ storeLogTests =
             saved = [CreateQueue rId qr, UpdateTime rId date],
             compacted = [CreateQueue rId qr {updatedAt = Just date}],
             state = M.fromList [(rId, qr {updatedAt = Just date})]
+          },
+        SLTC
+          { name = "update recipient keys",
+            saved = [CreateQueue rId qr, UpdateKeys rId newKeys],
+            compacted = [CreateQueue rId qr {recipientKeys = newKeys}],
+            state = M.fromList [(rId, qr {recipientKeys = newKeys})]
           }
       ]
 

tests/ServerTests.hs

@@ -60,6 +60,8 @@ serverTests = do
     describe "NEW and SKEY commands" $ do
       testCreateSndSecure
       testSndSecureProhibited
+    describe "RKEY command to add additional recipient keys" $
+      testCreateUpdateKeys
     describe "NEW, OFF and DEL commands, SEND messages" testCreateDelete
     describe "Stress test" stressTest
     describe "allowNewQueues setting" testAllowNewQueues
@@ -272,6 +274,38 @@ testSndSecureProhibited =
       (sId2, sId) #== "secures queue, same queue ID in response"
       (err, ERR AUTH) #== "rejects SKEY when not allowed in NEW command"
 
+testCreateUpdateKeys :: SpecWith (ATransport, AStoreType)
+testCreateUpdateKeys =
+  it "should create (NEW) and updated recipient keys (RKEY)" $ \(ATransport t, msType) ->
+    smpTest t msType $ \h -> do
+      g <- C.newRandom
+      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      Resp "1" NoEntity (Ids rId _sId _srvDh) <- signSendRecv h rKey ("1", NoEntity, NEW (NewQueueReq rPub dhPub Nothing SMSubscribe (Just (QRContact Nothing))))
+      (rPub', rKey') <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      Resp "2" rId1 OK <- signSendRecv h rKey ("2", rId, RKEY [rPub, rPub'])
+      rId1 `shouldBe` rId
+      -- old key still works
+      Resp "3" rId2 (INFO _) <- signSendRecv h rKey ("3", rId, QUE)
+      rId2 `shouldBe` rId
+      -- new key works too
+      Resp "4" _ (INFO _) <- signSendRecv h rKey ("4", rId, QUE)
+      -- remove old key, only keep the new one
+      Resp "5" _ OK <- signSendRecv h rKey' ("5", rId, RKEY [rPub'])
+      -- old key no longer works
+      Resp "6" _ (ERR AUTH) <- signSendRecv h rKey ("6", rId, QUE)
+      -- add old key back
+      Resp "7" _ OK <- signSendRecv h rKey' ("7", rId, RKEY [rPub, rPub'])
+      -- old key works again
+      Resp "8" _ (INFO _) <- signSendRecv h rKey ("8", rId, QUE)
+      -- key can remove itself
+      Resp "9" _ OK <- signSendRecv h rKey ("9", rId, RKEY [rPub'])
+      -- old key does not work
+      Resp "10" _ (ERR AUTH) <- signSendRecv h rKey ("10", rId, QUE)
+      -- new key works
+      Resp "11" _ (INFO _) <- signSendRecv h rKey' ("11", rId, QUE)
+      pure ()
+
 testCreateDelete :: SpecWith (ATransport, AStoreType)
 testCreateDelete =
   it "should create (NEW), suspend (OFF) and delete (DEL) queue" $ \(ATransport t, msType) ->

tests/ServerTests/SchemaDump.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module ServerTests.SchemaDump where
+
+import Control.Concurrent (threadDelay)
+import Control.DeepSeq
+import Control.Monad (unless, void)
+import qualified Data.ByteString.Char8 as B
+import Data.List (dropWhileEnd)
+import Data.Maybe (fromJust, isJust)
+import SMPClient
+import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore)
+import Simplex.Messaging.Agent.Store.Postgres.Common (DBOpts (..))
+import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
+import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
+import Simplex.Messaging.Server.QueueStore.Postgres.Migrations (serverMigrations)
+import Simplex.Messaging.Util (ifM)
+import System.Directory (doesFileExist, removeFile)
+import System.Environment (lookupEnv)
+import System.Process (readCreateProcess, readCreateProcessWithExitCode, shell)
+import Test.Hspec
+
+testDBSchema :: B.ByteString
+testDBSchema = "smp_server"
+
+serverSchemaPath :: FilePath
+serverSchemaPath = "src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql"
+
+testSchemaPath :: FilePath
+testSchemaPath = "tests/tmp/test_server_schema.sql"
+
+testServerDBOpts :: DBOpts
+testServerDBOpts = 
+  DBOpts
+    { connstr = testServerDBConnstr,
+      schema = testDBSchema,
+      poolSize = 3,
+      createSchema = True
+    }
+
+serverSchemaDumpTest :: Spec
+serverSchemaDumpTest = do
+  it "verify and overwrite schema dump" testVerifySchemaDump
+  it "verify schema down migrations" testSchemaMigrations
+
+testVerifySchemaDump :: IO ()
+testVerifySchemaDump = do
+  savedSchema <- ifM (doesFileExist serverSchemaPath) (readFile serverSchemaPath) (pure "")
+  savedSchema `deepseq` pure ()
+  void $ createDBStore testServerDBOpts serverMigrations MCConsole
+  getSchema serverSchemaPath `shouldReturn` savedSchema
+
+testSchemaMigrations :: IO ()
+testSchemaMigrations = do
+  let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) serverMigrations
+  Right st <- createDBStore testServerDBOpts noDownMigrations MCError
+  mapM_ (testDownMigration st) $ drop (length noDownMigrations) serverMigrations
+  closeDBStore st
+  removeFile testSchemaPath
+  where
+    testDownMigration st m = do
+      putStrLn $ "down migration " <> name m
+      let downMigr = fromJust $ toDownMigration m
+      schema <- getSchema testSchemaPath
+      Migrations.run st $ MTRUp [m]
+      schema' <- getSchema testSchemaPath
+      schema' `shouldNotBe` schema
+      Migrations.run st $ MTRDown [downMigr]
+      unless (name m `elem` skipComparisonForDownMigrations) $ do
+        schema'' <- getSchema testSchemaPath
+        schema'' `shouldBe` schema
+      Migrations.run st $ MTRUp [m]
+      schema''' <- getSchema testSchemaPath
+      schema''' `shouldBe` schema'
+
+skipComparisonForDownMigrations :: [String]
+skipComparisonForDownMigrations =
+  [ -- snd_secure moves to the bottom on down migration
+    "20250320_short_links"
+  ]
+
+getSchema :: FilePath -> IO String
+getSchema schemaPath = do
+  ci <- (Just "true" ==) <$> lookupEnv "CI"
+  let cmd =
+        ("pg_dump " <> B.unpack testServerDBConnstr <> " --schema " <> B.unpack testDBSchema)
+          <> " --schema-only --no-owner --no-privileges --no-acl --no-subscriptions --no-tablespaces > "
+          <> schemaPath
+  (code, out, err) <- readCreateProcessWithExitCode (shell cmd) ""
+  print code
+  putStrLn $ "out: " <> out
+  putStrLn $ "err: " <> err
+  threadDelay 20000
+  let sed = (if ci then "sed -i" else "sed -i ''")
+  void $ readCreateProcess (shell $ sed <> " '/^--/d' " <> schemaPath) ""
+  sch <- readFile schemaPath
+  sch `deepseq` pure sch

tests/Test.hs

@@ -44,6 +44,7 @@ import AgentTests.SchemaDump (schemaDumpTest)
 
 #if defined(dbServerPostgres)
 import SMPClient (testServerDBConnectInfo)
+import ServerTests.SchemaDump
 #endif
 
 #if defined(dbPostgres) || defined(dbServerPostgres)
@@ -85,8 +86,10 @@ main = do
           describe "Util tests" utilTests
           describe "Agent core tests" agentCoreTests
 #if defined(dbServerPostgres)
-        aroundAll_ (postgressBracket testServerDBConnectInfo)
-          $ describe "SMP server via TLS, postgres+jornal message store" $
+        around_ (postgressBracket testServerDBConnectInfo) $
+          describe "Server schema dump" serverSchemaDumpTest
+        aroundAll_ (postgressBracket testServerDBConnectInfo) $
+          describe "SMP server via TLS, postgres+jornal message store" $
               before (pure (transport @TLS, ASType SQSPostgres SMSJournal)) serverTests
 #endif
         describe "SMP server via TLS, jornal message store" $ do