From 40623d2ae09dd6dc849d44cddee1af68c7215ca4 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 11 Jul 2026 16:39:15 +0000 Subject: [PATCH 01/81] rfc: agent support for PRC pattern without duplex connection --- .../2026-07-11-service-rpc-implementation.md | 229 ++++++++++++++++++ rfcs/2026-07-11-service-rpc.md | 175 +++++++++++++ 2 files changed, 404 insertions(+) create mode 100644 plans/2026-07-11-service-rpc-implementation.md create mode 100644 rfcs/2026-07-11-service-rpc.md diff --git a/plans/2026-07-11-service-rpc-implementation.md b/plans/2026-07-11-service-rpc-implementation.md new file mode 100644 index 000000000..e7fa0fd75 --- /dev/null +++ b/plans/2026-07-11-service-rpc-implementation.md @@ -0,0 +1,229 @@ +# Service RPC implementation plan + +RFC: [../rfcs/2026-07-11-service-rpc.md](../rfcs/2026-07-11-service-rpc.md) + +Types and instances below must encode exactly the ABNF in the RFC. Constructor and event names are provisional. + +## Versions + +- `VersionSMPA` (agent protocol): new version for `AgentRequest`/`AgentResponse` envelopes and the service key bundle in link data. +- `VersionSMPC` (SMP client): new version for the hybrid public header. +- `VersionSMP` (SMP protocol): new version for the `SSND` command. + +## Address type - `Simplex.Messaging.Agent.Protocol` + +```haskell +data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay | CCTService + +ctTypeChar CCTService = 'S' -- 's' in links: link encoding lowercases, parsing uppercases + +ctTypeP 'S' = pure CCTService +``` + +## Service key bundle - `Simplex.Messaging.Agent.Protocol` + +```haskell +data ServiceKeyBundle = ServiceKeyBundle + { keyId :: ByteString, + reqDhKey :: C.PublicKeyX25519, + reqKemKey :: KEMPublicKey + } + +instance Encoding ServiceKeyBundle where + smpEncode ServiceKeyBundle {keyId, reqDhKey, reqKemKey} = smpEncode (keyId, reqDhKey, reqKemKey) + smpP = do + (keyId, reqDhKey, reqKemKey) <- smpP + pure ServiceKeyBundle {keyId, reqDhKey, reqKemKey} +``` + +`UserContactData` gains a field, appended to the encoding (earlier versions skip it, its absence parses as `Nothing`): + +```haskell +data UserContactData = UserContactData + { direct :: Bool, + owners :: [OwnerAuth], + relays :: [ConnShortLink 'CMContact], + userData :: UserLinkData, + serviceKeys :: Maybe ServiceKeyBundle + } + +instance Encoding UserContactData where + smpEncode UserContactData {direct, owners, relays, userData, serviceKeys} = + B.concat [smpEncode direct, smpEncodeList owners, smpEncodeList relays, smpEncode userData, smpEncode serviceKeys] + smpP = do + direct <- smpP + owners <- smpListP + relays <- smpListP + userData <- smpP + serviceKeys <- fromMaybe Nothing <$> optional smpP -- absent in data from earlier versions + _ <- A.takeByteString -- ignoring tail for forward compatibility + pure UserContactData {direct, owners, relays, userData, serviceKeys} +``` + +The service address record stores current and previous private key bundles with rotation timestamps; expired bundles are deleted. + +## SSND command - `Simplex.Messaging.Protocol`, `Simplex.Messaging.Server` + +```haskell +-- Protocol.hs +SSND :: SndPublicAuthKey -> MsgFlags -> MsgBody -> Command Sender + +-- CommandTag, encoding "SSND" +SSND_ :: CommandTag Sender + +-- encodeProtocol +SSND k flags msg -> e (SSND_, ' ', k, ' ', flags, ' ', Tail msg) + +-- protocolP, gated by VersionSMP +SSND_ -> SSND <$> (smpP <* A.space) <*> (smpP <* A.space) <*> (unTail <$> smpP) +``` + +`checkCredentials`: as `SKEY` - authorization required, sender entity ID. Server verification: `vc SSender (SSND k _ _) = verifySecure k` - authorized by the key it sets. + +Server processing: `checkMode QMMessaging`, then `secureQueue_` (existing, idempotent), then deliver with deduplication. The queue store keeps the hash of the unacknowledged message delivered by `SSND`; a repeated `SSND` with an equal body hash responds `OK` without storing; the hash is dropped when the message is acknowledged. + +## Hybrid public header - `Simplex.Messaging.Protocol` + +```haskell +data PubHeader + = PubHeader + { phVersion :: VersionSMPC, + phE2ePubKey :: Maybe C.PublicKeyX25519 + } + | PubHeaderHybrid + { phVersion :: VersionSMPC, + phKeyId :: Maybe ByteString, -- present in requests, absent in replies + phDhKey :: C.PublicKeyX25519, + phKemCt :: KEMCiphertext + } + +instance Encoding PubHeader where + smpEncode = \case + PubHeader v k_ -> smpEncode (v, k_) -- Maybe encodes as '0' / '1' key, as today + PubHeaderHybrid v kId_ k ct -> smpEncode (v, '2', kId_, k, ct) + smpP = do + v <- smpP + A.anyChar >>= \case + '0' -> pure $ PubHeader v Nothing + '1' -> PubHeader v . Just <$> smpP + '2' -> PubHeaderHybrid v <$> smpP <*> smpP <*> smpP + _ -> fail "bad PubHeader" +``` + +Secret derivation and encryption (`Simplex.Messaging.Crypto`, used from `Simplex.Messaging.Agent.Client`): + +```haskell +hybridSecret :: C.DhSecretX25519 -> KEMSharedKey -> C.SbKey +hybridSecret dh (KEMSharedKey k) = C.unsafeSbKey $ C.hkdf "" (C.dhBytes' dh <> BA.convert k) "SimpleXSMPQueue" 32 +``` + +The body is encrypted with `C.sbEncrypt` (secret_box) instead of `C.cbEncrypt`, padded to the same lengths. Sending variant of `agentCbEncryptOnce`: generate ephemeral X25519 pair, encapsulate to the published KEM key, encode `PubHeaderHybrid`. Receiving: select private keys by `phKeyId` (requests) or use the reply queue keys from the request (replies); unknown key ID produces the error that makes the client re-fetch link data. + +## Agent envelopes - `Simplex.Messaging.Agent.Protocol` + +```haskell +data AgentMsgEnvelope + = ... -- existing constructors + | AgentRequest + { agentVersion :: VersionSMPA, + replyQueue :: RequestReplyQueue, + requestBody :: ByteString + } + | AgentResponse + { agentVersion :: VersionSMPA, + signature :: C.Signature 'C.Ed25519, -- root key signature of signedReply + signedReply :: ByteString -- encoded SignedReply, parsed after signature verification + } + +data RequestReplyQueue = RequestReplyQueue + { smpClientVersion :: VersionSMPC, + smpServer :: SMPServer, + senderId :: SMP.SenderId, + dhPublicKey :: C.PublicKeyX25519, -- fresh per request + kemPublicKey :: KEMPublicKey, -- fresh per request + sndAuthKey :: SndPublicAuthKey -- to secure the reply queue + } + +data SignedReply = SignedReply + { requestHash :: ByteString, -- SHA3-256 of the request message body + prevMsgHash :: ByteString, -- SHA3-256 of the previous reply envelope, empty in the first reply + final :: Bool, + replyBody :: ByteString + } +``` + +```haskell +instance Encoding AgentMsgEnvelope where + smpEncode = \case + ... -- existing constructors + AgentRequest {agentVersion, replyQueue, requestBody} -> + smpEncode (agentVersion, 'Q', replyQueue, Tail requestBody) + AgentResponse {agentVersion, signature, signedReply} -> + smpEncode (agentVersion, 'P', signature, Tail signedReply) + smpP = do + agentVersion <- smpP + smpP >>= \case + ... -- existing constructors + 'Q' -> do + (replyQueue, Tail requestBody) <- smpP + pure AgentRequest {agentVersion, replyQueue, requestBody} + 'P' -> do + (signature, Tail signedReply) <- smpP + pure AgentResponse {agentVersion, signature, signedReply} + +instance Encoding RequestReplyQueue where + smpEncode RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey} = + smpEncode (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey) + smpP = do + (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey) <- smpP + pure RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey} + +instance Encoding SignedReply where + smpEncode SignedReply {requestHash, prevMsgHash, final, replyBody} = + smpEncode (requestHash, prevMsgHash, final, Tail replyBody) + smpP = do + (requestHash, prevMsgHash, final, Tail replyBody) <- smpP + pure SignedReply {requestHash, prevMsgHash, final, replyBody} +``` + +Signing and verification follow the link data pattern (`Simplex.Messaging.Crypto.ShortLink`): + +```haskell +-- service +mkAgentResponse :: C.PrivateKeyEd25519 -> VersionSMPA -> SignedReply -> AgentMsgEnvelope +mkAgentResponse rootPrivKey agentVersion reply = + let signedReply = smpEncode reply + in AgentResponse {agentVersion, signature = C.sign' rootPrivKey signedReply, signedReply} + +-- client +verifyAgentResponse :: C.PublicKeyEd25519 -> AgentMsgEnvelope -> Either AgentErrorType SignedReply +verifyAgentResponse rootKey AgentResponse {signature, signedReply} + | C.verify' rootKey signature signedReply = parse smpP (AGENT A_MESSAGE) signedReply + | otherwise = Left ... -- verification error +``` + +## Agent processing - `Simplex.Messaging.Agent`, `Simplex.Messaging.Agent.Client` + +Client side: + +- `sendServiceRequest`: read link data (cached or `LGET`, proxied per config), create the reply queue (`NEW`, `QRMessaging`, subscribe), generate fresh X25519 + KEM keys and sender auth key, build and store the request message, send (proxied per config), return request ID. +- Retries re-send the stored byte-identical message. Deadline, cancellation and `final` delete the reply queue and the request record. +- Reply queue messages in `processSMPTransmissions`: decrypt with the stored hybrid secret (first reply establishes it from the hybrid header), verify with `verifyAgentResponse` and the hash chain, deliver as events; failures are acknowledged and dropped. +- New events: reply received (request ID, final flag, body), request failed (request ID, error). + +Service side: + +- Address queue messages with `AgentRequest`: compute request hash, look up the dedup store; on hit re-send stored replies (or the expiry error); on miss deliver a request event to the service application. +- Send replies: secure the reply queue and send the first reply with `SSND`, subsequent replies with `SEND`; store sent replies under the request hash until the window expires. + +Database: + +- Client: in-flight requests - request ID, stored request message, reply queue, hybrid secret, deadline, last reply hash. +- Service: dedup store - request hash, sent replies, expiry. + +## Phases + +1. SMP protocol: `SSND`, hybrid public header, version bumps, server dedup marker. +2. Agent: address type, key bundle, envelopes, client API and reply processing. +3. Agent: service-side dedup store and request events. +4. Adoption: `SSND` in the fast connection handshake; hybrid scheme for invitations and confirmations. diff --git a/rfcs/2026-07-11-service-rpc.md b/rfcs/2026-07-11-service-rpc.md new file mode 100644 index 000000000..b29e132c0 --- /dev/null +++ b/rfcs/2026-07-11-service-rpc.md @@ -0,0 +1,175 @@ +# One-off requests to service addresses + +Implementation plan: [../plans/2026-07-11-service-rpc-implementation.md](../plans/2026-07-11-service-rpc-implementation.md) + +## Problem + +Client applications need to interact with services, for example: badge issuance, directory requests, telemetry submissions, blockchain reads and writes, LLM calls. The only communication primitive available today is a duplex connection, so each of these interactions requires the full connection procedure - creating queues, key agreement, double ratchet initialization - and leaves persistent state on both sides: queues, ratchet state, connection records, message history. + +This is the wrong primitive for most service interactions: + +1. Cost. To send the first request to a not yet connected service, the client and the service exchange multiple commands across two servers. For "search the directory" all of it is overhead. The setup cost also creates an incentive to keep connections open, and a service with N users who used it once permanently holds N sets of queues and ratchet states. + +2. Privacy. A connection is a stable pairwise pseudonym. If a service were to use a duplex connection, it could link all requests made over it into a profile: search history in the directory, blockchain operations linked even when different on-chain keys are used, telemetry that becomes longitudinal tracking. The client also accumulates history that can be recovered from the device. Where continuity is needed, it can be provided in the application protocol (e.g., a token included in requests), without a transport-level identity. + +3. Encryption. Messages sent to contact addresses outside an established connection (invitations) have a single layer of X25519 encryption. This was acceptable while such messages contained only a connection link and profile (though it is planned to be improved); it is not acceptable for service requests. + +In-app service addresses should be stored as names resolving to links via the existing addressing layer (server host in the link authority, current link data retrieved with LGET), so that service links can be changed without redeploying the apps. Name resolution is already supported, and out of scope. + +## Security objectives + +1. Requests from the same client must not be linkable to each other by the service or by servers, and no state that outlives the exchange is created on either side. +2. Post-quantum resistant e2e encryption of requests and replies; decryptability of recorded requests must be bounded by key rotation, without changing the address. +3. Reply authenticity must be verifiable against the link; substitution, replay, dropping or reordering of replies by servers must be detectable. +4. A repeated or replayed request must not be executed twice. + +## Solution + +A service address is a contact address subtype. The client sends a request in a single message to the address queue and receives replies in a reply queue it creates for this request: + +1. Resolve the service name to a short link; retrieve and cache link data (`LGET`, via proxy when IP protection is needed). +2. Create a reply queue on a client-chosen server (`NEW`, messaging mode, sender can secure, subscribed at creation). +3. Send the request to the service address queue (unauthenticated `SEND`, via proxy when IP protection is needed). The request contains the reply queue address with fresh keys, and is encrypted to rotatable service keys published in link data, using hybrid X25519 + KEM encryption at the queue layer. +4. The service secures the reply queue and sends the first reply with one combined command. Replies are encrypted to the fresh keys from the request; each reply is signed with the root key over the reply and the request hash, and includes a flag whether more replies follow. +5. The client receives replies until the final one or a deadline, then deletes the reply queue (`DEL`). + +To the first request the client sends 3 commands (2 with cached link data). Streamed replies (LLM output) and delayed replies (credential issued after payment) are ordinary queue messages, distinguished only by the flag whether more replies follow. + +How this meets the objectives: + +1. Unlinkability: fresh keys and a fresh reply queue per request; the sender's IP address and session are protected by existing private routing; the reply queue is deleted after the exchange; nothing is shared between two requests. +2. Encryption: hybrid X25519 + sntrup761 secret at the queue layer for the request and all replies; keys are published in mutable link data, rotated with `LSET`, old keys deleted after a short window. The double ratchet is not used: it would create per-request state before the service decides to reply, and its properties serve long-lived sessions, not one-off exchanges. +3. Authenticity: every reply is signed with the root key committed in the immutable link data, over the reply and the request hash; the hash chain across replies detects dropped and reordered replies. +4. Replay protection: a retry or replay is the byte-identical request; the service agent stores sent replies for a limited window and re-sends them without executing the request again. + +## Design + +Syntax below uses [ABNF][1] with [case-sensitive strings extension][2]. `shortString`, `largeString` and `x509encoded` are defined in the [SMP protocol](../protocol/simplex-messaging.md); `smpServer` and `agentVersion` - in the [agent protocol](../protocol/agent-protocol.md). All hashes below are SHA3-256. + +### Service address + +A new contact address type - char `s` in short links, next to existing `a`/`c`/`g`/`r`: + +```abnf +contactType =/ %s"s" ; service address +``` + +Link data has the same structure as contact addresses: immutable fixed data (root key, connection request data with the queue address) committed by the link hash, and mutable user data signed by the root key. Fixed data and contact user data encodings ignore trailing bytes, so the fields below are added without a new link format. + +Agents dispatch on the address type and the envelope type: a normal address rejects requests, a service address rejects invitations and confirmations. + +### Service key bundle + +Mutable user data of a service address includes a key bundle, appended to the existing contact user data encoding: + +```abnf +userContactData = direct ownersList relaysList userLinkData [serviceKeys] +serviceKeys = %s"0" / (%s"1" serviceKeyBundle) ; skipped by earlier versions +serviceKeyBundle = keyId reqDhKey reqKemKey +keyId = shortString ; referenced by requests +reqDhKey = length x509encoded ; X25519, used instead of the fixed-data queue key +reqKemKey = largeString ; sntrup761 encapsulation key, 1158 bytes +``` + +The service periodically rotates the bundle with `LSET` and keeps previous private keys for a window covering client link data caching and queue message retention. A request encrypted to an unknown key ID fails with an error; the client then re-fetches link data and retries. Deleting expired keys is what bounds decryptability of recorded requests, so the window must be short and fixed. + +Link data is encrypted with a symmetric key derived from the link, which is not weakened by quantum computers, so publishing the bundle in link data does not undermine the scheme. + +Sizes: KEM public key is 1158 bytes, user data is padded to 13784 bytes - the bundle fits together with application data. + +### Queue-layer PQ encryption + +The single-shot queue encryption (today: crypto_box with a secret from the queue DH key and a sender ephemeral key, ephemeral key in the message public header) is extended to a hybrid scheme in a new SMP client version. The public header gains a third variant: + +```abnf +smpPubHeaderHybrid = smpClientVersion %s"2" optKeyId senderPublicDhKey kemCiphertext +optKeyId = %s"0" / (%s"1" keyId) ; present in requests, absent in replies +senderPublicDhKey = length x509encoded ; fresh X25519 key +kemCiphertext = largeString ; sntrup761 ciphertext, 1039 bytes +``` + +The secret is derived from both shared secrets, and the body is encrypted with NaCl secret_box, padded as today: + +``` +secret = HKDF(dh(recipient key, sender ephemeral key) || KEM shared secret) +``` + +The header is visible to the destination server, as invitation headers are today (with proxied sending it is not visible to the proxy). + +The same scheme applies to replies, using the keys from the request: the first reply includes the hybrid header, the hybrid secret is computed once per reply queue and used for subsequent replies with the empty header - the same one-secret-per-queue model as existing sender queues. Invitations and confirmations can adopt the same scheme independently of this design, removing the single-layer X25519 exposure of the profile. + +### Request + +A new agent envelope (alongside `agentConfirmation`, `agentMsgEnvelope`, `agentInvitation`, `agentRatchetKey`): + +```abnf +agentRequest = agentVersion %s"Q" replyQueue requestBody +replyQueue = smpClientVersion smpServer senderId dhPublicKey kemPublicKey sndAuthPublicKey +smpClientVersion = 2*2 OCTET +senderId = shortString ; sender ID of the reply queue +dhPublicKey = length x509encoded ; X25519, fresh per request +kemPublicKey = largeString ; sntrup761 encapsulation key, fresh per request +sndAuthPublicKey = length x509encoded ; key to secure the reply queue +requestBody = *OCTET ; remaining bytes, application-defined +``` + +The envelope type indicates to the receiving agent that no connection is created and replies are sent to the provided queue. The reply queue keys never appear outside the encrypted request. Requests must fit in one message; larger payloads are passed as an XFTP file description in the request body. + +A retry is the byte-identical stored request message, so all correlation uses one value: the request hash - the hash of the message body, the same bytes as sent by the client and as received by the service after the server encryption layer is removed. + +Request delivery failures follow existing SEND semantics: on QUOTA (the address queue is full) the client retries with backoff within the request deadline. + +### Replies + +The service secures the reply queue with the sender key from the request and sends the first reply in one combined SMP command (see below). Replies use a new agent envelope, following the signature-first structure of link data: + +```abnf +agentResponse = agentVersion %s"P" signature signedReply +signature = length 64*64 OCTET ; root key signature of signedReply +signedReply = requestHash prevMsgHash final replyBody +requestHash = shortString ; hash of the request message body +prevMsgHash = shortString ; hash of the previous agentResponse, empty in the first reply +final = %s"T" / %s"F" ; F - more replies follow +replyBody = *OCTET ; remaining bytes, application-defined +``` + +The client verifies each reply: the signature against the root key from link data, the request hash against the sent request, the hash chain against the previous reply. Forging a reply requires the root key even if the reply queue keys are compromised; a signed reply cannot be replayed for a different request; the hash chain detects replies dropped or reordered by the reply queue server. + +The client deletes the reply queue on the final flag, on the request deadline (application-defined per request), or on cancellation. Deleting the queue also cancels the stream: subsequent SEND commands from the service fail with AUTH. Router queue and message expiry limit the lifetime of abandoned queues. Stream length between client acknowledgements is bounded by queue capacity. + +Delayed replies (e.g., a credential issued after payment) are stored in the reply queue within message retention time and received when the client subscribes again; notification credentials can be added to the reply queue with existing commands. Messages in the reply queue that fail decryption or verification are acknowledged and dropped. + +### Combined SKEY+SEND command + +A new SMP command combining `SKEY` and `SEND` in one transmission: + +```abnf +secureSend = %s"SSND " senderAuthPublicKey SP msgFlags SP smpEncMessage +senderAuthPublicKey = length x509encoded +``` + +The command is authorized with the key it sets, as `SKEY`, and only accepted on messaging-mode queues. The server responds `OK` or `ERR`. It is idempotent in both parts: + +- key part: as `SKEY` today - repeated command with the same key succeeds, different key fails with AUTH +- send part: the server stores a hash of the message body until the message is acknowledged; within that window a repeated command with the same body is not delivered again and is reported as delivered + +A retry arriving after the message was acknowledged is delivered as a duplicate and suppressed by the receiving agent (by message hash), so the server-side marker covers the common case and the agent covers the rest. + +It is used by the service for the first reply, and by the joining party in the fast connection handshake (currently `SKEY` then `SEND` confirmation), removing one command and round trip from both flows. + +### Idempotency + +Handled uniformly by the agent: it stores the request hash and sent replies for a window declared in link data (with a default), and re-sends stored replies for a repeated request without invoking the service application. This gives exactly-once execution over at-least-once delivery for all services; services with idempotent semantics of their own lose nothing. + +The guarantee is bounded by the window: the client must not retry after the request deadline, and the deadline must not exceed the declared window. Stored replies may be evicted under storage pressure; a retry whose replies were evicted receives an error prompting a new request. Within the window a request is never executed twice. + +### Out of scope + +- Continuity: sessions across requests are an application concern (tokens in request and reply bodies). +- Service-initiated messages: there is no standing channel; use a connection where push is needed. +- Abuse protection beyond existing queue quotas: services can require application-level credentials (e.g., a badge) in request bodies; rate limiting options are a separate discussion. +- Scaling request reception: a single address queue bounds service throughput; distributing reception across multiple queues or relays (the existing `relays` field in contact link data) is a separate discussion. +- Name resolution: existing addressing layer. + +[1]: https://tools.ietf.org/html/rfc5234 +[2]: https://tools.ietf.org/html/rfc7405 From 97e7e9b7c5fc5ec0d217d713072da710ad7a6fb8 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 12 Jul 2026 15:09:01 +0000 Subject: [PATCH 02/81] update rfc, plan --- .../2026-07-11-service-rpc-implementation.md | 270 ++++++++++++++---- rfcs/2026-07-11-service-rpc.md | 107 +++---- 2 files changed, 265 insertions(+), 112 deletions(-) diff --git a/plans/2026-07-11-service-rpc-implementation.md b/plans/2026-07-11-service-rpc-implementation.md index e7fa0fd75..68b9bff67 100644 --- a/plans/2026-07-11-service-rpc-implementation.md +++ b/plans/2026-07-11-service-rpc-implementation.md @@ -2,7 +2,7 @@ RFC: [../rfcs/2026-07-11-service-rpc.md](../rfcs/2026-07-11-service-rpc.md) -Types and instances below must encode exactly the ABNF in the RFC. Constructor and event names are provisional. +Types and instances below must encode exactly the ABNF in the RFC. Constructor, event, table and function names are provisional. ## Versions @@ -20,7 +20,9 @@ ctTypeChar CCTService = 'S' -- 's' in links: link encoding lowercases, parsing u ctTypeP 'S' = pure CCTService ``` -## Service key bundle - `Simplex.Messaging.Agent.Protocol` +The contact type is currently fixed to `CCTContact` when the agent reconstructs a contact link (`Agent.hs`, `cslContact`). It becomes a stored property of the address (column `link_contact_type` below), read when the link is reconstructed and when an address queue message is dispatched. + +## Service key bundle in link data - `Simplex.Messaging.Agent.Protocol` ```haskell data ServiceKeyBundle = ServiceKeyBundle @@ -36,7 +38,7 @@ instance Encoding ServiceKeyBundle where pure ServiceKeyBundle {keyId, reqDhKey, reqKemKey} ``` -`UserContactData` gains a field, appended to the encoding (earlier versions skip it, its absence parses as `Nothing`): +`UserContactData` gains a field, appended to the encoding, absent in data written by earlier versions. The agent sets it when it signs and updates link data; the application supplies only its own data. There is no retention value in link data - retention is service configuration (see Idempotency). ```haskell data UserContactData = UserContactData @@ -60,8 +62,6 @@ instance Encoding UserContactData where pure UserContactData {direct, owners, relays, userData, serviceKeys} ``` -The service address record stores current and previous private key bundles with rotation timestamps; expired bundles are deleted. - ## SSND command - `Simplex.Messaging.Protocol`, `Simplex.Messaging.Server` ```haskell @@ -74,13 +74,15 @@ SSND_ :: CommandTag Sender -- encodeProtocol SSND k flags msg -> e (SSND_, ' ', k, ' ', flags, ' ', Tail msg) --- protocolP, gated by VersionSMP +-- protocolP, in a new VersionSMP SSND_ -> SSND <$> (smpP <* A.space) <*> (smpP <* A.space) <*> (unTail <$> smpP) ``` `checkCredentials`: as `SKEY` - authorization required, sender entity ID. Server verification: `vc SSender (SSND k _ _) = verifySecure k` - authorized by the key it sets. -Server processing: `checkMode QMMessaging`, then `secureQueue_` (existing, idempotent), then deliver with deduplication. The queue store keeps the hash of the unacknowledged message delivered by `SSND`; a repeated `SSND` with an equal body hash responds `OK` without storing; the hash is dropped when the message is acknowledged. +Server processing: `checkMode QMMessaging`, then `secureQueue_` (existing, idempotent), then deliver with deduplication. All queue store backends (STM, journal, PostgreSQL) keep the hash of the message delivered by `SSND` until it is acknowledged; a repeated `SSND` with an equal message hash responds `OK` without delivering it again; the hash is removed when the message is acknowledged. Server stats gain an `SSND` counter. + +Proxying: `proxySMPCommand` is polymorphic in the sender command, so `SSND` forwards through `PFWD`/`RFWD` without changes. ## Hybrid public header - `Simplex.Messaging.Protocol` @@ -117,7 +119,9 @@ hybridSecret :: C.DhSecretX25519 -> KEMSharedKey -> C.SbKey hybridSecret dh (KEMSharedKey k) = C.unsafeSbKey $ C.hkdf "" (C.dhBytes' dh <> BA.convert k) "SimpleXSMPQueue" 32 ``` -The body is encrypted with `C.sbEncrypt` (secret_box) instead of `C.cbEncrypt`, padded to the same lengths. Sending variant of `agentCbEncryptOnce`: generate ephemeral X25519 pair, encapsulate to the published KEM key, encode `PubHeaderHybrid`. Receiving: select private keys by `phKeyId` (requests) or use the reply queue keys from the request (replies); unknown key ID produces the error that makes the client re-fetch link data. +The body is encrypted with `C.sbEncrypt` (secret_box) rather than `C.cbEncrypt`, padded to the same lengths. The sending side generates an ephemeral X25519 pair, encapsulates to the recipient KEM key, and writes `PubHeaderHybrid`. The receiving side selects private keys by `phKeyId` for a request, or uses the reply queue keys for a reply, and computes the same secret. A request with an unknown key ID is discarded and counted. + +Size constants: the hybrid header adds about 1.2KB (KEM ciphertext 1039 bytes plus the ephemeral key). Define the request and reply body length constants from the existing padded body lengths at implementation. ## Agent envelopes - `Simplex.Messaging.Agent.Protocol` @@ -127,103 +131,249 @@ data AgentMsgEnvelope | AgentRequest { agentVersion :: VersionSMPA, replyQueue :: RequestReplyQueue, - requestBody :: ByteString + requestPayload :: ByteString -- opaque, hashed } | AgentResponse { agentVersion :: VersionSMPA, - signature :: C.Signature 'C.Ed25519, -- root key signature of signedReply - signedReply :: ByteString -- encoded SignedReply, parsed after signature verification + signature :: C.Signature 'C.Ed25519, -- root key signature of signedResponse + signedResponse :: ByteString -- encoded SignedResponse, parsed after the signature is verified } data RequestReplyQueue = RequestReplyQueue { smpClientVersion :: VersionSMPC, smpServer :: SMPServer, - senderId :: SMP.SenderId, - dhPublicKey :: C.PublicKeyX25519, -- fresh per request - kemPublicKey :: KEMPublicKey, -- fresh per request - sndAuthKey :: SndPublicAuthKey -- to secure the reply queue + senderId :: SMP.SenderId, -- sender ID of the reply queue + dhPublicKey :: C.PublicKeyX25519, -- reply queue X25519 key (its e2e key) + kemPublicKey :: KEMPublicKey -- reply queue sntrup761 key } -data SignedReply = SignedReply - { requestHash :: ByteString, -- SHA3-256 of the request message body - prevMsgHash :: ByteString, -- SHA3-256 of the previous reply envelope, empty in the first reply - final :: Bool, - replyBody :: ByteString +data SignedResponse = SignedResponse + { requestHash :: ByteString, -- SHA3-256 of requestPayload + prevMsgHash :: ByteString, -- SHA3-256 of the previous AgentResponse, empty in the first + more :: Bool, -- True if more reply messages follow + responses :: NonEmpty ByteString -- opaque application responses } ``` +The request does not include a key to secure the reply queue: the service generates its own sender key and secures the queue with `SSND`. `requestPayload` is the only hashed part; the reply queue fields are not hashed. + ```haskell instance Encoding AgentMsgEnvelope where smpEncode = \case ... -- existing constructors - AgentRequest {agentVersion, replyQueue, requestBody} -> - smpEncode (agentVersion, 'Q', replyQueue, Tail requestBody) - AgentResponse {agentVersion, signature, signedReply} -> - smpEncode (agentVersion, 'P', signature, Tail signedReply) + AgentRequest {agentVersion, replyQueue, requestPayload} -> + smpEncode (agentVersion, 'Q', replyQueue, Tail requestPayload) + AgentResponse {agentVersion, signature, signedResponse} -> + smpEncode (agentVersion, 'P', signature, Tail signedResponse) smpP = do agentVersion <- smpP smpP >>= \case ... -- existing constructors 'Q' -> do - (replyQueue, Tail requestBody) <- smpP - pure AgentRequest {agentVersion, replyQueue, requestBody} + (replyQueue, Tail requestPayload) <- smpP + pure AgentRequest {agentVersion, replyQueue, requestPayload} 'P' -> do - (signature, Tail signedReply) <- smpP - pure AgentResponse {agentVersion, signature, signedReply} + (signature, Tail signedResponse) <- smpP + pure AgentResponse {agentVersion, signature, signedResponse} instance Encoding RequestReplyQueue where - smpEncode RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey} = - smpEncode (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey) + smpEncode RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey} = + smpEncode (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey) smpP = do - (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey) <- smpP - pure RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey, sndAuthKey} + (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey) <- smpP + pure RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey} -instance Encoding SignedReply where - smpEncode SignedReply {requestHash, prevMsgHash, final, replyBody} = - smpEncode (requestHash, prevMsgHash, final, Tail replyBody) +instance Encoding SignedResponse where + smpEncode SignedResponse {requestHash, prevMsgHash, more, responses} = + smpEncode (requestHash, prevMsgHash, more) <> smpEncodeList (map Large $ L.toList responses) smpP = do - (requestHash, prevMsgHash, final, Tail replyBody) <- smpP - pure SignedReply {requestHash, prevMsgHash, final, replyBody} + (requestHash, prevMsgHash, more) <- smpP + rs <- map unLarge <$> smpListP + responses <- maybe (fail "empty responses") pure $ L.nonEmpty rs + pure SignedResponse {requestHash, prevMsgHash, more, responses} ``` Signing and verification follow the link data pattern (`Simplex.Messaging.Crypto.ShortLink`): ```haskell --- service -mkAgentResponse :: C.PrivateKeyEd25519 -> VersionSMPA -> SignedReply -> AgentMsgEnvelope -mkAgentResponse rootPrivKey agentVersion reply = - let signedReply = smpEncode reply - in AgentResponse {agentVersion, signature = C.sign' rootPrivKey signedReply, signedReply} - --- client -verifyAgentResponse :: C.PublicKeyEd25519 -> AgentMsgEnvelope -> Either AgentErrorType SignedReply -verifyAgentResponse rootKey AgentResponse {signature, signedReply} - | C.verify' rootKey signature signedReply = parse smpP (AGENT A_MESSAGE) signedReply +-- service: signing key is linkPrivSigKey from the address ShortLinkCreds +mkAgentResponse :: C.PrivateKeyEd25519 -> VersionSMPA -> SignedResponse -> AgentMsgEnvelope +mkAgentResponse rootPrivKey agentVersion resp = + let signedResponse = smpEncode resp + in AgentResponse {agentVersion, signature = C.sign' rootPrivKey signedResponse, signedResponse} + +-- client: rootKey from the fixed link data +verifyAgentResponse :: C.PublicKeyEd25519 -> AgentMsgEnvelope -> Either AgentErrorType SignedResponse +verifyAgentResponse rootKey AgentResponse {signature, signedResponse} + | C.verify' rootKey signature signedResponse = parse smpP (AGENT A_MESSAGE) signedResponse | otherwise = Left ... -- verification error ``` +## Reply queue - no new connection type + +The reply queue on the client is a receive connection (`RcvConnection`), extended to carry the KEM key and the computed hybrid secret. There is no new connection type and no flag on the connection: a client service request row (below) references the reply queue connection, and its presence identifies the connection as an RPC reply queue for dispatch and cleanup. + +The reply queue reuses the existing receive queue fields. `e2ePrivKey` is its X25519 key, its public half is the queue address DH key sent in the request. Two nullable columns are added to `rcv_queues`: + +- `reply_kem_priv_key` - the reply queue KEM private key. +- `reply_secret` - the hybrid secret, empty until the first reply, then set from the first reply's header, as the per-queue DH secret is set by `setRcvQueueConfirmedE2E` on the first message today. Later replies are decrypted with it by the standard receive path. + +The service does not create a connection or queue for the reply queue. It sends replies directly to the reply queue address, as `sendInvitation` sends to a queue with no connection. + +## Database schema - `Agent/Store/SQLite/Migrations`, `Agent/Store/Postgres/Migrations` + +One migration (`M20260712_service_rpc`), SQLite shown, PostgreSQL mirrors it; column types follow existing schema conventions. + +```sql +-- address contact type (contact address queues), and reply queue keys (reply queues). +-- NULL link_contact_type means 'A' (contact) for existing rows. +ALTER TABLE rcv_queues ADD COLUMN link_contact_type TEXT; +ALTER TABLE rcv_queues ADD COLUMN reply_kem_priv_key BLOB; +ALTER TABLE rcv_queues ADD COLUMN reply_secret BLOB; + +-- service side: current and retired bundle private keys. +CREATE TABLE service_address_keys( + service_address_key_id INTEGER PRIMARY KEY AUTOINCREMENT, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + key_id BLOB NOT NULL, + dh_priv_key BLOB NOT NULL, + kem_priv_key BLOB NOT NULL, + created_at TEXT NOT NULL, + retired_at TEXT -- set on rotation, row deleted when the key retention period ends +); +CREATE UNIQUE INDEX idx_service_address_keys ON service_address_keys(conn_id, key_id); + +-- client side: one pending request per reply queue connection. +CREATE TABLE snd_service_requests( + snd_service_request_id INTEGER PRIMARY KEY AUTOINCREMENT, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, -- reply queue connection + request_hash BLOB NOT NULL, + root_key BLOB NOT NULL, -- to verify replies + last_reply_hash BLOB, -- updated as reply messages arrive + deadline TEXT NOT NULL, + created_at TEXT NOT NULL +); + +-- service side: one record per distinct request hash on an address. +CREATE TABLE rcv_service_requests( + rcv_service_request_id INTEGER PRIMARY KEY AUTOINCREMENT, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, -- address connection + request_hash BLOB NOT NULL, + ended INTEGER NOT NULL DEFAULT 0, -- a reply message with more = False was sent + expires_at TEXT NOT NULL, -- created + retention + created_at TEXT NOT NULL +); +CREATE UNIQUE INDEX idx_rcv_service_requests ON rcv_service_requests(conn_id, request_hash); + +-- service side: ordered signed reply messages for a request; the signed envelope +-- is independent of the reply queue, so it is stored once and encrypted per queue on send. +CREATE TABLE rcv_service_replies( + rcv_service_reply_id INTEGER PRIMARY KEY AUTOINCREMENT, + rcv_service_request_id INTEGER NOT NULL REFERENCES rcv_service_requests ON DELETE CASCADE, + reply_seq INTEGER NOT NULL, + more INTEGER NOT NULL, + signed_reply BLOB NOT NULL -- encoded AgentResponse +); +CREATE UNIQUE INDEX idx_rcv_service_replies ON rcv_service_replies(rcv_service_request_id, reply_seq); + +-- service side: reply queues subscribed under a request (the first, and any repeat). +CREATE TABLE rcv_service_reply_queues( + rcv_service_reply_queue_id INTEGER PRIMARY KEY AUTOINCREMENT, + rcv_service_request_id INTEGER NOT NULL REFERENCES rcv_service_requests ON DELETE CASCADE, + host TEXT NOT NULL, + port TEXT NOT NULL, + snd_id BLOB NOT NULL, + server_key_hash BLOB, + reply_secret BLOB NOT NULL, -- hybrid secret to this reply queue + secured INTEGER NOT NULL DEFAULT 0, -- reply queue secured with SSND + last_sent_seq INTEGER NOT NULL DEFAULT 0 +); +``` + +## Agent API - `Simplex.Messaging.Agent` + +Service side: + +```haskell +-- Creates a contact connection with CCTService link type, generates the root key +-- and the first key bundle, composes and signs link data. +createServiceAddress :: AgentClient -> UserId -> UserLinkData -> AE (ConnId, ConnShortLink 'CMContact) + +-- Re-signs and updates user data with LSET, keeping the agent-owned key bundle. +updateServiceAddressData :: AgentClient -> ConnId -> UserLinkData -> AE () + +-- Generates a new bundle, updates link data, retires the previous keys until the retention period ends. +-- Also runs on a schedule (config) while the address is subscribed. +rotateServiceAddressKeys :: AgentClient -> ConnId -> AE () + +-- Sends one reply message with a list of responses; more = False ends the exchange. +-- The first message to each reply queue secures it with SSND; later messages use SEND. +sendServiceReply :: AgentClient -> ServiceRequestRef -> Bool -> NonEmpty ByteString -> AE () +``` + +Address deletion: existing `deleteConnection`. + +Client side (name resolution to a link is an existing API; the link must have `CCTService` type and a key bundle in link data): + +```haskell +-- Retrieves link data, creates the reply queue, sends the request, and waits for the first +-- reply message up to the deadline. The callback receives later reply messages while the process runs. +sendServiceRequest :: + AgentClient -> UserId -> ConnShortLink 'CMContact -> UTCTime -> + ByteString -> (ServiceReply -> IO ()) -> AE ServiceReply + +-- Deletes the reply queue and the request row, and drops the callback. +cancelServiceRequest :: AgentClient -> ConnId -> AE () + +data ServiceReply = ServiceReply {responses :: NonEmpty ByteString, more :: Bool} +``` + +The first reply message returns from `sendServiceRequest`; later messages are delivered through the callback. Both the waiting call and the callback are held in an in-memory map in `AgentClient`, keyed by the reply queue connection, and filled by the receive path. They do not survive a restart. + +Service side events (`AEvent`, entity is the address connection): + +```haskell +SREQ :: ServiceRequestRef -> ByteString -> AEvent AEConn -- request received, payload for the bot +``` + +`ServiceRequestRef` identifies the request record; the bot passes it to `sendServiceReply`. + ## Agent processing - `Simplex.Messaging.Agent`, `Simplex.Messaging.Agent.Client` Client side: -- `sendServiceRequest`: read link data (cached or `LGET`, proxied per config), create the reply queue (`NEW`, `QRMessaging`, subscribe), generate fresh X25519 + KEM keys and sender auth key, build and store the request message, send (proxied per config), return request ID. -- Retries re-send the stored byte-identical message. Deadline, cancellation and `final` delete the reply queue and the request record. -- Reply queue messages in `processSMPTransmissions`: decrypt with the stored hybrid secret (first reply establishes it from the hybrid header), verify with `verifyAgentResponse` and the hash chain, deliver as events; failures are acknowledged and dropped. -- New events: reply received (request ID, final flag, body), request failed (request ID, error). +- `sendServiceRequest`: retrieve link data (`LGET`, proxied per config) for every request - no caching; create the reply queue (`NEW`, messaging mode, subscribed) with an added KEM key; write the `snd_service_requests` row; send the request (proxied per config); wait on the in-memory sink for the first reply until the deadline. +- Reply processing in `processSMPTransmissions`: a message on a receive queue that has a `snd_service_requests` row is a reply. Decrypt (the first message sets `reply_secret` from its header), verify with `verifyAgentResponse`, check the request hash and the previous-message hash, update `last_reply_hash`, deliver to the waiting call or the callback. A message that fails verification is acknowledged and discarded. On `more = False`, or on the deadline, or on `cancelServiceRequest`, delete the reply queue (`DEL`) and the row. +- `cleanupManager` gains one step: delete `snd_service_requests` past the deadline and mark their reply queue connections deleted; the existing deleted-connections step sends `DEL` and removes them. After a restart every row is stale, so this step removes all reply queues left behind. Service side: -- Address queue messages with `AgentRequest`: compute request hash, look up the dedup store; on hit re-send stored replies (or the expiry error); on miss deliver a request event to the service application. -- Send replies: secure the reply queue and send the first reply with `SSND`, subsequent replies with `SEND`; store sent replies under the request hash until the window expires. +- Address queue message dispatch reads `link_contact_type`: a service address accepts only `AgentRequest` and rejects invitations and confirmations; a non-service address rejects `AgentRequest`. +- On `AgentRequest`: select bundle private keys by `keyId`, decrypt, compute the request hash. Look up `rcv_service_requests` by (address conn, hash): + - new: insert the request, insert a `rcv_service_reply_queues` row for the reply queue in the request, deliver `SREQ` to the bot. + - existing: insert a `rcv_service_reply_queues` row for the reply queue in this request, and send it every `rcv_service_replies` message already stored, in order. +- `sendServiceReply`: append a `rcv_service_replies` message (sign with the address root key), then send it to every reply queue of the request - `SSND` for a queue not yet secured, `SEND` after - encrypting the stored envelope to each queue's `reply_secret`; set `ended` when `more = False`. +- `cleanupManager` gains one step: delete `rcv_service_requests` past `expires_at` (cascading to replies and reply queues) and `service_address_keys` past the key retention period. + +Configuration (`AgentConfig`): default request deadline, request retention period (1 to 24 hours), key rotation interval. + +Errors: API failures reuse `AgentErrorType` (for example `CMD PROHIBITED` for a link that is not a service address). A new constructor is added only if the chat library needs to distinguish service request failures - decided at implementation. + +## Correlation and chat + +A reply is connected to its request by the reply queue: one request has one reply queue, and every message in that queue is a reply to that request. The request hash is used only in the reply signature, to bind a reply to the request content. The application ID is content inside `requestPayload`, used only by the application to make two requests equal or different; the agent does not read it. + +Both ends are chat bots on the chat library. The chat library serializes a service command into `requestPayload` and deserializes the responses; the agent transports them and correlates by reply queue. The chat framework's `chatServiceCalls` correlation by `(AgentConnId, SharedMsgId)` is not used - the agent correlates by reply queue and the call returns the first reply directly. -Database: +## Tests -- Client: in-flight requests - request ID, stored request message, reply queue, hybrid secret, deadline, last reply hash. -- Service: dedup store - request hash, sent replies, expiry. +- Encoding roundtrips: envelopes, `ServiceKeyBundle` in `UserContactData`, `PubHeader` (all three variants), `SSND`, `SignedResponse` with one and several responses. +- Server: `SSND` on messaging and contact queues, repeated `SSND` before and after ACK, a different key, via proxy. +- Agent end-to-end: a request with one reply message; several responses in one message; responses in several messages delivered to the callback; a repeat request while pending coalesces onto the same operation; a repeat request after completion receives the stored messages without a second execution; key rotation with an old key still accepted while kept; a request whose key was deleted fails at the deadline; deadline; cancellation; a restart deletes reply queues; envelope rejection on both address types. ## Phases -1. SMP protocol: `SSND`, hybrid public header, version bumps, server dedup marker. -2. Agent: address type, key bundle, envelopes, client API and reply processing. -3. Agent: service-side dedup store and request events. -4. Adoption: `SSND` in the fast connection handshake; hybrid scheme for invitations and confirmations. +1. SMP protocol: `SSND`, hybrid public header, version bumps, server dedup hash, server tests. +2. Agent: address type, key bundle in link data, envelopes, reply queue columns, schema migration, `createServiceAddress`, `sendServiceRequest`, reply processing, cleanup. +3. Agent: service-side request store, `sendServiceReply`, coalescing and repeats, key rotation, end-to-end tests. +4. Adoption: `SSND` in the fast connection handshake; the hybrid scheme for invitations and confirmations. diff --git a/rfcs/2026-07-11-service-rpc.md b/rfcs/2026-07-11-service-rpc.md index b29e132c0..1eb7a42df 100644 --- a/rfcs/2026-07-11-service-rpc.md +++ b/rfcs/2026-07-11-service-rpc.md @@ -21,26 +21,26 @@ In-app service addresses should be stored as names resolving to links via the ex 1. Requests from the same client must not be linkable to each other by the service or by servers, and no state that outlives the exchange is created on either side. 2. Post-quantum resistant e2e encryption of requests and replies; decryptability of recorded requests must be bounded by key rotation, without changing the address. 3. Reply authenticity must be verifiable against the link; substitution, replay, dropping or reordering of replies by servers must be detectable. -4. A repeated or replayed request must not be executed twice. +4. A repeated request for the same operation must not be executed twice. ## Solution -A service address is a contact address subtype. The client sends a request in a single message to the address queue and receives replies in a reply queue it creates for this request: +A service address is a contact address subtype. Both the client and the service are chat bots using the chat library over the agent. The chat library serializes a request into opaque bytes and calls the agent; the agent transports it and returns replies; the chat library deserializes them. The correlation of a reply with its request is the reply queue: each request has its own reply queue, and every message in that queue is a reply to that request. -1. Resolve the service name to a short link; retrieve and cache link data (`LGET`, via proxy when IP protection is needed). -2. Create a reply queue on a client-chosen server (`NEW`, messaging mode, sender can secure, subscribed at creation). -3. Send the request to the service address queue (unauthenticated `SEND`, via proxy when IP protection is needed). The request contains the reply queue address with fresh keys, and is encrypted to rotatable service keys published in link data, using hybrid X25519 + KEM encryption at the queue layer. -4. The service secures the reply queue and sends the first reply with one combined command. Replies are encrypted to the fresh keys from the request; each reply is signed with the root key over the reply and the request hash, and includes a flag whether more replies follow. -5. The client receives replies until the final one or a deadline, then deletes the reply queue (`DEL`). +The exchange: -To the first request the client sends 3 commands (2 with cached link data). Streamed replies (LLM output) and delayed replies (credential issued after payment) are ordinary queue messages, distinguished only by the flag whether more replies follow. +1. Resolve the service name to a short link and retrieve link data (`LGET`, via proxy when IP protection is needed). Link data holds the root key for verifying replies and the service key bundle for encrypting the request. +2. Create a reply queue (`NEW`, messaging mode, subscribed at creation). The reply queue is a receive queue with an added KEM key; the service encrypts replies to the reply queue keys. +3. Send the request to the service address queue once (unauthenticated `SEND`, via proxy when IP protection is needed). The request includes the reply queue address and its KEM key, and the application payload. It is encrypted to the service key bundle with hybrid X25519 + KEM encryption at the queue layer. There is no transport retry; a reply is the success signal, and a hard error fails the call. +4. The service decrypts the request, delivers the payload to the service application, secures the reply queue, and sends replies. Each reply message includes the request hash, the previous message hash, a flag whether more messages follow, and a non-empty list of application responses; it is signed with the root key. +5. The client verifies each reply message and delivers its responses to the application. The first reply message returns from the call; later reply messages are delivered through a callback the application registered. The client deletes the reply queue on the final message, on the request deadline, or when the application cancels the request. How this meets the objectives: 1. Unlinkability: fresh keys and a fresh reply queue per request; the sender's IP address and session are protected by existing private routing; the reply queue is deleted after the exchange; nothing is shared between two requests. -2. Encryption: hybrid X25519 + sntrup761 secret at the queue layer for the request and all replies; keys are published in mutable link data, rotated with `LSET`, old keys deleted after a short window. The double ratchet is not used: it would create per-request state before the service decides to reply, and its properties serve long-lived sessions, not one-off exchanges. -3. Authenticity: every reply is signed with the root key committed in the immutable link data, over the reply and the request hash; the hash chain across replies detects dropped and reordered replies. -4. Replay protection: a retry or replay is the byte-identical request; the service agent stores sent replies for a limited window and re-sends them without executing the request again. +2. Encryption: hybrid X25519 + sntrup761 secret at the queue layer for the request and all replies. Request keys are published in mutable link data and rotated with `LSET`; the double ratchet is not used, because it would create per-request state before the service decides to reply and its properties serve long-lived sessions. +3. Authenticity: every reply message is signed with the root key committed in the immutable link data, over the request hash and the message; the previous-message hash in each message detects dropped and reordered messages. +4. Single execution: the service identifies a request by the hash of its payload and, within a fixed retention period, repeats the stored replies for a repeated request without running the operation again. ## Design @@ -54,7 +54,7 @@ A new contact address type - char `s` in short links, next to existing `a`/`c`/` contactType =/ %s"s" ; service address ``` -Link data has the same structure as contact addresses: immutable fixed data (root key, connection request data with the queue address) committed by the link hash, and mutable user data signed by the root key. Fixed data and contact user data encodings ignore trailing bytes, so the fields below are added without a new link format. +Link data has the same structure as contact addresses: immutable fixed data (root key, connection request data with the queue address) committed by the link hash, and mutable user data signed by the root key. Fixed data and contact user data encodings ignore trailing bytes, so the field below is added without a new link format. Agents dispatch on the address type and the envelope type: a normal address rejects requests, a service address rejects invitations and confirmations. @@ -64,80 +64,80 @@ Mutable user data of a service address includes a key bundle, appended to the ex ```abnf userContactData = direct ownersList relaysList userLinkData [serviceKeys] -serviceKeys = %s"0" / (%s"1" serviceKeyBundle) ; skipped by earlier versions +serviceKeys = %s"0" / (%s"1" serviceKeyBundle) ; absent in data from earlier versions serviceKeyBundle = keyId reqDhKey reqKemKey -keyId = shortString ; referenced by requests +keyId = shortString ; identifies the bundle, included in requests reqDhKey = length x509encoded ; X25519, used instead of the fixed-data queue key reqKemKey = largeString ; sntrup761 encapsulation key, 1158 bytes ``` -The service periodically rotates the bundle with `LSET` and keeps previous private keys for a window covering client link data caching and queue message retention. A request encrypted to an unknown key ID fails with an error; the client then re-fetches link data and retries. Deleting expired keys is what bounds decryptability of recorded requests, so the window must be short and fixed. +The service rotates the bundle with `LSET` and keeps the previous private keys long enough to decrypt requests already in the address queue - the queue message retention. The client retrieves link data for every request, so the published keys are current when the request is sent; a request becomes undecryptable only if it stays in the address queue longer than its key is kept, and such a request is not answered and fails at the client's deadline. Deleting old keys bounds the time recorded requests can be decrypted, so the retention is short and fixed. Nothing about retries or retention is published in link data. -Link data is encrypted with a symmetric key derived from the link, which is not weakened by quantum computers, so publishing the bundle in link data does not undermine the scheme. +Link data is encrypted with a symmetric key derived from the link, which is not weakened by quantum computers, so publishing the bundle in link data does not weaken the scheme. -Sizes: KEM public key is 1158 bytes, user data is padded to 13784 bytes - the bundle fits together with application data. +Sizes: the KEM public key is 1158 bytes and user data is padded to 13784 bytes, so the bundle fits together with application data. ### Queue-layer PQ encryption -The single-shot queue encryption (today: crypto_box with a secret from the queue DH key and a sender ephemeral key, ephemeral key in the message public header) is extended to a hybrid scheme in a new SMP client version. The public header gains a third variant: +The single-shot queue encryption (today: crypto_box with a secret from the queue DH key and a sender ephemeral key, the ephemeral key in the message public header) is extended to a hybrid scheme in a new SMP client version. The public header gains a third variant: ```abnf smpPubHeaderHybrid = smpClientVersion %s"2" optKeyId senderPublicDhKey kemCiphertext -optKeyId = %s"0" / (%s"1" keyId) ; present in requests, absent in replies -senderPublicDhKey = length x509encoded ; fresh X25519 key +optKeyId = %s"0" / (%s"1" keyId) ; present in requests to select the bundle, absent in replies +senderPublicDhKey = length x509encoded ; sender ephemeral X25519 key kemCiphertext = largeString ; sntrup761 ciphertext, 1039 bytes ``` -The secret is derived from both shared secrets, and the body is encrypted with NaCl secret_box, padded as today: +The secret combines both shared secrets, and the body is encrypted with NaCl secret_box, padded as today: ``` secret = HKDF(dh(recipient key, sender ephemeral key) || KEM shared secret) ``` -The header is visible to the destination server, as invitation headers are today (with proxied sending it is not visible to the proxy). +The header is readable by the destination server, as invitation headers are today; with proxied sending it is not readable by the proxy. -The same scheme applies to replies, using the keys from the request: the first reply includes the hybrid header, the hybrid secret is computed once per reply queue and used for subsequent replies with the empty header - the same one-secret-per-queue model as existing sender queues. Invitations and confirmations can adopt the same scheme independently of this design, removing the single-layer X25519 exposure of the profile. +For a request, the recipient keys are the service bundle keys selected by `keyId`. For a reply, the recipient keys are the reply queue keys included in the request. The first reply message includes the hybrid header; the client computes the secret once and stores it in the reply queue record, and later reply messages use it with the plain header. This is the one-secret-per-queue model of existing queues, and the secret is stored the same way the per-queue DH secret is stored on receiving the first message. Invitations and confirmations can adopt the same scheme independently of this design. ### Request A new agent envelope (alongside `agentConfirmation`, `agentMsgEnvelope`, `agentInvitation`, `agentRatchetKey`): ```abnf -agentRequest = agentVersion %s"Q" replyQueue requestBody -replyQueue = smpClientVersion smpServer senderId dhPublicKey kemPublicKey sndAuthPublicKey +agentRequest = agentVersion %s"Q" replyQueue requestPayload +replyQueue = smpClientVersion smpServer senderId dhPublicKey kemPublicKey smpClientVersion = 2*2 OCTET senderId = shortString ; sender ID of the reply queue -dhPublicKey = length x509encoded ; X25519, fresh per request -kemPublicKey = largeString ; sntrup761 encapsulation key, fresh per request -sndAuthPublicKey = length x509encoded ; key to secure the reply queue -requestBody = *OCTET ; remaining bytes, application-defined +dhPublicKey = length x509encoded ; reply queue X25519 key +kemPublicKey = largeString ; reply queue sntrup761 encapsulation key +requestPayload = *OCTET ; remaining bytes, opaque application payload ``` -The envelope type indicates to the receiving agent that no connection is created and replies are sent to the provided queue. The reply queue keys never appear outside the encrypted request. Requests must fit in one message; larger payloads are passed as an XFTP file description in the request body. +The envelope type indicates to the receiving agent that no connection is created and replies are sent to the reply queue. The request does not include a key to secure the reply queue: the service generates its own sender key and secures the queue with it, as a sender does in the fast handshake. The reply queue address and keys are not part of the hashed payload. -A retry is the byte-identical stored request message, so all correlation uses one value: the request hash - the hash of the message body, the same bytes as sent by the client and as received by the service after the server encryption layer is removed. +The request hash is the SHA3-256 of `requestPayload` - the same bytes the client sends and the service reads after the server encryption layer is removed. The application sets a request ID inside the payload; two requests are the same operation when their payloads, and therefore their hashes, are equal. A request must fit in one message; a larger payload is sent as an XFTP file description in the payload. -Request delivery failures follow existing SEND semantics: on QUOTA (the address queue is full) the client retries with backoff within the request deadline. +Request delivery follows existing SEND semantics: a hard error (AUTH, QUOTA) fails the call, and the application decides whether to send a new request. ### Replies -The service secures the reply queue with the sender key from the request and sends the first reply in one combined SMP command (see below). Replies use a new agent envelope, following the signature-first structure of link data: +The service secures the reply queue and sends the first reply message with one combined SMP command (see below). A reply message uses a new agent envelope, following the signature-first structure of link data: ```abnf -agentResponse = agentVersion %s"P" signature signedReply -signature = length 64*64 OCTET ; root key signature of signedReply -signedReply = requestHash prevMsgHash final replyBody -requestHash = shortString ; hash of the request message body -prevMsgHash = shortString ; hash of the previous agentResponse, empty in the first reply -final = %s"T" / %s"F" ; F - more replies follow -replyBody = *OCTET ; remaining bytes, application-defined +agentResponse = agentVersion %s"P" signature signedResponse +signature = length 64*64 OCTET ; root key signature of signedResponse +signedResponse = requestHash prevMsgHash more responses +requestHash = shortString ; hash of the request payload +prevMsgHash = shortString ; hash of the previous agentResponse message, empty in the first +more = %s"T" / %s"F" ; T - more reply messages follow +responses = length 1*responseItem ; non-empty list of application responses +responseItem = largeString ; opaque application response ``` -The client verifies each reply: the signature against the root key from link data, the request hash against the sent request, the hash chain against the previous reply. Forging a reply requires the root key even if the reply queue keys are compromised; a signed reply cannot be replayed for a different request; the hash chain detects replies dropped or reordered by the reply queue server. +A reply message includes a list of responses, so responses known together are sent in one message rather than several; responses that become known over time are sent in separate messages. The signature covers the whole message. -The client deletes the reply queue on the final flag, on the request deadline (application-defined per request), or on cancellation. Deleting the queue also cancels the stream: subsequent SEND commands from the service fail with AUTH. Router queue and message expiry limit the lifetime of abandoned queues. Stream length between client acknowledgements is bounded by queue capacity. +The client verifies each reply message: the signature against the root key from link data, the request hash against the sent request, the previous-message hash against the previous message. A message that fails verification is acknowledged and discarded. Forging a reply message requires the root key even if the reply queue keys are known; a signed message cannot be reused for a different request; the previous-message hash detects messages dropped or reordered by the reply queue server. -Delayed replies (e.g., a credential issued after payment) are stored in the reply queue within message retention time and received when the client subscribes again; notification credentials can be added to the reply queue with existing commands. Messages in the reply queue that fail decryption or verification are acknowledged and dropped. +The first reply message returns from the request call. Later reply messages are delivered through the callback the application registered with the request. The exchange ends on a message with `more` set to false. The client deletes the reply queue on that message, on the request deadline, or when the application cancels the request. Deleting the queue stops further replies: later SEND commands from the service fail with AUTH. Server queue and message expiry limit the lifetime of a reply queue left after a client restart. ### Combined SKEY+SEND command @@ -150,24 +150,27 @@ senderAuthPublicKey = length x509encoded The command is authorized with the key it sets, as `SKEY`, and only accepted on messaging-mode queues. The server responds `OK` or `ERR`. It is idempotent in both parts: -- key part: as `SKEY` today - repeated command with the same key succeeds, different key fails with AUTH -- send part: the server stores a hash of the message body until the message is acknowledged; within that window a repeated command with the same body is not delivered again and is reported as delivered +- key part: as `SKEY` today - a repeated command with the same key succeeds, a different key fails with AUTH. +- send part: the server keeps the hash of the message until it is acknowledged, and a repeated command with the same message within that period is reported as delivered without delivering it again. -A retry arriving after the message was acknowledged is delivered as a duplicate and suppressed by the receiving agent (by message hash), so the server-side marker covers the common case and the agent covers the rest. +A repeat arriving after the message was acknowledged is delivered as a duplicate and discarded by the receiving agent by message hash, so the server-side hash covers the common case and the agent covers the rest. -It is used by the service for the first reply, and by the joining party in the fast connection handshake (currently `SKEY` then `SEND` confirmation), removing one command and round trip from both flows. +The service uses this command for the first reply message. The joining party uses it in the fast connection handshake, where it replaces `SKEY` followed by the `SEND` confirmation, removing one command and one round trip. ### Idempotency -Handled uniformly by the agent: it stores the request hash and sent replies for a window declared in link data (with a default), and re-sends stored replies for a repeated request without invoking the service application. This gives exactly-once execution over at-least-once delivery for all services; services with idempotent semantics of their own lose nothing. +The service agent identifies a request by its hash and keeps, for a fixed retention period it chooses (in the 1 to 24 hour range, in service configuration, not in link data), a record of the ordered reply messages it has sent and the reply queues subscribed under that hash. A repeat request with the same hash does not reach the service application: -The guarantee is bounded by the window: the client must not retry after the request deadline, and the deadline must not exceed the declared window. Stored replies may be evicted under storage pressure; a retry whose replies were evicted receives an error prompting a new request. Within the window a request is never executed twice. +- while the first request is being answered, the repeat is added to the record and receives the reply messages already sent, and each later message is sent to every reply queue in the record. +- after the operation completed, the repeat receives the whole stored sequence of reply messages, in order. + +This gives single execution over at-least-once delivery. The retention period bounds it: after the record is deleted, a request with the same hash is a new operation and runs again. The application does not rely on the transport for recovery across a restart; it keeps its own state and, after a restart, sends whatever request fits what it knows, which is often a different request (for example, "is this payment still pending" rather than a repeat of "start this payment"). ### Out of scope -- Continuity: sessions across requests are an application concern (tokens in request and reply bodies). -- Service-initiated messages: there is no standing channel; use a connection where push is needed. -- Abuse protection beyond existing queue quotas: services can require application-level credentials (e.g., a badge) in request bodies; rate limiting options are a separate discussion. +- Recovery across restart: the transport keeps no exchange across a client restart. The application persists its own state and sends a new request when it needs to. +- Service-initiated messages: there is no standing channel; use a connection where the service must reach the client without a request. +- Abuse protection beyond existing queue quotas: services can require application-level credentials (e.g., a badge) in the request payload; rate limiting is a separate discussion. - Scaling request reception: a single address queue bounds service throughput; distributing reception across multiple queues or relays (the existing `relays` field in contact link data) is a separate discussion. - Name resolution: existing addressing layer. From 5633bbfb139e5c1e0733b8b3f7756c8ae4f50001 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 12 Jul 2026 16:16:58 +0100 Subject: [PATCH 03/81] corrections Co-authored-by: Evgeny --- rfcs/2026-07-11-service-rpc.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rfcs/2026-07-11-service-rpc.md b/rfcs/2026-07-11-service-rpc.md index 1eb7a42df..074658e4f 100644 --- a/rfcs/2026-07-11-service-rpc.md +++ b/rfcs/2026-07-11-service-rpc.md @@ -12,13 +12,13 @@ This is the wrong primitive for most service interactions: 2. Privacy. A connection is a stable pairwise pseudonym. If a service were to use a duplex connection, it could link all requests made over it into a profile: search history in the directory, blockchain operations linked even when different on-chain keys are used, telemetry that becomes longitudinal tracking. The client also accumulates history that can be recovered from the device. Where continuity is needed, it can be provided in the application protocol (e.g., a token included in requests), without a transport-level identity. -3. Encryption. Messages sent to contact addresses outside an established connection (invitations) have a single layer of X25519 encryption. This was acceptable while such messages contained only a connection link and profile (though it is planned to be improved); it is not acceptable for service requests. +3. Encryption. Messages sent to contact addresses outside an established connection (invitations) have a single layer of X25519 encryption. This was acceptable while such messages contained only a connection link and profile (though it is planned to be improved); it is probably less acceptable for service requests. In-app service addresses should be stored as names resolving to links via the existing addressing layer (server host in the link authority, current link data retrieved with LGET), so that service links can be changed without redeploying the apps. Name resolution is already supported, and out of scope. ## Security objectives -1. Requests from the same client must not be linkable to each other by the service or by servers, and no state that outlives the exchange is created on either side. +1. Requests from the same client must not be linkable to each other by the service or by servers, and no long term state is created on either side in the transport layer. 2. Post-quantum resistant e2e encryption of requests and replies; decryptability of recorded requests must be bounded by key rotation, without changing the address. 3. Reply authenticity must be verifiable against the link; substitution, replay, dropping or reordering of replies by servers must be detectable. 4. A repeated request for the same operation must not be executed twice. @@ -171,7 +171,7 @@ This gives single execution over at-least-once delivery. The retention period bo - Recovery across restart: the transport keeps no exchange across a client restart. The application persists its own state and sends a new request when it needs to. - Service-initiated messages: there is no standing channel; use a connection where the service must reach the client without a request. - Abuse protection beyond existing queue quotas: services can require application-level credentials (e.g., a badge) in the request payload; rate limiting is a separate discussion. -- Scaling request reception: a single address queue bounds service throughput; distributing reception across multiple queues or relays (the existing `relays` field in contact link data) is a separate discussion. +- Scaling request reception: a single address queue bounds service throughput; distributing reception across multiple queues or relays (the existing `relays` field in contact link data) is a separate question, but it would fit well with name resolving to multiple addresses, both for redundancy, reliability and higher throughput. - Name resolution: existing addressing layer. [1]: https://tools.ietf.org/html/rfc5234 From d7226635319dd5fc0527a2378486bd84953c940a Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Mon, 13 Jul 2026 10:55:00 +0000 Subject: [PATCH 04/81] split rfcs, add plan --- .../2026-07-11-service-rpc-implementation.md | 380 +++++------------- plans/2026-07-12-address-dr-implementation.md | 195 +++++++++ rfcs/2026-07-11-service-rpc.md | 152 ++----- rfcs/2026-07-12-address-pqdr-keys.md | 95 +++++ rfcs/2026-07-12-queue-pq-encryption.md | 42 ++ rfcs/2026-07-12-smp-secure-send.md | 55 +++ 6 files changed, 534 insertions(+), 385 deletions(-) create mode 100644 plans/2026-07-12-address-dr-implementation.md create mode 100644 rfcs/2026-07-12-address-pqdr-keys.md create mode 100644 rfcs/2026-07-12-queue-pq-encryption.md create mode 100644 rfcs/2026-07-12-smp-secure-send.md diff --git a/plans/2026-07-11-service-rpc-implementation.md b/plans/2026-07-11-service-rpc-implementation.md index 68b9bff67..d3529f141 100644 --- a/plans/2026-07-11-service-rpc-implementation.md +++ b/plans/2026-07-11-service-rpc-implementation.md @@ -2,378 +2,204 @@ RFC: [../rfcs/2026-07-11-service-rpc.md](../rfcs/2026-07-11-service-rpc.md) -Types and instances below must encode exactly the ABNF in the RFC. Constructor, event, table and function names are provisional. +Depends on: [2026-07-12-address-dr-implementation.md](2026-07-12-address-dr-implementation.md). RPC establishes the double ratchet from the service address exactly as the address-DR plan does; this plan is the RPC layer on top of it. Steps named R2'/O2'/O3' below are from that plan. Constructor, event, table and function names are provisional. -## Versions - -- `VersionSMPA` (agent protocol): new version for `AgentRequest`/`AgentResponse` envelopes and the service key bundle in link data. -- `VersionSMPC` (SMP client): new version for the hybrid public header. -- `VersionSMP` (SMP protocol): new version for the `SSND` command. - -## Address type - `Simplex.Messaging.Agent.Protocol` - -```haskell -data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay | CCTService - -ctTypeChar CCTService = 'S' -- 's' in links: link encoding lowercases, parsing uppercases - -ctTypeP 'S' = pure CCTService -``` +RPC is a one-directional short-lived DR exchange: the client establishes the ratchet from the address (address-DR requester), sends one request, receives one or more responses on its reply queue, and both sides tear the ratchet down after the final response. Unlike a connection, the service does not send a reply queue back and no persistent connection remains. -The contact type is currently fixed to `CCTContact` when the agent reconstructs a contact link (`Agent.hs`, `cslContact`). It becomes a stored property of the address (column `link_contact_type` below), read when the link is reconstructed and when an address queue message is dispatched. +## Versions -## Service key bundle in link data - `Simplex.Messaging.Agent.Protocol` +- `VersionSMPA` (agent protocol): the new `AgentServiceRequest`/`AgentServiceResponse` messages and the service address subtype. RPC requires the address-DR agent version, whose ratchet establishment it reuses. -```haskell -data ServiceKeyBundle = ServiceKeyBundle - { keyId :: ByteString, - reqDhKey :: C.PublicKeyX25519, - reqKemKey :: KEMPublicKey - } - -instance Encoding ServiceKeyBundle where - smpEncode ServiceKeyBundle {keyId, reqDhKey, reqKemKey} = smpEncode (keyId, reqDhKey, reqKemKey) - smpP = do - (keyId, reqDhKey, reqKemKey) <- smpP - pure ServiceKeyBundle {keyId, reqDhKey, reqKemKey} -``` +`SSND` (SMP protocol) and the hybrid queue header (SMP client) are not used here - they are separate RFCs (combined secure-send; queue-layer PQ). The ratchet provides post-quantum encryption, and the reply queue is secured with `SKEY` as in the address-DR owner path (O3'). -`UserContactData` gains a field, appended to the encoding, absent in data written by earlier versions. The agent sets it when it signs and updates link data; the application supplies only its own data. There is no retention value in link data - retention is service configuration (see Idempotency). +## Service address -```haskell -data UserContactData = UserContactData - { direct :: Bool, - owners :: [OwnerAuth], - relays :: [ConnShortLink 'CMContact], - userData :: UserLinkData, - serviceKeys :: Maybe ServiceKeyBundle - } - -instance Encoding UserContactData where - smpEncode UserContactData {direct, owners, relays, userData, serviceKeys} = - B.concat [smpEncode direct, smpEncodeList owners, smpEncodeList relays, smpEncode userData, smpEncode serviceKeys] - smpP = do - direct <- smpP - owners <- smpListP - relays <- smpListP - userData <- smpP - serviceKeys <- fromMaybe Nothing <$> optional smpP -- absent in data from earlier versions - _ <- A.takeByteString -- ignoring tail for forward compatibility - pure UserContactData {direct, owners, relays, userData, serviceKeys} -``` +A service address is a DR-advertising contact address (address-DR plan: `linkRatchetKey` in fixed data, `RatchetKeys` in mutable data) with a service subtype. There is no separate `ServiceKeyBundle` - requests are encrypted by establishing the ratchet against the advertised keys. -## SSND command - `Simplex.Messaging.Protocol`, `Simplex.Messaging.Server` +The subtype distinguishes RPC from a normal connection and drives the owner's handling. Reuse the `ContactConnType` char slot: ```haskell --- Protocol.hs -SSND :: SndPublicAuthKey -> MsgFlags -> MsgBody -> Command Sender - --- CommandTag, encoding "SSND" -SSND_ :: CommandTag Sender - --- encodeProtocol -SSND k flags msg -> e (SSND_, ' ', k, ' ', flags, ' ', Tail msg) - --- protocolP, in a new VersionSMP -SSND_ -> SSND <$> (smpP <* A.space) <*> (smpP <* A.space) <*> (unTail <$> smpP) +data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay | CCTService +ctTypeChar CCTService = 'S' -- 's' in links +ctTypeP 'S' = pure CCTService ``` -`checkCredentials`: as `SKEY` - authorization required, sender entity ID. Server verification: `vc SSender (SSND k _ _) = verifySecure k` - authorized by the key it sets. +Stored on the address receive queue as `link_contact_type` (NULL means the current contact type). A service address rejects `AgentInvitation` and connection `AgentConfirmation`; a non-service address rejects service requests. -Server processing: `checkMode QMMessaging`, then `secureQueue_` (existing, idempotent), then deliver with deduplication. All queue store backends (STM, journal, PostgreSQL) keep the hash of the message delivered by `SSND` until it is acknowledged; a repeated `SSND` with an equal message hash responds `OK` without delivering it again; the hash is removed when the message is acknowledged. Server stats gain an `SSND` counter. +## RPC messages -Proxying: `proxySMPCommand` is polymorphic in the sender command, so `SSND` forwards through `PFWD`/`RFWD` without changes. - -## Hybrid public header - `Simplex.Messaging.Protocol` - -```haskell -data PubHeader - = PubHeader - { phVersion :: VersionSMPC, - phE2ePubKey :: Maybe C.PublicKeyX25519 - } - | PubHeaderHybrid - { phVersion :: VersionSMPC, - phKeyId :: Maybe ByteString, -- present in requests, absent in replies - phDhKey :: C.PublicKeyX25519, - phKemCt :: KEMCiphertext - } - -instance Encoding PubHeader where - smpEncode = \case - PubHeader v k_ -> smpEncode (v, k_) -- Maybe encodes as '0' / '1' key, as today - PubHeaderHybrid v kId_ k ct -> smpEncode (v, '2', kId_, k, ct) - smpP = do - v <- smpP - A.anyChar >>= \case - '0' -> pure $ PubHeader v Nothing - '1' -> PubHeader v . Just <$> smpP - '2' -> PubHeaderHybrid v <$> smpP <*> smpP <*> smpP - _ -> fail "bad PubHeader" -``` - -Secret derivation and encryption (`Simplex.Messaging.Crypto`, used from `Simplex.Messaging.Agent.Client`): +RPC adds two `AgentMessage` variants (Protocol.hs:883-889, parsed by `parseMessage`), parallel to `AgentConnInfoReply`, not new top-level envelopes. They are the decrypted content of the existing per-queue-e2e envelopes: the request is the `encConnInfo` of the address-DR `AgentConfirmation`; each response is the `encConnInfo` of an `AgentConfirmation` (first message to the reply queue) or the `encAgentMessage` of an `AgentMsgEnvelope` (later messages), all double-ratchet-encrypted. Their tags `Q`/`P` are the RFC's `agentRequest`/`agentResponse`. ```haskell -hybridSecret :: C.DhSecretX25519 -> KEMSharedKey -> C.SbKey -hybridSecret dh (KEMSharedKey k) = C.unsafeSbKey $ C.hkdf "" (C.dhBytes' dh <> BA.convert k) "SimpleXSMPQueue" 32 +data AgentMessage + = ... -- AgentConnInfo 'I', AgentConnInfoReply 'D', AgentRatchetInfo 'R', AgentMessage 'M' + | AgentServiceRequest (NonEmpty SMPQueueInfo) MsgBody -- 'Q': reply queue(s) + opaque request payload + | AgentServiceResponse Bool (NonEmpty MsgBody) -- 'P': final flag + one or more response payloads + +-- encoding (extends AgentMessage Encoding) +AgentServiceRequest qs body -> smpEncode ('Q', qs, Tail body) +AgentServiceResponse final bodies -> smpEncode ('P', final) <> smpEncodeList (map Large (L.toList bodies)) ``` -The body is encrypted with `C.sbEncrypt` (secret_box) rather than `C.cbEncrypt`, padded to the same lengths. The sending side generates an ephemeral X25519 pair, encapsulates to the recipient KEM key, and writes `PubHeaderHybrid`. The receiving side selects private keys by `phKeyId` for a request, or uses the reply queue keys for a reply, and computes the same secret. A request with an unknown key ID is discarded and counted. +One response message carries one or more response payloads, so responses known together are one message; responses over time are separate messages, each with `final = False` until the last. There is no signature and no previous-message hash: the ratchet, established against the `linkRatchetKey` committed by the link hash (address-DR authentication), authenticates each message and its message numbering detects dropping and reordering. The request payload is opaque application bytes (the chat command); the reply queue fields are outside it. -Size constants: the hybrid header adds about 1.2KB (KEM ciphertext 1039 bytes plus the ephemeral key). Define the request and reply body length constants from the existing padded body lengths at implementation. +The request hash used for idempotency is `SHA3-256` of the decrypted request payload (the `MsgBody` in `AgentServiceRequest`). -## Agent envelopes - `Simplex.Messaging.Agent.Protocol` +The `AgentMsgEnvelope` receive path (`agentClientMsg`, Agent.hs:3289) today expects only `AgentMessage APrivHeader aMessage`; it is extended to accept `AgentServiceResponse` for the stream after the first response. -```haskell -data AgentMsgEnvelope - = ... -- existing constructors - | AgentRequest - { agentVersion :: VersionSMPA, - replyQueue :: RequestReplyQueue, - requestPayload :: ByteString -- opaque, hashed - } - | AgentResponse - { agentVersion :: VersionSMPA, - signature :: C.Signature 'C.Ed25519, -- root key signature of signedResponse - signedResponse :: ByteString -- encoded SignedResponse, parsed after the signature is verified - } - -data RequestReplyQueue = RequestReplyQueue - { smpClientVersion :: VersionSMPC, - smpServer :: SMPServer, - senderId :: SMP.SenderId, -- sender ID of the reply queue - dhPublicKey :: C.PublicKeyX25519, -- reply queue X25519 key (its e2e key) - kemPublicKey :: KEMPublicKey -- reply queue sntrup761 key - } - -data SignedResponse = SignedResponse - { requestHash :: ByteString, -- SHA3-256 of requestPayload - prevMsgHash :: ByteString, -- SHA3-256 of the previous AgentResponse, empty in the first - more :: Bool, -- True if more reply messages follow - responses :: NonEmpty ByteString -- opaque application responses - } -``` - -The request does not include a key to secure the reply queue: the service generates its own sender key and secures the queue with `SSND`. `requestPayload` is the only hashed part; the reply queue fields are not hashed. +## Ratchet establishment - reuse of the address-DR flow -```haskell -instance Encoding AgentMsgEnvelope where - smpEncode = \case - ... -- existing constructors - AgentRequest {agentVersion, replyQueue, requestPayload} -> - smpEncode (agentVersion, 'Q', replyQueue, Tail requestPayload) - AgentResponse {agentVersion, signature, signedResponse} -> - smpEncode (agentVersion, 'P', signature, Tail signedResponse) - smpP = do - agentVersion <- smpP - smpP >>= \case - ... -- existing constructors - 'Q' -> do - (replyQueue, Tail requestPayload) <- smpP - pure AgentRequest {agentVersion, replyQueue, requestPayload} - 'P' -> do - (signature, Tail signedResponse) <- smpP - pure AgentResponse {agentVersion, signature, signedResponse} - -instance Encoding RequestReplyQueue where - smpEncode RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey} = - smpEncode (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey) - smpP = do - (smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey) <- smpP - pure RequestReplyQueue {smpClientVersion, smpServer, senderId, dhPublicKey, kemPublicKey} - -instance Encoding SignedResponse where - smpEncode SignedResponse {requestHash, prevMsgHash, more, responses} = - smpEncode (requestHash, prevMsgHash, more) <> smpEncodeList (map Large $ L.toList responses) - smpP = do - (requestHash, prevMsgHash, more) <- smpP - rs <- map unLarge <$> smpListP - responses <- maybe (fail "empty responses") pure $ L.nonEmpty rs - pure SignedResponse {requestHash, prevMsgHash, more, responses} -``` +Request (client), reusing the address-DR requester path (R2'/R3'): -Signing and verification follow the link data pattern (`Simplex.Messaging.Crypto.ShortLink`): +- Retrieve link data, reconstruct and negotiate the advertised `RcvE2ERatchetParamsUri`, create the reply queue Q_A (messaging mode, subscribed), establish the send ratchet (`generateSndE2EParams`, `pqX3dhSnd`, `initSndRatchet`, `createSndRatchet`). +- Send `AgentConfirmation {e2eEncryption_ = Just sndParams, ratchetKeyId = Just ratchetKeyId, encConnInfo = ratchetEncrypt(AgentServiceRequest (Q_A :| []) payload)}` to the address queue, unauthenticated (`agentCbEncryptOnce`). The client connection is `RcvConnection` (Q_A) with the send ratchet. -```haskell --- service: signing key is linkPrivSigKey from the address ShortLinkCreds -mkAgentResponse :: C.PrivateKeyEd25519 -> VersionSMPA -> SignedResponse -> AgentMsgEnvelope -mkAgentResponse rootPrivKey agentVersion resp = - let signedResponse = smpEncode resp - in AgentResponse {agentVersion, signature = C.sign' rootPrivKey signedResponse, signedResponse} - --- client: rootKey from the fixed link data -verifyAgentResponse :: C.PublicKeyEd25519 -> AgentMsgEnvelope -> Either AgentErrorType SignedResponse -verifyAgentResponse rootKey AgentResponse {signature, signedResponse} - | C.verify' rootKey signature signedResponse = parse smpP (AGENT A_MESSAGE) signedResponse - | otherwise = Left ... -- verification error -``` +Request (service), reusing the address-DR owner path (O1'/O2'): -## Reply queue - no new connection type +- `smpAddressConfirmation` selects the private keys by `ratchetKeyId`, `pqX3dhRcv`, `initRcvRatchet`, and `rcDecrypt` of `encConnInfo`, which also gives the connection its send side. The decrypted message is `AgentServiceRequest` (not `AgentConnInfoReply`), so the owner takes the RPC branch: create a `SndConnection` to Q_A (no Q_B, unidirectional) holding the ratchet, run idempotency (below), and either deliver `SREQ` or replay stored responses. This is receive-time establishment on unauthenticated input - the abuse bound of the address-DR plan ("Receive-time establishment, state, and abuse") applies unchanged. -The reply queue on the client is a receive connection (`RcvConnection`), extended to carry the KEM key and the computed hybrid secret. There is no new connection type and no flag on the connection: a client service request row (below) references the reply queue connection, and its presence identifies the connection as an RPC reply queue for dispatch and cleanup. +Response (service): send each response to Q_A under the ratchet. The first message to Q_A is `AgentConfirmation {e2eEncryption_ = Nothing, encConnInfo = ratchetEncrypt(AgentServiceResponse final bodies)}` (per-queue e2e is unestablished on Q_A - the address-DR first-message constraint), securing Q_A with `SKEY` using the service's own key (`agentSecureSndQueue`, Q_A is messaging mode); later messages are `AgentMsgEnvelope {encAgentMessage = ratchetEncrypt(AgentServiceResponse …)}`. After the `final = True` message, delete the send connection and its ratchet. -The reply queue reuses the existing receive queue fields. `e2ePrivKey` is its X25519 key, its public half is the queue address DH key sent in the request. Two nullable columns are added to `rcv_queues`: +Response (client): a message on Q_A (its `snd_service_requests` row marks it an RPC reply queue). The first is `AgentConfirmation … Nothing` and takes the address-DR `RcvConnection … Nothing` branch (R5'), extended to accept `AgentServiceResponse`; later ones are `AgentMsgEnvelope` and take the standard message path, extended to accept `AgentServiceResponse`. Each `agentRatchetDecrypt` advances the ratchet. The first response returns from the call; later responses go to the callback. On `final`, the deadline, or `cancelServiceRequest`, delete Q_A (`DEL`) and the reply connection. -- `reply_kem_priv_key` - the reply queue KEM private key. -- `reply_secret` - the hybrid secret, empty until the first reply, then set from the first reply's header, as the per-queue DH secret is set by `setRcvQueueConfirmedE2E` on the first message today. Later replies are decrypted with it by the standard receive path. +## Reply queue - the requester's DR connection -The service does not create a connection or queue for the reply queue. It sends replies directly to the reply queue address, as `sendInvitation` sends to a queue with no connection. +The reply queue is the address-DR requester connection: an `RcvConnection` whose receive queue is Q_A, with a ratchet. No `reply_kem_priv_key`/`reply_secret` columns (those were the queue-layer hybrid secret, not used here). A `snd_service_requests` row referencing this connection marks it an RPC reply queue for dispatch and cleanup; there is no new connection type. -## Database schema - `Agent/Store/SQLite/Migrations`, `Agent/Store/Postgres/Migrations` +## Database schema -One migration (`M20260712_service_rpc`), SQLite shown, PostgreSQL mirrors it; column types follow existing schema conventions. +One migration (`M20260712_service_rpc`), on top of the address-DR migration. SQLite shown, PostgreSQL mirrors it. ```sql --- address contact type (contact address queues), and reply queue keys (reply queues). --- NULL link_contact_type means 'A' (contact) for existing rows. -ALTER TABLE rcv_queues ADD COLUMN link_contact_type TEXT; -ALTER TABLE rcv_queues ADD COLUMN reply_kem_priv_key BLOB; -ALTER TABLE rcv_queues ADD COLUMN reply_secret BLOB; - --- service side: current and retired bundle private keys. -CREATE TABLE service_address_keys( - service_address_key_id INTEGER PRIMARY KEY AUTOINCREMENT, - conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, - key_id BLOB NOT NULL, - dh_priv_key BLOB NOT NULL, - kem_priv_key BLOB NOT NULL, - created_at TEXT NOT NULL, - retired_at TEXT -- set on rotation, row deleted when the key retention period ends -); -CREATE UNIQUE INDEX idx_service_address_keys ON service_address_keys(conn_id, key_id); +-- service subtype on the address receive queue (address-DR adds the ratchet key columns) +ALTER TABLE rcv_queues ADD COLUMN link_contact_type TEXT; -- NULL = current contact type -- client side: one pending request per reply queue connection. CREATE TABLE snd_service_requests( snd_service_request_id INTEGER PRIMARY KEY AUTOINCREMENT, - conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, -- reply queue connection - request_hash BLOB NOT NULL, - root_key BLOB NOT NULL, -- to verify replies - last_reply_hash BLOB, -- updated as reply messages arrive + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, -- reply queue (RcvConnection) with the ratchet deadline TEXT NOT NULL, created_at TEXT NOT NULL ); --- service side: one record per distinct request hash on an address. +-- service side: one record per distinct request hash on a service address. CREATE TABLE rcv_service_requests( rcv_service_request_id INTEGER PRIMARY KEY AUTOINCREMENT, - conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, -- address connection + address_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, -- the service address connection request_hash BLOB NOT NULL, - ended INTEGER NOT NULL DEFAULT 0, -- a reply message with more = False was sent + ended INTEGER NOT NULL DEFAULT 0, -- a response with final = True was produced expires_at TEXT NOT NULL, -- created + retention created_at TEXT NOT NULL ); -CREATE UNIQUE INDEX idx_rcv_service_requests ON rcv_service_requests(conn_id, request_hash); +CREATE UNIQUE INDEX idx_rcv_service_requests ON rcv_service_requests(address_conn_id, request_hash); --- service side: ordered signed reply messages for a request; the signed envelope --- is independent of the reply queue, so it is stored once and encrypted per queue on send. -CREATE TABLE rcv_service_replies( - rcv_service_reply_id INTEGER PRIMARY KEY AUTOINCREMENT, +-- service side: ordered response payloads (plaintext) for a request; re-encrypted per reply +-- connection because each request establishes its own ratchet, so ciphertext is not reusable. +CREATE TABLE rcv_service_responses( + rcv_service_response_id INTEGER PRIMARY KEY AUTOINCREMENT, rcv_service_request_id INTEGER NOT NULL REFERENCES rcv_service_requests ON DELETE CASCADE, - reply_seq INTEGER NOT NULL, - more INTEGER NOT NULL, - signed_reply BLOB NOT NULL -- encoded AgentResponse + response_seq INTEGER NOT NULL, + final INTEGER NOT NULL, + response_bodies BLOB NOT NULL -- plaintext response payloads for this message (encoded NonEmpty MsgBody) ); -CREATE UNIQUE INDEX idx_rcv_service_replies ON rcv_service_replies(rcv_service_request_id, reply_seq); +CREATE UNIQUE INDEX idx_rcv_service_responses ON rcv_service_responses(rcv_service_request_id, response_seq); --- service side: reply queues subscribed under a request (the first, and any repeat). -CREATE TABLE rcv_service_reply_queues( - rcv_service_reply_queue_id INTEGER PRIMARY KEY AUTOINCREMENT, +-- service side: reply connections subscribed under a request (the first, and any repeat while pending +-- or after completion). Each is a SndConnection to a reply queue with its own ratchet (in ratchets table). +CREATE TABLE rcv_service_reply_conns( + rcv_service_reply_conn_id INTEGER PRIMARY KEY AUTOINCREMENT, rcv_service_request_id INTEGER NOT NULL REFERENCES rcv_service_requests ON DELETE CASCADE, - host TEXT NOT NULL, - port TEXT NOT NULL, - snd_id BLOB NOT NULL, - server_key_hash BLOB, - reply_secret BLOB NOT NULL, -- hybrid secret to this reply queue - secured INTEGER NOT NULL DEFAULT 0, -- reply queue secured with SSND + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, -- SndConnection to the reply queue, holds the ratchet last_sent_seq INTEGER NOT NULL DEFAULT 0 ); ``` +The service's address ratchet keys are the address-DR `address_ratchet_keys` table - not duplicated here. + ## Agent API - `Simplex.Messaging.Agent` Service side: ```haskell --- Creates a contact connection with CCTService link type, generates the root key --- and the first key bundle, composes and signs link data. +-- Creates a DR-advertising contact address with CCTService subtype (address-DR createServiceAddress +-- plus the subtype), generating the link ratchet key and the first RatchetKeys row. createServiceAddress :: AgentClient -> UserId -> UserLinkData -> AE (ConnId, ConnShortLink 'CMContact) --- Re-signs and updates user data with LSET, keeping the agent-owned key bundle. -updateServiceAddressData :: AgentClient -> ConnId -> UserLinkData -> AE () - --- Generates a new bundle, updates link data, retires the previous keys until the retention period ends. --- Also runs on a schedule (config) while the address is subscribed. -rotateServiceAddressKeys :: AgentClient -> ConnId -> AE () - --- Sends one reply message with a list of responses; more = False ends the exchange. --- The first message to each reply queue secures it with SSND; later messages use SEND. -sendServiceReply :: AgentClient -> ServiceRequestRef -> Bool -> NonEmpty ByteString -> AE () +-- Sends one response message with one or more payloads (final = True ends the exchange). The first +-- message to each reply connection secures the reply queue with SKEY; later ones use SEND. Appends to +-- rcv_service_responses. +sendServiceReply :: AgentClient -> ServiceRequestRef -> Bool -> NonEmpty MsgBody -> AE () ``` -Address deletion: existing `deleteConnection`. +Key rotation and update use the address-DR `rotateRatchetKeys`/link-data update; address deletion is `deleteConnection`. -Client side (name resolution to a link is an existing API; the link must have `CCTService` type and a key bundle in link data): +Client side (name resolution to a link is an existing API; the link must be a `CCTService` DR-advertising address): ```haskell --- Retrieves link data, creates the reply queue, sends the request, and waits for the first --- reply message up to the deadline. The callback receives later reply messages while the process runs. +-- Establishes the ratchet from the address, creates the reply queue, sends the request, and waits for +-- the first response up to the deadline. The callback receives later responses while the process runs. sendServiceRequest :: AgentClient -> UserId -> ConnShortLink 'CMContact -> UTCTime -> - ByteString -> (ServiceReply -> IO ()) -> AE ServiceReply + MsgBody -> (ServiceResponse -> IO ()) -> AE ServiceResponse --- Deletes the reply queue and the request row, and drops the callback. cancelServiceRequest :: AgentClient -> ConnId -> AE () -data ServiceReply = ServiceReply {responses :: NonEmpty ByteString, more :: Bool} +data ServiceResponse = ServiceResponse {bodies :: NonEmpty MsgBody, final :: Bool} ``` -The first reply message returns from `sendServiceRequest`; later messages are delivered through the callback. Both the waiting call and the callback are held in an in-memory map in `AgentClient`, keyed by the reply queue connection, and filled by the receive path. They do not survive a restart. +The waiting call and the callback are held in an in-memory map in `AgentClient`, keyed by the reply queue connection, filled by the receive path; they do not survive a restart. -Service side events (`AEvent`, entity is the address connection): +Service side event (`AEvent`, entity is the service address connection): ```haskell -SREQ :: ServiceRequestRef -> ByteString -> AEvent AEConn -- request received, payload for the bot +SREQ :: ServiceRequestRef -> MsgBody -> AEvent AEConn -- request payload for the bot ``` -`ServiceRequestRef` identifies the request record; the bot passes it to `sendServiceReply`. +`ServiceRequestRef` identifies the `rcv_service_requests` record; the bot passes it to `sendServiceReply`. + +Rejection reuses `AgentRejection` (communicating-rejection RFC) as an `AgentServiceResponse`-level refusal or a dedicated variant - decided with that RFC. -## Agent processing - `Simplex.Messaging.Agent`, `Simplex.Messaging.Agent.Client` +## Agent processing Client side: -- `sendServiceRequest`: retrieve link data (`LGET`, proxied per config) for every request - no caching; create the reply queue (`NEW`, messaging mode, subscribed) with an added KEM key; write the `snd_service_requests` row; send the request (proxied per config); wait on the in-memory sink for the first reply until the deadline. -- Reply processing in `processSMPTransmissions`: a message on a receive queue that has a `snd_service_requests` row is a reply. Decrypt (the first message sets `reply_secret` from its header), verify with `verifyAgentResponse`, check the request hash and the previous-message hash, update `last_reply_hash`, deliver to the waiting call or the callback. A message that fails verification is acknowledged and discarded. On `more = False`, or on the deadline, or on `cancelServiceRequest`, delete the reply queue (`DEL`) and the row. -- `cleanupManager` gains one step: delete `snd_service_requests` past the deadline and mark their reply queue connections deleted; the existing deleted-connections step sends `DEL` and removes them. After a restart every row is stale, so this step removes all reply queues left behind. +- `sendServiceRequest`: retrieve link data per request (proxied per config); establish the ratchet and create Q_A (address-DR R2'); write the `snd_service_requests` row; send the `AgentServiceRequest` confirmation (proxied per config); wait on the in-memory sink for the first response until the deadline. +- Response processing in `processSMPTransmissions`: a message on a queue with a `snd_service_requests` row is a response; `agentRatchetDecrypt` (advancing the ratchet), parse `AgentServiceResponse`, deliver to the waiting call or the callback. On `final`/deadline/cancel, delete Q_A and the reply connection. +- `cleanupManager`: delete `snd_service_requests` past the deadline and mark their reply connections deleted; the existing deleted-connections step sends `DEL`. After a restart every row is stale, so this removes reply queues left behind. Service side: -- Address queue message dispatch reads `link_contact_type`: a service address accepts only `AgentRequest` and rejects invitations and confirmations; a non-service address rejects `AgentRequest`. -- On `AgentRequest`: select bundle private keys by `keyId`, decrypt, compute the request hash. Look up `rcv_service_requests` by (address conn, hash): - - new: insert the request, insert a `rcv_service_reply_queues` row for the reply queue in the request, deliver `SREQ` to the bot. - - existing: insert a `rcv_service_reply_queues` row for the reply queue in this request, and send it every `rcv_service_replies` message already stored, in order. -- `sendServiceReply`: append a `rcv_service_replies` message (sign with the address root key), then send it to every reply queue of the request - `SSND` for a queue not yet secured, `SEND` after - encrypting the stored envelope to each queue's `reply_secret`; set `ended` when `more = False`. -- `cleanupManager` gains one step: delete `rcv_service_requests` past `expires_at` (cascading to replies and reply queues) and `service_address_keys` past the key retention period. +- Address-queue dispatch on `link_contact_type`: a service address routes `AgentConfirmation` with `ratchetKeyId` to the RPC handler (address-DR `smpAddressConfirmation` producing `AgentServiceRequest`); it rejects `AgentInvitation` and connection confirmations. +- On `AgentServiceRequest`: establish the ratchet (address-DR O2'), create the `SndConnection` to Q_A, compute the request hash, look up `rcv_service_requests` by (address conn, hash): + - new: insert the request, insert a `rcv_service_reply_conns` row, deliver `SREQ` to the bot. + - existing: insert a `rcv_service_reply_conns` row and send it every stored `rcv_service_responses` in order, each `AgentServiceResponse` re-encrypted under this connection's ratchet. +- `sendServiceReply`: append a `rcv_service_responses` row, then send `AgentServiceResponse` to every reply connection of the request under its ratchet (`SKEY`+`SEND` for the first message to a connection, `SEND` after); set `ended` on `final`. +- `cleanupManager`: delete `rcv_service_requests` past `expires_at` (cascading to responses and reply connections, and their ratchets/queues). + +Configuration (`AgentConfig`): default request deadline, request retention period (1 to 24 hours). Ratchet key rotation interval is the address-DR config. + +Errors reuse `AgentErrorType` (e.g. `CMD PROHIBITED` for a link that is not a service address). -Configuration (`AgentConfig`): default request deadline, request retention period (1 to 24 hours), key rotation interval. +## Idempotency -Errors: API failures reuse `AgentErrorType` (for example `CMD PROHIBITED` for a link that is not a service address). A new constructor is added only if the chat library needs to distinguish service request failures - decided at implementation. +The service identifies a request by its hash and keeps, for the retention period (config, not in link data), the ordered response payloads (`rcv_service_responses`) and the reply connections under that hash (`rcv_service_reply_conns`). A repeat request (same payload, therefore same hash) establishes its own ratchet and reply connection and does not reach the bot: while pending it is added and receives the responses so far and each later one; after completion it receives the whole stored sequence. Responses are stored as plaintext and re-encrypted per reply connection because each request has its own ratchet. This gives single execution over at-least-once delivery, bounded by the retention period. ## Correlation and chat -A reply is connected to its request by the reply queue: one request has one reply queue, and every message in that queue is a reply to that request. The request hash is used only in the reply signature, to bind a reply to the request content. The application ID is content inside `requestPayload`, used only by the application to make two requests equal or different; the agent does not read it. +A response is connected to its request by the reply queue (one request, one reply queue, one ratchet). The request hash is only the idempotency key. The application ID is content inside the request payload, used only by the application to make two requests equal or different; the agent does not read it. -Both ends are chat bots on the chat library. The chat library serializes a service command into `requestPayload` and deserializes the responses; the agent transports them and correlates by reply queue. The chat framework's `chatServiceCalls` correlation by `(AgentConnId, SharedMsgId)` is not used - the agent correlates by reply queue and the call returns the first reply directly. +Both ends are chat bots on the chat library, which serializes a service command into the request payload and deserializes the responses; the agent transports them and correlates by reply queue. The chat framework's `chatServiceCalls` correlation is not used. ## Tests -- Encoding roundtrips: envelopes, `ServiceKeyBundle` in `UserContactData`, `PubHeader` (all three variants), `SSND`, `SignedResponse` with one and several responses. -- Server: `SSND` on messaging and contact queues, repeated `SSND` before and after ACK, a different key, via proxy. -- Agent end-to-end: a request with one reply message; several responses in one message; responses in several messages delivered to the callback; a repeat request while pending coalesces onto the same operation; a repeat request after completion receives the stored messages without a second execution; key rotation with an old key still accepted while kept; a request whose key was deleted fails at the deadline; deadline; cancellation; a restart deletes reply queues; envelope rejection on both address types. +- Encoding roundtrips: `AgentServiceRequest`, `AgentServiceResponse` in `AgentMessage` (one and several response bodies); the service subtype in `UserContactData`/link. +- End to end (on the address-DR machinery): a request with one response; several responses streamed to the callback; `pqEncryption` on (hybrid) and off (X448-only) per the advertised keys; the request payload never travels under per-queue-only encryption. +- Idempotency: a repeat while pending coalesces onto the same operation; a repeat after completion receives the stored responses without a second `SREQ`; both under fresh ratchets. +- Lifecycle: the reply connection and the service ratchet are deleted after `final`; deadline; cancellation; a restart deletes client reply queues. +- Rejection and rejection of the wrong envelope on a service vs non-service address. ## Phases -1. SMP protocol: `SSND`, hybrid public header, version bumps, server dedup hash, server tests. -2. Agent: address type, key bundle in link data, envelopes, reply queue columns, schema migration, `createServiceAddress`, `sendServiceRequest`, reply processing, cleanup. -3. Agent: service-side request store, `sendServiceReply`, coalescing and repeats, key rotation, end-to-end tests. -4. Adoption: `SSND` in the fast connection handshake; the hybrid scheme for invitations and confirmations. +1. Service address subtype and dispatch on top of the address-DR flow; `AgentServiceRequest`/`AgentServiceResponse` messages; `createServiceAddress`. +2. Client: `sendServiceRequest`, reply-queue reception and callback, cleanup. +3. Service: request store, `sendServiceReply`, idempotency (coalescing and repeats under fresh ratchets), end-to-end and idempotency tests. diff --git a/plans/2026-07-12-address-dr-implementation.md b/plans/2026-07-12-address-dr-implementation.md new file mode 100644 index 000000000..dc10412dd --- /dev/null +++ b/plans/2026-07-12-address-dr-implementation.md @@ -0,0 +1,195 @@ +# Establishing the double ratchet from address data - implementation plan + +RFC: [../rfcs/2026-07-12-address-pqdr-keys.md](../rfcs/2026-07-12-address-pqdr-keys.md) + +All references are to the current tree. Names of new constructors, fields, tables and functions are provisional. + +Goal: a contact address advertises the owner's X3DH parameters in link data; a requester establishes the double ratchet in its first message, so that message and the profile in it are under the ratchet with post-quantum protection. The change reuses the invitation/confirmation machinery, with the requester in the joiner role and the owner in the initiator role - opposite to today's contact flow, but every message and code path below is reused. + +## Part 1 - the current contact-address handshake, step by step + +Requester Alice connects to owner Bob's contact address. Q_A is Alice's receive queue (Bob to Alice), Q_B is Bob's receive queue (Alice to Bob). + +Requester side, in `joinConnSrv … CRContactUri` (Agent.hs:1398-1428): + +- R1. `compatibleContactUri` (Agent.hs:1370) - version check, yields the address queue `SMPQueueInfo`. +- R2. `mkJoinInvitation` (Agent.hs:1411): creates or reuses the receive queue Q_A; `getRatchetX3dhKeys` or `generateRcvE2EParams` produces Alice's Rcv X3DH parameters, stored by `createRatchetX3dhKeys` (Agent.hs:1424); builds `cReq = CRInvitationUri crData aliceRcvParams` (Agent.hs:1426). +- R3. `sendInvitation` (Agent.hs:1408; Agent/Client.hs:1924-1934): sends `AgentInvitation {connReq = cReq, connInfo = aliceProfile}` to the address queue, per-queue encrypted with a fresh ephemeral key by `agentCbEncryptOnce` (Agent/Client.hs:1929-1934), unauthenticated. **`connInfo` (Alice's profile) is under the per-queue X25519 layer only - the gap this plan closes.** + +Owner side, receiving on the contact address: + +- O1. `processClientMsg` dispatch (Agent.hs:3185): state `(Nothing, Just e2ePubKey)`, `(PHEmpty, AgentInvitation {connReq, connInfo})` -> `smpInvitation` (Agent.hs:3186). +- O2. `smpInvitation` (Agent.hs:3610): stores an `Invitation`, emits `REQ` with Alice's `connInfo`. +- O3. `acceptContact'` (Agent.hs:1477): `getInvitation`, then `joinConn` with Alice's `connReq` (Agent.hs:1480). +- O4. `joinConnSrv … CRInvitationUri` (Agent.hs:1383) -> `startJoinInvitation` (Agent.hs:1395). +- O5. `startJoinInvitation` (Agent.hs:1310-1350): creates Bob's send queue to Q_A (`newSndQueue`, Agent.hs:1335); `createRatchet_` (Agent.hs:1343-1350) runs `generateSndE2EParams`, `pqX3dhSnd` against Alice's Rcv parameters, `initSndRatchet`, `createSndRatchet`. +- O6. `secureConfirmQueue` (Agent.hs:1396, 3747-3765): `agentSecureSndQueue` secures Q_A with `SKEY` (Agent.hs:3749); `mkAgentConfirmation` (Agent.hs:3780-3785) calls `createReplyQueue` to create Bob's receive queue Q_B and returns `AgentConnInfoReply (Q_B :| []) bobInfo`; `mkConfirmation` ratchet-encrypts it and wraps `AgentConfirmation {e2eEncryption_ = Just bobSndParams, encConnInfo}`; `sendConfirmation` sends it to Q_A. This is confirmation #1. + +Requester side, receiving confirmation #1 on Q_A: + +- R4. dispatch (Agent.hs:3181-3183): state `(Nothing, Just e2ePubKey)`, `AgentConfirmation` -> `smpConfirmation`. +- R5. `smpConfirmation`, initiating-party branch `RcvConnection … Just e2eEncryption` (Agent.hs:3405-3444): `getRatchetX3dhKeys`, `pqX3dhRcv` (Agent.hs:3408), `initRcvRatchet` (Agent.hs:3411), `createRatchet` (Agent.hs:3436), `setRcvQueueConfirmedE2E` (Agent.hs:3440); decrypts `AgentConnInfoReply` (Agent.hs:3420); `processConf` emits `CONF` (Agent.hs:3444). +- R6. `allowConnection'` (Agent.hs:1467-1474): `acceptConfirmation`, then `ICAllowSecure` secures Q_A with Bob's sender key. +- R7. `connectReplyQueues` (Agent.hs:3724-3737): `upgradeConn` creates Alice's send queue to Q_B; `agentSecureSndQueue` secures Q_B; `enqueueConfirmation … Nothing` (Agent.hs:3733) stores `AgentConnInfo aliceInfo` and sends `AgentConfirmation {e2eEncryption_ = Nothing, encConnInfo}` to Q_B. This is confirmation #2. + +Owner side, receiving confirmation #2 on Q_B: + +- O7. dispatch (Agent.hs:3182): `AgentConfirmation` -> `smpConfirmation`. +- O8. `smpConfirmation`, accepting-party branch `DuplexConnection … Nothing` (Agent.hs:3447-3462): `agentRatchetDecrypt` with the established ratchet; `AgentConnInfo` -> `INFO` (Agent.hs:3452); `ICDuplexSecure` or `CON`. + +`HELLO`/`CON` completion follows via `helloMsg` (Agent.hs:3466). + +## Part 2 - the DR-from-address handshake, mapped to Part 1 + +The address advertises Bob's Rcv X3DH parameters in link data (Part 3). Alice, when the address advertises them and versions are compatible, takes the joiner role; Bob takes the initiator role. + +Requester side - a new branch in `joinConnSrv … CRContactUri`, chosen when the fetched link data has `ratchetKeys`: + +- R2'. Replaces R2/R3. Read the advertised `linkRatchetKey`, `ratchetKeyId`, `e2eVRange`, `prekey`, and optional `kemKey` from link data; reconstruct Bob's `RcvE2ERatchetParamsUri 'C.X448` and negotiate the concrete version with `compatibleVersion` against the client e2e range, as `compatibleInvitationUri` does (Agent.hs:1362-1368). Create the receive queue Q_A subscribed (`newRcvQueue` with `subMode`), messaging mode so Bob can secure it. Run `generateSndE2EParams` (with `replyKEM_` to accept the KEM only when advertised), `pqX3dhSnd` against the negotiated parameters, `initSndRatchet`, `createSndRatchet` - the body of `createRatchet_` (Agent.hs:1343-1350), with parameters from link data rather than a received invitation. +- R3'. Build `AgentConfirmation {e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just ratchetKeyId, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_A :| []) aliceProfile)}` - the `mkAgentConfirmation`/`mkConfirmation` bodies (Agent.hs:3780-3765) with the reply queue being Alice's own Q_A. Send it to the address queue unauthenticated with `agentCbEncryptOnce`, as `sendInvitation` sends (Agent/Client.hs:1929-1934). **Alice's profile is now inside `encConnInfo`, under the ratchet.** Alice's connection is `RcvConnection` (Q_A) with a send ratchet, until she receives Q_B. + +Owner side - a new dispatch branch and a new receive handler: + +- O1'. In `processClientMsg` (Agent.hs:3176-3187), add a branch in state `(Nothing, Just e2ePubKey)`: an `AgentConfirmation` with `ratchetKeyId = Just _` on a `ContactConnection` -> `smpAddressConfirmation` (new). It must be placed **before** the existing `(PHEmpty, AgentConfirmation) | senderCanSecure queueMode` case (Agent.hs:3182-3184), because a contact-address queue is `QMContact` (not `senderCanSecure`) and would otherwise fall into `prohibited "handshake: missing sender key"` (Agent.hs:3184). The address queue's `e2eDhSecret` stays `Nothing` (it is never set for a contact address - `smpInvitation` does not set it, Agent.hs:3609-3622), so every request is decrypted with its own ephemeral key via this `(Nothing, Just e2ePubKey)` path. +- O2'. `smpAddressConfirmation` (new, modeled on `smpConfirmation` initiating branch, Agent.hs:3405-3444): select the private prekey and, if any, KEM keypair by `ratchetKeyId` from `address_ratchet_keys`; `pqX3dhRcv` with the `linkRatchetKey` private key, the selected prekey private key, and the optional KEM keypair (as `PrivateRKParamsProposed`) against `aliceSndParams`; `initRcvRatchet` (its `PQSupport` follows from whether the address advertises a KEM and version compatibility, as `smpConfirmation` derives `pqSupport'`, Agent.hs:3410); `rcDecrypt` of `encConnInfo` performs the first ratchet step, giving the connection its send side too (as it does for the initiator today), so the owner can later reply; `createRatchet` stores the post-decrypt ratchet under a **new connection created now** for this request. Parse `AgentConnInfoReply (Q_A :| []) aliceProfile`, store a pending-request record referencing the new connection, its ratchet, and Q_A (not a `connReq`), and emit `REQ`. An unknown or expired `ratchetKeyId`, or a decryption failure: discard and acknowledge, as an undecryptable message is dropped today. This establishes ratchet state on unauthenticated input before the user accepts - see "Receive-time establishment, state, and abuse". +- O3'. `acceptContact'` for a DR-established request - a new branch that continues the ratchet instead of `joinConn`: reuse `mkAgentConfirmation` (Agent.hs:3780-3785) to create Bob's receive queue Q_B and return `AgentConnInfoReply (Q_B :| []) bobInfo`; create Bob's send queue to Q_A (`newSndQueue`, generating Bob's own sender key) and secure Q_A with `SKEY` using that key (`agentSecureSndQueue`, valid because Q_A is messaging mode) - the securing key is Bob's own, not taken from Alice's message; send the response to Q_A as `AgentConfirmation {e2eEncryption_ = Nothing, ratchetKeyId = Nothing, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_B :| []) bobInfo)}`, per-queue encrypted with `agentCbEncryptOnce` (first message to Q_A). The reply content is `AgentConnInfoReply`, not `AgentConnInfo`: it takes the `mkAgentConfirmation` path with `e2eEncryption_ = Nothing`, not the `enqueueConfirmation` path (which produces `AgentConnInfo`, Agent.hs:3789). + +Requester side, receiving the response on Q_A: + +- R5'. `smpConfirmation` needs a new branch `RcvConnection … Nothing` (today only `RcvConnection … Just` and `DuplexConnection … Nothing` exist, Agent.hs:3403-3447): Alice already holds the send ratchet, so `agentRatchetDecrypt` advances it and creates the receive side; `setRcvQueueConfirmedE2E` on Q_A so later messages use the stored per-queue secret (as the current branches do, Agent.hs:3440,3455); parse `AgentConnInfoReply (Q_B :| []) bobInfo`; connect Q_B (create Alice's send queue to Q_B, `agentSecureSndQueue` it, upgrade `RcvConnection` to `DuplexConnection`); emit `INFO`. The accepting-party branch (Agent.hs:3447) must also accept `AgentConnInfoReply`, not only `AgentConnInfo` (Agent.hs:3451, 3462), for the reply-queue case. +- R6'/completion. The response went to Q_A, so Bob has no signal that Alice secured Q_B and would never reach `CON` on its own. The essential extra message is Alice -> Q_B: after R5' Alice sends `HELLO` on Q_B, and `helloMsg` (Agent.hs:3466) sets Q_B active on Bob's side and emits Bob's `CON`. Alice reaches `CON` from the response (Q_A active, Q_B secured). Whether Bob also needs to send `HELLO` on Q_A for Alice's `CON`, or the response suffices, follows the existing `helloMsg`/fast-path completion and is confirmed at implementation - the fixed point is that Alice must send on Q_B. + +Net code touch points: `joinConnSrv` (new requester branch), `processClientMsg` (new owner dispatch), `smpConfirmation` (new `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance), `acceptContact'` (new continue-ratchet branch), a new `smpAddressConfirmation`, and the link data and storage of Part 3-4. + +### Receive-time establishment, state, and abuse + +This is the substantive departure from the current flow. Today `smpInvitation` creates only a lightweight `NewInvitation` and emits `REQ` (Agent.hs:3618-3621); no connection or ratchet exists until the user accepts. For DR the request is under the ratchet, so to show the requester's profile in `REQ` the owner must decrypt it, which means establishing the ratchet at **receive**, before accept. + +Design decision (Q1): decrypt at receive. Both use cases need the request content at `REQ` - a person decides to accept from the profile, and a service bot needs the request payload to act. Deferring decryption to accept would make `REQ` contentless and does not fit the service case, so it is not done. + +Consequences: + +- A connection is created at receive to hold the ratchet (ratchets are keyed by `conn_id`). O2' creates a `NewConnection`, stores the post-decrypt ratchet under it, and a pending-request record with Q_A's address; O3' (accept) adds Bob's send queue to Q_A and receive queue Q_B, upgrading to `DuplexConnection`; reject deletes the connection, its ratchet, and the record. +- Per incoming `AgentConfirmation` the owner does one `pqX3dhRcv` (three DH plus, with PQ, one `sntrup761` decapsulation) and one `rcDecrypt`, on unauthenticated input, and creates a connection row and a ratchet row - more CPU and state than the current `NewInvitation`. + +Abuse (Q2): a contact address already accepts and processes unauthenticated invitations today, so this is a degree-worse version of an existing surface, not a new class. It is bounded by the address queue quota (an attacker fills it, the owner drains and acknowledges) and, optionally, by basic auth on the address (already supported for contact addresses, `optBasicAuth`). The pending-request state is bounded by a request TTL: `cleanupManager` deletes pending DR connections never accepted or rejected past that TTL (Part 4 cleanup). Proof-of-work or a stricter gate can be added later; it is out of scope here and noted as a follow-up. + +The `acceptContact'` dispatch branches on the pending record: a classic invitation (`connReq` present) takes the current `joinConn` path (O3-O6); a DR request (pending connection and ratchet present, no `connReq`) takes the continue-ratchet path (O3'). + +## Part 3 - types and link data + +### Fixed data - link ratchet key + +Appended to `FixedLinkData` (Protocol.hs:1824); the encoding already stops at a trailing tail (Protocol.hs:1928), so earlier versions ignore it: + +```haskell +data FixedLinkData c = FixedLinkData + { agentVRange :: VersionRangeSMPA, + rootKey :: C.PublicKeyEd25519, + linkConnReq :: ConnectionRequestUri c, + linkEntityId :: Maybe ByteString, + linkRatchetKey :: Maybe C.PublicKeyX448 -- stable X448 key, the first X3DH key + } +``` + +### Mutable data - ratchet keys bundle + +Appended to `UserContactData` (Protocol.hs:1840); the encoding stops at a trailing tail (Protocol.hs:1981), so earlier versions ignore it: + +```haskell +data RatchetKeys = RatchetKeys + { ratchetKeyId :: ByteString, -- identifies this bundle; changes on rotation + e2eVRange :: VersionRangeE2E, -- advertised e2e version range, for negotiation + prekey :: C.PublicKeyX448, + kemKey :: Maybe KEMPublicKey -- opt-in, as PQ is opt-in in the ratchet (PQSupport) + } + +data UserContactData = UserContactData + { direct :: Bool, owners :: [OwnerAuth], relays :: [ConnShortLink 'CMContact], + userData :: UserLinkData, + ratchetKeys :: Maybe RatchetKeys + } +``` + +Reconstruction produces `RcvE2ERatchetParamsUri 'C.X448` (a version range, `E2ERatchetParamsUri VersionRangeE2E k1 k2 (Maybe kem)`), not concrete params: `e2eVRange` as the range, `linkRatchetKey` (from fixed data) as the first key, `prekey` as the second, `kemKey` as the optional KEM parameter. The requester negotiates the concrete version with `compatibleVersion` against its own e2e range, exactly as `compatibleInvitationUri` does for an invitation (Agent.hs:1362-1368), then uses the resulting `RcvE2ERatchetParams` in `pqX3dhSnd`. The KEM is optional: with `kemKey = Nothing` the ratchet is X448-only, as when `PQSupport` is off; with `Just` it is hybrid, matching `E2ERatchetParams … (Maybe (RKEMParams s))` (Ratchet.hs:220-221) and `generateRcvE2EParams`'s `PQSupport` gate (Ratchet.hs:439-445). + +The owner does not use `generateRcvE2EParams` (which generates both keys together, Ratchet.hs:439): `linkRatchetKey` (k1) is generated once at address creation, the prekey (k2) and KEM per rotation. To advertise it derives the public keys with `mkRcvE2ERatchetParams` (Ratchet.hs:412), whose argument is `(PrivateKey a, PrivateKey a, Maybe RcvPrivRKEMParams)`, from the stored link ratchet private key, the current prekey private key, and the current KEM keypair; the published `e2eVRange` is stored alongside, so the version in `mkRcvE2ERatchetParams` is only a carrier for the public keys. `ratchetKeys` and `linkRatchetKey` are set by the agent when it signs link data (`Crypto.ShortLink.encodeSignFixedData`/`encodeSignUserData`), not by the application. + +### Authentication of the advertised keys + +No signature is added on the keys: the link data already signs them. `decryptLinkData` (Crypto/ShortLink.hs:106-114) verifies `sig1` over fixed data and `sig2` over the mutable `UserContactData`, both by `rootKey`, and checks `linkKey = sha3_256(fixedData)`. So `linkRatchetKey` is hash-committed and root-signed, and `ratchetKeys` (prekey, KEM, `e2eVRange`) is root-signed as part of `UserContactData`. This is the X3DH anti-substitution property: an SMP server cannot substitute the prekey or KEM without forging the root signature or breaking the link hash. The signer is the root Ed25519 key, not `linkRatchetKey` (X448, which cannot sign) - the DH identity and the signing identity are separate keys, both anchored to the link hash. A malicious server can still serve an older but validly-signed mutable data (rollback to a retired prekey); this is bounded by the prekey retention window and by the ratchet advancing after the first message, and a signature does not prevent it. Inline ratchet params in a `CRInvitationUri` contact request are not in signed link data and remain unsigned - a separate change, out of scope here. + +### Request envelope + +`AgentConfirmation` (Protocol.hs:830-834) gains an optional `ratchetKeyId` - the `ratchetKeyId` of the `RatchetKeys` bundle the requester used, so the owner selects the matching private keys: + +```haskell +AgentConfirmation + { agentVersion :: VersionSMPA, + e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), + ratchetKeyId :: Maybe ByteString, + encConnInfo :: ByteString + } +``` + +Encoding (extends Protocol.hs:853-866): from `addressDRVersion`, `smpEncode (agentVersion, 'C', e2eEncryption_, ratchetKeyId, Tail encConnInfo)`, where `ratchetKeyId` is `Just` for an address-DR confirmation and `Nothing` for the current joiner-to-initiator and initiator-to-joiner confirmations; earlier versions omit the field entirely and use `smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo)`. Parsing gates the field on `agentVersion`. `CRInvitationUri` is unchanged - a connection request URI holds Rcv parameters and must not hold Snd parameters. + +## Part 4 - key rotation (separate concern) + +Rotation is required but independent of the handshake above. The link ratchet key is stable; the prekey and KEM pair rotate on a schedule. + +### Schema + +```sql +-- private stable link ratchet key on the contact address receive queue +ALTER TABLE rcv_queues ADD COLUMN link_ratchet_priv_key BLOB; -- X448 + +-- one row per ratchet-keys generation for an address; current plus retired-within-window +CREATE TABLE address_ratchet_keys( + address_ratchet_key_id INTEGER PRIMARY KEY AUTOINCREMENT, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + ratchet_key_id BLOB NOT NULL, -- the published id echoed by requests + prekey_priv_key BLOB NOT NULL, -- X448 private key (public derivable with publicKey) + kem_keypair BLOB, -- sntrup761 keypair (public + secret): the ratchet keeps the KEM keypair, and the retired public is not otherwise retained after LSET; NULL when PQ is off for this address + created_at TEXT NOT NULL, + retired_at TEXT -- set on rotation +); +CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); +``` + +PostgreSQL mirrors this. Migration `M20260712_address_dr`. + +### Rotation logic + +`rotateRatchetKeys` (new), scheduled while the address is subscribed: + +1. Generate an X448 prekey pair, and an sntrup761 pair only if PQ is on for this address, with a fresh `ratchetKeyId`. +2. Recompute mutable link data with the new `RatchetKeys`, re-sign with the root key (`encodeSignUserData`), and `LSET` it to the address queue (`addSMPQueueLink`/`setConnShortLink` path). +3. Insert the new `address_ratchet_keys` row; set `retired_at` on the previous row. + +Retention window equals queue message retention (`storedMsgDataTTL`, Env/SQLite.hs:237), covering a request that used a just-retired prekey and is still in the address queue. Cadence is configuration; it bounds how long a recorded first message stays decryptable after a compromise of the current prekey - the link ratchet key alone decrypts nothing. + +### Cleanup + +`cleanupManager` (Agent.hs:2994) gains two steps: delete `address_ratchet_keys` rows with `retired_at` older than the window; and delete pending DR request connections (below) never accepted or rejected, past a request TTL. Both are batched like `deleteRcvMsgHashesExpired` (Agent.hs:3001). + +## Part 5 - backward compatibility + +- A requester older than `addressDRVersion`, or an address without `ratchetKeys`, uses R2/R3 (`AgentInvitation`); the owner uses O1-O8. Unchanged. +- The owner dispatches on the envelope: `AgentInvitation` -> `smpInvitation` (current); `AgentConfirmation` with `ratchetKeyId` on a `ContactConnection` -> `smpAddressConfirmation` (new). Both coexist. +- `AgentConfirmation` without `ratchetKeyId` remains the current confirmation on established connections. + +## Part 6 - tests + +- Encoding roundtrips: `FixedLinkData` with and without `linkRatchetKey`; `UserContactData` with and without `ratchetKeys`, and with `kemKey` present and absent; `AgentConfirmation` with and without `ratchetKeyId`, across versions. +- Address creation advertises `linkRatchetKey`, `prekey`, and optionally `kemKey`; `decryptLinkData` (Crypto/ShortLink.hs:100) verifies hash and signatures and reconstructs the advertised `RcvE2ERatchetParamsUri` (then negotiates to concrete) with and without the KEM. +- Both PQ modes: an address with `kemKey` gives a hybrid ratchet (`pqEncryption` on); an address without gives an X448-only ratchet. +- End to end: a DR-advertising address; a new requester establishes the ratchet, sends its profile under it, owner emits `REQ`, accepts, both reach `CON`; assert the profile never travels under per-queue-only encryption; assert `pqEncryption` on. +- Rotation: request against the current prekey; request against a just-retired prekey within the window still decrypts; request against a prekey past the window is discarded and the requester times out. +- Backward compatibility: old requester against a DR address connects via `AgentInvitation`; new requester against a non-DR address falls back to `AgentInvitation`. + +## Part 7 - phases + +1. Link data: `linkRatchetKey`, `RatchetKeys` (with optional `kemKey`), encodings, reconstruction, `encodeSignFixedData`/`encodeSignUserData`; address creation generating and storing the link ratchet private key and the first prekey row. +2. Handshake: requester R2'/R3', `AgentConfirmation.ratchetKeyId`, owner O1'/O2'/O3', `smpConfirmation` `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance; end-to-end connection with the profile under the ratchet. +3. Rotation: schema migration, `rotateRatchetKeys`, retention window, cleanup step, rotation tests. diff --git a/rfcs/2026-07-11-service-rpc.md b/rfcs/2026-07-11-service-rpc.md index 074658e4f..2fc18520c 100644 --- a/rfcs/2026-07-11-service-rpc.md +++ b/rfcs/2026-07-11-service-rpc.md @@ -1,6 +1,12 @@ +--- +Proposed: 2026-07-11 +Protocol: agent-protocol (new version) +Depends on: 2026-07-12-address-pqdr-keys +--- + # One-off requests to service addresses -Implementation plan: [../plans/2026-07-11-service-rpc-implementation.md](../plans/2026-07-11-service-rpc-implementation.md) +Implementation plan: to follow, after this and the address-DR RFC are reviewed. ## Problem @@ -12,163 +18,93 @@ This is the wrong primitive for most service interactions: 2. Privacy. A connection is a stable pairwise pseudonym. If a service were to use a duplex connection, it could link all requests made over it into a profile: search history in the directory, blockchain operations linked even when different on-chain keys are used, telemetry that becomes longitudinal tracking. The client also accumulates history that can be recovered from the device. Where continuity is needed, it can be provided in the application protocol (e.g., a token included in requests), without a transport-level identity. -3. Encryption. Messages sent to contact addresses outside an established connection (invitations) have a single layer of X25519 encryption. This was acceptable while such messages contained only a connection link and profile (though it is planned to be improved); it is probably less acceptable for service requests. +3. Encryption. Messages sent to contact addresses outside an established connection have a single layer of X25519 encryption, with no post-quantum protection and no forward secrecy. This is not acceptable for service requests. -In-app service addresses should be stored as names resolving to links via the existing addressing layer (server host in the link authority, current link data retrieved with LGET), so that service links can be changed without redeploying the apps. Name resolution is already supported, and out of scope. +In-app service addresses should be stored as names resolving to links via the existing addressing layer (server host in the link authority, current link data retrieved with `LGET`), so that service links can be changed without redeploying the apps. Name resolution is already supported, and out of scope. ## Security objectives 1. Requests from the same client must not be linkable to each other by the service or by servers, and no long term state is created on either side in the transport layer. -2. Post-quantum resistant e2e encryption of requests and replies; decryptability of recorded requests must be bounded by key rotation, without changing the address. +2. Post-quantum resistant end-to-end encryption of requests and replies. 3. Reply authenticity must be verifiable against the link; substitution, replay, dropping or reordering of replies by servers must be detectable. 4. A repeated request for the same operation must not be executed twice. ## Solution -A service address is a contact address subtype. Both the client and the service are chat bots using the chat library over the agent. The chat library serializes a request into opaque bytes and calls the agent; the agent transports it and returns replies; the chat library deserializes them. The correlation of a reply with its request is the reply queue: each request has its own reply queue, and every message in that queue is a reply to that request. +A service address is an ordinary short-link contact address. The client sends one request to the address queue and receives replies in a reply queue it creates for the request. The double ratchet is established from the address's published keys (see the address-DR RFC): the request is the first ratchet message, and replies are subsequent ratchet messages. So a request-response exchange is a short-lived one-directional double ratchet connection, established from the first message and removed after the last. The exchange: -1. Resolve the service name to a short link and retrieve link data (`LGET`, via proxy when IP protection is needed). Link data holds the root key for verifying replies and the service key bundle for encrypting the request. -2. Create a reply queue (`NEW`, messaging mode, subscribed at creation). The reply queue is a receive queue with an added KEM key; the service encrypts replies to the reply queue keys. -3. Send the request to the service address queue once (unauthenticated `SEND`, via proxy when IP protection is needed). The request includes the reply queue address and its KEM key, and the application payload. It is encrypted to the service key bundle with hybrid X25519 + KEM encryption at the queue layer. There is no transport retry; a reply is the success signal, and a hard error fails the call. -4. The service decrypts the request, delivers the payload to the service application, secures the reply queue, and sends replies. Each reply message includes the request hash, the previous message hash, a flag whether more messages follow, and a non-empty list of application responses; it is signed with the root key. -5. The client verifies each reply message and delivers its responses to the application. The first reply message returns from the call; later reply messages are delivered through a callback the application registered. The client deletes the reply queue on the final message, on the request deadline, or when the application cancels the request. +1. Retrieve the address link data (`LGET`, via proxy when IP protection is needed): the root key, the identity key, the prekey with its id, and the KEM key. +2. Create a reply queue (`NEW`, subscribed). +3. Establish the sending ratchet from the published keys (`pqX3dhSnd`, `initSndRatchet`). Build the request: the reply queue, the requester's X3DH parameters, and the payload encrypted under the ratchet. Encrypt the whole request to the address queue and send it once (unauthenticated `SEND`, via proxy when IP protection is needed). There is no transport retry; a reply is the success signal, and a hard error fails the request. +4. The service establishes the receiving ratchet from its private keys and the request's X3DH parameters (`pqX3dhRcv`, `initRcvRatchet`), decrypts the payload, and delivers it to the service application. To reply it creates a send connection with the ratchet and sends reply messages to the reply queue, each encrypted under the ratchet. +5. The client decrypts and delivers each reply message to the application. The first reply message returns from the request; later reply messages are delivered through a callback the application registered. The exchange ends on a reply marked final. The client deletes the reply queue and the ratchet on the final message, the deadline, or when the application cancels. How this meets the objectives: -1. Unlinkability: fresh keys and a fresh reply queue per request; the sender's IP address and session are protected by existing private routing; the reply queue is deleted after the exchange; nothing is shared between two requests. -2. Encryption: hybrid X25519 + sntrup761 secret at the queue layer for the request and all replies. Request keys are published in mutable link data and rotated with `LSET`; the double ratchet is not used, because it would create per-request state before the service decides to reply and its properties serve long-lived sessions. -3. Authenticity: every reply message is signed with the root key committed in the immutable link data, over the request hash and the message; the previous-message hash in each message detects dropped and reordered messages. -4. Single execution: the service identifies a request by the hash of its payload and, within a fixed retention period, repeats the stored replies for a repeated request without running the operation again. +1. Unlinkability: fresh X3DH keys and a fresh reply queue per request; the sender's IP address and session are protected by existing private routing; the reply queue and both ratchets are removed after the exchange; nothing is shared between two requests. +2. Encryption: the double ratchet with its sntrup761 KEM, from the first message. +3. Authenticity: the ratchet is established against the identity key committed by the link hash, so a decryptable reply proves it came from the address owner; the ratchet message numbering detects dropped and reordered replies. No separate signature is needed. +4. Single execution: the service identifies a request by the hash of its decrypted payload and, within a fixed retention period, re-sends the stored replies for a repeated request without running the operation again. ## Design -Syntax below uses [ABNF][1] with [case-sensitive strings extension][2]. `shortString`, `largeString` and `x509encoded` are defined in the [SMP protocol](../protocol/simplex-messaging.md); `smpServer` and `agentVersion` - in the [agent protocol](../protocol/agent-protocol.md). All hashes below are SHA3-256. - -### Service address - -A new contact address type - char `s` in short links, next to existing `a`/`c`/`g`/`r`: +Syntax uses [ABNF][1] with [case-sensitive strings extension][2]. `SMPQueueInfo`, `agentVersion`, and the X3DH and ratchet types are as in the [agent protocol](../protocol/agent-protocol.md) and `Crypto.Ratchet`. -```abnf -contactType =/ %s"s" ; service address -``` +### Correlation and chat -Link data has the same structure as contact addresses: immutable fixed data (root key, connection request data with the queue address) committed by the link hash, and mutable user data signed by the root key. Fixed data and contact user data encodings ignore trailing bytes, so the field below is added without a new link format. +A reply is connected to its request by the reply queue: each request has its own reply queue, and every message in that queue is a reply to that request. The request hash (of the decrypted payload) is used only for idempotency. The application sets an id inside the payload to make two requests the same operation or different ones; the agent does not read it. -Agents dispatch on the address type and the envelope type: a normal address rejects requests, a service address rejects invitations and confirmations. - -### Service key bundle - -Mutable user data of a service address includes a key bundle, appended to the existing contact user data encoding: - -```abnf -userContactData = direct ownersList relaysList userLinkData [serviceKeys] -serviceKeys = %s"0" / (%s"1" serviceKeyBundle) ; absent in data from earlier versions -serviceKeyBundle = keyId reqDhKey reqKemKey -keyId = shortString ; identifies the bundle, included in requests -reqDhKey = length x509encoded ; X25519, used instead of the fixed-data queue key -reqKemKey = largeString ; sntrup761 encapsulation key, 1158 bytes -``` - -The service rotates the bundle with `LSET` and keeps the previous private keys long enough to decrypt requests already in the address queue - the queue message retention. The client retrieves link data for every request, so the published keys are current when the request is sent; a request becomes undecryptable only if it stays in the address queue longer than its key is kept, and such a request is not answered and fails at the client's deadline. Deleting old keys bounds the time recorded requests can be decrypted, so the retention is short and fixed. Nothing about retries or retention is published in link data. - -Link data is encrypted with a symmetric key derived from the link, which is not weakened by quantum computers, so publishing the bundle in link data does not weaken the scheme. - -Sizes: the KEM public key is 1158 bytes and user data is padded to 13784 bytes, so the bundle fits together with application data. - -### Queue-layer PQ encryption - -The single-shot queue encryption (today: crypto_box with a secret from the queue DH key and a sender ephemeral key, the ephemeral key in the message public header) is extended to a hybrid scheme in a new SMP client version. The public header gains a third variant: - -```abnf -smpPubHeaderHybrid = smpClientVersion %s"2" optKeyId senderPublicDhKey kemCiphertext -optKeyId = %s"0" / (%s"1" keyId) ; present in requests to select the bundle, absent in replies -senderPublicDhKey = length x509encoded ; sender ephemeral X25519 key -kemCiphertext = largeString ; sntrup761 ciphertext, 1039 bytes -``` - -The secret combines both shared secrets, and the body is encrypted with NaCl secret_box, padded as today: - -``` -secret = HKDF(dh(recipient key, sender ephemeral key) || KEM shared secret) -``` - -The header is readable by the destination server, as invitation headers are today; with proxied sending it is not readable by the proxy. - -For a request, the recipient keys are the service bundle keys selected by `keyId`. For a reply, the recipient keys are the reply queue keys included in the request. The first reply message includes the hybrid header; the client computes the secret once and stores it in the reply queue record, and later reply messages use it with the plain header. This is the one-secret-per-queue model of existing queues, and the secret is stored the same way the per-queue DH secret is stored on receiving the first message. Invitations and confirmations can adopt the same scheme independently of this design. +Both ends are chat bots on the chat library over the agent. The chat library serializes a service command into the request payload and deserializes the responses; the agent transports them, establishes and removes the ratchet, and correlates by reply queue. ### Request -A new agent envelope (alongside `agentConfirmation`, `agentMsgEnvelope`, `agentInvitation`, `agentRatchetKey`): +A new agent envelope, shaped like `AgentConfirmation` (X3DH parameters to establish the ratchet, plus a body encrypted under it): ```abnf -agentRequest = agentVersion %s"Q" replyQueue requestPayload -replyQueue = smpClientVersion smpServer senderId dhPublicKey kemPublicKey -smpClientVersion = 2*2 OCTET -senderId = shortString ; sender ID of the reply queue -dhPublicKey = length x509encoded ; reply queue X25519 key -kemPublicKey = largeString ; reply queue sntrup761 encapsulation key -requestPayload = *OCTET ; remaining bytes, opaque application payload +agentRequest = agentVersion %s"Q" replyQueues prekeyId sndE2EParams encRequest +replyQueues = length 1*SMPQueueInfo ; the first is used; more are for redundancy +prekeyId = shortString ; the published prekey used, from link data +sndE2EParams = +encRequest = ``` -The envelope type indicates to the receiving agent that no connection is created and replies are sent to the reply queue. The request does not include a key to secure the reply queue: the service generates its own sender key and secures the queue with it, as a sender does in the fast handshake. The reply queue address and keys are not part of the hashed payload. - -The request hash is the SHA3-256 of `requestPayload` - the same bytes the client sends and the service reads after the server encryption layer is removed. The application sets a request ID inside the payload; two requests are the same operation when their payloads, and therefore their hashes, are equal. A request must fit in one message; a larger payload is sent as an XFTP file description in the payload. +The whole `agentRequest` is encrypted to the address queue with the per-queue layer and sent with `SEND`, as an invitation is today. The reply queue keys and the X3DH parameters are not visible to servers. A request must fit one message; a larger payload is an XFTP file description in the payload. -Request delivery follows existing SEND semantics: a hard error (AUTH, QUOTA) fails the call, and the application decides whether to send a new request. +The request hash is the SHA3-256 of the decrypted payload - the same bytes on both sides. There is no transport retry; a hard error (`AUTH`, `QUOTA`) fails the request, and the application decides whether to send a new one. ### Replies -The service secures the reply queue and sends the first reply message with one combined SMP command (see below). A reply message uses a new agent envelope, following the signature-first structure of link data: +The service creates a send connection with the ratchet and sends reply messages to the reply queue, each encrypted under the ratchet. A reply message uses a new agent envelope: ```abnf -agentResponse = agentVersion %s"P" signature signedResponse -signature = length 64*64 OCTET ; root key signature of signedResponse -signedResponse = requestHash prevMsgHash more responses -requestHash = shortString ; hash of the request payload -prevMsgHash = shortString ; hash of the previous agentResponse message, empty in the first -more = %s"T" / %s"F" ; T - more reply messages follow +agentResponse = agentVersion %s"P" final responses +final = %s"T" / %s"F" ; T - no more reply messages follow responses = length 1*responseItem ; non-empty list of application responses responseItem = largeString ; opaque application response ``` -A reply message includes a list of responses, so responses known together are sent in one message rather than several; responses that become known over time are sent in separate messages. The signature covers the whole message. - -The client verifies each reply message: the signature against the root key from link data, the request hash against the sent request, the previous-message hash against the previous message. A message that fails verification is acknowledged and discarded. Forging a reply message requires the root key even if the reply queue keys are known; a signed message cannot be reused for a different request; the previous-message hash detects messages dropped or reordered by the reply queue server. - -The first reply message returns from the request call. Later reply messages are delivered through the callback the application registered with the request. The exchange ends on a message with `more` set to false. The client deletes the reply queue on that message, on the request deadline, or when the application cancels the request. Deleting the queue stops further replies: later SEND commands from the service fail with AUTH. Server queue and message expiry limit the lifetime of a reply queue left after a client restart. - -### Combined SKEY+SEND command - -A new SMP command combining `SKEY` and `SEND` in one transmission: - -```abnf -secureSend = %s"SSND " senderAuthPublicKey SP msgFlags SP smpEncMessage -senderAuthPublicKey = length x509encoded -``` - -The command is authorized with the key it sets, as `SKEY`, and only accepted on messaging-mode queues. The server responds `OK` or `ERR`. It is idempotent in both parts: +Each message includes a list of responses, so responses known together are sent in one message and responses that become known over time are sent in separate messages. The message is encrypted and numbered by the ratchet, which authenticates it against the committed identity key and detects dropped or reordered messages; no separate signature is used. -- key part: as `SKEY` today - a repeated command with the same key succeeds, a different key fails with AUTH. -- send part: the server keeps the hash of the message until it is acknowledged, and a repeated command with the same message within that period is reported as delivered without delivering it again. +The first reply message returns from the request. Later reply messages are delivered through the callback the application registered with the request, while the process runs. The exchange ends on a message with `final = T`. The client deletes the reply queue and the ratchet on that message, on the deadline, or when the application cancels. Deleting the reply queue stops further replies. The transport keeps no exchange across a client restart; the application keeps its own state and sends a new request when it needs to. -A repeat arriving after the message was acknowledged is delivered as a duplicate and discarded by the receiving agent by message hash, so the server-side hash covers the common case and the agent covers the rest. +### Rejection -The service uses this command for the first reply message. The joining party uses it in the fast connection handshake, where it replaces `SKEY` followed by the `SEND` confirmation, removing one command and one round trip. +The service refuses a request with the `AgentRejection` envelope from the [communicating rejection RFC](../../simplex-chat/docs/rfcs/2024-03-22-communicating-reject.md), sent to the reply queue under the ratchet, with an opaque application reason. The same envelope communicates refusal of a connection request, where today it is dropped silently. A rejection ends the exchange like a final reply. ### Idempotency -The service agent identifies a request by its hash and keeps, for a fixed retention period it chooses (in the 1 to 24 hour range, in service configuration, not in link data), a record of the ordered reply messages it has sent and the reply queues subscribed under that hash. A repeat request with the same hash does not reach the service application: +The service keeps, for a fixed retention period it chooses (1 to 24 hours, in service configuration, not in link data), the request hash, the ordered response messages it produced, and the reply queues and ratchets subscribed under that hash. A repeat request with the same hash does not reach the service application: -- while the first request is being answered, the repeat is added to the record and receives the reply messages already sent, and each later message is sent to every reply queue in the record. -- after the operation completed, the repeat receives the whole stored sequence of reply messages, in order. +- while the first request is being answered, the repeat establishes its own ratchet and reply queue, is added to the record, receives the responses already produced, and receives each later response too. +- after the operation completed, the repeat receives the whole stored sequence of responses, re-encrypted under its own ratchet. -This gives single execution over at-least-once delivery. The retention period bounds it: after the record is deleted, a request with the same hash is a new operation and runs again. The application does not rely on the transport for recovery across a restart; it keeps its own state and, after a restart, sends whatever request fits what it knows, which is often a different request (for example, "is this payment still pending" rather than a repeat of "start this payment"). +The stored responses are the application response bytes, not the ratchet ciphertext, because a repeat establishes a new ratchet and the responses are re-encrypted for it. This gives single execution over at-least-once delivery. After the retention period a request with the same hash is a new operation and runs again. ### Out of scope -- Recovery across restart: the transport keeps no exchange across a client restart. The application persists its own state and sends a new request when it needs to. +- Recovery across restart: the transport keeps no exchange across a client restart; the application persists its own state and sends a new request when it needs to. - Service-initiated messages: there is no standing channel; use a connection where the service must reach the client without a request. - Abuse protection beyond existing queue quotas: services can require application-level credentials (e.g., a badge) in the request payload; rate limiting is a separate discussion. - Scaling request reception: a single address queue bounds service throughput; distributing reception across multiple queues or relays (the existing `relays` field in contact link data) is a separate question, but it would fit well with name resolving to multiple addresses, both for redundancy, reliability and higher throughput. diff --git a/rfcs/2026-07-12-address-pqdr-keys.md b/rfcs/2026-07-12-address-pqdr-keys.md new file mode 100644 index 000000000..51e080f52 --- /dev/null +++ b/rfcs/2026-07-12-address-pqdr-keys.md @@ -0,0 +1,95 @@ +--- +Proposed: 2026-07-12 +Protocol: agent-protocol (new version) +--- + +# Establishing the double ratchet from address data + +## Problem + +A contact address receives a connection request as an `AgentInvitation` message, encrypted only with the per-queue X25519 layer. The double ratchet is established later: the address owner joins the requester's connection request, generates its X3DH keys, and sends them in the confirmation. So the first message to an address - the invitation and the profile in it - is not under the double ratchet, and has no post-quantum protection. + +The cause is that the address owner's X3DH contribution is generated per request and sent in the confirmation, so it cannot exist before the requester's first message. + +## Solution + +Publish the address owner's X3DH contribution in the address link data, so a requester can establish the double ratchet in its first message. The requester runs the existing `pqX3dhSnd` against the published keys, initializes a sending ratchet, and encrypts its first message under it. The owner runs the existing `pqX3dhRcv` against its stored private keys and the requester's X3DH keys from the message, initializes a receiving ratchet, and decrypts it. + +The published keys follow the X3DH structure: + +- The identity key goes in the immutable fixed link data, next to the root key, committed by the link hash. It is stable. +- The prekey and the KEM encapsulation key go in the mutable user data, signed by the root key, rotated with `LSET`. + +This is backward compatible. A requester that does not use the published keys sends a current `AgentInvitation` with its own X3DH keys, and the owner does what it does today: generates fresh X3DH keys and sends them in the confirmation. The owner branches on whether the incoming message uses the published keys. + +Two properties follow. The first message, including the profile, is under the double ratchet, which closes the profile gap and gives it post-quantum protection through the ratchet's sntrup761 KEM. And a decryptable message proves the sender established X3DH against the identity key committed by the link hash, so it authenticates the address owner without a separate signature. + +## Design + +Syntax uses [ABNF][1] with [case-sensitive strings extension][2]. Key and ratchet types are as in `Crypto.Ratchet` and the [agent protocol](../protocol/agent-protocol.md); all DH keys are X448, the KEM is sntrup761. + +### Published keys in link data + +The identity key is appended to fixed link data: + +```abnf +fixedData =/ addressIdentityKey ; appended, ignored by earlier versions +addressIdentityKey = %s"0" / (%s"1" length x509encoded) ; X448 +``` + +The prekey and KEM key are appended to contact user data: + +```abnf +userContactData =/ addressRatchetKeys ; appended, ignored by earlier versions +addressRatchetKeys = %s"0" / (%s"1" prekeyId prekey kemKey) +prekeyId = shortString ; identifies the prekey, echoed in the request +prekey = length x509encoded ; X448 +kemKey = largeString ; sntrup761 encapsulation key +``` + +Together with the version range in fixed data these reconstruct an `RcvE2ERatchetParams` (the owner's X3DH contribution): identity key as the first key, prekey as the second, KEM key as the KEM parameter. + +The owner keeps the private prekey and KEM key indexed by `prekeyId`. On rotation with `LSET` it publishes a new pair with a new id and keeps the previous private pair for a window covering queue message retention, so a request that used a just-rotated prekey still decrypts. The identity key is not rotated. + +### Existential ratchet in the request + +`CRInvitationUri` fixes the ratchet parameters to `RcvE2ERatchetParamsUri 'C.X448` today. It becomes existential over the establishment form, so a message can include either the current inline parameters or a reference to the published address keys: + +```haskell +data AddressE2EParams + = InlineE2EParams (RcvE2ERatchetParamsUri 'C.X448) -- current: requester's own keys + | PublishedE2EParams ByteString (SndE2ERatchetParams 'C.X448) -- prekeyId, requester's Snd params +``` + +`InlineE2EParams` is the current message. `PublishedE2EParams` names the prekey the requester used (so the owner selects the matching private keys) and includes the requester's Snd X3DH parameters (so the owner runs `pqX3dhRcv`). The owner branches on the constructor: `PublishedE2EParams` takes the published-key path with `pqX3dhRcv` against the stored private keys; `InlineE2EParams` takes the current path, generating fresh Snd params and sending them in the confirmation. + +### Establishing the ratchet + +Requester: + +1. Retrieve link data (`LGET`), read the identity key, the prekey with its id, and the KEM key, and reconstruct the owner's `RcvE2ERatchetParams`. +2. `generateSndE2EParams` for its own X3DH contribution. +3. `pqX3dhSnd` against the owner's parameters, then `initSndRatchet` - the sending ratchet. +4. Encrypt the first message under the ratchet, and include `PublishedE2EParams prekeyId sndParams`. + +Owner: + +1. On a message with `PublishedE2EParams prekeyId sndParams`, select the private prekey and KEM key by `prekeyId` (current or a retained previous pair). +2. `pqX3dhRcv` against `sndParams` with the identity, prekey, and KEM private keys, then `initRcvRatchet` - the receiving ratchet. +3. Decrypt, and reply under the ratchet. + +A request whose `prekeyId` is no longer retained cannot be decrypted; the owner does not learn the requester or its reply address, and the requester's attempt fails at its own timeout. + +### Authentication + +The ratchet is established against the identity key committed by the link hash, so a decryptable message proves the sender holds that identity key. Where a message today relies on a separate signature over its content for authenticity, this establishment provides it, and the signature is not needed. The identity key is a DH key and X3DH is over crypto_box, so deniability is preserved, and reuse of the identity key across requesters is consistent with the address already being a shared identifier. + +## Uses + +- Invitations to an address, and the profile in them, are under the double ratchet from the first message. +- The service RPC (see the RPC RFC) establishes the ratchet this way to send the request as the first ratchet message. + +This RFC depends on nothing else here. It replaces the need for the PQ-queue RFC in the address case, because the ratchet provides post-quantum protection for the first message; the PQ-queue RFC remains for first messages that do not establish a ratchet. + +[1]: https://tools.ietf.org/html/rfc5234 +[2]: https://tools.ietf.org/html/rfc7405 diff --git a/rfcs/2026-07-12-queue-pq-encryption.md b/rfcs/2026-07-12-queue-pq-encryption.md new file mode 100644 index 000000000..f82092323 --- /dev/null +++ b/rfcs/2026-07-12-queue-pq-encryption.md @@ -0,0 +1,42 @@ +--- +Proposed: 2026-07-12 +Protocol: smp-client (new version) +--- + +# Post-quantum encryption of the SMP queue layer + +## Problem + +A message sent to a queue outside an established double ratchet has one layer of end-to-end encryption: NaCl crypto_box over an X25519 DH secret. The sender generates an ephemeral X25519 key, computes the secret with the recipient's per-queue DH key, and puts its ephemeral key in the message public header (`agentCbEncryptOnce`). This layer protects invitations, confirmations, and the profile sent with them. + +It is not post-quantum. An adversary that records this traffic and later has a quantum computer can recover the X25519 secret and decrypt it. The double ratchet adds a post-quantum KEM once it is established, but the first message to a queue, before the ratchet, has only X25519. + +This RFC adds post-quantum protection to the single-shot queue encryption itself, for cases that do not establish a double ratchet from the first message. Where a double ratchet is established from the first message (see the address-DR RFC), the ratchet provides post-quantum protection and this layer is not needed. + +## Solution + +Extend the single-shot queue encryption to a hybrid X25519 + sntrup761 scheme, in a new SMP client version. The recipient publishes a KEM encapsulation key alongside its per-queue DH key. The sender encapsulates to it, combines the KEM shared secret with the X25519 DH secret, and encrypts the body with the combined secret. The KEM ciphertext travels in the message public header next to the ephemeral X25519 key. + +Recording the traffic and breaking X25519 later is not sufficient: without breaking sntrup761 as well, the combined secret is not recoverable. + +## Design + +The message public header (`PubHeader`) gains a hybrid variant, selected by a version and a tag, so older senders and the empty-header case are unchanged: + +```abnf +smpPubHeaderHybrid = smpClientVersion %s"2" senderPublicDhKey kemCiphertext +senderPublicDhKey = length x509encoded ; sender ephemeral X25519 key +kemCiphertext = largeString ; sntrup761 ciphertext, 1039 bytes +``` + +The secret combines both shared secrets, and the body is encrypted with NaCl secret_box (the DH-only path uses crypto_box today; the combined secret is no longer a plain DH result, so it is used as a secret_box key), padded to the same lengths: + +``` +secret = HKDF(dh(recipient key, sender ephemeral key) || KEM shared secret) +``` + +The recipient's KEM encapsulation key is distributed the same way its per-queue DH key is today - in the queue address for a connection request, and in link data for a short link. The KEM ciphertext is stored the same way the ephemeral DH key is: in the public header, readable by the destination server (and not by the proxy with proxied sending), which cannot derive the secret without the recipient's KEM private key. + +The recipient stores the computed secret the way the per-queue DH secret is stored on receiving the first message (`setRcvQueueConfirmedE2E`), and reuses it for later messages on the queue. + +Sizes: the KEM ciphertext is 1039 bytes and the encapsulation key 1158 bytes. Link data user data is padded to 13784 bytes, so the key fits with application data. This RFC is independent of the RPC, SSND, and address-DR RFCs. diff --git a/rfcs/2026-07-12-smp-secure-send.md b/rfcs/2026-07-12-smp-secure-send.md new file mode 100644 index 000000000..6bb444b09 --- /dev/null +++ b/rfcs/2026-07-12-smp-secure-send.md @@ -0,0 +1,55 @@ +--- +Proposed: 2026-07-12 +Protocol: smp (new version) +--- + +# SSND: combined secure-and-send command + +## Problem + +Two SMP flows secure a messaging queue and then immediately send the first message to it, as two commands and two round trips: + +- The fast connection handshake: the joining party secures the queue with `SKEY`, then sends the confirmation with `SEND`. +- Any first send to a sender-securable queue where the sender both secures it and delivers the first message. + +The two commands express one intent - "this is my key, and here is my first message" - so they can be one command and one round trip. The combination must be idempotent, because the first send is retried on network failure and a queue is often secured before the response is known. `SKEY` is already idempotent (a repeat with the same key succeeds). `SEND` is not, so a naive combination would deliver a duplicate message on retry. + +## Solution + +A new command `SSND` combines `SKEY` and `SEND` in one transmission, idempotent in both parts: + +- Key part: as `SKEY` - a repeat with the same key succeeds, a different key fails with `AUTH`. +- Send part: the server keeps the hash of the message until it is acknowledged, and reports a repeat of the same message as delivered without delivering it again. + +The server-side hash covers the common case, when the retry arrives before the message is acknowledged. A retry that arrives after the acknowledgement is delivered as a duplicate and discarded by the receiving agent by message hash, as duplicate messages are discarded today. + +## Design + +Syntax uses [ABNF][1] with [case-sensitive strings extension][2]. `senderAuthPublicKey`, `msgFlags` and `smpEncMessage` are as in the [SMP protocol](../protocol/simplex-messaging.md). + +```abnf +secureSend = %s"SSND " senderAuthPublicKey SP msgFlags SP smpEncMessage +senderAuthPublicKey = length x509encoded +``` + +`SSND` is a sender command, authorized with the key it sets, and accepted only on messaging-mode queues (`QMMessaging`), where the sender can secure the queue. The server responds `OK` or `ERR`. + +Server processing: + +1. Secure the queue with the key, as `SKEY`. A repeat with the same key succeeds; a different key returns `AUTH`. +2. If the queue holds an unacknowledged message whose stored hash equals the hash of this message, respond `OK` without storing it again. +3. Otherwise store the message, keep its hash with the queue until the message is acknowledged, and deliver it. + +The stored hash is one value per not-yet-acknowledged queue message. It is removed when the message is acknowledged. All queue store backends (in-memory, journal, PostgreSQL) keep it. + +`SSND` composes with the proxy protocol without change: `proxySMPCommand` forwards any sender command through `PFWD`/`RFWD`, so `SSND` is proxied as `SEND` and `SKEY` are today. + +## Uses + +- The fast connection handshake replaces `SKEY` then the `SEND` confirmation with one `SSND`. +- The service RPC response (see the RPC RFC) secures the reply queue and sends the first reply with one `SSND`. + +This RFC is independent of the RPC, PQ-queue, and address-DR RFCs and can be implemented on its own. + +[1]: https://tools.ietf.org/html/rfc5234 +[2]: https://tools.ietf.org/html/rfc7405 From 32351995fd798b9c4747de9b16c74e8b26d6566e Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Mon, 13 Jul 2026 11:21:31 +0000 Subject: [PATCH 05/81] update rfc --- rfcs/2026-07-12-address-pqdr-keys.md | 53 ++++++++++++++-------------- 1 file changed, 26 insertions(+), 27 deletions(-) diff --git a/rfcs/2026-07-12-address-pqdr-keys.md b/rfcs/2026-07-12-address-pqdr-keys.md index 51e080f52..d4846c7c6 100644 --- a/rfcs/2026-07-12-address-pqdr-keys.md +++ b/rfcs/2026-07-12-address-pqdr-keys.md @@ -17,12 +17,12 @@ Publish the address owner's X3DH contribution in the address link data, so a req The published keys follow the X3DH structure: -- The identity key goes in the immutable fixed link data, next to the root key, committed by the link hash. It is stable. -- The prekey and the KEM encapsulation key go in the mutable user data, signed by the root key, rotated with `LSET`. +- The link ratchet key - the stable first X3DH key - goes in the immutable fixed link data, next to the root key, committed by the link hash. +- The prekey, the KEM encapsulation key, and the e2e version range go in the mutable user data as a ratchet-keys bundle with an id, signed by the root key, rotated with `LSET`. This is backward compatible. A requester that does not use the published keys sends a current `AgentInvitation` with its own X3DH keys, and the owner does what it does today: generates fresh X3DH keys and sends them in the confirmation. The owner branches on whether the incoming message uses the published keys. -Two properties follow. The first message, including the profile, is under the double ratchet, which closes the profile gap and gives it post-quantum protection through the ratchet's sntrup761 KEM. And a decryptable message proves the sender established X3DH against the identity key committed by the link hash, so it authenticates the address owner without a separate signature. +Two properties follow. The first message, including the profile, is under the double ratchet, which closes the profile gap and gives it post-quantum protection through the ratchet's sntrup761 KEM. And a decryptable message proves the sender established X3DH against the link ratchet key committed by the link hash, so it authenticates the address owner without a separate signature. ## Design @@ -30,59 +30,58 @@ Syntax uses [ABNF][1] with [case-sensitive strings extension][2]. Key and ratche ### Published keys in link data -The identity key is appended to fixed link data: +The link ratchet key is appended to fixed link data: ```abnf -fixedData =/ addressIdentityKey ; appended, ignored by earlier versions -addressIdentityKey = %s"0" / (%s"1" length x509encoded) ; X448 +fixedData =/ linkRatchetKey ; appended, ignored by earlier versions +linkRatchetKey = %s"0" / (%s"1" length x509encoded) ; X448, stable, the first X3DH key ``` -The prekey and KEM key are appended to contact user data: +The ratchet-keys bundle is appended to contact user data: ```abnf -userContactData =/ addressRatchetKeys ; appended, ignored by earlier versions -addressRatchetKeys = %s"0" / (%s"1" prekeyId prekey kemKey) -prekeyId = shortString ; identifies the prekey, echoed in the request +userContactData =/ ratchetKeys ; appended, ignored by earlier versions +ratchetKeys = %s"0" / (%s"1" ratchetKeyId e2eVRange prekey kemKey) +ratchetKeyId = shortString ; identifies this bundle, changes on rotation, echoed in the request +e2eVRange = prekey = length x509encoded ; X448 -kemKey = largeString ; sntrup761 encapsulation key +kemKey = %s"0" / (%s"1" largeString) ; sntrup761 encapsulation key, optional (PQ is opt-in) ``` -Together with the version range in fixed data these reconstruct an `RcvE2ERatchetParams` (the owner's X3DH contribution): identity key as the first key, prekey as the second, KEM key as the KEM parameter. +Together these reconstruct the owner's X3DH contribution as an `RcvE2ERatchetParamsUri` - a version-range form: `linkRatchetKey` (from fixed data) as the first key, `prekey` as the second, `kemKey` as the optional KEM parameter, `e2eVRange` as the version range. The requester negotiates the concrete version against its own e2e range, as it does for an invitation, then runs `pqX3dhSnd` against the result. -The owner keeps the private prekey and KEM key indexed by `prekeyId`. On rotation with `LSET` it publishes a new pair with a new id and keeps the previous private pair for a window covering queue message retention, so a request that used a just-rotated prekey still decrypts. The identity key is not rotated. +The owner keeps the private prekey and, when PQ is on, the KEM keypair, indexed by `ratchetKeyId`. On rotation with `LSET` it publishes a new bundle with a new `ratchetKeyId` and keeps the previous private keys for a window covering queue message retention, so a request that used a just-rotated prekey still decrypts. The link ratchet key is stable and not rotated. -### Existential ratchet in the request +### Request confirmation -`CRInvitationUri` fixes the ratchet parameters to `RcvE2ERatchetParamsUri 'C.X448` today. It becomes existential over the establishment form, so a message can include either the current inline parameters or a reference to the published address keys: +A requester that uses the published keys establishes the sending ratchet before its first message, so it sends that message as a confirmation, not an invitation - the same envelope a joining party sends in a connection. The confirmation gains an optional `ratchetKeyId` naming the bundle the requester used, so the owner selects the matching private keys: -```haskell -data AddressE2EParams - = InlineE2EParams (RcvE2ERatchetParamsUri 'C.X448) -- current: requester's own keys - | PublishedE2EParams ByteString (SndE2ERatchetParams 'C.X448) -- prekeyId, requester's Snd params +```abnf +agentConfirmation =/ ratchetKeyId ; the bundle the requester used, echoed; absent on other confirmations ``` -`InlineE2EParams` is the current message. `PublishedE2EParams` names the prekey the requester used (so the owner selects the matching private keys) and includes the requester's Snd X3DH parameters (so the owner runs `pqX3dhRcv`). The owner branches on the constructor: `PublishedE2EParams` takes the published-key path with `pqX3dhRcv` against the stored private keys; `InlineE2EParams` takes the current path, generating fresh Snd params and sending them in the confirmation. +The confirmation holds the requester's Snd X3DH parameters (so the owner runs `pqX3dhRcv`) and, encrypted under the ratchet, the first message. A confirmation with `ratchetKeyId` on a contact address takes the published-key path; an `AgentInvitation`, as today, takes the current path where the owner generates fresh X3DH keys and returns them in its own confirmation. A connection-request URI is unchanged: it advertises the requester's Rcv parameters and must not include Snd parameters. ### Establishing the ratchet Requester: -1. Retrieve link data (`LGET`), read the identity key, the prekey with its id, and the KEM key, and reconstruct the owner's `RcvE2ERatchetParams`. -2. `generateSndE2EParams` for its own X3DH contribution. +1. Retrieve link data (`LGET`), read the link ratchet key, the prekey with its `ratchetKeyId`, the `e2eVRange`, and the optional KEM key, reconstruct the owner's `RcvE2ERatchetParamsUri`, and negotiate the concrete version against its own e2e range. +2. `generateSndE2EParams` for its own X3DH contribution (with the KEM only when the address advertises one). 3. `pqX3dhSnd` against the owner's parameters, then `initSndRatchet` - the sending ratchet. -4. Encrypt the first message under the ratchet, and include `PublishedE2EParams prekeyId sndParams`. +4. Encrypt the first message under the ratchet, and send a confirmation with its Snd parameters and `ratchetKeyId`. Owner: -1. On a message with `PublishedE2EParams prekeyId sndParams`, select the private prekey and KEM key by `prekeyId` (current or a retained previous pair). -2. `pqX3dhRcv` against `sndParams` with the identity, prekey, and KEM private keys, then `initRcvRatchet` - the receiving ratchet. +1. On a confirmation with `ratchetKeyId` on a contact address, select the private prekey and, if any, KEM keypair by `ratchetKeyId` (current or a retained previous generation). +2. `pqX3dhRcv` against the requester's Snd parameters with the link ratchet, prekey, and optional KEM private keys, then `initRcvRatchet` - the receiving ratchet. Decrypting the first message advances the ratchet and gives it a send side, so the owner can reply. 3. Decrypt, and reply under the ratchet. -A request whose `prekeyId` is no longer retained cannot be decrypted; the owner does not learn the requester or its reply address, and the requester's attempt fails at its own timeout. +A request whose `ratchetKeyId` is no longer retained cannot be decrypted; the owner does not learn the requester or its reply address, and the requester's attempt fails at its own timeout. ### Authentication -The ratchet is established against the identity key committed by the link hash, so a decryptable message proves the sender holds that identity key. Where a message today relies on a separate signature over its content for authenticity, this establishment provides it, and the signature is not needed. The identity key is a DH key and X3DH is over crypto_box, so deniability is preserved, and reuse of the identity key across requesters is consistent with the address already being a shared identifier. +The ratchet is established against the link ratchet key committed by the link hash and the prekey signed by the root key, so a decryptable message proves the sender established X3DH against the owner's published, link-committed keys. Where a message today relies on a separate signature over its content for authenticity, this establishment provides it, and the signature is not needed. The link ratchet key is a DH key (X448) and X3DH is over crypto_box, so deniability is preserved; the signing identity (the root key) and the DH key are separate keys, both anchored to the link hash. Reusing the link ratchet key across requesters is consistent with the address already being a shared identifier. ## Uses From 88ab41266e1a73528bc3258e59d0d831ead75d2a Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Mon, 13 Jul 2026 18:58:34 +0000 Subject: [PATCH 06/81] update rfc and plan --- plans/2026-07-12-address-dr-implementation.md | 161 +++++++++++------- rfcs/2026-07-12-address-pqdr-keys.md | 41 ++--- 2 files changed, 119 insertions(+), 83 deletions(-) diff --git a/plans/2026-07-12-address-dr-implementation.md b/plans/2026-07-12-address-dr-implementation.md index dc10412dd..86d72beb4 100644 --- a/plans/2026-07-12-address-dr-implementation.md +++ b/plans/2026-07-12-address-dr-implementation.md @@ -6,6 +6,8 @@ All references are to the current tree. Names of new constructors, fields, table Goal: a contact address advertises the owner's X3DH parameters in link data; a requester establishes the double ratchet in its first message, so that message and the profile in it are under the ratchet with post-quantum protection. The change reuses the invitation/confirmation machinery, with the requester in the joiner role and the owner in the initiator role - opposite to today's contact flow, but every message and code path below is reused. +Version: `addressDRVersion = VersionSMPA 8`, a plain agent-layer bump; `currentSMPAgentVersion` goes 7 → 8 (Agent/Protocol.hs:317-324). It gates the `AgentConfirmation.ratchetKeyId` field and the DR-from-address behavior. The receive-at-address path relies on ratchet-on-confirmation, already present since `ratchetOnConfSMPAgentVersion = 7` (Agent/Protocol.hs:317), so there is no cross-layer version dependency; the SMP and e2e-encryption versions are unchanged. + ## Part 1 - the current contact-address handshake, step by step Requester Alice connects to owner Bob's contact address. Q_A is Alice's receive queue (Bob to Alice), Q_B is Bob's receive queue (Alice to Bob). @@ -37,7 +39,7 @@ Owner side, receiving confirmation #2 on Q_B: - O7. dispatch (Agent.hs:3182): `AgentConfirmation` -> `smpConfirmation`. - O8. `smpConfirmation`, accepting-party branch `DuplexConnection … Nothing` (Agent.hs:3447-3462): `agentRatchetDecrypt` with the established ratchet; `AgentConnInfo` -> `INFO` (Agent.hs:3452); `ICDuplexSecure` or `CON`. -`HELLO`/`CON` completion follows via `helloMsg` (Agent.hs:3466). +Completion is direct `CON` on `senderCanSecure` (SKEY) messaging-mode queues (the sender on `AgentConnInfo`, Agent.hs:2252; the receiver with no `senderKey`, Agent.hs:3459-3461); the separate `HELLO` via `helloMsg` (Agent.hs:3466) is the older non-`senderCanSecure` (duplexHandshake v2, in-band-securing) path. ## Part 2 - the DR-from-address handshake, mapped to Part 1 @@ -45,21 +47,21 @@ The address advertises Bob's Rcv X3DH parameters in link data (Part 3). Alice, w Requester side - a new branch in `joinConnSrv … CRContactUri`, chosen when the fetched link data has `ratchetKeys`: -- R2'. Replaces R2/R3. Read the advertised `linkRatchetKey`, `ratchetKeyId`, `e2eVRange`, `prekey`, and optional `kemKey` from link data; reconstruct Bob's `RcvE2ERatchetParamsUri 'C.X448` and negotiate the concrete version with `compatibleVersion` against the client e2e range, as `compatibleInvitationUri` does (Agent.hs:1362-1368). Create the receive queue Q_A subscribed (`newRcvQueue` with `subMode`), messaging mode so Bob can secure it. Run `generateSndE2EParams` (with `replyKEM_` to accept the KEM only when advertised), `pqX3dhSnd` against the negotiated parameters, `initSndRatchet`, `createSndRatchet` - the body of `createRatchet_` (Agent.hs:1343-1350), with parameters from link data rather than a received invitation. -- R3'. Build `AgentConfirmation {e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just ratchetKeyId, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_A :| []) aliceProfile)}` - the `mkAgentConfirmation`/`mkConfirmation` bodies (Agent.hs:3780-3765) with the reply queue being Alice's own Q_A. Send it to the address queue unauthenticated with `agentCbEncryptOnce`, as `sendInvitation` sends (Agent/Client.hs:1929-1934). **Alice's profile is now inside `encConnInfo`, under the ratchet.** Alice's connection is `RcvConnection` (Q_A) with a send ratchet, until she receives Q_B. +- R2'. Replaces R2/R3. Read the advertised bundle from link data - `ratchetKeyId` and `e2eParams :: RcvE2ERatchetParamsUri 'C.X448` - and negotiate the concrete version with `compatibleVersion` against the client e2e range, as `compatibleInvitationUri` does (Agent.hs:1362-1368). Create the receive queue Q_A subscribed (`newRcvQueue` with `subMode`), messaging mode so Bob can secure it. Choose the requester's KEM with `replyKEM_ v ownerKem_ pqSup` (Ratchet.hs:839): if the bundle advertises a KEM (owner `IKUsePQ`) the requester encapsulates to it (`AcceptKEM`, PQ from message 1); if not and the requester wants PQ, it proposes its own (`ProposeKEM`, PQ from message 2 if the owner supports it). Run `generateSndE2EParams g v (replyKEM_ …)`, `pqX3dhSnd` against the negotiated parameters, `initSndRatchet`, `createSndRatchet` - the body of `createRatchet_` (Agent.hs:1343-1350), with parameters from link data rather than a received invitation. +- R3'. Build `AgentConfirmation {e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just ratchetKeyId, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_A :| []) aliceProfile)}` - the `mkAgentConfirmation`/`mkConfirmation` bodies (Agent.hs:3780-3765) with the reply queue being Alice's own Q_A. Send it to the address queue unauthenticated with `agentCbEncryptOnce`, as `sendInvitation` sends (Agent/Client.hs:1929-1934). Retry is chat re-invoking the join, reusing the prepared connection's keys via the existing `startJoinInvitation`-style reuse (Agent.hs:1314) - exactly as a classic contact request; a resend is not deduplicated (it may produce another `REQ` on the owner, as a resent classic invitation does). The connect UX (premature failure, lost-reply recovery) is a separate chat-layer concern, out of scope here. **Alice's profile is now inside `encConnInfo`, under the ratchet.** Alice's connection is `RcvConnection` (Q_A) with a send ratchet, until she receives Q_B. Owner side - a new dispatch branch and a new receive handler: - O1'. In `processClientMsg` (Agent.hs:3176-3187), add a branch in state `(Nothing, Just e2ePubKey)`: an `AgentConfirmation` with `ratchetKeyId = Just _` on a `ContactConnection` -> `smpAddressConfirmation` (new). It must be placed **before** the existing `(PHEmpty, AgentConfirmation) | senderCanSecure queueMode` case (Agent.hs:3182-3184), because a contact-address queue is `QMContact` (not `senderCanSecure`) and would otherwise fall into `prohibited "handshake: missing sender key"` (Agent.hs:3184). The address queue's `e2eDhSecret` stays `Nothing` (it is never set for a contact address - `smpInvitation` does not set it, Agent.hs:3609-3622), so every request is decrypted with its own ephemeral key via this `(Nothing, Just e2ePubKey)` path. -- O2'. `smpAddressConfirmation` (new, modeled on `smpConfirmation` initiating branch, Agent.hs:3405-3444): select the private prekey and, if any, KEM keypair by `ratchetKeyId` from `address_ratchet_keys`; `pqX3dhRcv` with the `linkRatchetKey` private key, the selected prekey private key, and the optional KEM keypair (as `PrivateRKParamsProposed`) against `aliceSndParams`; `initRcvRatchet` (its `PQSupport` follows from whether the address advertises a KEM and version compatibility, as `smpConfirmation` derives `pqSupport'`, Agent.hs:3410); `rcDecrypt` of `encConnInfo` performs the first ratchet step, giving the connection its send side too (as it does for the initiator today), so the owner can later reply; `createRatchet` stores the post-decrypt ratchet under a **new connection created now** for this request. Parse `AgentConnInfoReply (Q_A :| []) aliceProfile`, store a pending-request record referencing the new connection, its ratchet, and Q_A (not a `connReq`), and emit `REQ`. An unknown or expired `ratchetKeyId`, or a decryption failure: discard and acknowledge, as an undecryptable message is dropped today. This establishes ratchet state on unauthenticated input before the user accepts - see "Receive-time establishment, state, and abuse". -- O3'. `acceptContact'` for a DR-established request - a new branch that continues the ratchet instead of `joinConn`: reuse `mkAgentConfirmation` (Agent.hs:3780-3785) to create Bob's receive queue Q_B and return `AgentConnInfoReply (Q_B :| []) bobInfo`; create Bob's send queue to Q_A (`newSndQueue`, generating Bob's own sender key) and secure Q_A with `SKEY` using that key (`agentSecureSndQueue`, valid because Q_A is messaging mode) - the securing key is Bob's own, not taken from Alice's message; send the response to Q_A as `AgentConfirmation {e2eEncryption_ = Nothing, ratchetKeyId = Nothing, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_B :| []) bobInfo)}`, per-queue encrypted with `agentCbEncryptOnce` (first message to Q_A). The reply content is `AgentConnInfoReply`, not `AgentConnInfo`: it takes the `mkAgentConfirmation` path with `e2eEncryption_ = Nothing`, not the `enqueueConfirmation` path (which produces `AgentConnInfo`, Agent.hs:3789). +- O2'. `smpAddressConfirmation` (new, modeled on `smpConfirmation` initiating branch, Agent.hs:3405-3444): select the private triple `(pk1, pk2, pKem)` by `ratchetKeyId` from `address_ratchet_keys`; `pqX3dhRcv pk1 pk2 pKem aliceSndParams`; `initRcvRatchet` with the address connection's stored `PQSupport` (`connPQEncryption` of the address `InitialKeys` - `On` for `IKUsePQ` and `IKPQOn`, `Off` for `IKPQOff`; this is what lets `IKPQOn` accept the requester's proposed KEM), combined with version compatibility as `smpConfirmation` derives `pqSupport'` (Agent.hs:3410); `rcDecrypt` of `encConnInfo` performs the first ratchet step, giving the ratchet its send side too (as it does for the initiator today), so the owner can later reply. Parse `AgentConnInfoReply (Q_A :| []) aliceProfile`. Store the request with `createInvitation` on the address connection (`contact_conn_id`), exactly as a classic invitation - except the request value is the `CRConfirmation` variant (Part 3) carrying the post-decrypt ratchet state and Q_A, and `recipient_conn_info` is `aliceProfile` - so **no connection or `ratchets` row is created at receive**, as with a classic invitation. Emit `REQ` with the `invitation_id`. A resend is not deduplicated: like a resent classic invitation it produces another `REQ` (the connect-UX fix for that is separate chat work). An unknown or expired `ratchetKeyId`, or a decryption failure: discard and acknowledge, as an undecryptable message is dropped today. This establishes ratchet state on unauthenticated input before the user accepts - see "Receive-time establishment, state, and abuse". +- O3'. `acceptContact'` for a DR request - a new branch that continues the ratchet instead of `joinConn`. `getInvitation` returns the request; its `CRConfirmation` variant gives the stored ratchet state and Q_A. Create the connection now (as `joinConn` does for a classic invitation) and `createRatchet` (AgentStore.hs:1419) from the stored ratchet state. Reuse `mkAgentConfirmation` (Agent.hs:3780-3785) to create Bob's receive queue Q_B and return `AgentConnInfoReply (Q_B :| []) bobInfo`; create Bob's send queue to Q_A (`newSndQueue`, generating Bob's own sender key) and secure Q_A with `SKEY` using that key (`agentSecureSndQueue`, valid because Q_A is messaging mode) - the securing key is Bob's own, not taken from Alice's message; send the response to Q_A as `AgentConfirmation {e2eEncryption_ = Nothing, ratchetKeyId = Nothing, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_B :| []) bobInfo)}` via `sendConfirmation` (`agentCbEncrypt` over Bob's send queue to Q_A, `PHEmpty` because Q_A is `senderCanSecure`) - exactly the current contact msg 2 path (Client.hs:1916), not `agentCbEncryptOnce`. The reply content is `AgentConnInfoReply`, not `AgentConnInfo`: it takes the `mkAgentConfirmation` path with `e2eEncryption_ = Nothing`, not the `enqueueConfirmation` path (which produces `AgentConnInfo`, Agent.hs:3789). `rejectContact'` deletes the `conn_invitations` row (the current behaviour), discarding the inline ratchet; no connection was created, so there is nothing else to clean up. Requester side, receiving the response on Q_A: -- R5'. `smpConfirmation` needs a new branch `RcvConnection … Nothing` (today only `RcvConnection … Just` and `DuplexConnection … Nothing` exist, Agent.hs:3403-3447): Alice already holds the send ratchet, so `agentRatchetDecrypt` advances it and creates the receive side; `setRcvQueueConfirmedE2E` on Q_A so later messages use the stored per-queue secret (as the current branches do, Agent.hs:3440,3455); parse `AgentConnInfoReply (Q_B :| []) bobInfo`; connect Q_B (create Alice's send queue to Q_B, `agentSecureSndQueue` it, upgrade `RcvConnection` to `DuplexConnection`); emit `INFO`. The accepting-party branch (Agent.hs:3447) must also accept `AgentConnInfoReply`, not only `AgentConnInfo` (Agent.hs:3451, 3462), for the reply-queue case. -- R6'/completion. The response went to Q_A, so Bob has no signal that Alice secured Q_B and would never reach `CON` on its own. The essential extra message is Alice -> Q_B: after R5' Alice sends `HELLO` on Q_B, and `helloMsg` (Agent.hs:3466) sets Q_B active on Bob's side and emits Bob's `CON`. Alice reaches `CON` from the response (Q_A active, Q_B secured). Whether Bob also needs to send `HELLO` on Q_A for Alice's `CON`, or the response suffices, follows the existing `helloMsg`/fast-path completion and is confirmed at implementation - the fixed point is that Alice must send on Q_B. +- R5'. `smpConfirmation` needs a new branch `RcvConnection … Nothing` (today only `RcvConnection … Just` and `DuplexConnection … Nothing` exist, Agent.hs:3403-3447): Alice already holds the send ratchet, so `agentRatchetDecrypt` advances it and creates the receive side; `setRcvQueueConfirmedE2E` on Q_A so later messages use the stored per-queue secret (as the current branches do, Agent.hs:3440,3455); parse `AgentConnInfoReply (Q_B :| []) bobInfo`; emit `INFO` (Bob's profile); then `connectReplyQueues` (Agent.hs:3724) - create Alice's send queue to Q_B, secure Q_B with `SKEY` (`agentSecureSndQueue`, Q_B is messaging mode), upgrade to `DuplexConnection`, and `enqueueConfirmation … Nothing` to send the third message, `AgentConnInfo` to Q_B (`encConnInfo = ratchetEncrypt(AgentConnInfo aliceInfo)`). Because Q_B is sender-securable, sending `AgentConnInfo` completes Alice with `CON` (Agent.hs:2252) - no `HELLO`. +- R6'/completion. Unchanged from the current contact handshake, and modern (no `HELLO`). The exchange is three agent↔agent wire messages - Alice → address queue (msg 1), Bob → Q_A (msg 2, an `AgentConfirmation` carrying `AgentConnInfoReply` with Q_B), Alice → Q_B (msg 3, an `AgentConfirmation` carrying `AgentConnInfo`) - the same shape as the current contact flow, where msg 1 was `AgentInvitation`; here it is the ratchet-establishing `AgentConfirmation`. (`CON` is not a wire message - it is the agent→app event; `HELLO` and `AgentConnInfo` are the wire messages.) `HELLO` belongs to the older non-`senderCanSecure` path (duplexHandshake v2, before SKEY): there the confirmation secures the queue in-band (`PHConfirmation` carries the sender key, Client.hs:1918) and the receiver replies with `HELLO` (`ICDuplexSecure` → `enqueueDuplexHello`, Agent.hs:3457-3458). Both Q_A and Q_B here are messaging-mode - Q_A by R2', Q_B via `createReplyQueue` → `SCMInvitation` → `QMMessaging` (Agent.hs:1233,1458,3783) - so the sender secures with SKEY and sends `PHEmpty` (Client.hs:1918), the dispatch takes the `senderCanSecure` branch (Agent.hs:3182-3184), and each agent raises the `CON` app event locally off msg 3 - Bob on receiving it (`senderKey = Nothing`, Agent.hs:3459-3461), Alice on sending it (Agent.hs:2252) - with no separate `HELLO` wire message. (msg 2's `AgentConnInfoReply` only sets Q_A `Confirmed`, Agent.hs:2254.) Invitations are two messages because the initiator's queue is already in the link; a contact address needs three because Bob's receive queue Q_B is only delivered in msg 2. The third message no longer has a ratchet role: Bob's X3DH params are pre-published, so the agreement is complete once Bob receives msg 1 (in the current flow Bob's Snd params instead arrive in msg 2). msg 2 and msg 3 are queue setup - msg 2 delivers Q_B, msg 3 secures Q_B so Alice can send to Bob and signals Bob's `CON`; neither negotiates the ratchet. A one-directional exchange (the RPC) needs no Q_B and is two messages. -Net code touch points: `joinConnSrv` (new requester branch), `processClientMsg` (new owner dispatch), `smpConfirmation` (new `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance), `acceptContact'` (new continue-ratchet branch), a new `smpAddressConfirmation`, and the link data and storage of Part 3-4. +Net code touch points: `joinConnSrv` (new requester branch), `processClientMsg` (new owner dispatch), `smpConfirmation` (new `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance), `acceptContact'` (new continue-ratchet branch), a new `smpAddressConfirmation` reusing `createInvitation`/`getInvitation` with the sum request value, and the link data and storage of Part 3-4. `rejectContact'` is unchanged (it deletes the `conn_invitations` row either way). ### Receive-time establishment, state, and abuse @@ -69,59 +71,82 @@ Design decision (Q1): decrypt at receive. Both use cases need the request conten Consequences: -- A connection is created at receive to hold the ratchet (ratchets are keyed by `conn_id`). O2' creates a `NewConnection`, stores the post-decrypt ratchet under it, and a pending-request record with Q_A's address; O3' (accept) adds Bob's send queue to Q_A and receive queue Q_B, upgrading to `DuplexConnection`; reject deletes the connection, its ratchet, and the record. -- Per incoming `AgentConfirmation` the owner does one `pqX3dhRcv` (three DH plus, with PQ, one `sntrup761` decapsulation) and one `rcDecrypt`, on unauthenticated input, and creates a connection row and a ratchet row - more CPU and state than the current `NewInvitation`. +- No connection is created at receive, exactly as for a classic invitation. O2' stores the request with `createInvitation` on the address connection; the post-decrypt ratchet state and Q_A live inline in the `CRConfirmation` request value (`cr_invitation`). O3' (accept) creates the connection, `createRatchet` from the stored state, and adds Bob's queues, becoming a `DuplexConnection`; `rejectContact'` deletes the `conn_invitations` row. +- Per incoming `AgentConfirmation` the owner does one `pqX3dhRcv` (three DH plus, with PQ, one `sntrup761` decapsulation) and one `rcDecrypt`, on unauthenticated input, and writes one `conn_invitations` row - more CPU than the current `NewInvitation`, the same order of state (no connection, no `ratchets` row until accept). -Abuse (Q2): a contact address already accepts and processes unauthenticated invitations today, so this is a degree-worse version of an existing surface, not a new class. It is bounded by the address queue quota (an attacker fills it, the owner drains and acknowledges) and, optionally, by basic auth on the address (already supported for contact addresses, `optBasicAuth`). The pending-request state is bounded by a request TTL: `cleanupManager` deletes pending DR connections never accepted or rejected past that TTL (Part 4 cleanup). Proof-of-work or a stricter gate can be added later; it is out of scope here and noted as a follow-up. +Abuse (Q2): a contact address already accepts and processes unauthenticated invitations today, so this is a degree-worse version of an existing surface, not a new class. It is bounded by the address queue quota (an attacker fills it, the owner drains and acknowledges) and, optionally, by basic auth on the address (already supported for contact addresses, `optBasicAuth`). The per-request state is a single `conn_invitations` row - the same class as a classic contact request - so it is subject to the same limits and lifecycle, with no DR-specific dedup or TTL. Proof-of-work or a stricter gate can be added later; it is out of scope here and noted as a follow-up. -The `acceptContact'` dispatch branches on the pending record: a classic invitation (`connReq` present) takes the current `joinConn` path (O3-O6); a DR request (pending connection and ratchet present, no `connReq`) takes the continue-ratchet path (O3'). +`acceptContact'`/`rejectContact'` keep taking the `invitation_id` from `REQ` unchanged; the only difference is that `getInvitation` returns a request that is either a `CRInvitation` URI (current `joinConn` path, O3-O6) or a `CRConfirmation` (continue-ratchet path, O3'). Nothing in the `REQ`/accept/reject flow or the chat client changes - the change is contained in the agent. -## Part 3 - types and link data +### The four communication layers, per message (verified against code) -### Fixed data - link ratchet key +Layers, outermost (server-visible) first: -Appended to `FixedLinkData` (Protocol.hs:1824); the encoding already stops at a trailing tail (Protocol.hs:1928), so earlier versions ignore it: +- **L1 `ClientMsgEnvelope`** (Protocol.hs:1089), `PubHeader {phVersion, phE2ePubDhKey :: Maybe PublicKeyX25519}` (1096) - **this is where per-queue encryption is agreed** (not L2). `phE2ePubDhKey` is the sender's e2e DH public key; the recipient combines it with the queue's e2e private key: `(e2eDhSecret, e2ePubKey_) -> (Nothing, Just e2ePubKey) -> e2eDh = dh' e2ePubKey e2ePrivKey` (Agent.hs:3172-3178). `agentCbEncryptOnce` (Client.hs:2214) puts a **fresh ephemeral** pubkey (generated 2217, set 2223) - used when the sender has no send queue (the address queue), whose `e2eDhSecret` stays `Nothing`, so it decrypts every message with the per-message ephemeral. `agentCbEncrypt` (Client.hs:2203) puts the **send queue's persistent** e2e pubkey (`Just` on a confirmation, 2210); the recipient stores the secret via `setRcvQueueConfirmedE2E`, and *later* messages send `phE2ePubDhKey = Nothing` (`sendAgentMessage`, 2080). +- **L2 `ClientMessage PrivHeader`** (Protocol.hs:1113), `PrivHeader = PHConfirmation APublicAuthKey | PHEmpty` (1115) - **queue securing / authorization, not encryption**. `PHConfirmation` carries the sender's AUTH key for in-band securing (v2, non-`senderCanSecure`); `PHEmpty` when the sender secured the queue with SKEY out-of-band. `PHEmpty` on every message here is about securing, and says nothing about encryption (that is L1). Set in `sendConfirmation` (Client.hs:1918), `sendInvitation` (1934), `sendAgentMessage` (2079). +- **L3 `AgentMsgEnvelope`** (Agent/Protocol.hs:829, encoding 851) - outside the ratchet. `AgentConfirmation` ('C') carries `e2eEncryption_` (Snd X3DH params, agrees DR) + `encConnInfo`; `AgentInvitation` ('I') carries `connReq` (Rcv X3DH params) + plaintext `connInfo` (no DR); `AgentMsgEnvelope` ('M') carries `encAgentMessage`. +- **L4 `AgentMessage`** (Agent/Protocol.hs:883, encoding 893) - inside the ratchet. `AgentConnInfo` ('I'), `AgentConnInfoReply` ('D', reply queues + info), `AgentMessage APrivHeader AMessage` ('M'; `AMessage` includes `HELLO`, Agent/Protocol.hs:1018-1020). **Absent when L3 is `AgentInvitation`** (that profile is per-queue-only - the gap this plan closes). -```haskell -data FixedLinkData c = FixedLinkData - { agentVRange :: VersionRangeSMPA, - rootKey :: C.PublicKeyEd25519, - linkConnReq :: ConnectionRequestUri c, - linkEntityId :: Maybe ByteString, - linkRatchetKey :: Maybe C.PublicKeyX448 -- stable X448 key, the first X3DH key - } -``` +Send routing: msg 1 (to address) → `sendInvitation` today / a new `agentCbEncryptOnce` confirmation send for DR; msg 2 → `secureConfirmQueue` → `sendConfirmation` (Agent.hs:3747); msg 3 → `connectReplyQueues` → `enqueueConfirmation` → delivery worker `AM_CONN_INFO` → `sendConfirmation` (Agent.hs:3733,3789,2183). `AM_CONN_INFO`/`AM_CONN_INFO_REPLY` both go through `sendConfirmation` (2183-2184); other `AMessage`s go through `sendAgentMessage` wrapping `AgentMsgEnvelope` 'M' (2192-2193). + +Current contact handshake (address does **not** advertise DR): + +| msg | L1 `PubHeader.phE2ePubDhKey` (per-queue enc) | L2 `PrivHeader` (securing) | L3 `AgentMsgEnvelope` | L4 `AgentMessage` | +|---|---|---|---|---| +| 1 Alice→addr | `Just` fresh ephemeral, `agentCbEncryptOnce` (Client.hs:1933,2223) | `PHEmpty` (1934) | `AgentInvitation` {connReq = Alice Rcv params, connInfo = profile} (Client.hs:1932) | — none (profile per-queue only) | +| 2 Bob→Q_A | `Just` Bob's send-queue e2e pubkey, `agentCbEncrypt` (1920,2210) | `PHEmpty` [`senderCanSecure`] (1918) | `AgentConfirmation` {e2eEncryption_ = **Just Bob Snd params**, encConnInfo} (Agent.hs:3765) | `AgentConnInfoReply` (Q_B) bobInfo, DR-enc (Agent.hs:3785) | +| 3 Alice→Q_B | `Just` Alice's send-queue e2e pubkey, `agentCbEncrypt` (1920,2210) | `PHEmpty` [`senderCanSecure`] (1918) | `AgentConfirmation` {e2eEncryption_ = **Nothing**, encConnInfo} (Agent.hs:3802) | `AgentConnInfo` aliceInfo, DR-enc (Agent.hs:3789) | + +New DR handshake (address advertises DR): + +| msg | L1 `PubHeader.phE2ePubDhKey` (per-queue enc) | L2 `PrivHeader` (securing) | L3 `AgentMsgEnvelope` | L4 `AgentMessage` | +|---|---|---|---|---| +| 1 Alice→addr | `Just` fresh ephemeral, `agentCbEncryptOnce` [same] | `PHEmpty` [same] | **`AgentConfirmation`** {e2eEncryption_ = **Just Alice Snd params**, **ratchetKeyId = Just**, encConnInfo} [was `AgentInvitation`] | **`AgentConnInfoReply`** (Q_A) aliceProfile, **DR-enc** [was plaintext connInfo] | +| 2 Bob→Q_A | `Just` Bob's send-queue e2e pubkey, `agentCbEncrypt` [same] | `PHEmpty` [same] | `AgentConfirmation` {e2eEncryption_ = **Nothing**, ratchetKeyId = Nothing, encConnInfo} [was Just Bob Snd params] | `AgentConnInfoReply` (Q_B) bobInfo, DR-enc [same] | +| 3 Alice→Q_B | `Just` Alice's send-queue e2e pubkey, `agentCbEncrypt` [same] | `PHEmpty` [same] | `AgentConfirmation` {e2eEncryption_ = Nothing, encConnInfo} [same] | `AgentConnInfo` aliceInfo, DR-enc [same] | + +Net difference: **only msg 1 and msg 2's L3/L4 change.** msg 1's L3 becomes `AgentConfirmation` (was `AgentInvitation`) carrying Alice's Snd params + `ratchetKeyId`, and the profile moves from plaintext L3 to DR-encrypted L4 (`AgentConnInfoReply`) - the whole point of the change. msg 2 drops `e2eEncryption_` (Bob no longer sends Snd params - the ratchet is agreed from msg 1). msg 3 is unchanged. L1 (per-queue encryption - each queue agrees its own secret via the sender's e2e pubkey in the `PubHeader` on the first message to it) and L2 (securing, `PHEmpty` because SKEY is used) are unchanged throughout; the DR change is entirely at L3/L4. The only new send code is msg 1 (an `AgentConfirmation` fired to the address with `agentCbEncryptOnce`, like `sendInvitation` but with a confirmation envelope). + +## Part 3 - types and link data + +### Fixed data - unchanged + +`FixedLinkData` (Protocol.hs:1824) is not touched. The double-ratchet keys go entirely in mutable data, so an existing address advertises them without a new link (the fixed data is hash-committed and cannot change). Fixed data keeps only `agentVRange`, `rootKey`, `linkConnReq`, `linkEntityId`. ### Mutable data - ratchet keys bundle Appended to `UserContactData` (Protocol.hs:1840); the encoding stops at a trailing tail (Protocol.hs:1981), so earlier versions ignore it: ```haskell -data RatchetKeys = RatchetKeys - { ratchetKeyId :: ByteString, -- identifies this bundle; changes on rotation - e2eVRange :: VersionRangeE2E, -- advertised e2e version range, for negotiation - prekey :: C.PublicKeyX448, - kemKey :: Maybe KEMPublicKey -- opt-in, as PQ is opt-in in the ratchet (PQSupport) +data AddressRatchetKeys = AddressRatchetKeys + { ratchetKeyId :: ByteString, -- identifies this bundle; changes on rotation, echoed in the request + e2eParams :: CR.RcvE2ERatchetParamsUri 'C.X448 -- version range + both X3DH keys + optional KEM } data UserContactData = UserContactData { direct :: Bool, owners :: [OwnerAuth], relays :: [ConnShortLink 'CMContact], userData :: UserLinkData, - ratchetKeys :: Maybe RatchetKeys + ratchetKeys :: Maybe AddressRatchetKeys } ``` -Reconstruction produces `RcvE2ERatchetParamsUri 'C.X448` (a version range, `E2ERatchetParamsUri VersionRangeE2E k1 k2 (Maybe kem)`), not concrete params: `e2eVRange` as the range, `linkRatchetKey` (from fixed data) as the first key, `prekey` as the second, `kemKey` as the optional KEM parameter. The requester negotiates the concrete version with `compatibleVersion` against its own e2e range, exactly as `compatibleInvitationUri` does for an invitation (Agent.hs:1362-1368), then uses the resulting `RcvE2ERatchetParams` in `pqX3dhSnd`. The KEM is optional: with `kemKey = Nothing` the ratchet is X448-only, as when `PQSupport` is off; with `Just` it is hybrid, matching `E2ERatchetParams … (Maybe (RKEMParams s))` (Ratchet.hs:220-221) and `generateRcvE2EParams`'s `PQSupport` gate (Ratchet.hs:439-445). +`e2eParams` is the existing `RcvE2ERatchetParamsUri 'C.X448` (`E2ERatchetParamsUri VersionRangeE2E k1 k2 (Maybe (RKEMParams s))`, Ratchet.hs:282-286) - the same type a `CRInvitationUri` advertises - with `StrEncoding`/`Encoding` already defined (Ratchet.hs:302-374). There is no bespoke key type and no reconstruction: the requester negotiates the concrete version with `compatibleVersion` against its own e2e range, exactly as `compatibleInvitationUri` does for an invitation (Agent.hs:1362-1368), giving `RcvE2ERatchetParams` for `pqX3dhSnd`. The KEM is optional: `Nothing` gives an X448-only ratchet (as when `PQSupport` is off), `Just` a hybrid one, matching `generateRcvE2EParams`'s `PQSupport` gate (Ratchet.hs:439-445). + +The address-creation parameter is `InitialKeys` (Ratchet.hs:864) - the same 3-way choice as invitations, not a bare `PQSupport`. Currently `IKUsePQ` is prohibited for `SCMContact` (Agent.hs:990,1198) because a contact address carries no owner keys; this change lifts that prohibition. The bundle plays the published-contact-request role, so its KEM follows `initialPQEncryption False pqInitKeys` (Ratchet.hs:882) - exactly as the requester's contact request does today (Agent.hs:1422): -The owner does not use `generateRcvE2EParams` (which generates both keys together, Ratchet.hs:439): `linkRatchetKey` (k1) is generated once at address creation, the prekey (k2) and KEM per rotation. To advertise it derives the public keys with `mkRcvE2ERatchetParams` (Ratchet.hs:412), whose argument is `(PrivateKey a, PrivateKey a, Maybe RcvPrivRKEMParams)`, from the stored link ratchet private key, the current prekey private key, and the current KEM keypair; the published `e2eVRange` is stored alongside, so the version in `mkRcvE2ERatchetParams` is only a carrier for the public keys. `ratchetKeys` and `linkRatchetKey` are set by the agent when it signs link data (`Crypto.ShortLink.encodeSignFixedData`/`encodeSignUserData`), not by the application. +- `IKUsePQ` - the bundle advertises the KEM; the requester encapsulates to it, so PQ from message 1. +- `IKPQOn` (`IKLinkPQ PQSupportOn`) - the bundle is X448-only (no KEM advertised), but the owner's ratchet supports PQ (`connPQEncryption` = On, Ratchet.hs:888); the requester proposes its own KEM (R2'), so PQ from message 2. +- `IKPQOff` (`IKLinkPQ PQSupportOff`) - X448-only, and the owner's ratchet does not support PQ even if the requester proposes it. + +Advertising the KEM adds ~1158 B to the rotated, widely-fetched link data, which is why `IKPQOn` exists (PQ one round later, without the size cost). The owner generates the bundle with `generateRcvE2EParams g v (initialPQEncryption False pqInitKeys)` (Ratchet.hs:439), stores the private triple `(pk1, pk2, pKem)` (Part 4), and advertises `e2eParams` by wrapping the public `E2ERatchetParams` in the address's e2e version range (`toVersionRangeT`; or `mkRcvE2ERatchetParams` from the stored privates, Ratchet.hs:412) - the same private-key shape `createRatchetX3dhKeys`/`getRatchetX3dhKeys` already store (AgentStore.hs:1362-1367). `ratchetKeys` is set by the agent when it signs mutable link data (`Crypto.ShortLink.encodeSignUserData`), not by the application. ### Authentication of the advertised keys -No signature is added on the keys: the link data already signs them. `decryptLinkData` (Crypto/ShortLink.hs:106-114) verifies `sig1` over fixed data and `sig2` over the mutable `UserContactData`, both by `rootKey`, and checks `linkKey = sha3_256(fixedData)`. So `linkRatchetKey` is hash-committed and root-signed, and `ratchetKeys` (prekey, KEM, `e2eVRange`) is root-signed as part of `UserContactData`. This is the X3DH anti-substitution property: an SMP server cannot substitute the prekey or KEM without forging the root signature or breaking the link hash. The signer is the root Ed25519 key, not `linkRatchetKey` (X448, which cannot sign) - the DH identity and the signing identity are separate keys, both anchored to the link hash. A malicious server can still serve an older but validly-signed mutable data (rollback to a retired prekey); this is bounded by the prekey retention window and by the ratchet advancing after the first message, and a signature does not prevent it. Inline ratchet params in a `CRInvitationUri` contact request are not in signed link data and remain unsigned - a separate change, out of scope here. +No signature is added on the keys: the mutable link data already signs them. `decryptLinkData` (Crypto/ShortLink.hs:106-114) verifies `sig2` over the mutable `UserContactData` by `rootKey`, so `ratchetKeys` is root-signed. This is the X3DH anti-substitution property: an SMP server cannot substitute the keys without forging the root signature. The signer is the root Ed25519 key (the address's signing identity); the X3DH keys are separate DH keys (X448, which cannot sign). A single owner signs address data ("we don't use multiple owners"), so the root signature alone is sufficient - no per-key signature. A malicious server can still serve an older but validly-signed `UserContactData` (rollback to a retired bundle); this is bounded by the retention window and by the ratchet advancing after the first message, and a signature does not prevent it. Inline ratchet params in a `CRInvitationUri` contact request are not in signed link data and remain unsigned - a separate change, out of scope here. ### Request envelope -`AgentConfirmation` (Protocol.hs:830-834) gains an optional `ratchetKeyId` - the `ratchetKeyId` of the `RatchetKeys` bundle the requester used, so the owner selects the matching private keys: +`AgentConfirmation` (Protocol.hs:830-834) gains an optional `ratchetKeyId` - the `ratchetKeyId` of the `AddressRatchetKeys` bundle the requester used, so the owner selects the matching private keys: ```haskell AgentConfirmation @@ -134,62 +159,84 @@ AgentConfirmation Encoding (extends Protocol.hs:853-866): from `addressDRVersion`, `smpEncode (agentVersion, 'C', e2eEncryption_, ratchetKeyId, Tail encConnInfo)`, where `ratchetKeyId` is `Just` for an address-DR confirmation and `Nothing` for the current joiner-to-initiator and initiator-to-joiner confirmations; earlier versions omit the field entirely and use `smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo)`. Parsing gates the field on `agentVersion`. `CRInvitationUri` is unchanged - a connection request URI holds Rcv parameters and must not hold Snd parameters. +### Stored request - the invitation record + +The `conn_invitations` record stays; only the type of the stored request widens. From chat's point of view a DR request is still an invitation - it "contains a confirmation" instead of an invitation URI - so `REQ`, `acceptContact'`/`rejectContact'`, and the chat side are unchanged; the change is contained in the agent. The `NewInvitation`/`Invitation` request field (`cr_invitation`, stays `NOT NULL`) becomes a sum: + +```haskell +data ContactRequest + = CRInvitation (ConnectionRequestUri 'CMInvitation) -- classic: joinConn on accept (O3-O6) + | CRConfirmation DRRequest -- DR: continue the ratchet on accept (O3') + +data DRRequest = DRRequest + { drRatchet :: RatchetX448, -- post-decrypt receiving ratchet (with send side), stored inline + drReplyQueue :: SMPQueueInfo -- Q_A, where the owner replies + } +``` + +`recipient_conn_info` holds the profile in both cases. `getInvitation`/`createInvitation` carry `ContactRequest`; `acceptContact'` branches on the constructor. There is no dedup column: a resent request produces another `REQ`, exactly as a resent classic invitation does. + ## Part 4 - key rotation (separate concern) -Rotation is required but independent of the handshake above. The link ratchet key is stable; the prekey and KEM pair rotate on a schedule. +Rotation is required but independent of the handshake above. The whole ratchet-keys bundle - both X448 keys and the KEM - rotates on a schedule, generated fresh each time. ### Schema ```sql --- private stable link ratchet key on the contact address receive queue -ALTER TABLE rcv_queues ADD COLUMN link_ratchet_priv_key BLOB; -- X448 - --- one row per ratchet-keys generation for an address; current plus retired-within-window +-- one row per ratchet-keys generation for an address; current plus retired-within-window. +-- private side of the advertised RcvE2ERatchetParamsUri - same shape as the ratchets x3dh +-- columns and createRatchetX3dhKeys (AgentStore.hs:1362-1367). CREATE TABLE address_ratchet_keys( address_ratchet_key_id INTEGER PRIMARY KEY AUTOINCREMENT, conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, - ratchet_key_id BLOB NOT NULL, -- the published id echoed by requests - prekey_priv_key BLOB NOT NULL, -- X448 private key (public derivable with publicKey) - kem_keypair BLOB, -- sntrup761 keypair (public + secret): the ratchet keeps the KEM keypair, and the retired public is not otherwise retained after LSET; NULL when PQ is off for this address + ratchet_key_id BLOB NOT NULL, -- the published id echoed by requests + x3dh_priv_key_1 BLOB NOT NULL, -- X448 + x3dh_priv_key_2 BLOB NOT NULL, -- X448 + pq_priv_kem BLOB, -- RcvPrivRKEMParams (sntrup761 keypair); NULL when PQ is off for this address created_at TEXT NOT NULL, - retired_at TEXT -- set on rotation + retired_at TEXT -- set on rotation ); CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); + +-- a DR request stays in conn_invitations with NO schema change: cr_invitation now holds a ContactRequest +-- sum (an invitation URI or a confirmation carrying the post-decrypt ratchet + reply queue), so it stays +-- NOT NULL - no nullable change, no new column on conn_invitations, no new table for the request. ``` -PostgreSQL mirrors this. Migration `M20260712_address_dr`. +`cr_invitation` stays `NOT NULL` - only its decoded value gains a variant (Part 3), so the invitations flow, `REQ`, and chat are unchanged; the only new storage is the `address_ratchet_keys` table. The link signing key is already on the address queue (`rcv_queues.link_priv_sig_key`, M20250322), so nothing is added there - rotation and retrofit re-sign mutable data with it. PostgreSQL mirrors this. Migration `M20260712_address_dr`. ### Rotation logic -`rotateRatchetKeys` (new), scheduled while the address is subscribed: +`rotateRatchetKeys` (new), run on address subscription, at most every 2 weeks (skip if the current generation is younger): -1. Generate an X448 prekey pair, and an sntrup761 pair only if PQ is on for this address, with a fresh `ratchetKeyId`. -2. Recompute mutable link data with the new `RatchetKeys`, re-sign with the root key (`encodeSignUserData`), and `LSET` it to the address queue (`addSMPQueueLink`/`setConnShortLink` path). -3. Insert the new `address_ratchet_keys` row; set `retired_at` on the previous row. +1. `generateRcvE2EParams` (Ratchet.hs:439) for a fresh generation - two X448 keys, and an sntrup761 keypair only if PQ is on for this address - with a fresh `ratchetKeyId`. +2. Recompute mutable link data with the new `AddressRatchetKeys` (the public `e2eParams`), re-sign with the root key (`encodeSignUserData`, key from `rcv_queues.link_priv_sig_key`), and `LSET` it to the address queue (`setConnShortLink` path). +3. Insert the new `address_ratchet_keys` row (`x3dh_priv_key_1`, `x3dh_priv_key_2`, `pq_priv_kem`); set `retired_at` on the previous row. -Retention window equals queue message retention (`storedMsgDataTTL`, Env/SQLite.hs:237), covering a request that used a just-retired prekey and is still in the address queue. Cadence is configuration; it bounds how long a recorded first message stays decryptable after a compromise of the current prekey - the link ratchet key alone decrypts nothing. +Retention window equals queue message retention (`storedMsgDataTTL`, Env/SQLite.hs:237), covering a request that used a just-retired bundle and is still in the address queue. The 2-week cadence bounds how long a recorded first message stays decryptable after a compromise of the current private keys - a retired generation is deleted after the window and then decrypts nothing. ### Cleanup -`cleanupManager` (Agent.hs:2994) gains two steps: delete `address_ratchet_keys` rows with `retired_at` older than the window; and delete pending DR request connections (below) never accepted or rejected, past a request TTL. Both are batched like `deleteRcvMsgHashesExpired` (Agent.hs:3001). +`cleanupManager` (Agent.hs:2994) gains one step: delete `address_ratchet_keys` rows with `retired_at` older than the window, batched like `deleteRcvMsgHashesExpired` (Agent.hs:3001). Unaccepted DR request rows in `conn_invitations` are handled exactly like unaccepted classic invitation requests - no DR-specific cleanup (a DR request is one `conn_invitations` row, the same class of state as a classic contact request). ## Part 5 - backward compatibility - A requester older than `addressDRVersion`, or an address without `ratchetKeys`, uses R2/R3 (`AgentInvitation`); the owner uses O1-O8. Unchanged. - The owner dispatches on the envelope: `AgentInvitation` -> `smpInvitation` (current); `AgentConfirmation` with `ratchetKeyId` on a `ContactConnection` -> `smpAddressConfirmation` (new). Both coexist. - `AgentConfirmation` without `ratchetKeyId` remains the current confirmation on established connections. +- An existing address gains `ratchetKeys` when the app updates the address - with the user's confirmation and the current profile - combined with the full→short address migration, not by the agent alone (which has neither the profile nor the user's intent). The update is an `LSET` of mutable data re-signed with `rcv_queues.link_priv_sig_key`; no new link is issued, because the keys are in mutable, not fixed, data. Requesters that fetch the updated data use DR; older ones still use `AgentInvitation`. ## Part 6 - tests -- Encoding roundtrips: `FixedLinkData` with and without `linkRatchetKey`; `UserContactData` with and without `ratchetKeys`, and with `kemKey` present and absent; `AgentConfirmation` with and without `ratchetKeyId`, across versions. -- Address creation advertises `linkRatchetKey`, `prekey`, and optionally `kemKey`; `decryptLinkData` (Crypto/ShortLink.hs:100) verifies hash and signatures and reconstructs the advertised `RcvE2ERatchetParamsUri` (then negotiates to concrete) with and without the KEM. -- Both PQ modes: an address with `kemKey` gives a hybrid ratchet (`pqEncryption` on); an address without gives an X448-only ratchet. +- Encoding roundtrips: `UserContactData` with and without `ratchetKeys`, and with the KEM present and absent; `AgentConfirmation` with and without `ratchetKeyId`, across versions. +- Address creation advertises `ratchetKeys` (the `RcvE2ERatchetParamsUri`); `decryptLinkData` (Crypto/ShortLink.hs:100) verifies signatures and the requester negotiates the advertised params to a concrete version, with and without the KEM. +- Both PQ modes: an address whose bundle carries a KEM gives a hybrid ratchet (`pqEncryption` on); one without gives an X448-only ratchet. - End to end: a DR-advertising address; a new requester establishes the ratchet, sends its profile under it, owner emits `REQ`, accepts, both reach `CON`; assert the profile never travels under per-queue-only encryption; assert `pqEncryption` on. -- Rotation: request against the current prekey; request against a just-retired prekey within the window still decrypts; request against a prekey past the window is discarded and the requester times out. +- Rotation and retrofit: request against the current bundle; against a just-retired bundle within the window still decrypts; against a bundle past the window is discarded and the requester times out; an address that adds `ratchetKeys` via `LSET` is then reached by DR while an old requester still uses `AgentInvitation`. - Backward compatibility: old requester against a DR address connects via `AgentInvitation`; new requester against a non-DR address falls back to `AgentInvitation`. ## Part 7 - phases -1. Link data: `linkRatchetKey`, `RatchetKeys` (with optional `kemKey`), encodings, reconstruction, `encodeSignFixedData`/`encodeSignUserData`; address creation generating and storing the link ratchet private key and the first prekey row. -2. Handshake: requester R2'/R3', `AgentConfirmation.ratchetKeyId`, owner O1'/O2'/O3', `smpConfirmation` `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance; end-to-end connection with the profile under the ratchet. -3. Rotation: schema migration, `rotateRatchetKeys`, retention window, cleanup step, rotation tests. +1. Link data: `AddressRatchetKeys` in `UserContactData` (reusing `RcvE2ERatchetParamsUri`), encoding, `encodeSignUserData`; `AgentConfirmation.ratchetKeyId`; address creation taking `InitialKeys` (lifting the `IKUsePQ`-for-`SCMContact` prohibition), generating (`generateRcvE2EParams`, KEM per `initialPQEncryption False`) and storing the first `address_ratchet_keys` row. +2. Handshake: requester R2'/R3'; owner O1'/O2'/O3' storing the DR request as a `conn_invitations` row whose request value is the `CRConfirmation` variant; `smpConfirmation` `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance; end-to-end connection with the profile under the ratchet. +3. Rotation and retrofit: schema migration, `rotateRatchetKeys`, retention window, cleanup step, app-driven `LSET` retrofit (with the full→short address migration), rotation/retrofit tests. diff --git a/rfcs/2026-07-12-address-pqdr-keys.md b/rfcs/2026-07-12-address-pqdr-keys.md index d4846c7c6..dad2bb76d 100644 --- a/rfcs/2026-07-12-address-pqdr-keys.md +++ b/rfcs/2026-07-12-address-pqdr-keys.md @@ -15,14 +15,11 @@ The cause is that the address owner's X3DH contribution is generated per request Publish the address owner's X3DH contribution in the address link data, so a requester can establish the double ratchet in its first message. The requester runs the existing `pqX3dhSnd` against the published keys, initializes a sending ratchet, and encrypts its first message under it. The owner runs the existing `pqX3dhRcv` against its stored private keys and the requester's X3DH keys from the message, initializes a receiving ratchet, and decrypts it. -The published keys follow the X3DH structure: +Publish the owner's X3DH contribution - two X448 keys and an optional sntrup761 KEM key, with the e2e version range - as one bundle in the mutable contact user data, signed by the root key. The bundle is the existing `RcvE2ERatchetParamsUri` type that a one-time invitation already advertises, with an id for rotation. -- The link ratchet key - the stable first X3DH key - goes in the immutable fixed link data, next to the root key, committed by the link hash. -- The prekey, the KEM encapsulation key, and the e2e version range go in the mutable user data as a ratchet-keys bundle with an id, signed by the root key, rotated with `LSET`. +This is backward compatible. A requester that does not use the published bundle sends a current `AgentInvitation` with its own X3DH keys, and the owner does what it does today: generates fresh X3DH keys and sends them in the confirmation. The owner branches on whether the incoming message uses the published bundle. -This is backward compatible. A requester that does not use the published keys sends a current `AgentInvitation` with its own X3DH keys, and the owner does what it does today: generates fresh X3DH keys and sends them in the confirmation. The owner branches on whether the incoming message uses the published keys. - -Two properties follow. The first message, including the profile, is under the double ratchet, which closes the profile gap and gives it post-quantum protection through the ratchet's sntrup761 KEM. And a decryptable message proves the sender established X3DH against the link ratchet key committed by the link hash, so it authenticates the address owner without a separate signature. +Three properties follow. The first message, including the profile, is under the double ratchet, which closes the profile gap and gives it post-quantum protection through the ratchet's sntrup761 KEM. A decryptable message proves the sender established X3DH against the root-signed keys, so it authenticates the address owner without a separate signature. And because the bundle is in mutable data, an existing address can advertise the double ratchet by updating its mutable data - no new link. ## Design @@ -30,27 +27,18 @@ Syntax uses [ABNF][1] with [case-sensitive strings extension][2]. Key and ratche ### Published keys in link data -The link ratchet key is appended to fixed link data: - -```abnf -fixedData =/ linkRatchetKey ; appended, ignored by earlier versions -linkRatchetKey = %s"0" / (%s"1" length x509encoded) ; X448, stable, the first X3DH key -``` - -The ratchet-keys bundle is appended to contact user data: +The owner's X3DH contribution is a ratchet-keys bundle appended to the mutable contact user data, signed by the root key. Nothing is added to the immutable fixed link data: ```abnf userContactData =/ ratchetKeys ; appended, ignored by earlier versions -ratchetKeys = %s"0" / (%s"1" ratchetKeyId e2eVRange prekey kemKey) +ratchetKeys = %s"0" / (%s"1" ratchetKeyId e2eParams) ratchetKeyId = shortString ; identifies this bundle, changes on rotation, echoed in the request -e2eVRange = -prekey = length x509encoded ; X448 -kemKey = %s"0" / (%s"1" largeString) ; sntrup761 encapsulation key, optional (PQ is opt-in) +e2eParams = ``` -Together these reconstruct the owner's X3DH contribution as an `RcvE2ERatchetParamsUri` - a version-range form: `linkRatchetKey` (from fixed data) as the first key, `prekey` as the second, `kemKey` as the optional KEM parameter, `e2eVRange` as the version range. The requester negotiates the concrete version against its own e2e range, as it does for an invitation, then runs `pqX3dhSnd` against the result. +`e2eParams` is the existing `RcvE2ERatchetParamsUri` - the same type a one-time invitation advertises - so a requester reads it, negotiates the concrete e2e version against its own range, and runs `pqX3dhSnd` against it, exactly as it does for an invitation. The KEM key is optional (the params' KEM field is a `Maybe`), controlled by the address's initial-keys mode, the same 3-way choice as invitations: advertise the KEM (post-quantum from the first message), advertise X448-only but still support post-quantum if the requester proposes its own KEM (one message later, avoiding the ~1158-byte key in link data), or no post-quantum. -The owner keeps the private prekey and, when PQ is on, the KEM keypair, indexed by `ratchetKeyId`. On rotation with `LSET` it publishes a new bundle with a new `ratchetKeyId` and keeps the previous private keys for a window covering queue message retention, so a request that used a just-rotated prekey still decrypts. The link ratchet key is stable and not rotated. +The owner keeps the private side of each bundle - the two X448 private keys and, when PQ is on, the KEM keypair - indexed by `ratchetKeyId`. On rotation with `LSET` it publishes a new bundle with a new `ratchetKeyId` and keeps the previous private keys for a window covering queue message retention, so a request that used a just-rotated bundle still decrypts. Because the bundle is in mutable data, an existing address advertises the double ratchet by updating its mutable data - no new link, no re-creation. ### Request confirmation @@ -66,26 +54,27 @@ The confirmation holds the requester's Snd X3DH parameters (so the owner runs `p Requester: -1. Retrieve link data (`LGET`), read the link ratchet key, the prekey with its `ratchetKeyId`, the `e2eVRange`, and the optional KEM key, reconstruct the owner's `RcvE2ERatchetParamsUri`, and negotiate the concrete version against its own e2e range. -2. `generateSndE2EParams` for its own X3DH contribution (with the KEM only when the address advertises one). -3. `pqX3dhSnd` against the owner's parameters, then `initSndRatchet` - the sending ratchet. +1. Retrieve link data (`LGET`), read the bundle - its `ratchetKeyId` and `e2eParams` (`RcvE2ERatchetParamsUri`) - and negotiate the concrete e2e version against its own range. +2. `generateSndE2EParams` for its own X3DH contribution - encapsulating to the bundle's KEM if it advertises one, or proposing its own KEM if the requester wants post-quantum and the bundle is X448-only. +3. `pqX3dhSnd` against the bundle's parameters, then `initSndRatchet` - the sending ratchet. 4. Encrypt the first message under the ratchet, and send a confirmation with its Snd parameters and `ratchetKeyId`. Owner: -1. On a confirmation with `ratchetKeyId` on a contact address, select the private prekey and, if any, KEM keypair by `ratchetKeyId` (current or a retained previous generation). -2. `pqX3dhRcv` against the requester's Snd parameters with the link ratchet, prekey, and optional KEM private keys, then `initRcvRatchet` - the receiving ratchet. Decrypting the first message advances the ratchet and gives it a send side, so the owner can reply. +1. On a confirmation with `ratchetKeyId` on a contact address, select the private X3DH keys and, if any, KEM keypair by `ratchetKeyId` (current or a retained previous generation). +2. `pqX3dhRcv` against the requester's Snd parameters with those private keys, then `initRcvRatchet` - the receiving ratchet. Decrypting the first message advances the ratchet and gives it a send side, so the owner can reply. 3. Decrypt, and reply under the ratchet. A request whose `ratchetKeyId` is no longer retained cannot be decrypted; the owner does not learn the requester or its reply address, and the requester's attempt fails at its own timeout. ### Authentication -The ratchet is established against the link ratchet key committed by the link hash and the prekey signed by the root key, so a decryptable message proves the sender established X3DH against the owner's published, link-committed keys. Where a message today relies on a separate signature over its content for authenticity, this establishment provides it, and the signature is not needed. The link ratchet key is a DH key (X448) and X3DH is over crypto_box, so deniability is preserved; the signing identity (the root key) and the DH key are separate keys, both anchored to the link hash. Reusing the link ratchet key across requesters is consistent with the address already being a shared identifier. +The ratchet-keys bundle is in the mutable link data, signed by the root key. A decryptable message proves the sender established X3DH against those root-signed keys: an SMP server cannot substitute them without forging the root signature (`decryptLinkData` verifies it), which is the X3DH anti-substitution property. Where a message today relies on a separate signature over its content for authenticity, this establishment provides it, and the signature is not needed. The root Ed25519 key is the address's signing identity; the X3DH keys are separate DH keys (X448), and X3DH is over crypto_box, so deniability is preserved. A malicious server can still serve an older but validly-signed bundle (rollback to a retired generation); this is bounded by the retention window and by the ratchet advancing after the first message, and a per-key signature would not prevent it. Reusing a bundle across requesters is consistent with the address already being a shared identifier. ## Uses - Invitations to an address, and the profile in them, are under the double ratchet from the first message. +- An existing address gains the double ratchet when the app updates its mutable link data (`LSET`, with the user's confirmation and current profile, combined with the full→short address migration); no new link is issued. - The service RPC (see the RPC RFC) establishes the ratchet this way to send the request as the first ratchet message. This RFC depends on nothing else here. It replaces the need for the PQ-queue RFC in the address case, because the ratchet provides post-quantum protection for the first message; the PQ-queue RFC remains for first messages that do not establish a ratchet. From af99df73ccce867e558912929dc848173f9d7b3a Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 07:53:46 +0000 Subject: [PATCH 07/81] update plan --- plans/2026-07-12-address-dr-implementation.md | 35 +++++++++++++++---- 1 file changed, 28 insertions(+), 7 deletions(-) diff --git a/plans/2026-07-12-address-dr-implementation.md b/plans/2026-07-12-address-dr-implementation.md index 86d72beb4..2e67713bc 100644 --- a/plans/2026-07-12-address-dr-implementation.md +++ b/plans/2026-07-12-address-dr-implementation.md @@ -8,6 +8,8 @@ Goal: a contact address advertises the owner's X3DH parameters in link data; a r Version: `addressDRVersion = VersionSMPA 8`, a plain agent-layer bump; `currentSMPAgentVersion` goes 7 → 8 (Agent/Protocol.hs:317-324). It gates the `AgentConfirmation.ratchetKeyId` field and the DR-from-address behavior. The receive-at-address path relies on ratchet-on-confirmation, already present since `ratchetOnConfSMPAgentVersion = 7` (Agent/Protocol.hs:317), so there is no cross-layer version dependency; the SMP and e2e-encryption versions are unchanged. +Scope of this change: the **synchronous** DR handshake in join, gated on the address advertising `ratchetKeys`. `joinConnection`/`joinConn`/`joinConnSrv` gain an optional `Maybe AddressRatchetKeys` (the advertised `RcvE2ERatchetParamsUri` + `ratchetKeyId`), passed in from the link data the caller fetched at plan time (`LGET`); present → DR path (R2'/R3'), absent → the classic `AgentInvitation`. Chat wires that argument later (a chat change); the agent supports it now and tests pass it directly. Making the send **async** (worker retry, a "connecting" UX, the `CreatedConnLink` LGET-gate) is **deferred** - kept below under "Deferred" as future work, not part of this change. + ## Part 1 - the current contact-address handshake, step by step Requester Alice connects to owner Bob's contact address. Q_A is Alice's receive queue (Bob to Alice), Q_B is Bob's receive queue (Alice to Bob). @@ -45,10 +47,18 @@ Completion is direct `CON` on `senderCanSecure` (SKEY) messaging-mode queues (th The address advertises Bob's Rcv X3DH parameters in link data (Part 3). Alice, when the address advertises them and versions are compatible, takes the joiner role; Bob takes the initiator role. -Requester side - a new branch in `joinConnSrv … CRContactUri`, chosen when the fetched link data has `ratchetKeys`: +Requester side - a new branch in `joinConnSrv … CRContactUri`, taken when the passed `Maybe AddressRatchetKeys` is present (the caller's plan-time `LGET`): + +- R2'. Replaces R2/R3. Read the passed bundle - `ratchetKeyId` and `e2eParams :: RcvE2ERatchetParamsUri 'C.X448` - and negotiate the concrete version with `compatibleVersion` against the client e2e range, as `compatibleInvitationUri` does (Agent.hs:1362-1368). Create the receive queue Q_A subscribed (`newRcvQueue` with `subMode`), messaging mode so Bob can secure it. Choose the requester's KEM with `replyKEM_ v ownerKem_ pqSup` (Ratchet.hs:839): if the bundle advertises a KEM (owner `IKUsePQ`) the requester `AcceptKEM` - a **double KEM**: it both encapsulates to the address KEM (ciphertext) and includes its own new KEM public key (`generateSndE2EParams` → `sntrup761Enc` + a fresh keypair, Ratchet.hs:433-435), so PQ is bidirectional from message 1; if the bundle has no KEM and the requester wants PQ, it `ProposeKEM` (its own key only, PQ from message 2 if the owner supports it). Run `generateSndE2EParams g v (replyKEM_ …)`, `pqX3dhSnd` against the negotiated parameters, `initSndRatchet`, `createSndRatchet` - the body of `createRatchet_` (Agent.hs:1343-1350), with parameters from the passed bundle rather than a received invitation. +- R3'. Build `AgentConfirmation {e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just ratchetKeyId, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_A :| []) aliceProfile)}` - the `mkAgentConfirmation`/`mkConfirmation` bodies (Agent.hs:3780-3765) with the reply queue being Alice's own Q_A. Send it to the address queue unauthenticated with `agentCbEncryptOnce`, one-shot (as `sendInvitation` sends, Agent/Client.hs:1929-1934) - **synchronous**, with the same send-failure UX as today's classic contact join. Nothing is stored: a retry (chat re-invokes the join → `mkJoinInvitation` reuses Q_A + keys, 1418) re-builds the confirmation, advancing the send ratchet, and the owner absorbs the advance - a **failed send** is skipped when the owner establishes the ratchet (`maxSkip = 512`, Ratchet.hs:988), and a **lost reply** carries the current content and updates the owner's request by `XContactId` (ContactRequest.hs:99-101, 269); both testable. The requester does **not** SKEY the address (`QMContact`, not `senderCanSecure`); rotation is handled because the passed params are the current advertised keys. **Alice's profile is now inside `encConnInfo`, under the ratchet.** Alice's connection is `RcvConnection` (Q_A) with a send ratchet, until she receives Q_B. This "New `RcvConnection` + `ratchets` row" is a new state (today a New `RcvConnection` holds x3dh keys but no ratchet - the classic initiator builds the ratchet only at R5, `createRatchet` Agent.hs:3436), and it composes: connection type is derived from queue rows alone while the `ratchets` table is keyed independently by `conn_id`, so subscription (Agent.hs:1551), `connectionStats` (2658), and `allowConnectionAsync'` (888) never read the ratchet for a `RcvConnection`; the only handshake reader on it is `smpConfirmation` (R5'). + +### Deferred (future work): async delivery + connect UX + +The synchronous send above fails in the user's face on a lost reply (the same wart as today's classic contact join), even though the request may have been delivered. Making it async is a separate, later change, not part of this DR work: -- R2'. Replaces R2/R3. Read the advertised bundle from link data - `ratchetKeyId` and `e2eParams :: RcvE2ERatchetParamsUri 'C.X448` - and negotiate the concrete version with `compatibleVersion` against the client e2e range, as `compatibleInvitationUri` does (Agent.hs:1362-1368). Create the receive queue Q_A subscribed (`newRcvQueue` with `subMode`), messaging mode so Bob can secure it. Choose the requester's KEM with `replyKEM_ v ownerKem_ pqSup` (Ratchet.hs:839): if the bundle advertises a KEM (owner `IKUsePQ`) the requester encapsulates to it (`AcceptKEM`, PQ from message 1); if not and the requester wants PQ, it proposes its own (`ProposeKEM`, PQ from message 2 if the owner supports it). Run `generateSndE2EParams g v (replyKEM_ …)`, `pqX3dhSnd` against the negotiated parameters, `initSndRatchet`, `createSndRatchet` - the body of `createRatchet_` (Agent.hs:1343-1350), with parameters from link data rather than a received invitation. -- R3'. Build `AgentConfirmation {e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just ratchetKeyId, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_A :| []) aliceProfile)}` - the `mkAgentConfirmation`/`mkConfirmation` bodies (Agent.hs:3780-3765) with the reply queue being Alice's own Q_A. Send it to the address queue unauthenticated with `agentCbEncryptOnce`, as `sendInvitation` sends (Agent/Client.hs:1929-1934). Retry is chat re-invoking the join, reusing the prepared connection's keys via the existing `startJoinInvitation`-style reuse (Agent.hs:1314) - exactly as a classic contact request; a resend is not deduplicated (it may produce another `REQ` on the owner, as a resent classic invitation does). The connect UX (premature failure, lost-reply recovery) is a separate chat-layer concern, out of scope here. **Alice's profile is now inside `encConnInfo`, under the ratchet.** Alice's connection is `RcvConnection` (Q_A) with a send ratchet, until she receives Q_B. +- Delivery cannot use the message-delivery worker: a `SndQueue` is unique per `(host, port, snd_id)` and belongs to one connection (schema PK), while a contact address is one queue that many connections send to, so no per-connection SndQueue to it can exist. It would go through the **async command worker**, keyed by `(connId, server)` (`getAsyncCmdWorker`, Agent.hs:1856-1858), which already retries the `JOIN` command (`tryMoveableCommand` → `retrySndOp`, 2016-2024); each retry re-runs `joinConnSrv` (re-build + ratchet advance, which the owner absorbs - above), so nothing is stored. (`joinConnSrvAsync` for `CRContactUri` is `CMD PROHIBITED` today, Agent.hs:1452, and the `JOIN` handler falls back to sync `joinConnSrv`, 1899-1902; the `TBC` at Agent.hs:1897 is about async *receive*-queue creation - Q_A - and is orthogonal.) +- The async join returns "connecting" early and completes via the INFO/CON events chat already handles (`joinContact` sets `ConnJoined`; the DR requester auto-completes in R5' and emits INFO + CON, which `agentMsgConnStatus` processes with no prior `CONF`, Subscriber.hs:421-422; a permanent send failure still surfaces as `ERR → ConnFailed`). +- This needs a chat change: the join API takes a `CreatedConnLink` (full + short link), not the bare `ConnectionRequestUri` it takes today, so the agent can LGET-gate on the owner's server (a real reachability check) and verify the fetched `linkConnReq` equals the passed full link before reporting success. Used only for DR addresses (link data advertises `ratchetKeys`); old / non-DR addresses stay on the current sync path. Owner side - a new dispatch branch and a new receive handler: @@ -58,7 +68,7 @@ Owner side - a new dispatch branch and a new receive handler: Requester side, receiving the response on Q_A: -- R5'. `smpConfirmation` needs a new branch `RcvConnection … Nothing` (today only `RcvConnection … Just` and `DuplexConnection … Nothing` exist, Agent.hs:3403-3447): Alice already holds the send ratchet, so `agentRatchetDecrypt` advances it and creates the receive side; `setRcvQueueConfirmedE2E` on Q_A so later messages use the stored per-queue secret (as the current branches do, Agent.hs:3440,3455); parse `AgentConnInfoReply (Q_B :| []) bobInfo`; emit `INFO` (Bob's profile); then `connectReplyQueues` (Agent.hs:3724) - create Alice's send queue to Q_B, secure Q_B with `SKEY` (`agentSecureSndQueue`, Q_B is messaging mode), upgrade to `DuplexConnection`, and `enqueueConfirmation … Nothing` to send the third message, `AgentConnInfo` to Q_B (`encConnInfo = ratchetEncrypt(AgentConnInfo aliceInfo)`). Because Q_B is sender-securable, sending `AgentConnInfo` completes Alice with `CON` (Agent.hs:2252) - no `HELLO`. +- R5'. `smpConfirmation` needs a new branch `RcvConnection … Nothing` (today only `RcvConnection … Just` and `DuplexConnection … Nothing` exist, Agent.hs:3403-3447). It must look up the ratchet first (`getRatchet`) and, if there is none, fall through to `prohibited "conf: incorrect state"` - so a classic initiator (a New `RcvConnection` with x3dh keys but no ratchet) that receives a stray `Nothing`-confirmation keeps today's exact outcome; only a DR requester, which does hold a send ratchet, takes the new path. Alice already holds the send ratchet, so `agentRatchetDecrypt` advances it and creates the receive side; `setRcvQueueConfirmedE2E` on Q_A so later messages use the stored per-queue secret (as the current branches do, Agent.hs:3440,3455); parse `AgentConnInfoReply (Q_B :| []) bobInfo`; emit `INFO` (Bob's profile); then `connectReplyQueues` (Agent.hs:3724) - create Alice's send queue to Q_B, secure Q_B with `SKEY` (`agentSecureSndQueue`, Q_B is messaging mode), upgrade to `DuplexConnection`, and `enqueueConfirmation … Nothing` to send the third message, `AgentConnInfo` to Q_B (`encConnInfo = ratchetEncrypt(AgentConnInfo aliceInfo)`). Because Q_B is sender-securable, sending `AgentConnInfo` completes Alice with `CON` (Agent.hs:2252) - no `HELLO`. - R6'/completion. Unchanged from the current contact handshake, and modern (no `HELLO`). The exchange is three agent↔agent wire messages - Alice → address queue (msg 1), Bob → Q_A (msg 2, an `AgentConfirmation` carrying `AgentConnInfoReply` with Q_B), Alice → Q_B (msg 3, an `AgentConfirmation` carrying `AgentConnInfo`) - the same shape as the current contact flow, where msg 1 was `AgentInvitation`; here it is the ratchet-establishing `AgentConfirmation`. (`CON` is not a wire message - it is the agent→app event; `HELLO` and `AgentConnInfo` are the wire messages.) `HELLO` belongs to the older non-`senderCanSecure` path (duplexHandshake v2, before SKEY): there the confirmation secures the queue in-band (`PHConfirmation` carries the sender key, Client.hs:1918) and the receiver replies with `HELLO` (`ICDuplexSecure` → `enqueueDuplexHello`, Agent.hs:3457-3458). Both Q_A and Q_B here are messaging-mode - Q_A by R2', Q_B via `createReplyQueue` → `SCMInvitation` → `QMMessaging` (Agent.hs:1233,1458,3783) - so the sender secures with SKEY and sends `PHEmpty` (Client.hs:1918), the dispatch takes the `senderCanSecure` branch (Agent.hs:3182-3184), and each agent raises the `CON` app event locally off msg 3 - Bob on receiving it (`senderKey = Nothing`, Agent.hs:3459-3461), Alice on sending it (Agent.hs:2252) - with no separate `HELLO` wire message. (msg 2's `AgentConnInfoReply` only sets Q_A `Confirmed`, Agent.hs:2254.) Invitations are two messages because the initiator's queue is already in the link; a contact address needs three because Bob's receive queue Q_B is only delivered in msg 2. The third message no longer has a ratchet role: Bob's X3DH params are pre-published, so the agreement is complete once Bob receives msg 1 (in the current flow Bob's Snd params instead arrive in msg 2). msg 2 and msg 3 are queue setup - msg 2 delivers Q_B, msg 3 secures Q_B so Alice can send to Bob and signals Bob's `CON`; neither negotiates the ratchet. A one-directional exchange (the RPC) needs no Q_B and is two messages. Net code touch points: `joinConnSrv` (new requester branch), `processClientMsg` (new owner dispatch), `smpConfirmation` (new `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance), `acceptContact'` (new continue-ratchet branch), a new `smpAddressConfirmation` reusing `createInvitation`/`getInvitation` with the sum request value, and the link data and storage of Part 3-4. `rejectContact'` is unchanged (it deletes the `conn_invitations` row either way). @@ -170,12 +180,23 @@ data ContactRequest data DRRequest = DRRequest { drRatchet :: RatchetX448, -- post-decrypt receiving ratchet (with send side), stored inline - drReplyQueue :: SMPQueueInfo -- Q_A, where the owner replies + drReplyQueue :: SMPQueueInfo, -- Q_A, where the owner replies + drAgentVersion :: VersionSMPA, -- negotiated at receive; needed to build the connection shell at accept + drPQSupport :: PQSupport -- the address's PQ setting for this connection } ``` `recipient_conn_info` holds the profile in both cases. `getInvitation`/`createInvitation` carry `ContactRequest`; `acceptContact'` branches on the constructor. There is no dedup column: a resent request produces another `REQ`, exactly as a resent classic invitation does. +`drAgentVersion`/`drPQSupport` are stored because the accept flow creates the connection **shell** through `newConnToAccept` → `newConnToJoin` (via `prepareConnectionToAccept`, called by chat's sync accept before `acceptContact'`, Internal.hs:914,925) and `newConnToJoin` today derives `connAgentVersion`/`pqSupport` from the `ConnectionRequestUri` (Agent.hs:1277-1293); a `CRConfirmation` has no URI, so the values negotiated at receive (O2') are stored and used to build the shell. + +Three readers of the widened `connReq` field (all via `getInvitation`) branch on the constructor: +- `acceptContact'` (Agent.hs:1479, sync): `CRInvitation cr` → `joinConn … cr` (classic, unchanged); `CRConfirmation dr` → the O3' continue-ratchet path. +- `newConnToAccept` (Agent.hs:1296, via `prepareConnectionToAccept`): `CRInvitation cr` → `newConnToJoin … cr` (unchanged); `CRConfirmation dr` → create the `NewConnection` shell from `drAgentVersion`/`drPQSupport` (`createNewConn`, generating the connId). +- `acceptContactAsync'` (Agent.hs:900): `CRInvitation cr` → `joinConnAsync … cr` (unchanged); `CRConfirmation _` → `throwE $ CMD PROHIBITED` (async DR accept is deferred; DR requests accept synchronously). Chat's REQ/accept is unaffected either way - it only ever passes `invId`, never the `ContactRequest`, which stays internal to the agent. + +Storage: `cr_invitation`'s `ToField`/`FromField` (AgentStore.hs:2074-2076) change from `strEncode`/`strDecode` of `ConnectionRequestUri` to a tagged `ContactRequest` encoding (`smpEncode ('I', cr)` / `('C', dr)`). `FromField` tries the tagged decode first and falls back to decoding a legacy bare-URI blob as `CRInvitation`, so un-accepted pre-upgrade rows still decode. `smpInvitation` (Agent.hs:3618) wraps its `connReq` in `CRInvitation`; `smpAddressConfirmation` (O2') writes `CRConfirmation`. + ## Part 4 - key rotation (separate concern) Rotation is required but independent of the handshake above. The whole ratchet-keys bundle - both X448 keys and the KEM - rotates on a schedule, generated fresh each time. @@ -224,7 +245,7 @@ Retention window equals queue message retention (`storedMsgDataTTL`, Env/SQLite. - A requester older than `addressDRVersion`, or an address without `ratchetKeys`, uses R2/R3 (`AgentInvitation`); the owner uses O1-O8. Unchanged. - The owner dispatches on the envelope: `AgentInvitation` -> `smpInvitation` (current); `AgentConfirmation` with `ratchetKeyId` on a `ContactConnection` -> `smpAddressConfirmation` (new). Both coexist. - `AgentConfirmation` without `ratchetKeyId` remains the current confirmation on established connections. -- An existing address gains `ratchetKeys` when the app updates the address - with the user's confirmation and the current profile - combined with the full→short address migration, not by the agent alone (which has neither the profile nor the user's intent). The update is an `LSET` of mutable data re-signed with `rcv_queues.link_priv_sig_key`; no new link is issued, because the keys are in mutable, not fixed, data. Requesters that fetch the updated data use DR; older ones still use `AgentInvitation`. +- An existing address gains `ratchetKeys` via a new agent API (e.g. `updateContactAddressLink`) that the app calls with the mutable link data (profile/badge and any other short-link data): the agent generates the DR bundle if absent (the first `address_ratchet_keys` row and its stored private keys), adds `ratchetKeys` to `UserContactData`, re-signs with `rcv_queues.link_priv_sig_key`, and `LSET`s it. **Only mutable data changes - the address (link) is unchanged**, because the keys are in mutable, not fixed, data. Requesters that fetch the updated data use DR; older ones still use `AgentInvitation`. The agent does not do this on its own (it lacks the profile and the user's intent); the app drives it, combined with the full→short address migration. ## Part 6 - tests @@ -238,5 +259,5 @@ Retention window equals queue message retention (`storedMsgDataTTL`, Env/SQLite. ## Part 7 - phases 1. Link data: `AddressRatchetKeys` in `UserContactData` (reusing `RcvE2ERatchetParamsUri`), encoding, `encodeSignUserData`; `AgentConfirmation.ratchetKeyId`; address creation taking `InitialKeys` (lifting the `IKUsePQ`-for-`SCMContact` prohibition), generating (`generateRcvE2EParams`, KEM per `initialPQEncryption False`) and storing the first `address_ratchet_keys` row. -2. Handshake: requester R2'/R3'; owner O1'/O2'/O3' storing the DR request as a `conn_invitations` row whose request value is the `CRConfirmation` variant; `smpConfirmation` `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance; end-to-end connection with the profile under the ratchet. +2. Handshake: thread the optional `Maybe AddressRatchetKeys` through `joinConnection`/`joinConn`/`joinConnSrv` (present → DR branch, absent → classic); requester R2'/R3' (synchronous one-shot send); owner O1'/O2'/O3' storing the DR request as a `conn_invitations` row whose request value is the `CRConfirmation` variant; `smpConfirmation` `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance; end-to-end connection with the profile under the ratchet. Tests pass `AddressRatchetKeys` directly (chat wiring is later work). 3. Rotation and retrofit: schema migration, `rotateRatchetKeys`, retention window, cleanup step, app-driven `LSET` retrofit (with the full→short address migration), rotation/retrofit tests. From 1fe6b209bb1ecdc141486e7bfbbd7fd2afa9dc77 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 14:26:27 +0000 Subject: [PATCH 08/81] add double ratchet keys to address --- plans/2026-07-12-address-dr-implementation.md | 33 ++- simplexmq.cabal | 2 + src/Simplex/Messaging/Agent.hs | 246 ++++++++++++++---- src/Simplex/Messaging/Agent/Client.hs | 7 + src/Simplex/Messaging/Agent/Protocol.hs | 63 ++++- src/Simplex/Messaging/Agent/Store.hs | 44 +++- .../Messaging/Agent/Store/AgentStore.hs | 39 +++ .../Agent/Store/Postgres/Migrations/App.hs | 4 +- .../Migrations/M20260712_address_dr.hs | 31 +++ .../Agent/Store/SQLite/Migrations/App.hs | 4 +- .../SQLite/Migrations/M20260712_address_dr.hs | 30 +++ tests/AgentTests/FunctionalAPITests.hs | 60 ++--- tests/AgentTests/ShortLinkTests.hs | 20 +- tests/SMPProxyTests.hs | 8 +- 14 files changed, 474 insertions(+), 117 deletions(-) create mode 100644 src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs diff --git a/plans/2026-07-12-address-dr-implementation.md b/plans/2026-07-12-address-dr-implementation.md index 2e67713bc..431c2b227 100644 --- a/plans/2026-07-12-address-dr-implementation.md +++ b/plans/2026-07-12-address-dr-implementation.md @@ -10,6 +10,18 @@ Version: `addressDRVersion = VersionSMPA 8`, a plain agent-layer bump; `currentS Scope of this change: the **synchronous** DR handshake in join, gated on the address advertising `ratchetKeys`. `joinConnection`/`joinConn`/`joinConnSrv` gain an optional `Maybe AddressRatchetKeys` (the advertised `RcvE2ERatchetParamsUri` + `ratchetKeyId`), passed in from the link data the caller fetched at plan time (`LGET`); present → DR path (R2'/R3'), absent → the classic `AgentInvitation`. Chat wires that argument later (a chat change); the agent supports it now and tests pass it directly. Making the send **async** (worker retry, a "connecting" UX, the `CreatedConnLink` LGET-gate) is **deferred** - kept below under "Deferred" as future work, not part of this change. +### Implementation status (as built; `lib:simplexmq` compiles) + +**Done** (compiles): version bump; `RatchetKeyId`/`AddressRatchetKeys` types + `Encoding`, `UserContactData.ratchetKeys` (appended, backward-compatible); `AgentConfirmation.ratchetKeyId` (version-gated encode/decode); `ContactRequest`/`DRRequest` sum with tagged `Encoding` + `cr_invitation` `ToField`/`FromField` (legacy-URI fallback); `address_ratchet_keys` table + `createAddressRatchetKeys`/`getAddressRatchetKeys` (SQLite + Postgres migrations `M20260712_address_dr`); join threading (`Maybe AddressRatchetKeys`); requester R2'/R3' (`joinAddressDR` + `sendConfirmationToAddress`); owner O1' dispatch, O2' `smpAddressConfirmation`, O3' (`acceptContact'` continue-ratchet branch), all three `connReq` readers (`acceptContact'`, `acceptContactAsync'` → `CMD PROHIBITED` for DR, `newConnToAccept` → shell from `drAgentVersion`/`drPQSupport`); requester R5' (`smpConfirmation` `RcvConnection … Nothing` branch, guarded on a ratchet existing); address-creation bundle generation (`mkAddressRatchetKeys`) wired into `createConnectionForLink'` (`IKUsePQ`-for-`SCMContact` prohibition lifted there). + +**Deltas from the plan discovered while building:** +- **R5' emits `CONF` and reuses the allow step** (not auto-complete). The DR requester is a `RcvConnection` receiving the owner's reply - the same position as the classic contact requester, which goes `CONF` → `allowConnection'` → `connectReplyQueues` (msg 3). R5' mirrors that (differing only in that the ratchet already exists, so it `getRatchet` + `rcDecrypt` instead of building it), so the app supplies `ownConnInfo` for msg 3 at allow, exactly as today. No new storage. +- **`DRRequest` carries `drAgentVersion` + `drPQSupport`** (Part 3): the sync accept creates the connection shell via `newConnToAccept`→`newConnToJoin` before O3', and there is no URI to derive the version/PQ from. +- `RatchetX448` is JSON-serialized, so `DRRequest`'s `Encoding` embeds it as a `Large` JSON blob; `PQSupport` (no `Encoding`) is stored via its `Bool`. +- **DR is opt-in per address**: `createConnectionForLink'`/`createConnectionForLink` gain a `Maybe InitialKeys` DR parameter (separate from the existing connection-PQ `InitialKeys`) - `Nothing` = no DR (old behavior, existing callers), `Just ik` = advertise the bundle with `ik`. The `IKUsePQ`-for-`SCMContact` prohibition stays on the connection-PQ parameter and is lifted only for the DR bundle. + +**Not yet done:** rotation (`rotateRatchetKeys`, Part 4), cleanup step (Part 4), the app-driven `LSET` upgrade API (Part 5), wiring the DR parameter into the non-prepared-link `newRcvConnSrv` path, tests (Part 6), regenerating `agent_schema.sql` if a schema-consistency test requires it, and chat wiring (deferred by design). + ## Part 1 - the current contact-address handshake, step by step Requester Alice connects to owner Bob's contact address. Q_A is Alice's receive queue (Bob to Alice), Q_B is Bob's receive queue (Alice to Bob). @@ -57,18 +69,18 @@ Requester side - a new branch in `joinConnSrv … CRContactUri`, taken when the The synchronous send above fails in the user's face on a lost reply (the same wart as today's classic contact join), even though the request may have been delivered. Making it async is a separate, later change, not part of this DR work: - Delivery cannot use the message-delivery worker: a `SndQueue` is unique per `(host, port, snd_id)` and belongs to one connection (schema PK), while a contact address is one queue that many connections send to, so no per-connection SndQueue to it can exist. It would go through the **async command worker**, keyed by `(connId, server)` (`getAsyncCmdWorker`, Agent.hs:1856-1858), which already retries the `JOIN` command (`tryMoveableCommand` → `retrySndOp`, 2016-2024); each retry re-runs `joinConnSrv` (re-build + ratchet advance, which the owner absorbs - above), so nothing is stored. (`joinConnSrvAsync` for `CRContactUri` is `CMD PROHIBITED` today, Agent.hs:1452, and the `JOIN` handler falls back to sync `joinConnSrv`, 1899-1902; the `TBC` at Agent.hs:1897 is about async *receive*-queue creation - Q_A - and is orthogonal.) -- The async join returns "connecting" early and completes via the INFO/CON events chat already handles (`joinContact` sets `ConnJoined`; the DR requester auto-completes in R5' and emits INFO + CON, which `agentMsgConnStatus` processes with no prior `CONF`, Subscriber.hs:421-422; a permanent send failure still surfaces as `ERR → ConnFailed`). +- The async join returns "connecting" early and completes via the events chat already handles (`joinContact` sets `ConnJoined`; the DR requester emits `CONF` in R5' and the chat allows it, exactly as the classic contact requester, driving msg 3 → `CON`; a permanent send failure still surfaces as `ERR → ConnFailed`). - This needs a chat change: the join API takes a `CreatedConnLink` (full + short link), not the bare `ConnectionRequestUri` it takes today, so the agent can LGET-gate on the owner's server (a real reachability check) and verify the fetched `linkConnReq` equals the passed full link before reporting success. Used only for DR addresses (link data advertises `ratchetKeys`); old / non-DR addresses stay on the current sync path. Owner side - a new dispatch branch and a new receive handler: -- O1'. In `processClientMsg` (Agent.hs:3176-3187), add a branch in state `(Nothing, Just e2ePubKey)`: an `AgentConfirmation` with `ratchetKeyId = Just _` on a `ContactConnection` -> `smpAddressConfirmation` (new). It must be placed **before** the existing `(PHEmpty, AgentConfirmation) | senderCanSecure queueMode` case (Agent.hs:3182-3184), because a contact-address queue is `QMContact` (not `senderCanSecure`) and would otherwise fall into `prohibited "handshake: missing sender key"` (Agent.hs:3184). The address queue's `e2eDhSecret` stays `Nothing` (it is never set for a contact address - `smpInvitation` does not set it, Agent.hs:3609-3622), so every request is decrypted with its own ephemeral key via this `(Nothing, Just e2ePubKey)` path. +- O1'. In `processClientMsg` (Agent.hs:3176-3187), add a branch in state `(Nothing, Just e2ePubKey)`: an `AgentConfirmation` with `ratchetKeyId = Just _` **and** `e2eEncryption_ = Just _` on a `ContactConnection` -> `smpAddressConfirmation` (new). A `ratchetKeyId` without `e2eEncryption_` is ignored (it does not match this branch and falls through as a non-DR confirmation). It must be placed **before** the existing `(PHEmpty, AgentConfirmation) | senderCanSecure queueMode` case (Agent.hs:3182-3184), because a contact-address queue is `QMContact` (not `senderCanSecure`) and would otherwise fall into `prohibited "handshake: missing sender key"` (Agent.hs:3184). The address queue's `e2eDhSecret` stays `Nothing` (it is never set for a contact address - `smpInvitation` does not set it, Agent.hs:3609-3622), so every request is decrypted with its own ephemeral key via this `(Nothing, Just e2ePubKey)` path. - O2'. `smpAddressConfirmation` (new, modeled on `smpConfirmation` initiating branch, Agent.hs:3405-3444): select the private triple `(pk1, pk2, pKem)` by `ratchetKeyId` from `address_ratchet_keys`; `pqX3dhRcv pk1 pk2 pKem aliceSndParams`; `initRcvRatchet` with the address connection's stored `PQSupport` (`connPQEncryption` of the address `InitialKeys` - `On` for `IKUsePQ` and `IKPQOn`, `Off` for `IKPQOff`; this is what lets `IKPQOn` accept the requester's proposed KEM), combined with version compatibility as `smpConfirmation` derives `pqSupport'` (Agent.hs:3410); `rcDecrypt` of `encConnInfo` performs the first ratchet step, giving the ratchet its send side too (as it does for the initiator today), so the owner can later reply. Parse `AgentConnInfoReply (Q_A :| []) aliceProfile`. Store the request with `createInvitation` on the address connection (`contact_conn_id`), exactly as a classic invitation - except the request value is the `CRConfirmation` variant (Part 3) carrying the post-decrypt ratchet state and Q_A, and `recipient_conn_info` is `aliceProfile` - so **no connection or `ratchets` row is created at receive**, as with a classic invitation. Emit `REQ` with the `invitation_id`. A resend is not deduplicated: like a resent classic invitation it produces another `REQ` (the connect-UX fix for that is separate chat work). An unknown or expired `ratchetKeyId`, or a decryption failure: discard and acknowledge, as an undecryptable message is dropped today. This establishes ratchet state on unauthenticated input before the user accepts - see "Receive-time establishment, state, and abuse". - O3'. `acceptContact'` for a DR request - a new branch that continues the ratchet instead of `joinConn`. `getInvitation` returns the request; its `CRConfirmation` variant gives the stored ratchet state and Q_A. Create the connection now (as `joinConn` does for a classic invitation) and `createRatchet` (AgentStore.hs:1419) from the stored ratchet state. Reuse `mkAgentConfirmation` (Agent.hs:3780-3785) to create Bob's receive queue Q_B and return `AgentConnInfoReply (Q_B :| []) bobInfo`; create Bob's send queue to Q_A (`newSndQueue`, generating Bob's own sender key) and secure Q_A with `SKEY` using that key (`agentSecureSndQueue`, valid because Q_A is messaging mode) - the securing key is Bob's own, not taken from Alice's message; send the response to Q_A as `AgentConfirmation {e2eEncryption_ = Nothing, ratchetKeyId = Nothing, encConnInfo = ratchetEncrypt(AgentConnInfoReply (Q_B :| []) bobInfo)}` via `sendConfirmation` (`agentCbEncrypt` over Bob's send queue to Q_A, `PHEmpty` because Q_A is `senderCanSecure`) - exactly the current contact msg 2 path (Client.hs:1916), not `agentCbEncryptOnce`. The reply content is `AgentConnInfoReply`, not `AgentConnInfo`: it takes the `mkAgentConfirmation` path with `e2eEncryption_ = Nothing`, not the `enqueueConfirmation` path (which produces `AgentConnInfo`, Agent.hs:3789). `rejectContact'` deletes the `conn_invitations` row (the current behaviour), discarding the inline ratchet; no connection was created, so there is nothing else to clean up. Requester side, receiving the response on Q_A: -- R5'. `smpConfirmation` needs a new branch `RcvConnection … Nothing` (today only `RcvConnection … Just` and `DuplexConnection … Nothing` exist, Agent.hs:3403-3447). It must look up the ratchet first (`getRatchet`) and, if there is none, fall through to `prohibited "conf: incorrect state"` - so a classic initiator (a New `RcvConnection` with x3dh keys but no ratchet) that receives a stray `Nothing`-confirmation keeps today's exact outcome; only a DR requester, which does hold a send ratchet, takes the new path. Alice already holds the send ratchet, so `agentRatchetDecrypt` advances it and creates the receive side; `setRcvQueueConfirmedE2E` on Q_A so later messages use the stored per-queue secret (as the current branches do, Agent.hs:3440,3455); parse `AgentConnInfoReply (Q_B :| []) bobInfo`; emit `INFO` (Bob's profile); then `connectReplyQueues` (Agent.hs:3724) - create Alice's send queue to Q_B, secure Q_B with `SKEY` (`agentSecureSndQueue`, Q_B is messaging mode), upgrade to `DuplexConnection`, and `enqueueConfirmation … Nothing` to send the third message, `AgentConnInfo` to Q_B (`encConnInfo = ratchetEncrypt(AgentConnInfo aliceInfo)`). Because Q_B is sender-securable, sending `AgentConnInfo` completes Alice with `CON` (Agent.hs:2252) - no `HELLO`. +- R5'. `smpConfirmation` needs a new branch `RcvConnection … Nothing` (today only `RcvConnection … Just` and `DuplexConnection … Nothing` exist, Agent.hs:3403-3447). It looks up the ratchet first (`getRatchet`) and, if there is none, falls through to `prohibited "conf: incorrect state"` - so a classic initiator (a New `RcvConnection` with x3dh keys but no ratchet) that receives a stray `Nothing`-confirmation keeps today's exact outcome; only a DR requester, which holds a send ratchet, takes the new path. Alice already holds the send ratchet, so `rcDecrypt` advances it and creates the receive side; parse `AgentConnInfoReply (Q_B :| []) bobInfo`. **This mirrors the classic contact requester exactly**: `setRcvQueueConfirmedE2E` on Q_A, `createRatchet` the advanced ratchet, store the reply as a `NewConfirmation`, and emit **`CONF`** - the app then calls `allowConnection'` (supplying `ownConnInfo` for msg 3), which drives `connectReplyQueues` (create Alice's send queue to Q_B, `SKEY`, upgrade to `DuplexConnection`, `enqueueConfirmation` the `AgentConnInfo` msg 3). Because Q_B is sender-securable, sending `AgentConnInfo` completes Alice with `CON` (Agent.hs:2252) - no `HELLO`. The only difference from the classic requester is that the ratchet is pre-built (from R2') rather than built from Bob's Snd params here, so there is no `CONF`-less auto-completion and no separate storage of Alice's own info. - R6'/completion. Unchanged from the current contact handshake, and modern (no `HELLO`). The exchange is three agent↔agent wire messages - Alice → address queue (msg 1), Bob → Q_A (msg 2, an `AgentConfirmation` carrying `AgentConnInfoReply` with Q_B), Alice → Q_B (msg 3, an `AgentConfirmation` carrying `AgentConnInfo`) - the same shape as the current contact flow, where msg 1 was `AgentInvitation`; here it is the ratchet-establishing `AgentConfirmation`. (`CON` is not a wire message - it is the agent→app event; `HELLO` and `AgentConnInfo` are the wire messages.) `HELLO` belongs to the older non-`senderCanSecure` path (duplexHandshake v2, before SKEY): there the confirmation secures the queue in-band (`PHConfirmation` carries the sender key, Client.hs:1918) and the receiver replies with `HELLO` (`ICDuplexSecure` → `enqueueDuplexHello`, Agent.hs:3457-3458). Both Q_A and Q_B here are messaging-mode - Q_A by R2', Q_B via `createReplyQueue` → `SCMInvitation` → `QMMessaging` (Agent.hs:1233,1458,3783) - so the sender secures with SKEY and sends `PHEmpty` (Client.hs:1918), the dispatch takes the `senderCanSecure` branch (Agent.hs:3182-3184), and each agent raises the `CON` app event locally off msg 3 - Bob on receiving it (`senderKey = Nothing`, Agent.hs:3459-3461), Alice on sending it (Agent.hs:2252) - with no separate `HELLO` wire message. (msg 2's `AgentConnInfoReply` only sets Q_A `Confirmed`, Agent.hs:2254.) Invitations are two messages because the initiator's queue is already in the link; a contact address needs three because Bob's receive queue Q_B is only delivered in msg 2. The third message no longer has a ratchet role: Bob's X3DH params are pre-published, so the agreement is complete once Bob receives msg 1 (in the current flow Bob's Snd params instead arrive in msg 2). msg 2 and msg 3 are queue setup - msg 2 delivers Q_B, msg 3 secures Q_B so Alice can send to Bob and signals Bob's `CON`; neither negotiates the ratchet. A one-directional exchange (the RPC) needs no Q_B and is two messages. Net code touch points: `joinConnSrv` (new requester branch), `processClientMsg` (new owner dispatch), `smpConfirmation` (new `RcvConnection … Nothing` branch and `AgentConnInfoReply` acceptance), `acceptContact'` (new continue-ratchet branch), a new `smpAddressConfirmation` reusing `createInvitation`/`getInvitation` with the sum request value, and the link data and storage of Part 3-4. `rejectContact'` is unchanged (it deletes the `conn_invitations` row either way). @@ -128,15 +140,18 @@ Net difference: **only msg 1 and msg 2's L3/L4 change.** msg 1's L3 becomes `Age Appended to `UserContactData` (Protocol.hs:1840); the encoding stops at a trailing tail (Protocol.hs:1981), so earlier versions ignore it: ```haskell +newtype RatchetKeyId = RatchetKeyId ByteString -- opaque short id; one Encoding instance, shared below + data AddressRatchetKeys = AddressRatchetKeys - { ratchetKeyId :: ByteString, -- identifies this bundle; changes on rotation, echoed in the request + { ratchetKeyId :: RatchetKeyId, -- identifies this bundle; changes on rotation, echoed in the request e2eParams :: CR.RcvE2ERatchetParamsUri 'C.X448 -- version range + both X3DH keys + optional KEM } +instance Encoding AddressRatchetKeys where ... -- the key-bundle instance; both fields required data UserContactData = UserContactData { direct :: Bool, owners :: [OwnerAuth], relays :: [ConnShortLink 'CMContact], userData :: UserLinkData, - ratchetKeys :: Maybe AddressRatchetKeys + ratchetKeys :: Maybe AddressRatchetKeys -- whole bundle optional, one Encoding instance } ``` @@ -161,13 +176,15 @@ No signature is added on the keys: the mutable link data already signs them. `de ```haskell AgentConfirmation { agentVersion :: VersionSMPA, - e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), - ratchetKeyId :: Maybe ByteString, + e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), -- reused: Alice's Snd params in DR msg 1 + ratchetKeyId :: Maybe RatchetKeyId, -- selects the owner's key generation encConnInfo :: ByteString } ``` -Encoding (extends Protocol.hs:853-866): from `addressDRVersion`, `smpEncode (agentVersion, 'C', e2eEncryption_, ratchetKeyId, Tail encConnInfo)`, where `ratchetKeyId` is `Just` for an address-DR confirmation and `Nothing` for the current joiner-to-initiator and initiator-to-joiner confirmations; earlier versions omit the field entirely and use `smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo)`. Parsing gates the field on `agentVersion`. `CRInvitationUri` is unchanged - a connection request URI holds Rcv parameters and must not hold Snd parameters. +`ratchetKeyId` is a separate optional selector (the shared `RatchetKeyId` newtype), not the bundle - the owner already holds the published public bundle and looks up its private keys by this id. It reuses the existing `e2eEncryption_` for Alice's Snd params rather than a new combined bundle; the minor cost is two correlated `Maybe`s (`ratchetKeyId = Just` is only meaningful with `e2eEncryption_ = Just`). **A `ratchetKeyId` with `e2eEncryption_ = Nothing` is ignored** - O2' requires both (there are no Snd params to run `pqX3dhRcv`), so such a message falls through to the current dispatch as if it had no `ratchetKeyId`. + +Encoding (extends Protocol.hs:853-866): from `addressDRVersion`, `smpEncode (agentVersion, 'C', e2eEncryption_, ratchetKeyId, Tail encConnInfo)`; `ratchetKeyId` is `Just` for an address-DR confirmation and `Nothing` for the current joiner-to-initiator and initiator-to-joiner confirmations; earlier versions omit the field entirely and use `smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo)`. Parsing gates the field on `agentVersion`. `CRInvitationUri` is unchanged - a connection request URI holds Rcv parameters and must not hold Snd parameters. ### Stored request - the invitation record diff --git a/simplexmq.cabal b/simplexmq.cabal index 2f4651142..61b2fdaaf 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -188,6 +188,7 @@ library Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251230_strict_tables Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260410_receive_attempts Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs + Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr else exposed-modules: Simplex.Messaging.Agent.Store.SQLite @@ -240,6 +241,7 @@ library Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251230_strict_tables Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260410_receive_attempts Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs + Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr Simplex.Messaging.Agent.Store.SQLite.Util if flag(client_postgres) || flag(server_postgres) exposed-modules: diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index bd77b892a..ce224e431 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -422,8 +422,9 @@ prepareConnectionLink c userId rootKey linkEntityId checkNotices = withAgentEnv -- | Create connection for prepared link (single network call). -- Validates that server response matches the prepared link. -createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> SubscriptionMode -> AE ConnId -createConnectionForLink c nm userId enableNtfs = withAgentEnv c .::. createConnectionForLink' c nm userId enableNtfs +createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Maybe CR.InitialKeys -> SubscriptionMode -> AE ConnId +createConnectionForLink c nm userId enableNtfs ccLink params userLinkData pqInitKeys drInitKeys_ subMode = + withAgentEnv c $ createConnectionForLink' c nm userId enableNtfs ccLink params userLinkData pqInitKeys drInitKeys_ subMode {-# INLINE createConnectionForLink #-} -- | Create or update user's contact connection short link @@ -469,8 +470,9 @@ prepareConnectionToAccept c userId enableNtfs = withAgentEnv c .: newConnToAccep {-# INLINE prepareConnectionToAccept #-} -- | Join SMP agent connection (JOIN command). -joinConnection :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured -joinConnection c nm userId connId enableNtfs = withAgentEnv c .:: joinConn c nm userId connId enableNtfs +joinConnection :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AE SndQueueSecured +joinConnection c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSup subMode = + withAgentEnv c $ joinConn c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSup subMode {-# INLINE joinConnection #-} -- | Allow connection to continue after CONF notification (LET command) @@ -898,10 +900,14 @@ allowConnectionAsync' c corrId connId confId ownConnInfo = acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId - withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do - withStore' c (`unacceptInvitation` invId) - throwE err + case connReq of + -- async accept of a DR-from-address request is deferred; it accepts synchronously via acceptContact' + CRConfirmation _ -> throwE $ CMD PROHIBITED "acceptContactAsync: address DR requires sync accept" + CRInvitation cReq -> do + withStore' c $ \db -> acceptInvitation db invId ownConnInfo + joinConnAsync c userId corrId Nothing enableNtfs cReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do + withStore' c (`unacceptInvitation` invId) + throwE err ackMessageAsync' :: AgentClient -> ACorrId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM () ackMessageAsync' c corrId connId msgId rcptInfo_ = do @@ -982,16 +988,37 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo pure (ccLink, params) -- | Create connection for prepared link (single network call). -createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> SubscriptionMode -> AM ConnId -createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys subMode = do +-- | Generate a fresh address ratchet-keys bundle and store its private side, returning the public +-- bundle to advertise. The KEM is advertised only for IKUsePQ (initialPQEncryption False). +mkAddressRatchetKeys :: AgentClient -> ConnId -> CR.InitialKeys -> AM AddressRatchetKeys +mkAddressRatchetKeys c connId pqInitKeys = do + g <- asks random + e2eVR <- asks $ e2eEncryptVRange . config + let pqEnc = CR.initialPQEncryption False pqInitKeys + (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc + rkId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) + now <- liftIO getCurrentTime + withStore' c $ \db -> createAddressRatchetKeys db connId rkId pk1 pk2 pKem now + pure AddressRatchetKeys {ratchetKeyId = rkId, e2eParams = toVersionRangeT e2eRcvParams e2eVR} + +-- | Advertise DR in a contact address's mutable link data when initial keys are given (Nothing: no DR). +addAddressRatchetKeys :: AgentClient -> ConnId -> Maybe CR.InitialKeys -> UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) +addAddressRatchetKeys _ _ Nothing uld = pure uld +addAddressRatchetKeys c connId (Just pqInitKeys) (UserContactLinkData ucd) = do + bundle <- mkAddressRatchetKeys c connId pqInitKeys + pure $ UserContactLinkData ucd {ratchetKeys = Just bundle} + +createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Maybe CR.InitialKeys -> SubscriptionMode -> AM ConnId +createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys drInitKeys_ subMode = do g <- asks random AgentConfig {smpAgentVRange} <- asks config case pqInitKeys of CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink" _ -> pure () connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys) + userLinkData' <- addAddressRatchetKeys c connId drInitKeys_ userLinkData let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq - md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData + md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' linkData = (plpSignedFixedData, md) qd <- encryptContactLinkData g plpRootPrivKey plpLinkKey sndId linkData (_, qUri) <- @@ -1295,12 +1322,18 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> PQSupport -> AM ConnId newConnToAccept c userId connId enableNtfs invId pqSup = do Invitation {connReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId - newConnToJoin c userId connId enableNtfs connReq pqSup + case connReq of + CRInvitation cReq -> newConnToJoin c userId connId enableNtfs cReq pqSup + -- DR: build the connection shell (no URI to derive version/PQ from); acceptContact' continues the ratchet + CRConfirmation DRRequest {drAgentVersion, drPQSupport} -> do + g <- asks random + let cData = ConnData {userId, connId, connAgentVersion = drAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport = drPQSupport} + withStore c $ \db -> createNewConn db g cData SCMInvitation -joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured -joinConn c nm userId connId enableNtfs cReq cInfo pqSupport subMode = do +joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AM SndQueueSecured +joinConn c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSupport subMode = do srv <- getNextSMPServer c userId [qServer $ connReqQueue cReq] - joinConnSrv c nm userId connId enableNtfs cReq cInfo pqSupport subMode srv + joinConnSrv c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSupport subMode srv connReqQueue :: ConnectionRequestUri c -> SMPQueueUri connReqQueue = \case @@ -1379,8 +1412,8 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} -joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv = +joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys pqSup subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do SomeConn cType conn <- withStore c (`getConn` connId) case conn of @@ -1395,37 +1428,73 @@ joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup sub (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup secureConfirmQueue c nm cData rq_ sq srv cInfo (Just e2eSndParams) subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) -joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv = +joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case Just (qInfo, vrsn@(Compatible v)) -> - withInvLock c (strEncode cReqUri) "joinConnSrv" $ do - SomeConn cType conn <- withStore c (`getConn` connId) - let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup - CCLink cReq _ <- case conn of - NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv - RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys - _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType - void $ sendInvitation c nm userId connId qInfo vrsn cReq cInfo - pure False - where - mkJoinInvitation rq pqInitKeys = do - g <- asks random - AgentConfig {smpClientVRange = vr, smpAgentVRange, e2eEncryptVRange = e2eVR} <- asks config - let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMMessaging} - crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing - e2eRcvParams <- withStore' c $ \db -> do - lockConnForUpdate db connId - getRatchetX3dhKeys db connId >>= \case - Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eVR) keys - Left e -> do - nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no rcv ratchet " <> show e)) - let pqEnc = CR.initialPQEncryption False pqInitKeys - (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc - createRatchetX3dhKeys db connId pk1 pk2 pKem - pure e2eRcvParams - let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR - pure $ CCLink cReq Nothing + withInvLock c (strEncode cReqUri) "joinConnSrv" $ case addrKeys_ of + Just addrKeys -> joinAddressDR qInfo v addrKeys + Nothing -> joinAddressClassic qInfo vrsn v Nothing -> throwE $ AGENT A_VERSION + where + joinAddressClassic :: Compatible SMPQueueInfo -> Compatible VersionSMPA -> VersionSMPA -> AM SndQueueSecured + joinAddressClassic qInfo vrsn v = do + SomeConn cType conn <- withStore c (`getConn` connId) + let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup + CCLink cReq _ <- case conn of + NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv + RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys + _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType + void $ sendInvitation c nm userId connId qInfo vrsn cReq cInfo + pure False + mkJoinInvitation rq pqInitKeys = do + g <- asks random + AgentConfig {smpClientVRange = vr, smpAgentVRange, e2eEncryptVRange = e2eVR} <- asks config + let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMMessaging} + crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing + e2eRcvParams <- withStore' c $ \db -> do + lockConnForUpdate db connId + getRatchetX3dhKeys db connId >>= \case + Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eVR) keys + Left e -> do + nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no rcv ratchet " <> show e)) + let pqEnc = CR.initialPQEncryption False pqInitKeys + (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc + createRatchetX3dhKeys db connId pk1 pk2 pKem + pure e2eRcvParams + let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR + pure $ CCLink cReq Nothing + -- establish the send ratchet against the address keys and send the profile as a confirmation (DR message 1) + joinAddressDR :: Compatible SMPQueueInfo -> VersionSMPA -> AddressRatchetKeys -> AM SndQueueSecured + joinAddressDR qInfo v AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} = do + g <- asks random + e2eVR <- asks $ e2eEncryptVRange . config + case e2eParams `compatibleVersion` e2eVR of + Nothing -> throwE $ AGENT A_VERSION + Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ rcDHRr kem_)) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) + (pk1, pk2, pKem, aliceSndParams) <- liftIO $ CR.generateSndE2EParams g e2eV (CR.replyKEM_ e2eV kem_ pqSupport) + (_, rcDHRs) <- atomically $ C.generateKeyPair g + rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams + let rcVs = CR.RatchetVersions {current = e2eV, maxSupported = maxVersion e2eVR} + rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams + e2eKeys <- atomically $ C.generateKeyPair g + (rq, _) <- createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys + SomeConn _ conn <- withStore c (`getConn` connId) + let RcvQueue {smpClientVersion = rqV} = rq + cData = (toConnData conn) {pqSupport} :: ConnData + qAInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) + aliceReply = AgentConnInfoReply (qAInfo :| []) cInfo + currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config + encConnInfo <- withStore c $ \db -> runExceptT $ do + liftIO $ createSndRatchet db connId rc aliceSndParams + liftIO $ setConnPQSupport db connId pqSupport + let agentMsgBody = smpEncode aliceReply + (_, internalSndId, _) <- ExceptT $ updateSndIds db connId + liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody) + fst <$> agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) currentE2EVersion + let agentEnvelope = AgentConfirmation {agentVersion = v, e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just addrRKId, encConnInfo} + void $ sendConfirmationToAddress c nm userId connId qInfo agentEnvelope + pure False delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SMP.LinkId -> AM () delInvSL c connId srv lnkId = @@ -1477,7 +1546,21 @@ allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConne acceptContact' :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId - r <- joinConn c nm userId connId enableNtfs connReq ownConnInfo pqSupport subMode + r <- case connReq of + CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode + -- continue the ratchet from receive: create the send queue to Q_A and reply with Q_B under the ratchet + CRConfirmation DRRequest {drRatchet, drReplyQueue} -> do + SomeConn _ conn <- withStore c (`getConn` connId) + let cData = toConnData conn + srv <- getNextSMPServer c userId [qServer drReplyQueue] + clientVRange <- asks $ smpClientVRange . config + qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ drReplyQueue `proveCompatible` clientVRange + (q, _) <- lift $ newSndQueue userId connId qInfo Nothing + sq <- withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + liftIO $ createRatchet db connId drRatchet + ExceptT $ updateNewConnSnd db connId q + secureConfirmQueue c nm cData Nothing sq srv ownConnInfo Nothing subMode withStore' c $ \db -> acceptInvitation db invId ownConnInfo pure r @@ -1899,7 +1982,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv + sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo Nothing pqEnc subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK @@ -3179,6 +3262,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar decryptClientMessage e2eDh clientMsg >>= \case (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) -> smpConfirmation srvMsgId conn (Just senderKey) e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack + -- DR-from-address request (needs both ratchetKeyId and Snd params) + (SMP.PHEmpty, AgentConfirmation {e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo, agentVersion}) -> + smpAddressConfirmation srvMsgId conn e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion >> ack (SMP.PHEmpty, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) | senderCanSecure queueMode -> smpConfirmation srvMsgId conn Nothing e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack | otherwise -> prohibited "handshake: missing sender key" >> ack @@ -3460,9 +3546,69 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar notify $ CON pqEncryption withStore' c $ \db -> setRcvQueueStatus db rq' Active _ -> prohibited "conf: not AgentConnInfo" + -- DR requester: the reply arrives with the ratchet already established (built in join) + (RcvConnection _ _, Nothing) -> + withStore' c (`getRatchet` connId) >>= \case + Left _ -> prohibited "conf: incorrect state" + Right rc -> do + g <- asks random + (agentMsgBody_, rc', _) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + case agentMsgBody_ of + Right agentMsgBody -> + parseMessage agentMsgBody >>= \case + AgentConnInfoReply smpQueues connInfo -> do + let senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} + newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} + confId <- withStore c $ \db -> do + liftIO $ do + createRatchet db connId rc' + let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq + dhSecret = C.dh' e2ePubKey e2ePrivKey' + setRcvQueueConfirmedE2E db rq dhSecret $ min v phVer + updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) + createConfirmation db g newConfirmation + notify $ CONF confId pqSupport (map qServer $ smpReplyQueues senderConf) connInfo + _ -> prohibited "conf: not AgentConnInfoReply" + _ -> prohibited "conf: decrypt error" _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" + -- establish the ratchet from the stored keys, decrypt the request, and store it, emitting REQ (no connection until accept) + smpAddressConfirmation :: SMP.MsgId -> Connection c -> C.PublicKeyX25519 -> RatchetKeyId -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> VersionSMPC -> VersionSMPA -> AM () + smpAddressConfirmation srvMsgId conn' _e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion = do + logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId + AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config + let ConnData {pqSupport} = toConnData conn' + compatible = + (agentVersion `isCompatible` smpAgentVRange || agentVersion <= agreedAgentVersion) + && (phVer `isCompatible` smpClientVRange || phVer <= agreedClientVerion) + unless compatible $ throwE $ AGENT A_VERSION + case conn' of + -- the existential ratchet-KEM state must be matched in a case (not let) so it stays scoped + ContactConnection {} -> case e2eSndParams of + CR.AE2ERatchetParams _ innerParams@(CR.E2ERatchetParams e2eVersion _ _ _) -> do + unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION) + withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case + Left _ -> prohibited "addr conf: unknown ratchetKeyId" + Right (pk1, pk2, pKem) -> do + rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem innerParams + let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} + pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) + rc = CR.initRcvRatchet rcVs pk2 rcParams pqSupport' + g <- asks random + (agentMsgBody_, rc', _skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + case agentMsgBody_ of + Right agentMsgBody -> + parseMessage agentMsgBody >>= \case + AgentConnInfoReply (qA :| _) aliceProfile -> do + let dr = DRRequest {drRatchet = rc', drReplyQueue = qA, drAgentVersion = agentVersion, drPQSupport = pqSupport'} + newInv = NewInvitation {contactConnId = connId, connReq = CRConfirmation dr, recipientConnInfo = aliceProfile} + invId <- withStore c $ \db -> createInvitation db g newInv + notify $ REQ invId pqSupport' (qServer qA :| []) aliceProfile + _ -> prohibited "addr conf: not AgentConnInfoReply" + _ -> prohibited "addr conf: decrypt error" + _ -> prohibited "addr conf: not a contact address" + helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId @@ -3615,7 +3761,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- in case invitation not compatible, assume there is no PQ encryption support. pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq g <- asks random - let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo} + let newInv = NewInvitation {contactConnId = connId, connReq = CRInvitation connReq, recipientConnInfo = cInfo} invId <- withStore c $ \db -> createInvitation db g newInv let srvs = L.map qServer $ crSmpQueues crData notify $ REQ invId pqSupport srvs cInfo @@ -3762,7 +3908,7 @@ secureConfirmQueue c nm cData@ConnData {connId, connAgentVersion, pqSupport} rq_ liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody) let pqEnc = CR.pqSupportToEnc pqSupport (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion - pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo} + pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, ratchetKeyId = Nothing, encConnInfo} agentSecureSndQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> AM SndQueueSecured agentSecureSndQueue c nm ConnData {connAgentVersion} sq@SndQueue {queueMode, status} @@ -3799,7 +3945,7 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq internalHash = C.sha256Hash agentMsgStr pqEnc = CR.pqSupportToEnc pqSupport (encConnInfo, pqEncryption) <- agentRatchetEncrypt db cData agentMsgStr e2eEncConnInfoLength (Just pqEnc) currentE2EVersion - let msgBody = smpEncode $ AgentConfirmation {agentVersion = v, e2eEncryption_, encConnInfo} + let msgBody = smpEncode $ AgentConfirmation {agentVersion = v, e2eEncryption_, ratchetKeyId = Nothing, encConnInfo} msgType = agentMessageType agentMsg msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing} liftIO $ createSndMsg db connId msgData diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index d33794006..b3a0929f4 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -59,6 +59,7 @@ module Simplex.Messaging.Agent.Client getSubscriptions, sendConfirmation, sendInvitation, + sendConfirmationToAddress, temporaryAgentError, temporaryOrHostError, serverHostError, @@ -1933,6 +1934,12 @@ sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {s agentCbEncryptOnce v dhPublicKey . smpEncode $ SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) +-- send a pre-built confirmation to a contact address, unauthenticated (as sendInvitation) +sendConfirmationToAddress :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> AgentMsgEnvelope -> AM (Maybe SMPServer) +sendConfirmationToAddress c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) agentEnvelope = do + msg <- agentCbEncryptOnce v dhPublicKey . smpEncode $ SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) + sendOrProxySMPMessage c nm userId smpServer connId "" Nothing senderId (MsgFlags {notification = True}) msg + getQueueMessage :: AgentClient -> RcvQueue -> AM (Maybe SMPMsgMeta) getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do atomically createTakeGetLock diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index cd8148e45..08910edcb 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -46,6 +46,7 @@ module Simplex.Messaging.Agent.Protocol pqdrSMPAgentVersion, sndAuthKeySMPAgentVersion, ratchetOnConfSMPAgentVersion, + addressDRSMPAgentVersion, currentSMPAgentVersion, supportedSMPAgentVRange, e2eEncConnInfoLength, @@ -118,6 +119,8 @@ module Simplex.Messaging.Agent.Protocol UserConnLinkData (..), UserContactData (..), UserLinkData (..), + AddressRatchetKeys (..), + RatchetKeyId (..), OwnerAuth (..), OwnerId, ConnectionLink (..), @@ -317,11 +320,16 @@ sndAuthKeySMPAgentVersion = VersionSMPA 6 ratchetOnConfSMPAgentVersion :: VersionSMPA ratchetOnConfSMPAgentVersion = VersionSMPA 7 +-- | The address advertises the owner's X3DH keys in link data, and a requester +-- establishes the double ratchet from its first message (a confirmation with ratchetKeyId). +addressDRSMPAgentVersion :: VersionSMPA +addressDRSMPAgentVersion = VersionSMPA 8 + minSupportedSMPAgentVersion :: VersionSMPA minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion currentSMPAgentVersion :: VersionSMPA -currentSMPAgentVersion = VersionSMPA 7 +currentSMPAgentVersion = VersionSMPA 8 supportedSMPAgentVRange :: VersionRangeSMPA supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion @@ -830,6 +838,8 @@ data AgentMsgEnvelope = AgentConfirmation { agentVersion :: VersionSMPA, e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), + -- DR-from-address (with e2eEncryption_): selects the owner's key generation; else Nothing + ratchetKeyId :: Maybe RatchetKeyId, encConnInfo :: ByteString } | AgentMsgEnvelope @@ -850,8 +860,11 @@ data AgentMsgEnvelope instance Encoding AgentMsgEnvelope where smpEncode = \case - AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} -> - smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo) + AgentConfirmation {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} + | agentVersion >= addressDRSMPAgentVersion -> + smpEncode (agentVersion, 'C', e2eEncryption_, ratchetKeyId, Tail encConnInfo) + | otherwise -> + smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo) AgentMsgEnvelope {agentVersion, encAgentMessage} -> smpEncode (agentVersion, 'M', Tail encAgentMessage) AgentInvitation {agentVersion, connReq, connInfo} -> @@ -862,8 +875,10 @@ instance Encoding AgentMsgEnvelope where agentVersion <- smpP smpP >>= \case 'C' -> do - (e2eEncryption_, Tail encConnInfo) <- smpP - pure AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} + e2eEncryption_ <- smpP + ratchetKeyId <- if agentVersion >= addressDRSMPAgentVersion then smpP else pure Nothing + Tail encConnInfo <- smpP + pure AgentConfirmation {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} 'M' -> do Tail encAgentMessage <- smpP pure AgentMsgEnvelope {agentVersion, encAgentMessage} @@ -1837,6 +1852,29 @@ deriving instance Eq (ConnLinkData c) deriving instance Show (ConnLinkData c) +-- | Identifies an 'AddressRatchetKeys' generation; echoed in a request so the owner selects its keys. +newtype RatchetKeyId = RatchetKeyId ByteString + deriving (Eq, Show) + +instance Encoding RatchetKeyId where + smpEncode (RatchetKeyId s) = smpEncode s + {-# INLINE smpEncode #-} + smpP = RatchetKeyId <$> smpP + {-# INLINE smpP #-} + +-- | The address owner's published X3DH keys, letting a requester establish the ratchet from message 1. +data AddressRatchetKeys = AddressRatchetKeys + { ratchetKeyId :: RatchetKeyId, + e2eParams :: RcvE2ERatchetParamsUri 'C.X448 + } + deriving (Eq, Show) + +instance Encoding AddressRatchetKeys where + smpEncode AddressRatchetKeys {ratchetKeyId, e2eParams} = smpEncode (ratchetKeyId, e2eParams) + smpP = do + (ratchetKeyId, e2eParams) <- smpP + pure AddressRatchetKeys {ratchetKeyId, e2eParams} + data UserContactData = UserContactData { -- direct connection via connReq in fixed data is allowed. direct :: Bool, @@ -1844,7 +1882,9 @@ data UserContactData = UserContactData owners :: [OwnerAuth], -- alternative addresses of chat relays that receive requests for this contact address. relays :: [ConnShortLink 'CMContact], - userData :: UserLinkData + userData :: UserLinkData, + -- appended, so earlier versions ignore it + ratchetKeys :: Maybe AddressRatchetKeys } deriving (Eq, Show) @@ -1972,14 +2012,17 @@ instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where {-# INLINE strP #-} instance Encoding UserContactData where - smpEncode UserContactData {direct, owners, relays, userData} = - B.concat [smpEncode direct, smpEncodeList owners, smpEncodeList relays, smpEncode userData] + smpEncode UserContactData {direct, owners, relays, userData, ratchetKeys} = + B.concat [smpEncode direct, smpEncodeList owners, smpEncodeList relays, smpEncode userData, maybe "" smpEncode ratchetKeys] smpP = do direct <- smpP owners <- smpListP relays <- smpListP - userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding - pure UserContactData {direct, owners, relays, userData} + userData <- smpP + -- ratchetKeys is appended: absent in earlier data (optional -> Nothing), and the trailing + -- takeByteString ignores any further fields for forward compatibility. + ratchetKeys <- optional smpP <* A.takeByteString + pure UserContactData {direct, owners, relays, userData, ratchetKeys} instance Encoding UserLinkData where smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s) diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 605a07e78..d4154cbf0 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -45,6 +45,8 @@ module Simplex.Messaging.Agent.Store AcceptedConfirmation (..), NewInvitation (..), Invitation (..), + ContactRequest (..), + DRRequest (..), PrevExternalSndId, PrevRcvMsgHash, PrevSndMsgHash, @@ -107,8 +109,11 @@ import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Agent.Store.Interface (createDBStore) import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations) import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..)) +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as LB import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448) +import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport (..), RatchetX448) +import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol ( MsgBody, @@ -626,19 +631,52 @@ data AcceptedConfirmation = AcceptedConfirmation data NewInvitation = NewInvitation { contactConnId :: ConnId, - connReq :: ConnectionRequestUri 'CMInvitation, + connReq :: ContactRequest, recipientConnInfo :: ConnInfo } data Invitation = Invitation { invitationId :: InvitationId, contactConnId_ :: Maybe ConnId, - connReq :: ConnectionRequestUri 'CMInvitation, + connReq :: ContactRequest, recipientConnInfo :: ConnInfo, ownConnInfo :: Maybe ConnInfo, accepted :: Bool } +-- | The stored request in a conn_invitations row: a classic connection request URI, or a +-- double-ratchet confirmation received on a DR-advertising address. +data ContactRequest + = CRInvitation (ConnectionRequestUri 'CMInvitation) + | CRConfirmation DRRequest + +-- | A double-ratchet request received at a contact address (no connection until accept): the +-- receiving ratchet from decrypting the first message, the reply queue, and the negotiated versions. +data DRRequest = DRRequest + { drRatchet :: RatchetX448, + drReplyQueue :: SMPQueueInfo, + drAgentVersion :: VersionSMPA, + drPQSupport :: PQSupport + } + +instance Encoding DRRequest where + smpEncode DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport} = + smpEncode (Large $ LB.toStrict $ J.encode drRatchet, drReplyQueue, drAgentVersion, supportPQ drPQSupport) + smpP = do + (rcJson, drReplyQueue, drAgentVersion, pqB) <- smpP + drRatchet <- either fail pure $ J.eitherDecodeStrict' $ unLarge rcJson + pure DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport = PQSupport pqB} + +instance Encoding ContactRequest where + smpEncode = \case + CRInvitation cr -> smpEncode ('I', cr) + CRConfirmation dr -> smpEncode ('C', dr) + smpP = + smpP >>= \case + 'I' -> CRInvitation <$> smpP + 'C' -> CRConfirmation <$> smpP + _ -> fail "bad ContactRequest tag" + -- * Message integrity validation types -- | Corresponds to `last_external_snd_msg_id` in `connections` table diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index e3ea1671b..46991027a 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -152,6 +152,8 @@ module Simplex.Messaging.Agent.Store.AgentStore createRatchetX3dhKeys, getRatchetX3dhKeys, setRatchetX3dhKeys, + createAddressRatchetKeys, + getAddressRatchetKeys, createSndRatchet, getSndRatchet, createRatchet, @@ -1384,6 +1386,31 @@ setRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem = |] (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem, connId) +createAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> UTCTime -> IO () +createAddressRatchetKeys db connId ratchetKeyId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem createdAt = + DB.execute + db + [sql| + INSERT INTO address_ratchet_keys + (conn_id, ratchet_key_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem, created_at) + VALUES (?, ?, ?, ?, ?, ?) + |] + (connId, ratchetKeyId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem, createdAt) + +getAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) +getAddressRatchetKeys db connId ratchetKeyId = + firstRow' keys SEX3dhKeysNotFound $ + DB.query + db + [sql| + SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem + FROM address_ratchet_keys + WHERE conn_id = ? AND ratchet_key_id = ? + |] + (connId, ratchetKeyId) + where + keys (k1, k2, pKem) = Right (k1, k2, pKem) + createSndRatchet :: DB.Connection -> ConnId -> RatchetX448 -> CR.AE2ERatchetParams 'C.X448 -> IO () createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetParams _ x3dhPubKey1 x3dhPubKey2 pqPubKem)) = DB.execute @@ -2075,6 +2102,18 @@ instance ConnectionModeI c => ToField (ConnectionRequestUri c) where toField = t instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequestUri c) where fromField = blobFieldDecoder strDecode +instance ToField RatchetKeyId where toField (RatchetKeyId s) = toField $ Binary s + +instance FromField RatchetKeyId where fromField = blobFieldDecoder $ Right . RatchetKeyId + +instance ToField ContactRequest where toField = toField . Binary . smpEncode + +-- falls back to a legacy bare-URI row (un-tagged) as a classic invitation +instance FromField ContactRequest where + fromField = blobFieldDecoder $ \bs -> case smpDecode bs of + Right cr -> Right cr + Left _ -> CRInvitation <$> strDecode bs + instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode instance FromField ConnectionMode where fromField = fromTextField_ connModeT diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs index b2ac33a68..12bf3f183 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs @@ -13,6 +13,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251010_client_notice import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251230_strict_tables import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260410_receive_attempts import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs +import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -25,7 +26,8 @@ schemaMigrations = ("20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices), ("20251230_strict_tables", m20251230_strict_tables, Just down_m20251230_strict_tables), ("20260410_receive_attempts", m20260410_receive_attempts, Just down_m20260410_receive_attempts), - ("20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs) + ("20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs), + ("20260712_address_dr", m20260712_address_dr, Just down_m20260712_address_dr) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs new file mode 100644 index 000000000..3be969a46 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr where + +import Data.Text (Text) +import Text.RawString.QQ (r) + +m20260712_address_dr :: Text +m20260712_address_dr = + [r| +CREATE TABLE address_ratchet_keys( + address_ratchet_key_id BIGSERIAL PRIMARY KEY, + conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE, + ratchet_key_id BYTEA NOT NULL, + x3dh_priv_key_1 BYTEA NOT NULL, + x3dh_priv_key_2 BYTEA NOT NULL, + pq_priv_kem BYTEA, + created_at TEXT NOT NULL, + retired_at TEXT +); + +CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); + |] + +down_m20260712_address_dr :: Text +down_m20260712_address_dr = + [r| +DROP INDEX idx_address_ratchet_keys; +DROP TABLE address_ratchet_keys; + |] diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs index bfdab2729..c17a191a9 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs @@ -49,6 +49,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251010_client_notices import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251230_strict_tables import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260410_receive_attempts import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs +import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -97,7 +98,8 @@ schemaMigrations = ("m20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices), ("m20251230_strict_tables", m20251230_strict_tables, Just down_m20251230_strict_tables), ("m20260410_receive_attempts", m20260410_receive_attempts, Just down_m20260410_receive_attempts), - ("m20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs) + ("m20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs), + ("m20260712_address_dr", m20260712_address_dr, Just down_m20260712_address_dr) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs new file mode 100644 index 000000000..98472b477 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20260712_address_dr :: Query +m20260712_address_dr = + [sql| +CREATE TABLE address_ratchet_keys( + address_ratchet_key_id INTEGER PRIMARY KEY, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + ratchet_key_id BLOB NOT NULL, -- published id echoed by requests + x3dh_priv_key_1 BLOB NOT NULL, -- X448 + x3dh_priv_key_2 BLOB NOT NULL, -- X448 + pq_priv_kem BLOB, -- sntrup761 keypair; NULL when PQ is off for this address + created_at TEXT NOT NULL, + retired_at TEXT -- set on rotation +) STRICT; + +CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); + |] + +down_m20260712_address_dr :: Query +down_m20260712_address_dr = + [sql| +DROP INDEX idx_address_ratchet_keys; +DROP TABLE address_ratchet_keys; + |] diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index fba0eac4a..d8c74aa80 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -290,7 +290,7 @@ createConnection c userId enableNtfs cMode clientData subMode = do joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured) joinConnection c userId enableNtfs cReq connInfo subMode = do connId <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn - sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq connInfo PQSupportOn subMode + sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq connInfo Nothing PQSupportOn subMode pure (connId, sndSecure) acceptContact :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured @@ -725,7 +725,7 @@ runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId = runRight_ $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ - sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing bPQ SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ @@ -954,7 +954,7 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b runRight_ $ do (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` reqPQSupport @@ -1005,7 +1005,7 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId msgId = subtract baseId . fst connectViaContact b pq qInfo = do aId <- A.prepareConnectionToJoin b 1 True qInfo pq - sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" pq SMSubscribe + sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" Nothing pq SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -1051,7 +1051,7 @@ testRejectContactRequest = withAgentClients2 $ \alice bob -> runRight_ $ do (_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice rejectContact alice invId @@ -1064,7 +1064,7 @@ testUpdateConnectionUserId = newUserId <- createUser alice False [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer] _ <- changeConnectionUser alice 1 connId newUserId aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ sqSecured' `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -1224,13 +1224,13 @@ testInvitationErrors ps restart = do ("", "", DOWN _ [_]) <- nGet a aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to secure the queue on testPort - BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe (testPort `isSuffixOf` srv) `shouldBe` True withServer1 ps $ do ("", "", UP _ [_]) <- nGet a let loopSecure = do -- secures the queue on testPort, but fails to create reply queue on testPort2 - BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe unless (testPort2 `isSuffixOf` srv2) $ putStrLn "retrying secure" >> threadDelay 200000 >> loopSecure loopSecure ("", "", DOWN _ [_]) <- nGet a @@ -1238,7 +1238,7 @@ testInvitationErrors ps restart = do threadDelay 200000 let loopCreate = do -- creates the reply queue on testPort2, but fails to send it to testPort - BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create" >> threadDelay 200000 >> loopCreate loopCreate restartAgentB restart b [aId] @@ -1247,7 +1247,7 @@ testInvitationErrors ps restart = do ("", "", UP _ [_]) <- nGet a threadDelay 200000 let loopConfirm n = - runExceptT (A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe) >>= \case + runExceptT (A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe) >>= \case Right True -> pure n Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying confirm" >> threadDelay 200000 >> loopConfirm (n + 1) @@ -1294,12 +1294,12 @@ testContactErrors ps restart = do ("", "", DOWN _ [_]) <- nGet a aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to create queue on testPort2 - BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe (testPort2 `isSuffixOf` srv2) `shouldBe` True b' <- restartAgentB restart b [aId] let loopCreate2 = do -- creates the reply queue on testPort2, but fails to send invitation to testPort - BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create 2" >> threadDelay 200000 >> loopCreate2 b'' <- withServer2 ps $ do loopCreate2 @@ -1309,7 +1309,7 @@ testContactErrors ps restart = do ("", "", UP _ [_]) <- nGet a let loopSend = do -- sends the invitation to testPort - runExceptT (A.joinConnection b'' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe) >>= \case + runExceptT (A.joinConnection b'' NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe) >>= \case Right False -> pure () Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying send" >> threadDelay 200000 >> loopSend @@ -1398,7 +1398,7 @@ testInvitationShortLink viaProxy a b = 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 NRMInteractive 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe + sndSecure' <- A.joinConnection b NRMInteractive 1 aId True connReq "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` sndSecure ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" @@ -1444,7 +1444,7 @@ testContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO testContactShortLink viaProxy a b = withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do let userData = UserLinkData "some user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData (contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe Right connReq <- pure $ smpDecode (smpEncode connReq0) @@ -1475,7 +1475,7 @@ testContactShortLink viaProxy a b = exchangeGreetingsViaProxy viaProxy a bId b aId -- update user data let updatedData = UserLinkData "updated user data" - updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData} + updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing} userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink @@ -1496,7 +1496,7 @@ testAddContactShortLink viaProxy a b = (contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe Right connReq <- pure $ smpDecode (smpEncode connReq0) -- let userData = UserLinkData "some user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink @@ -1526,7 +1526,7 @@ testAddContactShortLink viaProxy a b = exchangeGreetingsViaProxy viaProxy a bId b aId -- update user data let updatedData = UserLinkData "updated user data" - updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData} + updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing} userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink @@ -1550,13 +1550,13 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do testContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do let userData = UserLinkData "some user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData (contactId, CCLink connReq0 (Just shortLink)) <- withSmpServer ps $ runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMOnlyCreate Right connReq <- pure $ smpDecode (smpEncode connReq0) let updatedData = UserLinkData "updated user data" - updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData} + updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing} updatedLinkData = UserContactLinkData updatedCtData withSmpServer ps $ do (fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink @@ -1574,14 +1574,14 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do testAddContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do let userData = UserLinkData "some user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData ((contactId, CCLink connReq0 Nothing), shortLink) <- withSmpServer ps $ runRight $ do r@(contactId, _) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate (r,) <$> setConnShortLink a contactId SCMContact newLinkData Nothing Right connReq <- pure $ smpDecode (smpEncode connReq0) let updatedData = UserLinkData "updated user data" - updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData} + updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing} updatedLinkData = UserContactLinkData updatedCtData withSmpServer ps $ do (fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink @@ -1628,7 +1628,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do withSmpServer ps $ do let userData = UserLinkData "some user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} userLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink @@ -1637,7 +1637,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do userCtData' `shouldBe` userCtData -- update user data let updatedData = UserLinkData "updated user data" - updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData} + updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing} userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink @@ -1655,7 +1655,7 @@ replaceSubstringInFile filePath oldText newText = do testPrepareCreateConnectionLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do let userData = UserLinkData "test user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} userLinkData = UserContactLinkData userCtData g <- C.newRandom rootKey <- atomically $ C.generateKeyPair g @@ -1664,7 +1664,7 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b (ccLink@(CCLink connReq (Just shortLink)), preparedParams) <- A.prepareConnectionLink a 1 rootKey linkEntId True Nothing liftIO $ strDecode (strEncode shortLink) `shouldBe` Right shortLink - _ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn SMSubscribe + _ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn Nothing SMSubscribe (FixedLinkData {linkConnReq = connReq', linkEntityId}, ContactLinkData _ userCtData') <- getConnShortLink b 1 shortLink liftIO $ Just linkEntId `shouldBe` linkEntityId Right connReqDecoded <- pure $ smpDecode (smpEncode connReq) @@ -2408,7 +2408,7 @@ makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> Agent makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) SMSubscribe aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport - sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" Nothing pqSupport SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` pqSupport @@ -2737,7 +2737,7 @@ testSetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO () testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do let userData = UserLinkData "test user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData (cId, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe -- verify initial link data @@ -2745,7 +2745,7 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> liftIO $ userCtData' `shouldBe` userCtData -- update link data async let updatedData = UserLinkData "updated user data" - updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData} + updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData, ratchetKeys = Nothing} setConnShortLinkAsync alice "1" cId (UserContactLinkData updatedCtData) Nothing ("1", cId', LINK shortLink' (UserContactLinkData updatedCtData')) <- get alice liftIO $ cId' `shouldBe` cId @@ -2769,7 +2769,7 @@ testGetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO () testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do let userData = UserLinkData "test user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData (_, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe -- get link data async - creates new connection for bob diff --git a/tests/AgentTests/ShortLinkTests.hs b/tests/AgentTests/ShortLinkTests.hs index edffaa3d9..9ca7d2d14 100644 --- a/tests/AgentTests/ShortLinkTests.hs +++ b/tests/AgentTests/ShortLinkTests.hs @@ -80,7 +80,7 @@ testContactShortLink = do g <- C.newRandom sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g let userData = UserLinkData "some user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} userLinkData = UserContactLinkData userCtData (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData (_linkId, k) = SL.contactShortLinkKdf linkKey @@ -96,14 +96,14 @@ testUpdateContactShortLink = do g <- C.newRandom sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g let userData = UserLinkData "some user data" - userCtData = UserContactData {direct = True, owners = [], relays = [], userData} + userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} userLinkData = UserContactLinkData userCtData (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData (_linkId, k) = SL.contactShortLinkKdf linkKey Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData -- encrypt updated user data let updatedUserData = UserLinkData "updated user data" - userCtData' = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedUserData} + userCtData' = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedUserData, ratchetKeys = Nothing} userLinkData' = UserContactLinkData userCtData' signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData' Right ud' <- runExceptT $ SL.encryptUserData g k signed @@ -118,7 +118,7 @@ testContactShortLinkBadDataHash = do g <- C.newRandom sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g let userData = UserLinkData "some user data" - userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData} + userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} (_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData -- different key linkKey <- LinkKey <$> atomically (C.randomBytes 32 g) @@ -134,13 +134,13 @@ testContactShortLinkBadSignature = do g <- C.newRandom sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g let userData = UserLinkData "some user data" - userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData} + userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData (_linkId, k) = SL.contactShortLinkKdf linkKey Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData -- encrypt updated user data let updatedUserData = UserLinkData "updated user data" - userLinkData' = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = updatedUserData} + userLinkData' = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = updatedUserData, ratchetKeys = Nothing} -- another signature key (_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange userLinkData' @@ -156,7 +156,7 @@ testContactShortLinkOwner = do (pk, lnk) <- encryptLink g -- encrypt updated user data (ownerPK, owner) <- authNewOwner g pk - let ud = UserContactData {direct = True, owners = [owner], relays = [], userData = UserLinkData "updated user data"} + let ud = UserContactData {direct = True, owners = [owner], relays = [], userData = UserLinkData "updated user data", ratchetKeys = Nothing} testEncDec g pk lnk ud testEncDec g ownerPK lnk ud (_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g @@ -166,7 +166,7 @@ encryptLink :: TVar ChaChaDRG -> IO (C.PrivateKeyEd25519, (EncFixedDataBytes, Li encryptLink g = do sigKeys@(_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g let userData = UserLinkData "some user data" - userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData} + userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} (linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData (_linkId, k) = SL.contactShortLinkKdf linkKey Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData @@ -199,7 +199,7 @@ testContactShortLinkManyOwners = do (ownerPK4, owner4) <- authNewOwner g ownerPK1 (ownerPK5, owner5) <- authNewOwner g ownerPK3 let owners = [owner1, owner2, owner3, owner4, owner5] - ud = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"} + ud = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data", ratchetKeys = Nothing} testEncDec g pk lnk ud testEncDec g ownerPK1 lnk ud testEncDec g ownerPK2 lnk ud @@ -216,7 +216,7 @@ testContactShortLinkInvalidOwners = do (pk, lnk) <- encryptLink g -- encrypt updated user data (ownerPK, owner) <- authNewOwner g pk - let mkCtData owners = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"} + let mkCtData owners = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data", ratchetKeys = Nothing} -- decryption fails: owner uses root key let ud = mkCtData [owner {ownerKey = C.publicKey pk}] err = A_LINK $ "owner key for ID " <> ownerIdStr owner <> " matches root key" diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 0d8ccdf89..8f76e2f68 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -226,7 +226,7 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -282,7 +282,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs = prePair alice bob = do (bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True confId <- get alice >>= \case @@ -333,7 +333,7 @@ agentViaProxyVersionError = withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do (_bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe pure () where servers srvs = (initAgentServersProxy_ SPMUnknown SPFProhibit) {smp = userServers srvs} @@ -353,7 +353,7 @@ agentViaProxyRetryOffline = do (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn From 8309f95ec51a7b61f86f19e6efb27ae54e0ff758 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Tue, 14 Jul 2026 18:34:11 +0100 Subject: [PATCH 09/81] agent schema --- .../Agent/Store/SQLite/Migrations/agent_schema.sql | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index e77582b92..195783cce 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -465,6 +465,16 @@ CREATE TABLE client_services( service_queue_ids_hash BLOB NOT NULL DEFAULT x'00000000000000000000000000000000', FOREIGN KEY(host, port) REFERENCES servers ON UPDATE CASCADE ON DELETE RESTRICT ) STRICT; +CREATE TABLE address_ratchet_keys( + address_ratchet_key_id INTEGER PRIMARY KEY, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + ratchet_key_id BLOB NOT NULL, -- published id echoed by requests + x3dh_priv_key_1 BLOB NOT NULL, -- X448 + x3dh_priv_key_2 BLOB NOT NULL, -- X448 + pq_priv_kem BLOB, -- sntrup761 keypair; NULL when PQ is off for this address + created_at TEXT NOT NULL, + retired_at TEXT -- set on rotation +) STRICT; CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id); CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id); CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id); @@ -615,6 +625,10 @@ CREATE UNIQUE INDEX idx_server_certs_user_id_host_port ON client_services( server_key_hash ); CREATE INDEX idx_server_certs_host_port ON client_services(host, port); +CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys( + conn_id, + ratchet_key_id +); CREATE TRIGGER tr_rcv_queue_insert AFTER INSERT ON rcv_queues FOR EACH ROW From 18d8b190ba7917c4a2d2e84a0a1b120a5f3b7539 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Tue, 14 Jul 2026 18:39:14 +0100 Subject: [PATCH 10/81] fix version in test --- tests/AgentTests/ConnectionRequestTests.hs | 30 +++++++++++----------- tests/AgentTests/FunctionalAPITests.hs | 4 +-- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 13ee3e156..a0ea929d1 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -256,26 +256,26 @@ connectionRequestTests = queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr) 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) - 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) - connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest #== ("https://simplex.chat/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequestNoQM #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStrNoQM <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest1 #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest2queues #==# ("simplex:/invitation#/?v=2-8&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequestNew #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-8&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}") - contactAddress #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr) - contactAddress #== ("https://simplex.chat/contact#/?v=2-7&smp=" <> url queueStr) - contactAddress2queues #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr)) - contactAddressNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueNewStr) - contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr)) + connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}") + contactAddress #==# ("simplex:/contact#/?v=2-8&smp=" <> url queueStr) + contactAddress #== ("https://simplex.chat/contact#/?v=2-8&smp=" <> url queueStr) + contactAddress2queues #==# ("simplex:/contact#/?v=2-8&smp=" <> url (queueStr <> ";" <> queueStr)) + contactAddressNew #==# ("simplex:/contact#/?v=2-8&smp=" <> url queueNewStr) + contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-8&smp=" <> url (queueNewStr <> ";" <> queueNewStr)) contactAddressV2 #==# ("simplex:/contact#/?v=2&smp=" <> url queueStr) contactAddressV2 #== ("https://simplex.chat/contact#/?v=1&smp=" <> url queueStr) -- adjusted to v2 contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2 contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr) - contactAddressClientData #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}") + contactAddressClientData #==# ("simplex:/contact#/?v=2-8&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 queueNoQM -- this passes, no queue mode patch in SMPQueueUri encoding diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 5ed441891..ee59f6135 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -3702,8 +3702,8 @@ testDeliveryReceiptsVersion ps = do subscribeConnection a' bId subscribeConnection b' aId exchangeGreetingsMsgId_ PQEncOff 4 a' bId b' aId - checkVersion a' bId 7 - checkVersion b' aId 7 + checkVersion a' bId 8 + checkVersion b' aId 8 (6, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello" get a' ##> ("", bId, SENT 6) get b' =##> \case ("", c, Msg' 6 PQEncOff "hello") -> c == aId; _ -> False From b09e7c022045f29123009bc5b41a2d38dde543f8 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 17:43:06 +0000 Subject: [PATCH 11/81] change ContactRequest encoding --- plans/2026-07-12-address-dr-implementation.md | 4 +-- src/Simplex/Messaging/Agent/Protocol.hs | 11 +++++++ src/Simplex/Messaging/Agent/Store.hs | 31 +++++++------------ .../Messaging/Agent/Store/AgentStore.hs | 17 +++++++--- 4 files changed, 36 insertions(+), 27 deletions(-) diff --git a/plans/2026-07-12-address-dr-implementation.md b/plans/2026-07-12-address-dr-implementation.md index 431c2b227..bfca5b054 100644 --- a/plans/2026-07-12-address-dr-implementation.md +++ b/plans/2026-07-12-address-dr-implementation.md @@ -17,7 +17,7 @@ Scope of this change: the **synchronous** DR handshake in join, gated on the add **Deltas from the plan discovered while building:** - **R5' emits `CONF` and reuses the allow step** (not auto-complete). The DR requester is a `RcvConnection` receiving the owner's reply - the same position as the classic contact requester, which goes `CONF` → `allowConnection'` → `connectReplyQueues` (msg 3). R5' mirrors that (differing only in that the ratchet already exists, so it `getRatchet` + `rcDecrypt` instead of building it), so the app supplies `ownConnInfo` for msg 3 at allow, exactly as today. No new storage. - **`DRRequest` carries `drAgentVersion` + `drPQSupport`** (Part 3): the sync accept creates the connection shell via `newConnToAccept`→`newConnToJoin` before O3', and there is no URI to derive the version/PQ from. -- `RatchetX448` is JSON-serialized, so `DRRequest`'s `Encoding` embeds it as a `Large` JSON blob; `PQSupport` (no `Encoding`) is stored via its `Bool`. +- `cr_invitation` serialization is downgrade-safe: `CRInvitation` keeps the legacy URI (`strEncode`, byte-identical to before), so an older agent still reads classic invitations; `CRConfirmation` is JSON (`DRRequest` has manual `ToJSON`/`FromJSON`), told apart on read by the leading `{` (a URI never starts with it). JSON keeps `DRRequest` extensible. `SMPQueueInfo` gained a base64 `StrEncoding` + JSON (it only had `Encoding`) so it can sit in the JSON. - **DR is opt-in per address**: `createConnectionForLink'`/`createConnectionForLink` gain a `Maybe InitialKeys` DR parameter (separate from the existing connection-PQ `InitialKeys`) - `Nothing` = no DR (old behavior, existing callers), `Just ik` = advertise the bundle with `ik`. The `IKUsePQ`-for-`SCMContact` prohibition stays on the connection-PQ parameter and is lifted only for the DR bundle. **Not yet done:** rotation (`rotateRatchetKeys`, Part 4), cleanup step (Part 4), the app-driven `LSET` upgrade API (Part 5), wiring the DR parameter into the non-prepared-link `newRcvConnSrv` path, tests (Part 6), regenerating `agent_schema.sql` if a schema-consistency test requires it, and chat wiring (deferred by design). @@ -212,7 +212,7 @@ Three readers of the widened `connReq` field (all via `getInvitation`) branch on - `newConnToAccept` (Agent.hs:1296, via `prepareConnectionToAccept`): `CRInvitation cr` → `newConnToJoin … cr` (unchanged); `CRConfirmation dr` → create the `NewConnection` shell from `drAgentVersion`/`drPQSupport` (`createNewConn`, generating the connId). - `acceptContactAsync'` (Agent.hs:900): `CRInvitation cr` → `joinConnAsync … cr` (unchanged); `CRConfirmation _` → `throwE $ CMD PROHIBITED` (async DR accept is deferred; DR requests accept synchronously). Chat's REQ/accept is unaffected either way - it only ever passes `invId`, never the `ContactRequest`, which stays internal to the agent. -Storage: `cr_invitation`'s `ToField`/`FromField` (AgentStore.hs:2074-2076) change from `strEncode`/`strDecode` of `ConnectionRequestUri` to a tagged `ContactRequest` encoding (`smpEncode ('I', cr)` / `('C', dr)`). `FromField` tries the tagged decode first and falls back to decoding a legacy bare-URI blob as `CRInvitation`, so un-accepted pre-upgrade rows still decode. `smpInvitation` (Agent.hs:3618) wraps its `connReq` in `CRInvitation`; `smpAddressConfirmation` (O2') writes `CRConfirmation`. +Storage: `cr_invitation`'s `ToField`/`FromField` encode `CRInvitation` as the legacy `strEncode` URI (unchanged from before, so the format is downgrade-safe) and `CRConfirmation` as JSON (`J.encode` of `DRRequest`). `FromField` peeks the first byte: `{` → JSON `CRConfirmation`, else `strDecode` → `CRInvitation` (a URI never starts with `{`). `DRRequest` uses manual `ToJSON`/`FromJSON` (extensible), and `SMPQueueInfo` gets a base64 `StrEncoding` + JSON to sit inside it. `smpInvitation` (Agent.hs:3618) wraps its `connReq` in `CRInvitation`; `smpAddressConfirmation` (O2') writes `CRConfirmation`. ## Part 4 - key rotation (separate concern) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index fc061f0db..a505a60a0 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1360,6 +1360,17 @@ instance Encoding SMPQueueInfo where queueMode <- queueModeP pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode} +instance StrEncoding SMPQueueInfo where + strEncode = strEncode . smpEncode + strP = smpDecode <$?> strP + +instance ToJSON SMPQueueInfo where + toJSON = strToJSON + toEncoding = strToJEncoding + +instance FromJSON SMPQueueInfo where + parseJSON = strParseJSON "SMPQueueInfo" + -- This instance seems contrived and there was a temptation to split a common part of both types. -- But this is created to allow backward and forward compatibility where SMPQueueUri -- could have more fields to convert to different versions of SMPQueueInfo in a different way, diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index d4154cbf0..de30e27e0 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -109,11 +109,10 @@ import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Agent.Store.Interface (createDBStore) import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations) import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..)) +import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J -import qualified Data.ByteString.Lazy as LB import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport (..), RatchetX448) -import Simplex.Messaging.Encoding +import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol ( MsgBody, @@ -659,23 +658,15 @@ data DRRequest = DRRequest drPQSupport :: PQSupport } -instance Encoding DRRequest where - smpEncode DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport} = - smpEncode (Large $ LB.toStrict $ J.encode drRatchet, drReplyQueue, drAgentVersion, supportPQ drPQSupport) - smpP = do - (rcJson, drReplyQueue, drAgentVersion, pqB) <- smpP - drRatchet <- either fail pure $ J.eitherDecodeStrict' $ unLarge rcJson - pure DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport = PQSupport pqB} - -instance Encoding ContactRequest where - smpEncode = \case - CRInvitation cr -> smpEncode ('I', cr) - CRConfirmation dr -> smpEncode ('C', dr) - smpP = - smpP >>= \case - 'I' -> CRInvitation <$> smpP - 'C' -> CRConfirmation <$> smpP - _ -> fail "bad ContactRequest tag" +instance ToJSON DRRequest where + toJSON DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport} = + J.object ["ratchet" J..= drRatchet, "replyQueue" J..= drReplyQueue, "agentVersion" J..= drAgentVersion, "pqSupport" J..= drPQSupport] + toEncoding DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport} = + J.pairs $ "ratchet" J..= drRatchet <> "replyQueue" J..= drReplyQueue <> "agentVersion" J..= drAgentVersion <> "pqSupport" J..= drPQSupport + +instance FromJSON DRRequest where + parseJSON = J.withObject "DRRequest" $ \o -> + DRRequest <$> o J..: "ratchet" <*> o J..: "replyQueue" <*> o J..: "agentVersion" <*> o J..: "pqSupport" -- * Message integrity validation types diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 46991027a..ccbcc1c2a 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -280,9 +280,11 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Except import Crypto.Random (ChaChaDRG) import Data.Bifunctor (first) +import qualified Data.Aeson as J import Data.ByteString (ByteString) import qualified Data.ByteString.Base64.URL as U import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as LB import Data.Functor (($>)) import Data.Int (Int64) import Data.List (foldl', sortBy) @@ -2106,13 +2108,18 @@ instance ToField RatchetKeyId where toField (RatchetKeyId s) = toField $ Binary instance FromField RatchetKeyId where fromField = blobFieldDecoder $ Right . RatchetKeyId -instance ToField ContactRequest where toField = toField . Binary . smpEncode +-- a classic invitation keeps its legacy URI encoding (unchanged, so older agents can still read it); +-- a DR confirmation is JSON, told apart by the leading '{' (a URI never starts with it) +instance ToField ContactRequest where + toField = toField . Binary . \case + CRInvitation cr -> strEncode cr + CRConfirmation dr -> LB.toStrict $ J.encode dr --- falls back to a legacy bare-URI row (un-tagged) as a classic invitation instance FromField ContactRequest where - fromField = blobFieldDecoder $ \bs -> case smpDecode bs of - Right cr -> Right cr - Left _ -> CRInvitation <$> strDecode bs + fromField = blobFieldDecoder $ \bs -> + if "{" `B.isPrefixOf` bs + then CRConfirmation <$> J.eitherDecodeStrict' bs + else CRInvitation <$> strDecode bs instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode From 3eb0426a82a259aa50423ea7e5ba21b033778128 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 18:02:21 +0000 Subject: [PATCH 12/81] fix tests --- tests/AgentTests/FunctionalAPITests.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index ee59f6135..56e683125 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -586,18 +586,18 @@ testMatrix2 ps runTest = do it "current, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 agentCfg agentCfg initAgentServersProxy 1 $ runTest PQSupportOn True True it "v8, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 initAgentServersProxy 3 $ runTest PQSupportOn False True it "current" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False - it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfgVPrev 1 $ runTest PQSupportOff False False - it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfg 1 $ runTest PQSupportOff False False - it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrev 1 $ runTest PQSupportOff False False + it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfgVPrev 1 $ runTest PQSupportOff True False + it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfg 1 $ runTest PQSupportOff True False + it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrev 1 $ runTest PQSupportOff True False testMatrix2Stress :: HasCallStack => (ASrvTransport, AStoreType) -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testMatrix2Stress ps runTest = do it "current, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 aCfg aCfg initAgentServersProxy 1 $ runTest PQSupportOn True True it "v8, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 initAgentServersProxy 1 $ runTest PQSupportOn False True it "current" $ withSmpServer ps $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn True False - it "prev" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfgVPrev 1 $ runTest PQSupportOff False False - it "prev to current" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfg 1 $ runTest PQSupportOff False False - it "current to prev" $ withSmpServer ps $ runTestCfg2 aCfg aCfgVPrev 1 $ runTest PQSupportOff False False + it "prev" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfgVPrev 1 $ runTest PQSupportOff True False + it "prev to current" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfg 1 $ runTest PQSupportOff True False + it "current to prev" $ withSmpServer ps $ runTestCfg2 aCfg aCfgVPrev 1 $ runTest PQSupportOff True False where aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval} aProxyCfgV8 = agentProxyCfgV8 {messageRetryInterval = fastMessageRetryInterval} @@ -606,9 +606,9 @@ testMatrix2Stress ps runTest = do testBasicMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testBasicMatrix2 ps runTest = do it "current" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfg 1 $ runTest True - it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 1 $ runTest False - it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfg 1 $ runTest False - it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrevPQ 1 $ runTest False + it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 1 $ runTest True + it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfg 1 $ runTest True + it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrevPQ 1 $ runTest True testRatchetMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testRatchetMatrix2 ps runTest = do From 8b95b5a517815f24fd75aa166f8d602d533ce859 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 18:08:55 +0000 Subject: [PATCH 13/81] update plan --- plans/2026-07-12-address-dr-implementation.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/plans/2026-07-12-address-dr-implementation.md b/plans/2026-07-12-address-dr-implementation.md index bfca5b054..6ba55b159 100644 --- a/plans/2026-07-12-address-dr-implementation.md +++ b/plans/2026-07-12-address-dr-implementation.md @@ -20,7 +20,9 @@ Scope of this change: the **synchronous** DR handshake in join, gated on the add - `cr_invitation` serialization is downgrade-safe: `CRInvitation` keeps the legacy URI (`strEncode`, byte-identical to before), so an older agent still reads classic invitations; `CRConfirmation` is JSON (`DRRequest` has manual `ToJSON`/`FromJSON`), told apart on read by the leading `{` (a URI never starts with it). JSON keeps `DRRequest` extensible. `SMPQueueInfo` gained a base64 `StrEncoding` + JSON (it only had `Encoding`) so it can sit in the JSON. - **DR is opt-in per address**: `createConnectionForLink'`/`createConnectionForLink` gain a `Maybe InitialKeys` DR parameter (separate from the existing connection-PQ `InitialKeys`) - `Nothing` = no DR (old behavior, existing callers), `Just ik` = advertise the bundle with `ik`. The `IKUsePQ`-for-`SCMContact` prohibition stays on the connection-PQ parameter and is lifted only for the DR bundle. -**Not yet done:** rotation (`rotateRatchetKeys`, Part 4), cleanup step (Part 4), the app-driven `LSET` upgrade API (Part 5), wiring the DR parameter into the non-prepared-link `newRcvConnSrv` path, tests (Part 6), regenerating `agent_schema.sql` if a schema-consistency test requires it, and chat wiring (deferred by design). +**Test-matrix consequence of the version bump:** `currentSMPAgentVersion` 7 → 8 moves the version-matrix "prev" (`current − 1`) from v6 to v7. v7 ≥ `ratchetOnConfSMPAgentVersion (7)`, so a joiner/acceptor at "prev" now secures the send queue on confirmation - the `sqSecured` expectation for the prev variants in `testMatrix2`/`testMatrix2Stress`/`testBasicMatrix2` flips `False → True`. (Standard version-bump maintenance; the pre-`ratchetOnConf` unsecured path is now two versions back and no longer exercised by these matrices.) + +**Not yet done:** rotation (`rotateRatchetKeys`, Part 4), cleanup step (Part 4), the app-driven `LSET` upgrade API (Part 5), wiring the DR parameter into the non-prepared-link `newRcvConnSrv` path, DR-specific tests (Part 6), regenerating `agent_schema.sql` if a schema-consistency test requires it, and chat wiring (deferred by design). ## Part 1 - the current contact-address handshake, step by step From 406bdb5c61cfc63c66a41bad225d315a0e212f23 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 19:20:03 +0000 Subject: [PATCH 14/81] tests, refactor --- src/Simplex/Messaging/Agent.hs | 147 ++++++++---------- src/Simplex/Messaging/Agent/Client.hs | 1 - src/Simplex/Messaging/Agent/Protocol.hs | 4 - src/Simplex/Messaging/Agent/Store.hs | 28 ++-- .../Messaging/Agent/Store/AgentStore.hs | 3 +- .../SQLite/Migrations/M20260712_address_dr.hs | 10 +- tests/AgentTests/FunctionalAPITests.hs | 45 ++++++ 7 files changed, 126 insertions(+), 112 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index d63eadcff..3d7c83153 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -431,8 +431,7 @@ prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData srv_ -- | Create connection for prepared link (single network call). -- Validates that server response matches the prepared link. createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Maybe CR.InitialKeys -> SubscriptionMode -> AE ConnId -createConnectionForLink c nm userId enableNtfs ccLink params userLinkData pqInitKeys drInitKeys_ subMode = - withAgentEnv c $ createConnectionForLink' c nm userId enableNtfs ccLink params userLinkData pqInitKeys drInitKeys_ subMode +createConnectionForLink c nm userId enableNtfs = withAgentEnv c .::: createConnectionForLink' c nm userId enableNtfs {-# INLINE createConnectionForLink #-} -- | Create or update user's contact connection short link @@ -486,8 +485,7 @@ prepareConnectionToAccept c userId enableNtfs = withAgentEnv c .: newConnToAccep -- | Join SMP agent connection (JOIN command). joinConnection :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AE SndQueueSecured -joinConnection c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSup subMode = - withAgentEnv c $ joinConn c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSup subMode +joinConnection c nm userId connId enableNtfs = withAgentEnv c .::. joinConn c nm userId connId enableNtfs {-# INLINE joinConnection #-} -- | Allow connection to continue after CONF notification (LET command) @@ -902,7 +900,6 @@ acceptContactAsync' :: AgentClient -> ACorrId -> ConnId -> Bool -> InvitationId acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMode = do Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId case connReq of - -- async accept of a DR-from-address request is deferred; it accepts synchronously via acceptContact' CRConfirmation _ -> throwE $ CMD PROHIBITED "acceptContactAsync: address DR requires sync accept" CRInvitation cReq -> do withStore' c $ \db -> acceptInvitation db invId ownConnInfo @@ -989,8 +986,6 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo pure (ccLink, params) -- | Create connection for prepared link (single network call). --- | Generate a fresh address ratchet-keys bundle and store its private side, returning the public --- bundle to advertise. The KEM is advertised only for IKUsePQ (initialPQEncryption False). mkAddressRatchetKeys :: AgentClient -> ConnId -> CR.InitialKeys -> AM AddressRatchetKeys mkAddressRatchetKeys c connId pqInitKeys = do g <- asks random @@ -1002,7 +997,6 @@ mkAddressRatchetKeys c connId pqInitKeys = do withStore' c $ \db -> createAddressRatchetKeys db connId rkId pk1 pk2 pKem now pure AddressRatchetKeys {ratchetKeyId = rkId, e2eParams = toVersionRangeT e2eRcvParams e2eVR} --- | Advertise DR in a contact address's mutable link data when initial keys are given (Nothing: no DR). addAddressRatchetKeys :: AgentClient -> ConnId -> Maybe CR.InitialKeys -> UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) addAddressRatchetKeys _ _ Nothing uld = pure uld addAddressRatchetKeys c connId (Just pqInitKeys) (UserContactLinkData ucd) = do @@ -1330,10 +1324,9 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do Invitation {connReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId case connReq of CRInvitation cReq -> newConnToJoin c userId connId enableNtfs cReq pqSup - -- DR: build the connection shell (no URI to derive version/PQ from); acceptContact' continues the ratchet - CRConfirmation DRRequest {drAgentVersion, drPQSupport} -> do + CRConfirmation DRRequest {agentVersion, pqSupport} -> do g <- asks random - let cData = ConnData {userId, connId, connAgentVersion = drAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport = drPQSupport} + let cData = ConnData {userId, connId, connAgentVersion = agentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} withStore c $ \db -> createNewConn db g cData SCMInvitation joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AM SndQueueSecured @@ -1439,68 +1432,64 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys Just (qInfo, vrsn@(Compatible v)) -> withInvLock c (strEncode cReqUri) "joinConnSrv" $ case addrKeys_ of Just addrKeys -> joinAddressDR qInfo v addrKeys - Nothing -> joinAddressClassic qInfo vrsn v - Nothing -> throwE $ AGENT A_VERSION - where - joinAddressClassic :: Compatible SMPQueueInfo -> Compatible VersionSMPA -> VersionSMPA -> AM SndQueueSecured - joinAddressClassic qInfo vrsn v = do - SomeConn cType conn <- withStore c (`getConn` connId) - let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup - CCLink cReq _ <- case conn of - NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv - RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys - _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType - void $ sendInvitation c nm userId connId qInfo vrsn cReq cInfo - pure False - mkJoinInvitation rq pqInitKeys = do - g <- asks random - AgentConfig {smpClientVRange = vr, smpAgentVRange, e2eEncryptVRange = e2eVR} <- asks config - let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMMessaging} - crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing - e2eRcvParams <- withStore' c $ \db -> do - lockConnForUpdate db connId - getRatchetX3dhKeys db connId >>= \case - Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eVR) keys - Left e -> do - nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no rcv ratchet " <> show e)) - let pqEnc = CR.initialPQEncryption False pqInitKeys - (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc - createRatchetX3dhKeys db connId pk1 pk2 pKem - pure e2eRcvParams - let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR - pure $ CCLink cReq Nothing - -- establish the send ratchet against the address keys and send the profile as a confirmation (DR message 1) - joinAddressDR :: Compatible SMPQueueInfo -> VersionSMPA -> AddressRatchetKeys -> AM SndQueueSecured - joinAddressDR qInfo v AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} = do - g <- asks random - e2eVR <- asks $ e2eEncryptVRange . config - case e2eParams `compatibleVersion` e2eVR of - Nothing -> throwE $ AGENT A_VERSION - Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ rcDHRr kem_)) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) - (pk1, pk2, pKem, aliceSndParams) <- liftIO $ CR.generateSndE2EParams g e2eV (CR.replyKEM_ e2eV kem_ pqSupport) - (_, rcDHRs) <- atomically $ C.generateKeyPair g - rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams - let rcVs = CR.RatchetVersions {current = e2eV, maxSupported = maxVersion e2eVR} - rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams - e2eKeys <- atomically $ C.generateKeyPair g - (rq, _) <- createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys - SomeConn _ conn <- withStore c (`getConn` connId) - let RcvQueue {smpClientVersion = rqV} = rq - cData = (toConnData conn) {pqSupport} :: ConnData - qAInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) - aliceReply = AgentConnInfoReply (qAInfo :| []) cInfo - currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config - encConnInfo <- withStore c $ \db -> runExceptT $ do - liftIO $ createSndRatchet db connId rc aliceSndParams - liftIO $ setConnPQSupport db connId pqSupport - let agentMsgBody = smpEncode aliceReply - (_, internalSndId, _) <- ExceptT $ updateSndIds db connId - liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody) - fst <$> agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) currentE2EVersion - let agentEnvelope = AgentConfirmation {agentVersion = v, e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just addrRKId, encConnInfo} - void $ sendConfirmationToAddress c nm userId connId qInfo agentEnvelope + Nothing -> do + SomeConn cType conn <- withStore c (`getConn` connId) + let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup + CCLink cReq _ <- case conn of + NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv + RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys + _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType + void $ sendInvitation c nm userId connId qInfo vrsn cReq cInfo pure False + where + mkJoinInvitation rq pqInitKeys = do + g <- asks random + AgentConfig {smpClientVRange = vr, smpAgentVRange, e2eEncryptVRange = e2eVR} <- asks config + let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMMessaging} + crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] Nothing + e2eRcvParams <- withStore' c $ \db -> do + lockConnForUpdate db connId + getRatchetX3dhKeys db connId >>= \case + Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eVR) keys + Left e -> do + nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no rcv ratchet " <> show e)) + let pqEnc = CR.initialPQEncryption False pqInitKeys + (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc + createRatchetX3dhKeys db connId pk1 pk2 pKem + pure e2eRcvParams + let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR + pure $ CCLink cReq Nothing + joinAddressDR qInfo v AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} = do + g <- asks random + e2eVR <- asks $ e2eEncryptVRange . config + case e2eParams `compatibleVersion` e2eVR of + Nothing -> throwE $ AGENT A_VERSION + Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ rcDHRr kem_)) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) + (pk1, pk2, pKem, aliceSndParams) <- liftIO $ CR.generateSndE2EParams g e2eV (CR.replyKEM_ e2eV kem_ pqSupport) + (_, rcDHRs) <- atomically $ C.generateKeyPair g + rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams + let rcVs = CR.RatchetVersions {current = e2eV, maxSupported = maxVersion e2eVR} + rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams + e2eKeys <- atomically $ C.generateKeyPair g + (rq, _) <- createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys + SomeConn _ conn <- withStore c (`getConn` connId) + let RcvQueue {smpClientVersion = rqV} = rq + cData = (toConnData conn) {pqSupport} :: ConnData + qAInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) + aliceReply = AgentConnInfoReply (qAInfo :| []) cInfo + currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config + encConnInfo <- withStore c $ \db -> runExceptT $ do + liftIO $ createSndRatchet db connId rc aliceSndParams + liftIO $ setConnPQSupport db connId pqSupport + let agentMsgBody = smpEncode aliceReply + (_, internalSndId, _) <- ExceptT $ updateSndIds db connId + liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody) + fst <$> agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) currentE2EVersion + let agentEnvelope = AgentConfirmation {agentVersion = v, e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just addrRKId, encConnInfo} + void $ sendConfirmationToAddress c nm userId connId qInfo agentEnvelope + pure False + Nothing -> throwE $ AGENT A_VERSION delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SMP.LinkId -> AM () delInvSL c connId srv lnkId = @@ -1554,17 +1543,16 @@ acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId r <- case connReq of CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode - -- continue the ratchet from receive: create the send queue to Q_A and reply with Q_B under the ratchet - CRConfirmation DRRequest {drRatchet, drReplyQueue} -> do + CRConfirmation DRRequest {ratchetState, replyQueue} -> do SomeConn _ conn <- withStore c (`getConn` connId) let cData = toConnData conn - srv <- getNextSMPServer c userId [qServer drReplyQueue] + srv <- getNextSMPServer c userId [qServer replyQueue] clientVRange <- asks $ smpClientVRange . config - qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ drReplyQueue `proveCompatible` clientVRange + qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange (q, _) <- lift $ newSndQueue userId connId qInfo Nothing sq <- withStore c $ \db -> runExceptT $ do liftIO $ lockConnForUpdate db connId - liftIO $ createRatchet db connId drRatchet + liftIO $ createRatchet db connId ratchetState ExceptT $ updateNewConnSnd db connId q secureConfirmQueue c nm cData Nothing sq srv ownConnInfo Nothing subMode withStore' c $ \db -> acceptInvitation db invId ownConnInfo @@ -3268,7 +3256,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar decryptClientMessage e2eDh clientMsg >>= \case (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) -> smpConfirmation srvMsgId conn (Just senderKey) e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack - -- DR-from-address request (needs both ratchetKeyId and Snd params) (SMP.PHEmpty, AgentConfirmation {e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo, agentVersion}) -> smpAddressConfirmation srvMsgId conn e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion >> ack (SMP.PHEmpty, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) @@ -3579,7 +3566,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - -- establish the ratchet from the stored keys, decrypt the request, and store it, emitting REQ (no connection until accept) smpAddressConfirmation :: SMP.MsgId -> Connection c -> C.PublicKeyX25519 -> RatchetKeyId -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> VersionSMPC -> VersionSMPA -> AM () smpAddressConfirmation srvMsgId conn' _e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId @@ -3590,7 +3576,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar && (phVer `isCompatible` smpClientVRange || phVer <= agreedClientVerion) unless compatible $ throwE $ AGENT A_VERSION case conn' of - -- the existential ratchet-KEM state must be matched in a case (not let) so it stays scoped ContactConnection {} -> case e2eSndParams of CR.AE2ERatchetParams _ innerParams@(CR.E2ERatchetParams e2eVersion _ _ _) -> do unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION) @@ -3607,7 +3592,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply (qA :| _) aliceProfile -> do - let dr = DRRequest {drRatchet = rc', drReplyQueue = qA, drAgentVersion = agentVersion, drPQSupport = pqSupport'} + let dr = DRRequest {ratchetState = rc', replyQueue = qA, agentVersion, pqSupport = pqSupport'} newInv = NewInvitation {contactConnId = connId, connReq = CRConfirmation dr, recipientConnInfo = aliceProfile} invId <- withStore c $ \db -> createInvitation db g newInv notify $ REQ invId pqSupport' (qServer qA :| []) aliceProfile diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index f7be8484a..be9330e9e 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1926,7 +1926,6 @@ sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {s agentCbEncryptOnce v dhPublicKey . smpEncode $ SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) --- send a pre-built confirmation to a contact address, unauthenticated (as sendInvitation) sendConfirmationToAddress :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> AgentMsgEnvelope -> AM (Maybe SMPServer) sendConfirmationToAddress c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) agentEnvelope = do msg <- agentCbEncryptOnce v dhPublicKey . smpEncode $ SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index a505a60a0..1723a519c 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -840,7 +840,6 @@ data AgentMsgEnvelope = AgentConfirmation { agentVersion :: VersionSMPA, e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), - -- DR-from-address (with e2eEncryption_): selects the owner's key generation; else Nothing ratchetKeyId :: Maybe RatchetKeyId, encConnInfo :: ByteString } @@ -1811,7 +1810,6 @@ deriving instance Eq (ConnLinkData c) deriving instance Show (ConnLinkData c) --- | Identifies an 'AddressRatchetKeys' generation; echoed in a request so the owner selects its keys. newtype RatchetKeyId = RatchetKeyId ByteString deriving (Eq, Show) @@ -1821,7 +1819,6 @@ instance Encoding RatchetKeyId where smpP = RatchetKeyId <$> smpP {-# INLINE smpP #-} --- | The address owner's published X3DH keys, letting a requester establish the ratchet from message 1. data AddressRatchetKeys = AddressRatchetKeys { ratchetKeyId :: RatchetKeyId, e2eParams :: RcvE2ERatchetParamsUri 'C.X448 @@ -1842,7 +1839,6 @@ data UserContactData = UserContactData -- alternative addresses of chat relays that receive requests for this contact address. relays :: [ConnShortLink 'CMContact], userData :: UserLinkData, - -- appended, so earlier versions ignore it ratchetKeys :: Maybe AddressRatchetKeys } deriving (Eq, Show) diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index de30e27e0..7c2619865 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -12,6 +12,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} module Simplex.Messaging.Agent.Store @@ -109,11 +110,11 @@ import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Agent.Store.Interface (createDBStore) import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations) import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..)) -import Data.Aeson (FromJSON (..), ToJSON (..)) -import qualified Data.Aeson as J +import qualified Data.Aeson.TH as J import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448) import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol ( MsgBody, MsgFlags, @@ -643,30 +644,19 @@ data Invitation = Invitation accepted :: Bool } --- | The stored request in a conn_invitations row: a classic connection request URI, or a --- double-ratchet confirmation received on a DR-advertising address. +-- | A classic connection request URI, or a double-ratchet confirmation received at a DR address. data ContactRequest = CRInvitation (ConnectionRequestUri 'CMInvitation) | CRConfirmation DRRequest --- | A double-ratchet request received at a contact address (no connection until accept): the --- receiving ratchet from decrypting the first message, the reply queue, and the negotiated versions. data DRRequest = DRRequest - { drRatchet :: RatchetX448, - drReplyQueue :: SMPQueueInfo, - drAgentVersion :: VersionSMPA, - drPQSupport :: PQSupport + { ratchetState :: RatchetX448, + replyQueue :: SMPQueueInfo, + agentVersion :: VersionSMPA, + pqSupport :: PQSupport } -instance ToJSON DRRequest where - toJSON DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport} = - J.object ["ratchet" J..= drRatchet, "replyQueue" J..= drReplyQueue, "agentVersion" J..= drAgentVersion, "pqSupport" J..= drPQSupport] - toEncoding DRRequest {drRatchet, drReplyQueue, drAgentVersion, drPQSupport} = - J.pairs $ "ratchet" J..= drRatchet <> "replyQueue" J..= drReplyQueue <> "agentVersion" J..= drAgentVersion <> "pqSupport" J..= drPQSupport - -instance FromJSON DRRequest where - parseJSON = J.withObject "DRRequest" $ \o -> - DRRequest <$> o J..: "ratchet" <*> o J..: "replyQueue" <*> o J..: "agentVersion" <*> o J..: "pqSupport" +$(J.deriveJSON defaultJSON ''DRRequest) -- * Message integrity validation types diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index ccbcc1c2a..0fb74c43f 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -2108,8 +2108,7 @@ instance ToField RatchetKeyId where toField (RatchetKeyId s) = toField $ Binary instance FromField RatchetKeyId where fromField = blobFieldDecoder $ Right . RatchetKeyId --- a classic invitation keeps its legacy URI encoding (unchanged, so older agents can still read it); --- a DR confirmation is JSON, told apart by the leading '{' (a URI never starts with it) +-- CRInvitation keeps the legacy URI (downgrade-safe); CRConfirmation is JSON, told apart by leading '{' instance ToField ContactRequest where toField = toField . Binary . \case CRInvitation cr -> strEncode cr diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs index 98472b477..e5634b6db 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs @@ -11,12 +11,12 @@ m20260712_address_dr = CREATE TABLE address_ratchet_keys( address_ratchet_key_id INTEGER PRIMARY KEY, conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, - ratchet_key_id BLOB NOT NULL, -- published id echoed by requests - x3dh_priv_key_1 BLOB NOT NULL, -- X448 - x3dh_priv_key_2 BLOB NOT NULL, -- X448 - pq_priv_kem BLOB, -- sntrup761 keypair; NULL when PQ is off for this address + ratchet_key_id BLOB NOT NULL, + x3dh_priv_key_1 BLOB NOT NULL, + x3dh_priv_key_2 BLOB NOT NULL, + pq_priv_kem BLOB, created_at TEXT NOT NULL, - retired_at TEXT -- set on rotation + retired_at TEXT ) STRICT; CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 56e683125..a8635589d 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -347,6 +347,8 @@ functionalAPITests ps = do testRatchetMatrix2 ps runAgentClientContactTest describe "Establish duplex connection via contact address, different PQ settings" $ do testPQMatrix3 ps $ runAgentClientContactTestPQ3 True + describe "Establish duplex connection via contact address with DR" $ + testContactDRMatrix ps it "should support rejecting contact request" $ withSmpServer ps testRejectContactRequest describe "Changing connection user id" $ do @@ -994,6 +996,49 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b where msgId = subtract baseId . fst +-- Establish a connection via a DR-advertising contact address (short-link data carries ratchetKeys). +-- addrIK drives the advertised bundle and the owner's PQ; useDR chooses the DR path (pass the fetched +-- keys) or the classic path (ignore them); bPQ is the joiner's PQSupport. +runAgentClientContactDRTest :: HasCallStack => InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () +runAgentClientContactDRTest addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do + g <- C.newRandom + rootKey <- atomically $ C.generateKeyPair g + linkEntId <- atomically $ C.randomBytes 32 g + let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} + userLinkData = UserContactLinkData userCtData + connIK = IKLinkPQ (CR.connPQEncryption addrIK) -- owner connection PQ (never IKUsePQ) + pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ + runRight_ $ do + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing + _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK (Just addrIK) SMSubscribe + (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink + let addrKeys_ = if useDR then ratchetKeys userCtData' else Nothing + aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe + liftIO $ sqSecuredJoin `shouldBe` False + ("", _, A.REQ invId _ "bob's connInfo") <- get alice + bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + ("", _, A.CONF confId _ "alice's connInfo") <- get bob + allowConnection bob aliceId confId "bob's connInfo" + get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") + get alice ##> ("", bobId, A.CON pqEnc) + get bob ##> ("", aliceId, A.CON pqEnc) + exchangeGreetings_ pqEnc alice bobId bob aliceId + +testContactDRMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> Spec +testContactDRMatrix ps = do + describe "DR join (ratchet from the invitation)" $ do + it "IKPQOff, dh join" $ runAgentClientContactDRTest IKPQOff True PQSupportOff ps + it "IKPQOff, pq join" $ runAgentClientContactDRTest IKPQOff True PQSupportOn ps + it "IKPQOn, dh join" $ runAgentClientContactDRTest IKPQOn True PQSupportOff ps + it "IKPQOn, pq join" $ runAgentClientContactDRTest IKPQOn True PQSupportOn ps + it "IKUsePQ, dh join" $ runAgentClientContactDRTest IKUsePQ True PQSupportOff ps + it "IKUsePQ, pq join" $ runAgentClientContactDRTest IKUsePQ True PQSupportOn ps + describe "classic join, ratchet keys ignored" $ do + it "IKUsePQ, dh join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOff ps + it "IKUsePQ, pq join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOn ps + runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ SMSubscribe From 975b58ecd87d250e0c6982a24a1640b10da73ef6 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Tue, 14 Jul 2026 20:26:03 +0100 Subject: [PATCH 15/81] fix compilation --- src/Simplex/Messaging/Agent/Store.hs | 4 ++-- tests/AgentTests/FunctionalAPITests.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 7c2619865..98c1d6906 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -656,8 +656,6 @@ data DRRequest = DRRequest pqSupport :: PQSupport } -$(J.deriveJSON defaultJSON ''DRRequest) - -- * Message integrity validation types -- | Corresponds to `last_external_snd_msg_id` in `connections` table @@ -847,3 +845,5 @@ instance AnyStoreError StoreError where SEWorkItemError {} -> True _ -> False mkWorkItemError errContext = SEWorkItemError {errContext} + +$(J.deriveJSON defaultJSON ''DRRequest) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index a8635589d..656be6914 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -1016,10 +1016,10 @@ runAgentClientContactDRTest addrIK useDR bPQ ps = withSmpServer ps $ withAgentCl aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False - ("", _, A.REQ invId _ "bob's connInfo") <- get alice + ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe - ("", _, A.CONF confId _ "alice's connInfo") <- get bob + ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob allowConnection bob aliceId confId "bob's connInfo" get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") get alice ##> ("", bobId, A.CON pqEnc) From 2413dbee4ac6b11e5ee7ba2f8d4235bd0fd227bd Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 20:48:54 +0000 Subject: [PATCH 16/81] refactor --- src/Simplex/Messaging/Agent.hs | 102 ++++++++++-------------- src/Simplex/Messaging/Agent/Protocol.hs | 88 ++++++++++---------- 2 files changed, 89 insertions(+), 101 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 3d7c83153..adcd7225c 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1357,7 +1357,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = Right r -> pure $ Right $ snd r Left e -> do nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) - runExceptT $ createRatchet_ db g maxSupported pqSupport e2eRcvParams + runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams pure (cData, sq, e2eSndParams, Nothing) _ -> do let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo @@ -1367,19 +1367,20 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_ withStore c $ \db -> runExceptT $ do liftIO $ lockConnForUpdate db connId - e2eSndParams <- createRatchet_ db g maxSupported pqSupport e2eRcvParams + e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ pure (cData, sq', e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION - where - createRatchet_ db g maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do - (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport) - (_, rcDHRs) <- atomically $ C.generateKeyPair g - rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams - let rcVs = CR.RatchetVersions {current = v, maxSupported} - rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams - liftIO $ createSndRatchet db connId rc e2eSndParams - pure e2eSndParams + +createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) +createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do + (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport) + (_, rcDHRs) <- atomically $ C.generateKeyPair g + rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams + let rcVs = CR.RatchetVersions {current = v, maxSupported} + rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams + liftIO $ createSndRatchet db connId rc e2eSndParams + pure e2eSndParams connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of @@ -1431,7 +1432,7 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys lift (compatibleContactUri cReqUri) >>= \case Just (qInfo, vrsn@(Compatible v)) -> withInvLock c (strEncode cReqUri) "joinConnSrv" $ case addrKeys_ of - Just addrKeys -> joinAddressDR qInfo v addrKeys + Just addrKeys -> joinAddressDR addrKeys Nothing -> do SomeConn cType conn <- withStore c (`getConn` connId) let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup @@ -1459,18 +1460,13 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys pure e2eRcvParams let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR pure $ CCLink cReq Nothing - joinAddressDR qInfo v AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} = do + joinAddressDR AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} = do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config case e2eParams `compatibleVersion` e2eVR of Nothing -> throwE $ AGENT A_VERSION - Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ rcDHRr kem_)) -> do + Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) - (pk1, pk2, pKem, aliceSndParams) <- liftIO $ CR.generateSndE2EParams g e2eV (CR.replyKEM_ e2eV kem_ pqSupport) - (_, rcDHRs) <- atomically $ C.generateKeyPair g - rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams - let rcVs = CR.RatchetVersions {current = e2eV, maxSupported = maxVersion e2eVR} - rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams e2eKeys <- atomically $ C.generateKeyPair g (rq, _) <- createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys SomeConn _ conn <- withStore c (`getConn` connId) @@ -1478,14 +1474,11 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys cData = (toConnData conn) {pqSupport} :: ConnData qAInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) aliceReply = AgentConnInfoReply (qAInfo :| []) cInfo - currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config - encConnInfo <- withStore c $ \db -> runExceptT $ do - liftIO $ createSndRatchet db connId rc aliceSndParams + (aliceSndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do + aliceSndParams <- createRatchet_ db g connId (maxVersion e2eVR) pqSupport e2eRcvParams liftIO $ setConnPQSupport db connId pqSupport - let agentMsgBody = smpEncode aliceReply - (_, internalSndId, _) <- ExceptT $ updateSndIds db connId - liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody) - fst <$> agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) currentE2EVersion + encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode aliceReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) (maxVersion e2eVR) + pure (aliceSndParams, encConnInfo) let agentEnvelope = AgentConfirmation {agentVersion = v, e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just addrRKId, encConnInfo} void $ sendConfirmationToAddress c nm userId connId qInfo agentEnvelope pure False @@ -3497,30 +3490,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do - processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} + processReplyConf agentVersion pqSupport pqSupport' rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2 - where - processConf connInfo senderConf = do - let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} - confId <- withStore c $ \db -> do - setConnAgentVersion db connId agentVersion - when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport' - -- / - -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), - -- initiating party initializes ratchet on processing confirmation; - -- previously, it initialized ratchet on allowConnection; - -- this is to support decryption of messages that may be received before allowConnection - liftIO $ do - createRatchet db connId rc' - let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq - SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf - dhSecret = C.dh' e2ePubKey' e2ePrivKey' - setRcvQueueConfirmedE2E db rq dhSecret $ min v v' - -- / - createConfirmation db g newConfirmation - let srvs = map qServer $ smpReplyQueues senderConf - notify $ CONF confId pqSupport' srvs connInfo _ -> prohibited "conf: decrypt error" -- party accepting connection (DuplexConnection _ (rq'@RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do @@ -3550,22 +3522,34 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do - let senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} - newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} - confId <- withStore c $ \db -> do - liftIO $ do - createRatchet db connId rc' - let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq - dhSecret = C.dh' e2ePubKey e2ePrivKey' - setRcvQueueConfirmedE2E db rq dhSecret $ min v phVer - updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) - createConfirmation db g newConfirmation - notify $ CONF confId pqSupport (map qServer $ smpReplyQueues senderConf) connInfo + processReplyConf agentVersion pqSupport pqSupport rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo + withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) _ -> prohibited "conf: not AgentConnInfoReply" _ -> prohibited "conf: decrypt error" _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" + -- persists a confirmation reply and its ratchet, then notifies CONF; shared by the connection + -- initiator (ratchet built here) and the address DR requester (ratchet built during join). + processReplyConf :: VersionSMPA -> PQSupport -> PQSupport -> CR.RatchetX448 -> SMPConfirmation -> ConnInfo -> AM () + processReplyConf agentVersion pqSupport pqSupport' rc' senderConf connInfo = do + let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} + g <- asks random + confId <- withStore c $ \db -> do + setConnAgentVersion db connId agentVersion + when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport' + -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), the ratchet is initialized + -- on processing confirmation (previously on allowConnection), to decrypt messages that may + -- be received before allowConnection. + liftIO $ do + createRatchet db connId rc' + let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq + SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf + dhSecret = C.dh' e2ePubKey' e2ePrivKey' + setRcvQueueConfirmedE2E db rq dhSecret $ min v v' + createConfirmation db g newConfirmation + notify $ CONF confId pqSupport' (map qServer $ smpReplyQueues senderConf) connInfo + smpAddressConfirmation :: SMP.MsgId -> Connection c -> C.PublicKeyX25519 -> RatchetKeyId -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> VersionSMPC -> VersionSMPA -> AM () smpAddressConfirmation srvMsgId conn' _e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 1723a519c..d7e999ac7 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1359,10 +1359,6 @@ instance Encoding SMPQueueInfo where queueMode <- queueModeP pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode} -instance StrEncoding SMPQueueInfo where - strEncode = strEncode . smpEncode - strP = smpDecode <$?> strP - instance ToJSON SMPQueueInfo where toJSON = strToJSON toEncoding = strToJEncoding @@ -1421,42 +1417,52 @@ sameQAddress :: (SMPServer, SMP.QueueId) -> (SMPServer, SMP.QueueId) -> Bool sameQAddress (srv, qId) (srv', qId') = sameSrvAddr srv srv' && qId == qId' {-# INLINE sameQAddress #-} +strEncodeSMPQueue :: StrEncoding v => (v -> VersionSMPC) -> v -> SMPQueueAddress -> ByteString +strEncodeSMPQueue minVer v SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, queueMode} + | minVer v >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams + | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam) + where + query = strEncode . QSP QEscape + queryParams = [("v", strEncode v), ("dh", strEncode dhPublicKey)] <> queueModeParam <> sndSecureParam + where + queueModeParam = case queueMode of + Just QMMessaging -> [("q", "m")] + Just QMContact -> [("q", "c")] + Nothing -> [] + sndSecureParam = [("k", "s") | senderCanSecure queueMode && minVer v < shortLinksSMPClientVersion] + srvParam = [("srv", strEncode $ TransportHosts_ hs) | not (null hs)] + hs = L.tail $ host srv + +strPSMPQueue :: StrEncoding v => v -> (v -> VersionSMPC) -> A.Parser (v, SMPQueueAddress) +strPSMPQueue defaultVer maxVer = do + srv@ProtocolServer {host = h :| host} <- strP <* A.char '/' + senderId <- strP <* optional (A.char '/') <* A.char '#' + (ver, hs, dhPublicKey, queueMode) <- versioned <|> unversioned + let srv' = srv {host = h :| host <> hs} + smpServer = if maxVer ver < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv' + pure (ver, SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}) + where + unversioned = (defaultVer,[],,Nothing) <$> strP <* A.endOfInput + versioned = do + dhKey_ <- optional strP + query <- optional (A.char '/') *> A.char '?' *> strP + ver <- queryParam "v" query + dhKey <- maybe (queryParam "dh" query) pure dhKey_ + hs_ <- queryParam_ "srv" query + let queueMode = case queryParamStr "q" query of + Just "m" -> Just QMMessaging + Just "c" -> Just QMContact + _ | queryParamStr "k" query == Just "s" -> Just QMMessaging + _ -> Nothing + pure (ver, maybe [] thList_ hs_, dhKey, queueMode) + instance StrEncoding SMPQueueUri where - strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, queueMode}) - | minVersion vr >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams - | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam) - where - query = strEncode . QSP QEscape - queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)] <> queueModeParam <> sndSecureParam - where - queueModeParam = case queueMode of - Just QMMessaging -> [("q", "m")] - Just QMContact -> [("q", "c")] - Nothing -> [] - sndSecureParam = [("k", "s") | senderCanSecure queueMode && minVersion vr < shortLinksSMPClientVersion] - srvParam = [("srv", strEncode $ TransportHosts_ hs) | not (null hs)] - hs = L.tail $ host srv - strP = do - srv@ProtocolServer {host = h :| host} <- strP <* A.char '/' - senderId <- strP <* optional (A.char '/') <* A.char '#' - (vr, hs, dhPublicKey, queueMode) <- versioned <|> unversioned - let srv' = srv {host = h :| host <> hs} - smpServer = if maxVersion vr < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv' - pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode} - where - unversioned = (versionToRange initialSMPClientVersion,[],,Nothing) <$> strP <* A.endOfInput - versioned = do - dhKey_ <- optional strP - query <- optional (A.char '/') *> A.char '?' *> strP - vr <- queryParam "v" query - dhKey <- maybe (queryParam "dh" query) pure dhKey_ - hs_ <- queryParam_ "srv" query - let queueMode = case queryParamStr "q" query of - Just "m" -> Just QMMessaging - Just "c" -> Just QMContact - _ | queryParamStr "k" query == Just "s" -> Just QMMessaging - _ -> Nothing - pure (vr, maybe [] thList_ hs_, dhKey, queueMode) + strEncode (SMPQueueUri vr addr) = strEncodeSMPQueue minVersion vr addr + strP = uncurry SMPQueueUri <$> strPSMPQueue (versionToRange initialSMPClientVersion) maxVersion + +instance StrEncoding SMPQueueInfo where + strEncode (SMPQueueInfo v addr) = strEncodeSMPQueue id v addr + strP = uncurry SMPQueueInfo <$> strPSMPQueue initialSMPClientVersion id instance Encoding SMPQueueUri where smpEncode (SMPQueueUri clientVRange@(VersionRange minV maxV) SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}) @@ -1974,9 +1980,7 @@ instance Encoding UserContactData where owners <- smpListP relays <- smpListP userData <- smpP - -- ratchetKeys is appended: absent in earlier data (optional -> Nothing), and the trailing - -- takeByteString ignores any further fields for forward compatibility. - ratchetKeys <- optional smpP <* A.takeByteString + ratchetKeys <- optional smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding pure UserContactData {direct, owners, relays, userData, ratchetKeys} instance Encoding UserLinkData where From c19d8a7acbcfad67ed7cbbb234bd926069701dbb Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 20:57:12 +0000 Subject: [PATCH 17/81] refactor more --- src/Simplex/Messaging/Agent.hs | 47 +++++++++++++------------ src/Simplex/Messaging/Agent/Protocol.hs | 9 ++--- 2 files changed, 27 insertions(+), 29 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index adcd7225c..edf949fa1 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1382,6 +1382,23 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar liftIO $ createSndRatchet db connId rc e2eSndParams pure e2eSndParams +-- initializes the receive ratchet from X3DH keys and decrypts the confirmation reply (first ratchet message); +-- shared by the connection initiator and the address DR owner, which differ only in the key source. +initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.RcvE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) +initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _) encConnInfo = do + e2eEncryptVRange <- asks $ e2eEncryptVRange . config + unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION + rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams + let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} + pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) + rc = CR.initRcvRatchet rcVs pk2 rcParams pqSupport' + g <- asks random + (agentMsgBody_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + case skipped of + CR.SMDNoChange -> pure () + _ -> logWarn "conf: skipped confirmations" + pure (agentMsgBody_, rc', pqSupport') + connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of CRInvitationUri {} -> invPQSupported <$$> compatibleInvitationUri cReq @@ -3474,18 +3491,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case status of New -> case (conn', e2eEncryption) of -- party initiating connection - (RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _))) -> do - unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION) - (pk1, rcDHRs, pKem) <- withStore c (`getRatchetX3dhKeys` connId) - rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 rcDHRs pKem e2eSndParams - let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} - pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) - rc = CR.initRcvRatchet rcVs rcDHRs rcParams pqSupport' - g <- asks random - (agentMsgBody_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo - case skipped of - CR.SMDNoChange -> pure () - _ -> logWarn "conf: skipped confirmations" + (RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams)) -> do + keys <- withStore c (`getRatchetX3dhKeys` connId) + (agentMsgBody_, rc', pqSupport') <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case @@ -3553,7 +3561,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar smpAddressConfirmation :: SMP.MsgId -> Connection c -> C.PublicKeyX25519 -> RatchetKeyId -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> VersionSMPC -> VersionSMPA -> AM () smpAddressConfirmation srvMsgId conn' _e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId - AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config + AgentConfig {smpClientVRange, smpAgentVRange} <- asks config let ConnData {pqSupport} = toConnData conn' compatible = (agentVersion `isCompatible` smpAgentVRange || agentVersion <= agreedAgentVersion) @@ -3561,21 +3569,16 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar unless compatible $ throwE $ AGENT A_VERSION case conn' of ContactConnection {} -> case e2eSndParams of - CR.AE2ERatchetParams _ innerParams@(CR.E2ERatchetParams e2eVersion _ _ _) -> do - unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION) + CR.AE2ERatchetParams _ innerParams -> withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case Left _ -> prohibited "addr conf: unknown ratchetKeyId" - Right (pk1, pk2, pKem) -> do - rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem innerParams - let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} - pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) - rc = CR.initRcvRatchet rcVs pk2 rcParams pqSupport' - g <- asks random - (agentMsgBody_, rc', _skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + Right keys -> do + (agentMsgBody_, rc', pqSupport') <- initRcvRatchetDecrypt agentVersion pqSupport keys innerParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply (qA :| _) aliceProfile -> do + g <- asks random let dr = DRRequest {ratchetState = rc', replyQueue = qA, agentVersion, pqSupport = pqSupport'} newInv = NewInvitation {contactConnId = connId, connReq = CRConfirmation dr, recipientConnInfo = aliceProfile} invId <- withStore c $ \db -> createInvitation db g newInv diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index d7e999ac7..c22c64b3d 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -1342,6 +1343,7 @@ sameQueue addr q = sameQAddress addr (qAddress q) data SMPQueueInfo = SMPQueueInfo {clientVersion :: VersionSMPC, queueAddress :: SMPQueueAddress} deriving (Eq, Show) + deriving (ToJSON, FromJSON) via (StrJSON "SMPQueueInfo" SMPQueueInfo) instance Encoding SMPQueueInfo where smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}) @@ -1359,13 +1361,6 @@ instance Encoding SMPQueueInfo where queueMode <- queueModeP pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode} -instance ToJSON SMPQueueInfo where - toJSON = strToJSON - toEncoding = strToJEncoding - -instance FromJSON SMPQueueInfo where - parseJSON = strParseJSON "SMPQueueInfo" - -- This instance seems contrived and there was a temptation to split a common part of both types. -- But this is created to allow backward and forward compatibility where SMPQueueUri -- could have more fields to convert to different versions of SMPQueueInfo in a different way, From ab6186486439e840a53da1f3a4e0a8a53c3fe7a0 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 21:07:28 +0000 Subject: [PATCH 18/81] fix --- src/Simplex/Messaging/Agent.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index edf949fa1..f77ed8055 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1384,7 +1384,7 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar -- initializes the receive ratchet from X3DH keys and decrypts the confirmation reply (first ratchet message); -- shared by the connection initiator and the address DR owner, which differ only in the key source. -initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.RcvE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) +initRcvRatchetDecrypt :: CR.RatchetKEMStateI s => VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.E2ERatchetParams s 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION From c9451405c37223118ae3d7241825fdbce10cf5f3 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Tue, 14 Jul 2026 22:09:36 +0100 Subject: [PATCH 19/81] add export --- src/Simplex/Messaging/Crypto/Ratchet.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs index 7250a1d60..b1c28bda6 100644 --- a/src/Simplex/Messaging/Crypto/Ratchet.hs +++ b/src/Simplex/Messaging/Crypto/Ratchet.hs @@ -37,6 +37,7 @@ module Simplex.Messaging.Crypto.Ratchet AUseKEM (..), RatchetKEMState (..), SRatchetKEMState (..), + RatchetKEMStateI (..), RcvPrivRKEMParams, APrivRKEMParams (..), RcvE2ERatchetParamsUri, From 45ee5dfce5cda10483db4475454de50543ec3ec1 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 14 Jul 2026 21:35:40 +0000 Subject: [PATCH 20/81] fix --- src/Simplex/Messaging/Agent.hs | 61 +++++++++++++++++----------------- 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index f77ed8055..8d433b4d1 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1384,8 +1384,8 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar -- initializes the receive ratchet from X3DH keys and decrypts the confirmation reply (first ratchet message); -- shared by the connection initiator and the address DR owner, which differ only in the key source. -initRcvRatchetDecrypt :: CR.RatchetKEMStateI s => VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.E2ERatchetParams s 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) -initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _) encConnInfo = do +initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) +initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams @@ -3478,20 +3478,24 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar parseMessage :: Encoding a => ByteString -> AM a parseMessage = liftEither . parse smpP (AGENT A_MESSAGE) + -- checking agreed versions to continue connection in case of client/agent version downgrades + checkConfVersions :: VersionSMPA -> VersionSMPC -> AM () + checkConfVersions agentVersion phVer = do + AgentConfig {smpClientVRange, smpAgentVRange} <- asks config + let compatible = + (agentVersion `isCompatible` smpAgentVRange || agentVersion <= agreedAgentVersion) + && (phVer `isCompatible` smpClientVRange || phVer <= agreedClientVerion) + unless compatible $ throwE $ AGENT A_VERSION + smpConfirmation :: SMP.MsgId -> Connection c -> Maybe C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> AM () smpConfirmation srvMsgId conn' senderKey e2ePubKey e2eEncryption encConnInfo phVer agentVersion = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId - AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config + checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' - -- checking agreed versions to continue connection in case of client/agent version downgrades - compatible = - (agentVersion `isCompatible` smpAgentVRange || agentVersion <= agreedAgentVersion) - && (phVer `isCompatible` smpClientVRange || phVer <= agreedClientVerion) - unless compatible $ throwE $ AGENT A_VERSION case status of New -> case (conn', e2eEncryption) of -- party initiating connection - (RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams)) -> do + (RcvConnection _ _, Just e2eSndParams) -> do keys <- withStore c (`getRatchetX3dhKeys` connId) (agentMsgBody_, rc', pqSupport') <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo case agentMsgBody_ of @@ -3561,30 +3565,25 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar smpAddressConfirmation :: SMP.MsgId -> Connection c -> C.PublicKeyX25519 -> RatchetKeyId -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> VersionSMPC -> VersionSMPA -> AM () smpAddressConfirmation srvMsgId conn' _e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId - AgentConfig {smpClientVRange, smpAgentVRange} <- asks config + checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' - compatible = - (agentVersion `isCompatible` smpAgentVRange || agentVersion <= agreedAgentVersion) - && (phVer `isCompatible` smpClientVRange || phVer <= agreedClientVerion) - unless compatible $ throwE $ AGENT A_VERSION case conn' of - ContactConnection {} -> case e2eSndParams of - CR.AE2ERatchetParams _ innerParams -> - withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case - Left _ -> prohibited "addr conf: unknown ratchetKeyId" - Right keys -> do - (agentMsgBody_, rc', pqSupport') <- initRcvRatchetDecrypt agentVersion pqSupport keys innerParams encConnInfo - case agentMsgBody_ of - Right agentMsgBody -> - parseMessage agentMsgBody >>= \case - AgentConnInfoReply (qA :| _) aliceProfile -> do - g <- asks random - let dr = DRRequest {ratchetState = rc', replyQueue = qA, agentVersion, pqSupport = pqSupport'} - newInv = NewInvitation {contactConnId = connId, connReq = CRConfirmation dr, recipientConnInfo = aliceProfile} - invId <- withStore c $ \db -> createInvitation db g newInv - notify $ REQ invId pqSupport' (qServer qA :| []) aliceProfile - _ -> prohibited "addr conf: not AgentConnInfoReply" - _ -> prohibited "addr conf: decrypt error" + ContactConnection {} -> + withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case + Left _ -> prohibited "addr conf: unknown ratchetKeyId" + Right keys -> do + (agentMsgBody_, rc', pqSupport') <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + case agentMsgBody_ of + Right agentMsgBody -> + parseMessage agentMsgBody >>= \case + AgentConnInfoReply (qA :| _) aliceProfile -> do + g <- asks random + let dr = DRRequest {ratchetState = rc', replyQueue = qA, agentVersion, pqSupport = pqSupport'} + newInv = NewInvitation {contactConnId = connId, connReq = CRConfirmation dr, recipientConnInfo = aliceProfile} + invId <- withStore c $ \db -> createInvitation db g newInv + notify $ REQ invId pqSupport' (qServer qA :| []) aliceProfile + _ -> prohibited "addr conf: not AgentConnInfoReply" + _ -> prohibited "addr conf: decrypt error" _ -> prohibited "addr conf: not a contact address" helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () From 6620ab096a1a87a6eb5537d51adb9910c9222360 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Wed, 15 Jul 2026 21:29:58 +0000 Subject: [PATCH 21/81] refactor --- src/Simplex/Messaging/Agent.hs | 46 ++++++++++++++++---------- tests/AgentTests/FunctionalAPITests.hs | 12 +++++-- 2 files changed, 37 insertions(+), 21 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 8d433b4d1..dc47e9940 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1382,22 +1382,27 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar liftIO $ createSndRatchet db connId rc e2eSndParams pure e2eSndParams --- initializes the receive ratchet from X3DH keys and decrypts the confirmation reply (first ratchet message); --- shared by the connection initiator and the address DR owner, which differ only in the key source. -initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) +-- completes the X3DH receive, initializes the receive ratchet, and decrypts the first inbound ratchet +-- message (the peer's confirmation/request); shared by the connection initiator and the address DR owner, +-- which differ only in the key source. Does not persist the ratchet - the caller stores the returned rc'. +-- returns (decrypted body, updated ratchet, connection pqSupport, connection PQ capability). The connection +-- pqSupport is the enable choice clamped to the negotiated versions (seeds the ratchet); the capability is +-- whether the versions support PQ at all (same value smpInvitation reports in REQ - independent of enable). +initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport, PQSupport) initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} - pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) + pqCapability = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) + pqSupport' = pqSupport `CR.pqSupportAnd` pqCapability rc = CR.initRcvRatchet rcVs pk2 rcParams pqSupport' g <- asks random (agentMsgBody_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo case skipped of CR.SMDNoChange -> pure () _ -> logWarn "conf: skipped confirmations" - pure (agentMsgBody_, rc', pqSupport') + pure (agentMsgBody_, rc', pqSupport', pqCapability) connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of @@ -3497,12 +3502,12 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- party initiating connection (RcvConnection _ _, Just e2eSndParams) -> do keys <- withStore c (`getRatchetX3dhKeys` connId) - (agentMsgBody_, rc', pqSupport') <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + (agentMsgBody_, rc', pqSupport', _) <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do - processReplyConf agentVersion pqSupport pqSupport' rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo + processConf agentVersion pqSupport pqSupport' rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2 _ -> prohibited "conf: decrypt error" @@ -3534,33 +3539,37 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do - processReplyConf agentVersion pqSupport pqSupport rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo + processConf agentVersion pqSupport pqSupport rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) _ -> prohibited "conf: not AgentConnInfoReply" _ -> prohibited "conf: decrypt error" _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - -- persists a confirmation reply and its ratchet, then notifies CONF; shared by the connection - -- initiator (ratchet built here) and the address DR requester (ratchet built during join). - processReplyConf :: VersionSMPA -> PQSupport -> PQSupport -> CR.RatchetX448 -> SMPConfirmation -> ConnInfo -> AM () - processReplyConf agentVersion pqSupport pqSupport' rc' senderConf connInfo = do + -- shared by the initiator branch and the address DR requester branch; body unchanged from the + -- original inline processConf, parameterized over the ratchet and pqSupport values. + processConf :: VersionSMPA -> PQSupport -> PQSupport -> CR.RatchetX448 -> SMPConfirmation -> ConnInfo -> AM () + processConf agentVersion pqSupport pqSupport' rc' senderConf connInfo = do let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} g <- asks random confId <- withStore c $ \db -> do setConnAgentVersion db connId agentVersion when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport' - -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), the ratchet is initialized - -- on processing confirmation (previously on allowConnection), to decrypt messages that may - -- be received before allowConnection. + -- / + -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), + -- initiating party initializes ratchet on processing confirmation; + -- previously, it initialized ratchet on allowConnection; + -- this is to support decryption of messages that may be received before allowConnection liftIO $ do createRatchet db connId rc' let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf dhSecret = C.dh' e2ePubKey' e2ePrivKey' setRcvQueueConfirmedE2E db rq dhSecret $ min v v' + -- / createConfirmation db g newConfirmation - notify $ CONF confId pqSupport' (map qServer $ smpReplyQueues senderConf) connInfo + let srvs = map qServer $ smpReplyQueues senderConf + notify $ CONF confId pqSupport' srvs connInfo smpAddressConfirmation :: SMP.MsgId -> Connection c -> C.PublicKeyX25519 -> RatchetKeyId -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> VersionSMPC -> VersionSMPA -> AM () smpAddressConfirmation srvMsgId conn' _e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion = do @@ -3572,7 +3581,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case Left _ -> prohibited "addr conf: unknown ratchetKeyId" Right keys -> do - (agentMsgBody_, rc', pqSupport') <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + (agentMsgBody_, rc', pqSupport', pqCapability) <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case @@ -3581,7 +3590,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let dr = DRRequest {ratchetState = rc', replyQueue = qA, agentVersion, pqSupport = pqSupport'} newInv = NewInvitation {contactConnId = connId, connReq = CRConfirmation dr, recipientConnInfo = aliceProfile} invId <- withStore c $ \db -> createInvitation db g newInv - notify $ REQ invId pqSupport' (qServer qA :| []) aliceProfile + -- REQ reports the connection PQ capability (as smpInvitation does), not the owner's enable choice + notify $ REQ invId pqCapability (qServer qA :| []) aliceProfile _ -> prohibited "addr conf: not AgentConnInfoReply" _ -> prohibited "addr conf: decrypt error" _ -> prohibited "addr conf: not a contact address" diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 656be6914..e5f69eb9d 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -996,7 +996,7 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b where msgId = subtract baseId . fst --- Establish a connection via a DR-advertising contact address (short-link data carries ratchetKeys). +-- Establish a connection via a DR-advertising contact address (short-link data includes ratchetKeys). -- addrIK drives the advertised bundle and the owner's PQ; useDR chooses the DR path (pass the fetched -- keys) or the classic path (ignore them); bPQ is the joiner's PQSupport. runAgentClientContactDRTest :: HasCallStack => InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () @@ -1016,10 +1016,12 @@ runAgentClientContactDRTest addrIK useDR bPQ ps = withSmpServer ps $ withAgentCl aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False - ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice + ("", _, A.REQ invId reqPQ _ "bob's connInfo") <- get alice + liftIO $ reqPQ `shouldBe` PQSupportOn -- REQ reports the connection PQ capability (On when versions support PQ); same for DR and classic paths bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe - ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob + ("", _, A.CONF confId confPQ _ "alice's connInfo") <- get bob + liftIO $ confPQ `shouldBe` bPQ -- CONF reports the joiner's own connection PQ support allowConnection bob aliceId confId "bob's connInfo" get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") get alice ##> ("", bobId, A.CON pqEnc) @@ -1036,6 +1038,10 @@ testContactDRMatrix ps = do it "IKUsePQ, dh join" $ runAgentClientContactDRTest IKUsePQ True PQSupportOff ps it "IKUsePQ, pq join" $ runAgentClientContactDRTest IKUsePQ True PQSupportOn ps describe "classic join, ratchet keys ignored" $ do + it "IKPQOff, dh join" $ runAgentClientContactDRTest IKPQOff False PQSupportOff ps + it "IKPQOff, pq join" $ runAgentClientContactDRTest IKPQOff False PQSupportOn ps + it "IKPQOn, dh join" $ runAgentClientContactDRTest IKPQOn False PQSupportOff ps + it "IKPQOn, pq join" $ runAgentClientContactDRTest IKPQOn False PQSupportOn ps it "IKUsePQ, dh join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOff ps it "IKUsePQ, pq join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOn ps From 06c8261c7965ceff8b2b296514dd48d5dc8e075c Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Wed, 15 Jul 2026 21:53:09 +0000 Subject: [PATCH 22/81] refactor --- src/Simplex/Messaging/Agent.hs | 28 ++++++++++------------------ 1 file changed, 10 insertions(+), 18 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index dc47e9940..c62007f7b 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -986,23 +986,6 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo pure (ccLink, params) -- | Create connection for prepared link (single network call). -mkAddressRatchetKeys :: AgentClient -> ConnId -> CR.InitialKeys -> AM AddressRatchetKeys -mkAddressRatchetKeys c connId pqInitKeys = do - g <- asks random - e2eVR <- asks $ e2eEncryptVRange . config - let pqEnc = CR.initialPQEncryption False pqInitKeys - (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc - rkId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) - now <- liftIO getCurrentTime - withStore' c $ \db -> createAddressRatchetKeys db connId rkId pk1 pk2 pKem now - pure AddressRatchetKeys {ratchetKeyId = rkId, e2eParams = toVersionRangeT e2eRcvParams e2eVR} - -addAddressRatchetKeys :: AgentClient -> ConnId -> Maybe CR.InitialKeys -> UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) -addAddressRatchetKeys _ _ Nothing uld = pure uld -addAddressRatchetKeys c connId (Just pqInitKeys) (UserContactLinkData ucd) = do - bundle <- mkAddressRatchetKeys c connId pqInitKeys - pure $ UserContactLinkData ucd {ratchetKeys = Just bundle} - createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Maybe CR.InitialKeys -> SubscriptionMode -> AM ConnId createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys drInitKeys_ subMode = do g <- asks random @@ -1011,7 +994,16 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink" _ -> pure () connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys) - userLinkData' <- addAddressRatchetKeys c connId drInitKeys_ userLinkData + userLinkData' <- case drInitKeys_ of + Nothing -> pure userLinkData + Just ik -> do + e2eVR <- asks $ e2eEncryptVRange . config + (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption False ik) + rkId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) + now <- liftIO getCurrentTime + withStore' c $ \db -> createAddressRatchetKeys db connId rkId pk1 pk2 pKem now + let UserContactLinkData ucd = userLinkData + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId = rkId, e2eParams = toVersionRangeT e2eRcvParams e2eVR}} let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' linkData = (plpSignedFixedData, md) From 6bcae59df594595f4db6de49f76f000a82ed31f8 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Wed, 15 Jul 2026 22:55:30 +0100 Subject: [PATCH 23/81] update schema --- .../Agent/Store/SQLite/Migrations/agent_schema.sql | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index 195783cce..c4d9be3d3 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -468,12 +468,12 @@ CREATE TABLE client_services( CREATE TABLE address_ratchet_keys( address_ratchet_key_id INTEGER PRIMARY KEY, conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, - ratchet_key_id BLOB NOT NULL, -- published id echoed by requests - x3dh_priv_key_1 BLOB NOT NULL, -- X448 - x3dh_priv_key_2 BLOB NOT NULL, -- X448 - pq_priv_kem BLOB, -- sntrup761 keypair; NULL when PQ is off for this address + ratchet_key_id BLOB NOT NULL, + x3dh_priv_key_1 BLOB NOT NULL, + x3dh_priv_key_2 BLOB NOT NULL, + pq_priv_kem BLOB, created_at TEXT NOT NULL, - retired_at TEXT -- set on rotation + retired_at TEXT ) STRICT; CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id); CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id); From 19f1567d03e88a88bdc580ece8eafd0519cb9dca Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Wed, 15 Jul 2026 23:11:04 +0100 Subject: [PATCH 24/81] rename --- src/Simplex/Messaging/Agent.hs | 22 +++++++++---------- src/Simplex/Messaging/Agent/Store.hs | 4 ++-- .../Messaging/Agent/Store/AgentStore.hs | 8 +++---- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index c62007f7b..aefc6573b 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -898,8 +898,8 @@ allowConnectionAsync' c corrId connId confId ownConnInfo = -- while marking invitation as accepted inside "lock level transaction" after successful `joinConnAsync`. acceptContactAsync' :: AgentClient -> ACorrId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM () acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMode = do - Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId - case connReq of + Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId + case contactReq of CRConfirmation _ -> throwE $ CMD PROHIBITED "acceptContactAsync: address DR requires sync accept" CRInvitation cReq -> do withStore' c $ \db -> acceptInvitation db invId ownConnInfo @@ -999,11 +999,11 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP Just ik -> do e2eVR <- asks $ e2eEncryptVRange . config (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption False ik) - rkId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) + ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) now <- liftIO getCurrentTime - withStore' c $ \db -> createAddressRatchetKeys db connId rkId pk1 pk2 pKem now + withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem now let UserContactLinkData ucd = userLinkData - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId = rkId, e2eParams = toVersionRangeT e2eRcvParams e2eVR}} + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams = toVersionRangeT e2eRcvParams e2eVR}} let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' linkData = (plpSignedFixedData, md) @@ -1313,8 +1313,8 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> PQSupport -> AM ConnId newConnToAccept c userId connId enableNtfs invId pqSup = do - Invitation {connReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId - case connReq of + Invitation {contactReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId + case contactReq of CRInvitation cReq -> newConnToJoin c userId connId enableNtfs cReq pqSup CRConfirmation DRRequest {agentVersion, pqSupport} -> do g <- asks random @@ -1547,8 +1547,8 @@ allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConne -- | Accept contact (ACPT command) in Reader monad acceptContact' :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do - Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId - r <- case connReq of + Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId + r <- case contactReq of CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode CRConfirmation DRRequest {ratchetState, replyQueue} -> do SomeConn _ conn <- withStore c (`getConn` connId) @@ -3580,7 +3580,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar AgentConnInfoReply (qA :| _) aliceProfile -> do g <- asks random let dr = DRRequest {ratchetState = rc', replyQueue = qA, agentVersion, pqSupport = pqSupport'} - newInv = NewInvitation {contactConnId = connId, connReq = CRConfirmation dr, recipientConnInfo = aliceProfile} + newInv = NewInvitation {contactConnId = connId, contactReq = CRConfirmation dr, recipientConnInfo = aliceProfile} invId <- withStore c $ \db -> createInvitation db g newInv -- REQ reports the connection PQ capability (as smpInvitation does), not the owner's enable choice notify $ REQ invId pqCapability (qServer qA :| []) aliceProfile @@ -3740,7 +3740,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- in case invitation not compatible, assume there is no PQ encryption support. pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq g <- asks random - let newInv = NewInvitation {contactConnId = connId, connReq = CRInvitation connReq, recipientConnInfo = cInfo} + let newInv = NewInvitation {contactConnId = connId, contactReq = CRInvitation connReq, recipientConnInfo = cInfo} invId <- withStore c $ \db -> createInvitation db g newInv let srvs = L.map qServer $ crSmpQueues crData notify $ REQ invId pqSupport srvs cInfo diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 98c1d6906..c6bd5297b 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -631,14 +631,14 @@ data AcceptedConfirmation = AcceptedConfirmation data NewInvitation = NewInvitation { contactConnId :: ConnId, - connReq :: ContactRequest, + contactReq :: ContactRequest, recipientConnInfo :: ConnInfo } data Invitation = Invitation { invitationId :: InvitationId, contactConnId_ :: Maybe ConnId, - connReq :: ContactRequest, + contactReq :: ContactRequest, recipientConnInfo :: ConnInfo, ownConnInfo :: Maybe ConnInfo, accepted :: Bool diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 0fb74c43f..370e3012e 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -872,7 +872,7 @@ removeConfirmations db connId = (Only connId) createInvitation :: DB.Connection -> TVar ChaChaDRG -> NewInvitation -> IO (Either StoreError InvitationId) -createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInfo} = +createInvitation db gVar NewInvitation {contactConnId, contactReq, recipientConnInfo} = createWithRandomId db gVar $ \invitationId -> DB.execute db @@ -880,7 +880,7 @@ createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInf INSERT INTO conn_invitations (invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0); |] - (Binary invitationId, contactConnId, connReq, Binary recipientConnInfo) + (Binary invitationId, contactConnId, contactReq, Binary recipientConnInfo) getInvitation :: DB.Connection -> String -> InvitationId -> IO (Either StoreError Invitation) getInvitation db cxt invitationId = @@ -895,8 +895,8 @@ getInvitation db cxt invitationId = |] (Only (Binary invitationId)) where - invitation (contactConnId_, connReq, recipientConnInfo, ownConnInfo, BI accepted) = - Invitation {invitationId, contactConnId_, connReq, recipientConnInfo, ownConnInfo, accepted} + invitation (contactConnId_, contactReq, recipientConnInfo, ownConnInfo, BI accepted) = + Invitation {invitationId, contactConnId_, contactReq, recipientConnInfo, ownConnInfo, accepted} acceptInvitation :: DB.Connection -> InvitationId -> ConnInfo -> IO () acceptInvitation db invitationId ownConnInfo = From 91a28ecf7c8a795e87cf9cb466f4338d36dc17dc Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 16 Jul 2026 12:48:09 +0000 Subject: [PATCH 25/81] refactor --- src/Simplex/Messaging/Agent.hs | 378 ++++++++++-------- src/Simplex/Messaging/Agent/Client.hs | 23 +- src/Simplex/Messaging/Agent/Protocol.hs | 50 ++- src/Simplex/Messaging/Agent/Store.hs | 10 +- .../Messaging/Agent/Store/AgentStore.hs | 18 +- .../Migrations/M20260712_address_dr.hs | 3 +- .../SQLite/Migrations/M20260712_address_dr.hs | 3 +- .../Store/SQLite/Migrations/agent_schema.sql | 3 +- tests/AgentTests/ConnectionRequestTests.hs | 14 +- tests/AgentTests/FunctionalAPITests.hs | 105 ++++- 10 files changed, 396 insertions(+), 211 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index aefc6573b..233e0c646 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -873,14 +873,14 @@ joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} c lift (compatibleInvitationUri cReqUri) >>= \case Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitation enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo Nothing -> throwE $ AGENT A_VERSION joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = lift (compatibleContactUri cReqUri) >>= \case Just (_, Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing when updateConn $ withStore' c $ \db -> updateNewConnJoin db connId connAgentVersion pqSupport enableNtfs - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitation enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo Nothing -> throwE $ AGENT A_VERSION allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM () @@ -900,7 +900,12 @@ acceptContactAsync' :: AgentClient -> ACorrId -> ConnId -> Bool -> InvitationId acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMode = do Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId case contactReq of - CRConfirmation _ -> throwE $ CMD PROHIBITED "acceptContactAsync: address DR requires sync accept" + -- accept via JOIN, symmetrically with the classic branch: the command handler does the whole accept + CRConfirmation dr -> do + withStore' c $ \db -> acceptInvitation db invId ownConnInfo + enqueueCommand c corrId connId Nothing (AClientCommand $ JOIN (JRAddressDR dr) subMode ownConnInfo) `catchAllErrors` \err -> do + withStore' c (`unacceptInvitation` invId) + throwE err CRInvitation cReq -> do withStore' c $ \db -> acceptInvitation db invId ownConnInfo joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do @@ -993,12 +998,19 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP case pqInitKeys of CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink" _ -> pure () + -- the advertised bundle and the connection must agree on PQ: the owner seeds its receive ratchet from + -- the connection while the requester seeds its send ratchet from the bundle - a mismatch is a foot-gun + forM_ drInitKeys_ $ \ik -> + unless (CR.connPQEncryption ik == CR.connPQEncryption pqInitKeys) $ + throwE $ CMD PROHIBITED "createConnectionForLink: address keys PQ inconsistent with connection" connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys) userLinkData' <- case drInitKeys_ of Nothing -> pure userLinkData Just ik -> do e2eVR <- asks $ e2eEncryptVRange . config - (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption False ik) + -- this bundle is always short-link data, so IKLinkPQ's PQ is honored (shortLink = True) - the KEM is + -- advertised so a PQ requester can AcceptKEM and encrypt its first message (profile) with PQ from message 1 + (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption True ik) ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) now <- liftIO getCurrentTime withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem now @@ -1109,18 +1121,21 @@ setConnShortLink' c nm connId cMode userLinkData clientData = liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d' g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config + -- the app never sees the advertised DR keys, so re-inject them from the database to keep the + -- address offering the same ratchet across updates (non-DR addresses are left unchanged) + ud' <- preserveAddressRatchetKeys ud let cslContact = CSLContact SLSServer CCTContact (qServer rq) case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do let (linkId, k) = SL.contactShortLinkKdf shortLinkKey unless (shortLinkId == linkId) $ throwE $ INTERNAL "setConnShortLink: link ID is not derived from link" - d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud + d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud' pure (rq, linkId, cslContact shortLinkKey, (linkEncFixedData, d)) Nothing -> do sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact} connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData - (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud + (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud' (linkId, k) = SL.contactShortLinkKdf linkKey srvData <- liftError id $ SL.encryptLinkData g k linkData let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData) @@ -1136,6 +1151,14 @@ setConnShortLink' c nm connId cMode userLinkData clientData = let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey pure (rq, shortLinkId, sl, (linkEncFixedData, d)) Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation" + preserveAddressRatchetKeys :: UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) + preserveAddressRatchetKeys ud@(UserContactLinkData ucd) = + withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case + Left _ -> pure ud -- non-DR address: nothing to preserve + Right (rkId, pk1, pk2, pKem) -> do + e2eVR <- asks $ e2eEncryptVRange . config + let e2eRcv = CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem) + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId = rkId, e2eParams = toVersionRangeT e2eRcv e2eVR}} deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM () deleteConnShortLink' c nm connId cMode = @@ -1331,38 +1354,66 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q -startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Maybe SMP.LinkId) -startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = - lift (compatibleInvitationUri cReqUri) >>= \case - Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do - -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out - -- e2ePubKey is always present, it's Maybe historically - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) - g <- asks random - maxSupported <- asks $ maxVersion . e2eEncryptVRange . config - let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} - case sq_ of - Just sq@SndQueue {e2ePubKey = Just _k} -> do - e2eSndParams <- withStore c $ \db -> do - lockConnForUpdate db connId - getSndRatchet db connId v >>= \case - Right r -> pure $ Right $ snd r - Left e -> do - nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) - runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - pure (cData, sq, e2eSndParams, Nothing) - _ -> do - let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo - invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId - let lnkId_ = fst <$> invLink_ - sndKey_ = snd <$> invLink_ - (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_ +-- shared queue + ratchet setup for classic invitation joins/accepts (Left) and address DR accepts (Right). +-- Reads the connection and resumes safely: reuses the send queue, ratchet, and (on a duplex retry) the reply +-- queue created by a previous attempt, returning that reply queue so the caller does not open a duplicate. +-- A classic join builds the ratchet from the peer's X3DH params and returns them to send in the confirmation; +-- a DR accept persists the ratchet already established from message 1 and returns no params. +-- the Left case carries the invitation's own params (enableNtfs, PQSupport); the DR accept (Right) needs neither. +startJoinInvitation :: AgentClient -> ConnId -> Either (Bool, ConnectionRequestUri 'CMInvitation, PQSupport) DRRequest -> AM (ConnData, Maybe RcvQueue, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) +startJoinInvitation c connId joinReq = do + SomeConn cType conn <- withStore c (`getConn` connId) + let ConnData {userId} = toConnData conn + (rq_, sq_) <- case conn of + NewConnection _ -> pure (Nothing, Nothing) + SndConnection _ sq -> pure (Nothing, Just sq) + DuplexConnection _ (rq@RcvQueue {status = New} :| _) (sq@SndQueue {status = sqStatus} :| _) + | sqStatus == New || sqStatus == Secured -> pure (Just rq, Just sq) + _ -> throwE $ CMD PROHIBITED $ "startJoinInvitation: bad connection " <> show cType + case joinReq of + Left (enableNtfs, cReqUri, pqSup) -> + lift (compatibleInvitationUri cReqUri) >>= \case + Nothing -> throwE $ AGENT A_VERSION + Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) + g <- asks random + maxSupported <- asks $ maxVersion . e2eEncryptVRange . config + let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} + case sq_ of + -- reuse on resume avoids re-generating queue keys and a subsequent SKEY failure; e2ePubKey is always present + Just sq@SndQueue {e2ePubKey = Just _k} -> do + e2eSndParams <- withStore c $ \db -> do + lockConnForUpdate db connId + getSndRatchet db connId v >>= \case + Right r -> pure $ Right $ snd r + Left e -> do + nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) + runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams + pure (cData, rq_, sq, Just e2eSndParams, Nothing) + _ -> do + let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo + invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId + let lnkId_ = fst <$> invLink_ + sndKey_ = snd <$> invLink_ + (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_ + (sq', e2eSndParams) <- withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams + sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ + pure (sq', e2eSndParams) + pure (cData, rq_, sq', Just e2eSndParams, lnkId_) + Right DRRequest {ratchetState, replyQueue} -> do + sq <- case sq_ of + Just sq -> pure sq -- resume: send queue and ratchet were already created on the first attempt + Nothing -> do + clientVRange <- asks $ smpClientVRange . config + qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange + (q, _) <- lift $ newSndQueue userId connId qInfo Nothing withStore c $ \db -> runExceptT $ do liftIO $ lockConnForUpdate db connId - e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (cData, sq', e2eSndParams, lnkId_) - Nothing -> throwE $ AGENT A_VERSION + liftIO $ createRatchet db connId ratchetState + ExceptT $ updateNewConnSnd db connId q + pure (toConnData conn, rq_, sq, Nothing, Nothing) createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do @@ -1374,13 +1425,20 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar liftIO $ createSndRatchet db connId rc e2eSndParams pure e2eSndParams +-- the result of initRcvRatchetDecrypt. connPQSupport is the enable choice clamped to the negotiated versions +-- (it seeds the ratchet); pqCapability is whether the versions support PQ at all (the value smpInvitation +-- reports in REQ - independent of the enable choice). The ratchet is not yet persisted - the caller stores it. +data RcvRatchetInit = RcvRatchetInit + { decrypted :: Either C.CryptoError ByteString, + ratchet :: CR.RatchetX448, + connPQSupport :: PQSupport, + pqCapability :: PQSupport + } + -- completes the X3DH receive, initializes the receive ratchet, and decrypts the first inbound ratchet -- message (the peer's confirmation/request); shared by the connection initiator and the address DR owner, --- which differ only in the key source. Does not persist the ratchet - the caller stores the returned rc'. --- returns (decrypted body, updated ratchet, connection pqSupport, connection PQ capability). The connection --- pqSupport is the enable choice clamped to the negotiated versions (seeds the ratchet); the capability is --- whether the versions support PQ at all (same value smpInvitation reports in REQ - independent of enable). -initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport, PQSupport) +-- which differ only in the key source. +initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM RcvRatchetInit initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION @@ -1394,7 +1452,7 @@ initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetPar case skipped of CR.SMDNoChange -> pure () _ -> logWarn "conf: skipped confirmations" - pure (agentMsgBody_, rc', pqSupport', pqCapability) + pure RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of @@ -1427,35 +1485,56 @@ versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && ma {-# INLINE versionPQSupport_ #-} joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys pqSup subMode srv = +joinConnSrv c nm _userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys pqSup subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do - SomeConn cType conn <- withStore c (`getConn` connId) - case conn of - NewConnection _ -> doJoin Nothing Nothing - SndConnection _ sq -> doJoin Nothing (Just sq) - DuplexConnection _ (rq@RcvQueue {status = New} :| _) (sq@SndQueue {status = sqStatus} :| _) - | sqStatus == New || sqStatus == Secured -> doJoin (Just rq) (Just sq) - _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType - where - doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured - doJoin rq_ sq_ = do - (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup - secureConfirmQueue c nm cData rq_ sq srv cInfo (Just e2eSndParams) subMode - >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) + (cData, rq_, sq, params_, lnkId_) <- startJoinInvitation c connId (Left (enableNtfs, inv, pqSup)) + secureConfirmQueue c nm cData rq_ sq srv cInfo params_ subMode + >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case - Just (qInfo, vrsn@(Compatible v)) -> - withInvLock c (strEncode cReqUri) "joinConnSrv" $ case addrKeys_ of - Just addrKeys -> joinAddressDR addrKeys - Nothing -> do - SomeConn cType conn <- withStore c (`getConn` connId) - let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup - CCLink cReq _ <- case conn of - NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv - RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys - _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType - void $ sendInvitation c nm userId connId qInfo vrsn cReq cInfo - pure False + Just (qInfo, Compatible v) -> + withInvLock c (strEncode cReqUri) "joinConnSrv" $ do + SomeConn cType conn <- withStore c (`getConn` connId) + -- both flows create/resume a receive queue and build the message sent to the contact address: the + -- classic flow an invitation with fresh X3DH keys, the DR flow (addrKeys_ set) a confirmation + -- (message 1) whose ratchet is established now from the address's advertised keys + envelope <- case addrKeys_ of + Nothing -> do + let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup + CCLink cReq _ <- case conn of + NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv + RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys + _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType + pure AgentInvitation {agentVersion = v, connReq = cReq, connInfo = cInfo} + Just AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} -> do + g <- asks random + e2eVR <- asks $ e2eEncryptVRange . config + case e2eParams `compatibleVersion` e2eVR of + Nothing -> throwE $ AGENT A_VERSION + Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) + maxV = maxVersion e2eVR + -- resume-safe: create the reply queue and send ratchet only on the first attempt; a retry + -- reuses both so the ratchet the owner built from message 1 still matches + rq <- case conn of + NewConnection _ -> do + e2eKeys <- atomically $ C.generateKeyPair g + fst <$> createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys + RcvConnection _ rq -> pure rq + _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType + let RcvQueue {smpClientVersion = rqV} = rq + cData = (toConnData conn) {pqSupport} :: ConnData + replyQInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) + sndReply = AgentConnInfoReply (replyQInfo :| []) cInfo + (sndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + sndParams <- liftIO (getSndRatchet db connId e2eV) >>= either (const $ createRatchet_ db g connId maxV pqSupport e2eRcvParams) (pure . snd) + liftIO $ setConnPQSupport db connId pqSupport + encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode sndReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) maxV + pure (sndParams, encConnInfo) + pure AgentConfirmation {agentVersion = v, e2eEncryption_ = Just sndParams, ratchetKeyId = Just addrRKId, encConnInfo} + void $ sendInvitation c nm userId connId qInfo envelope + pure False where mkJoinInvitation rq pqInitKeys = do g <- asks random @@ -1474,28 +1553,6 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys pure e2eRcvParams let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR pure $ CCLink cReq Nothing - joinAddressDR AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} = do - g <- asks random - e2eVR <- asks $ e2eEncryptVRange . config - case e2eParams `compatibleVersion` e2eVR of - Nothing -> throwE $ AGENT A_VERSION - Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) - e2eKeys <- atomically $ C.generateKeyPair g - (rq, _) <- createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys - SomeConn _ conn <- withStore c (`getConn` connId) - let RcvQueue {smpClientVersion = rqV} = rq - cData = (toConnData conn) {pqSupport} :: ConnData - qAInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) - aliceReply = AgentConnInfoReply (qAInfo :| []) cInfo - (aliceSndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do - aliceSndParams <- createRatchet_ db g connId (maxVersion e2eVR) pqSupport e2eRcvParams - liftIO $ setConnPQSupport db connId pqSupport - encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode aliceReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) (maxVersion e2eVR) - pure (aliceSndParams, encConnInfo) - let agentEnvelope = AgentConfirmation {agentVersion = v, e2eEncryption_ = Just aliceSndParams, ratchetKeyId = Just addrRKId, encConnInfo} - void $ sendConfirmationToAddress c nm userId connId qInfo agentEnvelope - pure False Nothing -> throwE $ AGENT A_VERSION delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SMP.LinkId -> AM () @@ -1503,25 +1560,13 @@ delInvSL c connId srv lnkId = withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e -> liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e)) -joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do - SomeConn cType conn <- withStore c (`getConn` connId) - case conn of - NewConnection _ -> doJoin Nothing Nothing - SndConnection _ sq -> doJoin Nothing (Just sq) - -- this branch should never be reached with async flow because once receive queue is created, - -- there are not more failure points (sending confirmation is asynchronous) - DuplexConnection _ (rq@RcvQueue {status = New} :| _) (sq@SndQueue {status = sqStatus} :| _) - | sqStatus == New || sqStatus == Secured -> doJoin (Just rq) (Just sq) - _ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType - where - doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured - doJoin rq_ sq_ = do - (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport - secureConfirmQueueAsync c cData rq_ sq srv cInfo (Just e2eSndParams) subMode - >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) -joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do - throwE $ CMD PROHIBITED "joinConnSrvAsync" +-- async accept/join of an invitation URI (Left) or an address DR request (Right): create the send queue and +-- ratchet, then send the confirmation asynchronously. Shared by the JOIN command's invitation and DR handlers. +joinConnSrvAsync :: AgentClient -> ConnId -> Either (Bool, ConnectionRequestUri 'CMInvitation, PQSupport) DRRequest -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrvAsync c connId joinReq cInfo subMode srv = do + (cData, rq_, sq, params_, lnkId_) <- startJoinInvitation c connId joinReq + secureConfirmQueueAsync c cData rq_ sq srv cInfo params_ subMode + >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) createReplyQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo createReplyQueue c nm ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do @@ -1550,18 +1595,10 @@ acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId r <- case contactReq of CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode - CRConfirmation DRRequest {ratchetState, replyQueue} -> do - SomeConn _ conn <- withStore c (`getConn` connId) - let cData = toConnData conn + CRConfirmation dr@DRRequest {replyQueue} -> do srv <- getNextSMPServer c userId [qServer replyQueue] - clientVRange <- asks $ smpClientVRange . config - qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange - (q, _) <- lift $ newSndQueue userId connId qInfo Nothing - sq <- withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - liftIO $ createRatchet db connId ratchetState - ExceptT $ updateNewConnSnd db connId q - secureConfirmQueue c nm cData Nothing sq srv ownConnInfo Nothing subMode + (cData, rq_, sq, params_, _) <- startJoinInvitation c connId (Right dr) + secureConfirmQueue c nm cData rq_ sq srv ownConnInfo params_ subMode withStore' c $ \db -> acceptInvitation db invId ownConnInfo pure r @@ -1973,18 +2010,25 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do withServer' . tryCommand $ do (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink notify $ LDATA fixedData linkData - JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do + JOIN (JRInvitation enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv + sqSecured <- joinConnSrvAsync c connId (Left (enableNtfs, cReq, pqEnc)) connInfo subMode srv notify $ JOINED sqSecured -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. - JOIN enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc subMode connInfo -> noServer $ do + JOIN (JRInvitation enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo Nothing pqEnc subMode srv notify $ JOINED sqSecured + -- address DR accept: same shape as the invitation join above, sending no X3DH params; the reply queue's + -- server is excluded so our own reply queue is created elsewhere. startJoinInvitation makes this resume-safe. + JOIN (JRAddressDR dr@DRRequest {replyQueue}) subMode ownCInfo -> noServer $ do + triedHosts <- newTVarIO S.empty + tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do + sqSecured <- joinConnSrvAsync c connId (Right dr) ownCInfo subMode srv + notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK SWCH -> @@ -3263,13 +3307,13 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar decryptClientMessage e2eDh clientMsg >>= \case (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) -> smpConfirmation srvMsgId conn (Just senderKey) e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack - (SMP.PHEmpty, AgentConfirmation {e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo, agentVersion}) -> - smpAddressConfirmation srvMsgId conn e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion >> ack + (SMP.PHEmpty, e@AgentConfirmation {ratchetKeyId = Just _}) -> + smpInvitation srvMsgId conn e phVer >> ack (SMP.PHEmpty, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) | senderCanSecure queueMode -> smpConfirmation srvMsgId conn Nothing e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack | otherwise -> prohibited "handshake: missing sender key" >> ack - (SMP.PHEmpty, AgentInvitation {connReq, connInfo}) -> - smpInvitation srvMsgId conn connReq connInfo >> ack + (SMP.PHEmpty, e@AgentInvitation {}) -> + smpInvitation srvMsgId conn e phVer >> ack _ -> prohibited "handshake: incorrect state" >> ack (Just e2eDh, Nothing) -> do decryptClientMessage e2eDh clientMsg >>= \case @@ -3494,7 +3538,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- party initiating connection (RcvConnection _ _, Just e2eSndParams) -> do keys <- withStore c (`getRatchetX3dhKeys` connId) - (agentMsgBody_, rc', pqSupport', _) <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport'} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case @@ -3538,15 +3582,16 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - -- shared by the initiator branch and the address DR requester branch; body unchanged from the - -- original inline processConf, parameterized over the ratchet and pqSupport values. + -- persists the established ratchet and the negotiated pqSupport, records the confirmation, and + -- notifies the user with CONF; shared by the connection initiator and the address DR requester. + -- pqSupport is the connection's current support, agreedPQSupport the value negotiated for the ratchet. processConf :: VersionSMPA -> PQSupport -> PQSupport -> CR.RatchetX448 -> SMPConfirmation -> ConnInfo -> AM () - processConf agentVersion pqSupport pqSupport' rc' senderConf connInfo = do + processConf agentVersion pqSupport agreedPQSupport rc' senderConf connInfo = do let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} g <- asks random confId <- withStore c $ \db -> do setConnAgentVersion db connId agentVersion - when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport' + when (pqSupport /= agreedPQSupport) $ setConnPQSupport db connId agreedPQSupport -- / -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), -- initiating party initializes ratchet on processing confirmation; @@ -3561,32 +3606,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- / createConfirmation db g newConfirmation let srvs = map qServer $ smpReplyQueues senderConf - notify $ CONF confId pqSupport' srvs connInfo - - smpAddressConfirmation :: SMP.MsgId -> Connection c -> C.PublicKeyX25519 -> RatchetKeyId -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> VersionSMPC -> VersionSMPA -> AM () - smpAddressConfirmation srvMsgId conn' _e2ePubKey rkId e2eSndParams encConnInfo phVer agentVersion = do - logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId - checkConfVersions agentVersion phVer - let ConnData {pqSupport} = toConnData conn' - case conn' of - ContactConnection {} -> - withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case - Left _ -> prohibited "addr conf: unknown ratchetKeyId" - Right keys -> do - (agentMsgBody_, rc', pqSupport', pqCapability) <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo - case agentMsgBody_ of - Right agentMsgBody -> - parseMessage agentMsgBody >>= \case - AgentConnInfoReply (qA :| _) aliceProfile -> do - g <- asks random - let dr = DRRequest {ratchetState = rc', replyQueue = qA, agentVersion, pqSupport = pqSupport'} - newInv = NewInvitation {contactConnId = connId, contactReq = CRConfirmation dr, recipientConnInfo = aliceProfile} - invId <- withStore c $ \db -> createInvitation db g newInv - -- REQ reports the connection PQ capability (as smpInvitation does), not the owner's enable choice - notify $ REQ invId pqCapability (qServer qA :| []) aliceProfile - _ -> prohibited "addr conf: not AgentConnInfoReply" - _ -> prohibited "addr conf: decrypt error" - _ -> prohibited "addr conf: not a contact address" + notify $ CONF confId agreedPQSupport srvs connInfo helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do @@ -3731,19 +3751,41 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar when (isNothing rcSnd) . void $ enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} (EREADY lastExternalSndId) - smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM () - smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData _) cInfo = do + -- owner receiving a contact request: a classic AgentInvitation, or an address DR AgentConfirmation + -- (message 1, ratchetKeyId set) that establishes the ratchet now. Both store a ContactRequest and REQ. + smpInvitation :: SMP.MsgId -> Connection c -> AgentMsgEnvelope -> VersionSMPC -> AM () + smpInvitation srvMsgId conn' envelope phVer = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId case conn' of ContactConnection {} -> do - -- show connection request even if invitaion via contact address is not compatible. - -- in case invitation not compatible, assume there is no PQ encryption support. - pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq - g <- asks random - let newInv = NewInvitation {contactConnId = connId, contactReq = CRInvitation connReq, recipientConnInfo = cInfo} - invId <- withStore c $ \db -> createInvitation db g newInv - let srvs = L.map qServer $ crSmpQueues crData - notify $ REQ invId pqSupport srvs cInfo + -- compute (request, PQ capability reported in REQ, servers, requester info) per flow, then + -- share the store + notify; REQ reports the connection PQ capability, not the owner's enable choice + req_ <- case envelope of + AgentInvitation {connReq = connReq@(CRInvitationUri crData _), connInfo} -> do + -- show connection request even if invitation via contact address is not compatible. + -- in case invitation not compatible, assume there is no PQ encryption support. + reqPQ <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq + pure $ Just (CRInvitation connReq, reqPQ, L.map qServer $ crSmpQueues crData, connInfo) + AgentConfirmation {agentVersion, e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo} -> do + checkConfVersions agentVersion phVer + let ConnData {pqSupport} = toConnData conn' + withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case + Left _ -> Nothing <$ prohibited "addr conf: unknown ratchetKeyId" + Right keys -> do + RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + case agentMsgBody_ of + Right agentMsgBody -> + parseMessage agentMsgBody >>= \case + AgentConnInfoReply (replyQInfo :| _) reqConnInfo -> + let dr = DRRequest {ratchetState = rc', replyQueue = replyQInfo, agentVersion, pqSupport = pqSupport'} + in pure $ Just (CRConfirmation dr, pqCapability, qServer replyQInfo :| [], reqConnInfo) + _ -> Nothing <$ prohibited "addr conf: not AgentConnInfoReply" + _ -> Nothing <$ prohibited "addr conf: decrypt error" + _ -> Nothing <$ prohibited "conf: incorrect state" + forM_ req_ $ \(contactReq, reqPQ, srvs, recipientConnInfo) -> do + g <- asks random + invId <- withStore c $ \db -> createInvitation db g NewInvitation {contactConnId = connId, contactReq, recipientConnInfo} + notify $ REQ invId reqPQ srvs recipientConnInfo _ -> prohibited "inv: sent to message conn" where pqSupported (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible agentVersion) = diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index be9330e9e..bfd3ccbf0 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -59,7 +59,6 @@ module Simplex.Messaging.Agent.Client getSubscriptions, sendConfirmation, sendInvitation, - sendConfirmationToAddress, temporaryAgentError, temporaryOrHostError, serverHostError, @@ -1914,22 +1913,14 @@ sendConfirmation c nm sq@SndQueue {userId, server, connId, sndId, queueMode, snd sendOrProxySMPMessage c nm userId server connId "" spKey sndId (MsgFlags {notification = True}) msg sendConfirmation _ _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database" -sendInvitation :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM (Maybe SMPServer) -sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) connReq connInfo = do - msg <- mkInvitation - sendOrProxySMPMessage c nm userId smpServer connId "" Nothing senderId (MsgFlags {notification = True}) msg - where - mkInvitation :: AM ByteString - -- this is only encrypted with per-queue E2E, not with double ratchet - mkInvitation = do - let agentEnvelope = AgentInvitation {agentVersion, connReq, connInfo} - agentCbEncryptOnce v dhPublicKey . smpEncode $ - SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) - -sendConfirmationToAddress :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> AgentMsgEnvelope -> AM (Maybe SMPServer) -sendConfirmationToAddress c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) agentEnvelope = do +-- sends an agent envelope to a contact address queue, encrypted only with per-queue E2E, not the double +-- ratchet: a classic AgentInvitation, or an address-DR AgentConfirmation (message 1) that establishes the ratchet +sendInvitation :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> AgentMsgEnvelope -> AM (Maybe SMPServer) +sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) agentEnvelope = do msg <- agentCbEncryptOnce v dhPublicKey . smpEncode $ SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) - sendOrProxySMPMessage c nm userId smpServer connId "" Nothing senderId (MsgFlags {notification = True}) msg + sendOrProxySMPMessage c nm userId smpServer connId label Nothing senderId (MsgFlags {notification = True}) msg + where + label = case agentEnvelope of AgentConfirmation {} -> ""; _ -> "" getQueueMessage :: AgentClient -> RcvQueue -> AM (Maybe SMPMsgMeta) getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index c22c64b3d..6789ff846 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -58,6 +58,7 @@ module Simplex.Messaging.Agent.Protocol SndQueueSecured, AEntityId, ACommand (..), + JoinRequest (..), AEvent (..), AEvt (..), ACommandTag (..), @@ -121,6 +122,7 @@ module Simplex.Messaging.Agent.Protocol UserContactData (..), UserLinkData (..), AddressRatchetKeys (..), + DRRequest (..), RatchetKeyId (..), OwnerAuth (..), OwnerId, @@ -204,6 +206,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 qualified Data.ByteString.Lazy as LB import Data.Char (toLower, toUpper) import Data.Foldable (find) import Data.Functor (($>)) @@ -234,6 +237,7 @@ import Simplex.Messaging.Crypto.Ratchet ( InitialKeys (..), PQEncryption (..), PQSupport, + RatchetX448, RcvE2ERatchetParams, RcvE2ERatchetParamsUri, SndE2ERatchetParams, @@ -466,12 +470,13 @@ data ACommand = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK | LGET (ConnShortLink 'CMContact) -- response LDATA - | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo + | JOIN JoinRequest SubscriptionMode ConnInfo | LET ConfirmationId ConnInfo -- ConnInfo is from client | ACK AgentMsgId (Maybe MsgReceiptInfo) | SWCH | DEL - deriving (Eq, Show) + -- no Eq: JOIN's JRAddressDR carries a DRRequest with a RatchetX448, which has no Eq + deriving (Show) data ACommandTag = NEW_ @@ -1832,6 +1837,25 @@ instance Encoding AddressRatchetKeys where (ratchetKeyId, e2eParams) <- smpP pure AddressRatchetKeys {ratchetKeyId, e2eParams} +-- | The double-ratchet request an address owner receives in message 1 and later accepts: the ratchet the +-- owner established from that message, the requester's reply queue, and the negotiated version and PQ support. +-- Kept here (not in Agent.Store) so JOIN commands can carry it; Agent.Store re-exports it. +data DRRequest = DRRequest + { ratchetState :: RatchetX448, + replyQueue :: SMPQueueInfo, + agentVersion :: VersionSMPA, + pqSupport :: PQSupport + } + deriving (Show) + +-- | What a JOIN command joins or accepts. Each variant carries only its own parameters; SubscriptionMode and +-- ConnInfo are needed by both and stay on JOIN itself. See JOIN's serialization for the backward-compatible +-- encoding (a JRInvitation is byte-identical to the pre-DR JOIN). +data JoinRequest + = JRInvitation {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} + | JRAddressDR DRRequest -- accepting an address double-ratchet request (owner side) + deriving (Show) + data UserContactData = UserContactData { -- direct connection via connReq in fixed data is allowed. direct :: Bool, @@ -2165,6 +2189,22 @@ cryptoErrToSyncState = \case RATCHET_SKIPPED _ -> RSRequired RATCHET_SYNC -> RSRequired +$(J.deriveJSON defaultJSON ''DRRequest) + +-- JoinRequest encodes itself, so JOIN's field order (see serializeCommand/commandP below) is fixed and never +-- depends on the variant. Backward compatibility: the pre-DR JOIN serialized "ntfs cReq pqSup subMode +-- ", and a JRInvitation serializes to "ntfs cReq pqSup", so JOIN (JRInvitation ...) subMode +-- connInfo is byte-for-byte the old JOIN - old and new clients read each other's classic JOINs. JRAddressDR is +-- new, a length-prefixed JSON DRRequest; the parser tells them apart because a JRInvitation starts with the +-- ntfs Bool (T/F) and a DR blob with its length digit. +instance StrEncoding JoinRequest where + strEncode = \case + JRInvitation ntfs cReq pqSup -> B.unwords [strEncode ntfs, strEncode cReq, strEncode pqSup] + JRAddressDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) + strP = + (JRInvitation <$> strP_ <*> strP_ <*> strP) + <|> (JRAddressDR <$> ((A.take =<< (A.decimal <* A.char '\n')) >>= either fail pure . J'.eitherDecodeStrict')) + -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) dbCommandP :: Parser ACommand dbCommandP = commandP $ A.take =<< (A.decimal <* "\n") @@ -2198,7 +2238,7 @@ commandP binaryP = NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe)) LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP)) LGET_ -> s (LGET <$> strP) - JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) + JOIN_ -> s (JOIN <$> strP_ <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP) ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP)) SWCH_ -> pure SWCH @@ -2208,8 +2248,6 @@ commandP binaryP = s p = A.space *> p pqIKP :: Parser InitialKeys pqIKP = strP_ <|> pure (IKLinkPQ PQSupportOff) - pqSupP :: Parser PQSupport - pqSupP = strP_ <|> pure PQSupportOff -- | Serialize SMP agent command. serializeCommand :: ACommand -> ByteString @@ -2217,7 +2255,7 @@ serializeCommand = \case NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode) LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_ LGET sl -> s (LGET_, sl) - JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo) + JOIN joinReq subMode cInfo -> s (JOIN_, joinReq, subMode, Str $ serializeBinary cInfo) LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo] ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_ SWCH -> s SWCH_ diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index c6bd5297b..b5dedc988 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -645,17 +645,11 @@ data Invitation = Invitation } -- | A classic connection request URI, or a double-ratchet confirmation received at a DR address. +-- DRRequest is defined in Agent.Protocol (re-exported here) so JOIN commands can carry it. data ContactRequest = CRInvitation (ConnectionRequestUri 'CMInvitation) | CRConfirmation DRRequest -data DRRequest = DRRequest - { ratchetState :: RatchetX448, - replyQueue :: SMPQueueInfo, - agentVersion :: VersionSMPA, - pqSupport :: PQSupport - } - -- * Message integrity validation types -- | Corresponds to `last_external_snd_msg_id` in `connections` table @@ -845,5 +839,3 @@ instance AnyStoreError StoreError where SEWorkItemError {} -> True _ -> False mkWorkItemError errContext = SEWorkItemError {errContext} - -$(J.deriveJSON defaultJSON ''DRRequest) diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 370e3012e..bcb5a86a7 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -154,6 +154,7 @@ module Simplex.Messaging.Agent.Store.AgentStore setRatchetX3dhKeys, createAddressRatchetKeys, getAddressRatchetKeys, + getAddressRatchetKeysByConnId, createSndRatchet, getSndRatchet, createRatchet, @@ -1401,7 +1402,7 @@ createAddressRatchetKeys db connId ratchetKeyId x3dhPrivKey1 x3dhPrivKey2 pqPriv getAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) getAddressRatchetKeys db connId ratchetKeyId = - firstRow' keys SEX3dhKeysNotFound $ + firstRow id SEX3dhKeysNotFound $ DB.query db [sql| @@ -1410,8 +1411,19 @@ getAddressRatchetKeys db connId ratchetKeyId = WHERE conn_id = ? AND ratchet_key_id = ? |] (connId, ratchetKeyId) - where - keys (k1, k2, pKem) = Right (k1, k2, pKem) + +-- the address's current advertised key set, read by conn only, to preserve it across short-link data updates +getAddressRatchetKeysByConnId :: DB.Connection -> ConnId -> IO (Either StoreError (RatchetKeyId, C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) +getAddressRatchetKeysByConnId db connId = + firstRow id SEX3dhKeysNotFound $ + DB.query + db + [sql| + SELECT ratchet_key_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem + FROM address_ratchet_keys + WHERE conn_id = ? + |] + (Only connId) createSndRatchet :: DB.Connection -> ConnId -> RatchetX448 -> CR.AE2ERatchetParams 'C.X448 -> IO () createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetParams _ x3dhPubKey1 x3dhPubKey2 pqPubKem)) = diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs index 3be969a46..72ff754fd 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs @@ -16,8 +16,7 @@ CREATE TABLE address_ratchet_keys( x3dh_priv_key_1 BYTEA NOT NULL, x3dh_priv_key_2 BYTEA NOT NULL, pq_priv_kem BYTEA, - created_at TEXT NOT NULL, - retired_at TEXT + created_at TEXT NOT NULL ); CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs index e5634b6db..2597c7003 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs @@ -15,8 +15,7 @@ CREATE TABLE address_ratchet_keys( x3dh_priv_key_1 BLOB NOT NULL, x3dh_priv_key_2 BLOB NOT NULL, pq_priv_kem BLOB, - created_at TEXT NOT NULL, - retired_at TEXT + created_at TEXT NOT NULL ) STRICT; CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index c4d9be3d3..bd7c4e378 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -472,8 +472,7 @@ CREATE TABLE address_ratchet_keys( x3dh_priv_key_1 BLOB NOT NULL, x3dh_priv_key_2 BLOB NOT NULL, pq_priv_kem BLOB, - created_at TEXT NOT NULL, - retired_at TEXT + created_at TEXT NOT NULL ) STRICT; CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id); CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id); diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index a0ea929d1..b8acc1e8a 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -25,7 +25,8 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Protocol (EntityId (..), ProtocolServer (..), QueueMode (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC) +import Simplex.Messaging.Parsers (parseAll) +import Simplex.Messaging.Protocol (EntityId (..), ProtocolServer (..), QueueMode (..), SubscriptionMode (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC) import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) import Simplex.Messaging.Version import Test.Hspec hiding (fit, it) @@ -255,6 +256,17 @@ connectionRequestTests = queueV1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr) + it "JOIN command is backward compatible: JRInvitation is byte-identical to the pre-DR JOIN" $ do + let uri = ACR SCMInvitation invConnRequest + cmd = JOIN (JRInvitation True uri PQSupportOff) SMSubscribe "hi" + -- the pre-DR JOIN wire format: "JOIN " + oldJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode PQSupportOff <> " " <> strEncode SMSubscribe <> " 2\nhi" + serializeCommand cmd `shouldBe` oldJoin + -- an old-format JOIN string decodes to a JRInvitation and re-serializes unchanged + case parseAll dbCommandP oldJoin of + Right (JOIN JRInvitation {} _ _) -> pure () + r -> expectationFailure $ "expected JOIN JRInvitation, got " <> show r + (serializeCommand <$> parseAll dbCommandP oldJoin) `shouldBe` Right oldJoin it "should serialize and parse connection invitations and contact addresses" $ do connectionRequest #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) connectionRequest #== ("https://simplex.chat/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index e5f69eb9d..d62c21baa 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -349,6 +349,10 @@ functionalAPITests ps = do testPQMatrix3 ps $ runAgentClientContactTestPQ3 True describe "Establish duplex connection via contact address with DR" $ testContactDRMatrix ps + it "should preserve address DR keys when the link data is updated" $ + testAddressUpdatePreservesDRKeys ps + it "should resume DR accept after a transient failure (reuse the send queue and ratchet)" $ + testAcceptContactDRResumeAfterOffline ps it "should support rejecting contact request" $ withSmpServer ps testRejectContactRequest describe "Changing connection user id" $ do @@ -1000,7 +1004,11 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b -- addrIK drives the advertised bundle and the owner's PQ; useDR chooses the DR path (pass the fetched -- keys) or the classic path (ignore them); bPQ is the joiner's PQSupport. runAgentClientContactDRTest :: HasCallStack => InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () -runAgentClientContactDRTest addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do +runAgentClientContactDRTest = runAgentClientContactDRTest_ False + +-- asyncAccept True exercises the ACPT command path (acceptContactAsync); False uses synchronous acceptContact. +runAgentClientContactDRTest_ :: HasCallStack => Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () +runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do g <- C.newRandom rootKey <- atomically $ C.generateKeyPair g linkEntId <- atomically $ C.randomBytes 32 g @@ -1012,6 +1020,11 @@ runAgentClientContactDRTest addrIK useDR bPQ ps = withSmpServer ps $ withAgentCl (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK (Just addrIK) SMSubscribe (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink + -- the advertised DR bundle includes a KEM iff the owner's PQ is on, so a PQ requester gets PQ from message 1 + liftIO $ case ratchetKeys userCtData' of + Just AddressRatchetKeys {e2eParams = CR.E2ERatchetParamsUri _ _ _ kem_} -> + isJust kem_ `shouldBe` supportPQ (CR.connPQEncryption addrIK) + Nothing -> expectationFailure "address must advertise DR ratchet keys" let addrKeys_ = if useDR then ratchetKeys userCtData' else Nothing aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe @@ -1019,7 +1032,11 @@ runAgentClientContactDRTest addrIK useDR bPQ ps = withSmpServer ps $ withAgentCl ("", _, A.REQ invId reqPQ _ "bob's connInfo") <- get alice liftIO $ reqPQ `shouldBe` PQSupportOn -- REQ reports the connection PQ capability (On when versions support PQ); same for DR and classic paths bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) - _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + if asyncAccept + then do + acceptContactAsync alice "accept" bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + get alice =##> \case ("accept", c, A.JOINED _) -> c == bobId; _ -> False + else void $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe ("", _, A.CONF confId confPQ _ "alice's connInfo") <- get bob liftIO $ confPQ `shouldBe` bPQ -- CONF reports the joiner's own connection PQ support allowConnection bob aliceId confId "bob's connInfo" @@ -1044,6 +1061,90 @@ testContactDRMatrix ps = do it "IKPQOn, pq join" $ runAgentClientContactDRTest IKPQOn False PQSupportOn ps it "IKUsePQ, dh join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOff ps it "IKUsePQ, pq join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOn ps + describe "DR join, async accept (JOIN command)" $ do + it "IKPQOff, dh join" $ runAgentClientContactDRTest_ True IKPQOff True PQSupportOff ps + it "IKPQOff, pq join" $ runAgentClientContactDRTest_ True IKPQOff True PQSupportOn ps + it "IKPQOn, dh join" $ runAgentClientContactDRTest_ True IKPQOn True PQSupportOff ps + it "IKPQOn, pq join" $ runAgentClientContactDRTest_ True IKPQOn True PQSupportOn ps + it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ True IKUsePQ True PQSupportOff ps + it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ True IKUsePQ True PQSupportOn ps + +-- Defect A: updating the mutable short-link data of a DR-advertising address must preserve the stored +-- ratchet keys (re-read from the DB), so requesters fetching the updated link can still establish DR. +testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO () +testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do + g <- C.newRandom + rootKey <- atomically $ C.generateKeyPair g + linkEntId <- atomically $ C.randomBytes 32 g + let addrIK = IKPQOn + userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "original", ratchetKeys = Nothing} + connIK = IKLinkPQ (CR.connPQEncryption addrIK) + bPQ = PQSupportOn + pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ + runRight_ $ do + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing + addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK (Just addrIK) SMSubscribe + -- the published link advertises generated ratchet keys + (_, ContactLinkData _ published) <- getConnShortLink bob 1 shortLink + liftIO $ ratchetKeys published `shouldSatisfy` isJust + -- update the mutable data passing ratchetKeys = Nothing; the stored keys must be preserved, not dropped + let updatedCtData = userCtData {userData = UserLinkData "updated", ratchetKeys = Nothing} + shortLink' <- setConnShortLink alice addrConnId SCMContact (UserContactLinkData updatedCtData) Nothing + liftIO $ shortLink' `shouldBe` shortLink + (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ updated) <- getConnShortLink bob 1 shortLink + liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published -- preserved exactly (same id and public params) + -- and the preserved keys still establish a DR connection end to end + aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" (ratchetKeys updated) bPQ SMSubscribe + liftIO $ sqSecuredJoin `shouldBe` False + ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice + bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob + allowConnection bob aliceId confId "bob's connInfo" + get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") + get alice ##> ("", bobId, A.CON pqEnc) + get bob ##> ("", aliceId, A.CON pqEnc) + exchangeGreetings_ pqEnc alice bobId bob aliceId + +-- Resume-safety regression: if the sync accept of a DR request fails at the network step after the send queue +-- and ratchet were already committed (SndConnection), retrying the accept must reuse them (startAcceptContactDR +-- is resume-safe, mirroring joinConnSrv) and complete, not fail with SEBadConnType. +testAcceptContactDRResumeAfterOffline :: HasCallStack => (ASrvTransport, AStoreType) -> IO () +testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do + g <- C.newRandom + rootKey <- atomically $ C.generateKeyPair g + linkEntId <- atomically $ C.randomBytes 32 g + let addrIK = IKPQOn + userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "u", ratchetKeys = Nothing} + connIK = IKLinkPQ (CR.connPQEncryption addrIK) + pqEnc = PQEncryption $ pqConnectionMode addrIK PQSupportOn + -- set up the DR address, bob joins, alice receives REQ and pre-creates the accept connection (server up) + (bobId, invId, aliceId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing + _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK (Just addrIK) SMSubscribe + (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink + aId <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn + _ <- A.joinConnection bob NRMInteractive 1 aId True connReq' "bob's connInfo" (ratchetKeys userCtData') PQSupportOn SMSubscribe + ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice + bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + pure (bId, invId, aId) + ("", "", DOWN _ _) <- nGet alice + ("", "", DOWN _ _) <- nGet bob + -- server is down: the accept commits the send queue + ratchet (DB-local) then fails at the network step + Left (BROKER _ (NETWORK _)) <- runExceptT $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + -- server is back: retrying the same accept must reuse the committed state and complete the handshake + withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do + ("", "", UP _ _) <- nGet alice + ("", "", UP _ _) <- nGet bob + liftIO $ threadDelay 250000 + _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob + allowConnection bob aliceId confId "bob's connInfo" + get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") + get alice ##> ("", bobId, A.CON pqEnc) + get bob ##> ("", aliceId, A.CON pqEnc) + exchangeGreetings_ pqEnc alice bobId bob aliceId runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do From e50ae446a2e09794399d8778030f1005aa32bf6b Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 16 Jul 2026 15:57:08 +0000 Subject: [PATCH 26/81] refactor 2 --- src/Simplex/Messaging/Agent.hs | 171 ++++++++---------- src/Simplex/Messaging/Agent/Client.hs | 10 +- src/Simplex/Messaging/Agent/Protocol.hs | 121 ++++++------- src/Simplex/Messaging/Agent/Store.hs | 4 - .../Messaging/Agent/Store/AgentStore.hs | 24 +-- .../Migrations/M20260712_address_dr.hs | 3 +- .../SQLite/Migrations/M20260712_address_dr.hs | 3 +- .../Store/SQLite/Migrations/agent_schema.sql | 3 +- tests/AgentTests/ConnectionRequestTests.hs | 4 +- tests/AgentTests/FunctionalAPITests.hs | 93 ++++------ 10 files changed, 176 insertions(+), 260 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 233e0c646..cea4a26ac 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -430,7 +430,7 @@ prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData srv_ -- | Create connection for prepared link (single network call). -- Validates that server response matches the prepared link. -createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Maybe CR.InitialKeys -> SubscriptionMode -> AE ConnId +createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Bool -> SubscriptionMode -> AE ConnId createConnectionForLink c nm userId enableNtfs = withAgentEnv c .::: createConnectionForLink' c nm userId enableNtfs {-# INLINE createConnectionForLink #-} @@ -899,18 +899,13 @@ allowConnectionAsync' c corrId connId confId ownConnInfo = acceptContactAsync' :: AgentClient -> ACorrId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM () acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMode = do Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId - case contactReq of - -- accept via JOIN, symmetrically with the classic branch: the command handler does the whole accept - CRConfirmation dr -> do - withStore' c $ \db -> acceptInvitation db invId ownConnInfo - enqueueCommand c corrId connId Nothing (AClientCommand $ JOIN (JRAddressDR dr) subMode ownConnInfo) `catchAllErrors` \err -> do - withStore' c (`unacceptInvitation` invId) - throwE err - CRInvitation cReq -> do - withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do - withStore' c (`unacceptInvitation` invId) - throwE err + withStore' c $ \db -> acceptInvitation db invId ownConnInfo + let joinCmd = case contactReq of + CRConfirmation dr -> enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRAddressDR dr) subMode ownConnInfo + CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo pqSupport subMode + joinCmd `catchAllErrors` \err -> do + withStore' c (`unacceptInvitation` invId) + throwE err ackMessageAsync' :: AgentClient -> ACorrId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM () ackMessageAsync' c corrId connId msgId rcptInfo_ = do @@ -990,32 +985,30 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} pure (ccLink, params) +addAddressRatchetKeys :: CR.VersionRangeE2E -> UserConnLinkData 'CMContact -> RatchetKeyId -> CR.RcvE2ERatchetParams 'C.X448 -> UserConnLinkData 'CMContact +addAddressRatchetKeys e2eVR (UserContactLinkData ucd) ratchetKeyId e2eParams = + UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams = toVersionRangeT e2eParams e2eVR}} + -- | Create connection for prepared link (single network call). -createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Maybe CR.InitialKeys -> SubscriptionMode -> AM ConnId -createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys drInitKeys_ subMode = do +createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Bool -> SubscriptionMode -> AM ConnId +createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys advertiseDR subMode = do g <- asks random AgentConfig {smpAgentVRange} <- asks config case pqInitKeys of CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink" _ -> pure () - -- the advertised bundle and the connection must agree on PQ: the owner seeds its receive ratchet from - -- the connection while the requester seeds its send ratchet from the bundle - a mismatch is a foot-gun - forM_ drInitKeys_ $ \ik -> - unless (CR.connPQEncryption ik == CR.connPQEncryption pqInitKeys) $ - throwE $ CMD PROHIBITED "createConnectionForLink: address keys PQ inconsistent with connection" connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys) - userLinkData' <- case drInitKeys_ of - Nothing -> pure userLinkData - Just ik -> do - e2eVR <- asks $ e2eEncryptVRange . config - -- this bundle is always short-link data, so IKLinkPQ's PQ is honored (shortLink = True) - the KEM is - -- advertised so a PQ requester can AcceptKEM and encrypt its first message (profile) with PQ from message 1 - (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption True ik) - ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) - now <- liftIO getCurrentTime - withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem now - let UserContactLinkData ucd = userLinkData - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams = toVersionRangeT e2eRcvParams e2eVR}} + userLinkData' <- + if advertiseDR + then do + e2eVR <- asks $ e2eEncryptVRange . config + -- the advertised bundle uses the connection's PQ, so its KEM is present iff the owner PQ is on, letting a + -- PQ requester encrypt its first message (profile) with PQ from message 1 + (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.connPQEncryption pqInitKeys) + ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) + withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem + pure $ addAddressRatchetKeys e2eVR userLinkData ratchetKeyId e2eRcvParams + else pure userLinkData let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' linkData = (plpSignedFixedData, md) @@ -1152,13 +1145,13 @@ setConnShortLink' c nm connId cMode userLinkData clientData = pure (rq, shortLinkId, sl, (linkEncFixedData, d)) Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation" preserveAddressRatchetKeys :: UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) - preserveAddressRatchetKeys ud@(UserContactLinkData ucd) = + preserveAddressRatchetKeys ud = withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case - Left _ -> pure ud -- non-DR address: nothing to preserve + Left _ -> pure ud Right (rkId, pk1, pk2, pKem) -> do e2eVR <- asks $ e2eEncryptVRange . config let e2eRcv = CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem) - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId = rkId, e2eParams = toVersionRangeT e2eRcv e2eVR}} + pure $ addAddressRatchetKeys e2eVR ud rkId e2eRcv deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM () deleteConnShortLink' c nm connId cMode = @@ -1354,13 +1347,13 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q --- shared queue + ratchet setup for classic invitation joins/accepts (Left) and address DR accepts (Right). --- Reads the connection and resumes safely: reuses the send queue, ratchet, and (on a duplex retry) the reply --- queue created by a previous attempt, returning that reply queue so the caller does not open a duplicate. --- A classic join builds the ratchet from the peer's X3DH params and returns them to send in the confirmation; --- a DR accept persists the ratchet already established from message 1 and returns no params. --- the Left case carries the invitation's own params (enableNtfs, PQSupport); the DR accept (Right) needs neither. -startJoinInvitation :: AgentClient -> ConnId -> Either (Bool, ConnectionRequestUri 'CMInvitation, PQSupport) DRRequest -> AM (ConnData, Maybe RcvQueue, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) +data JoinInvitationReq + = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport + | JIRAddressDR DRRequest + +-- Resume-safe: reuses the send queue, ratchet, and (on a duplex retry) the reply queue from a previous attempt, +-- returning that reply queue so the caller does not open a duplicate. +startJoinInvitation :: AgentClient -> ConnId -> JoinInvitationReq -> AM (ConnData, Maybe RcvQueue, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) startJoinInvitation c connId joinReq = do SomeConn cType conn <- withStore c (`getConn` connId) let ConnData {userId} = toConnData conn @@ -1371,7 +1364,7 @@ startJoinInvitation c connId joinReq = do | sqStatus == New || sqStatus == Secured -> pure (Just rq, Just sq) _ -> throwE $ CMD PROHIBITED $ "startJoinInvitation: bad connection " <> show cType case joinReq of - Left (enableNtfs, cReqUri, pqSup) -> + JIRInvitation enableNtfs cReqUri pqSup -> lift (compatibleInvitationUri cReqUri) >>= \case Nothing -> throwE $ AGENT A_VERSION Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do @@ -1380,7 +1373,8 @@ startJoinInvitation c connId joinReq = do maxSupported <- asks $ maxVersion . e2eEncryptVRange . config let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} case sq_ of - -- reuse on resume avoids re-generating queue keys and a subsequent SKEY failure; e2ePubKey is always present + -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out + -- e2ePubKey is always present, it's Maybe historically Just sq@SndQueue {e2ePubKey = Just _k} -> do e2eSndParams <- withStore c $ \db -> do lockConnForUpdate db connId @@ -1402,9 +1396,9 @@ startJoinInvitation c connId joinReq = do sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ pure (sq', e2eSndParams) pure (cData, rq_, sq', Just e2eSndParams, lnkId_) - Right DRRequest {ratchetState, replyQueue} -> do + JIRAddressDR DRRequest {ratchetState, replyQueue} -> do sq <- case sq_ of - Just sq -> pure sq -- resume: send queue and ratchet were already created on the first attempt + Just sq -> pure sq Nothing -> do clientVRange <- asks $ smpClientVRange . config qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange @@ -1487,25 +1481,22 @@ versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && ma joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured joinConnSrv c nm _userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys pqSup subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do - (cData, rq_, sq, params_, lnkId_) <- startJoinInvitation c connId (Left (enableNtfs, inv, pqSup)) + (cData, rq_, sq, params_, lnkId_) <- startJoinInvitation c connId (JIRInvitation enableNtfs inv pqSup) secureConfirmQueue c nm cData rq_ sq srv cInfo params_ subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case - Just (qInfo, Compatible v) -> + Just (qInfo, vrsn@(Compatible v)) -> withInvLock c (strEncode cReqUri) "joinConnSrv" $ do SomeConn cType conn <- withStore c (`getConn` connId) - -- both flows create/resume a receive queue and build the message sent to the contact address: the - -- classic flow an invitation with fresh X3DH keys, the DR flow (addrKeys_ set) a confirmation - -- (message 1) whose ratchet is established now from the address's advertised keys - envelope <- case addrKeys_ of + invOrConfirmation <- case addrKeys_ of Nothing -> do let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup CCLink cReq _ <- case conn of NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType - pure AgentInvitation {agentVersion = v, connReq = cReq, connInfo = cInfo} + pure $ SndInvitation cReq cInfo Just AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} -> do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config @@ -1514,8 +1505,6 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) maxV = maxVersion e2eVR - -- resume-safe: create the reply queue and send ratchet only on the first attempt; a retry - -- reuses both so the ratchet the owner built from message 1 still matches rq <- case conn of NewConnection _ -> do e2eKeys <- atomically $ C.generateKeyPair g @@ -1532,8 +1521,8 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys liftIO $ setConnPQSupport db connId pqSupport encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode sndReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) maxV pure (sndParams, encConnInfo) - pure AgentConfirmation {agentVersion = v, e2eEncryption_ = Just sndParams, ratchetKeyId = Just addrRKId, encConnInfo} - void $ sendInvitation c nm userId connId qInfo envelope + pure $ SndConfirmation sndParams addrRKId encConnInfo + void $ sendInvitation c nm userId connId qInfo vrsn invOrConfirmation pure False where mkJoinInvitation rq pqInitKeys = do @@ -1560,9 +1549,7 @@ delInvSL c connId srv lnkId = withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e -> liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e)) --- async accept/join of an invitation URI (Left) or an address DR request (Right): create the send queue and --- ratchet, then send the confirmation asynchronously. Shared by the JOIN command's invitation and DR handlers. -joinConnSrvAsync :: AgentClient -> ConnId -> Either (Bool, ConnectionRequestUri 'CMInvitation, PQSupport) DRRequest -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrvAsync :: AgentClient -> ConnId -> JoinInvitationReq -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured joinConnSrvAsync c connId joinReq cInfo subMode srv = do (cData, rq_, sq, params_, lnkId_) <- startJoinInvitation c connId joinReq secureConfirmQueueAsync c cData rq_ sq srv cInfo params_ subMode @@ -1597,7 +1584,7 @@ acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode CRConfirmation dr@DRRequest {replyQueue} -> do srv <- getNextSMPServer c userId [qServer replyQueue] - (cData, rq_, sq, params_, _) <- startJoinInvitation c connId (Right dr) + (cData, rq_, sq, params_, _) <- startJoinInvitation c connId (JIRAddressDR dr) secureConfirmQueue c nm cData rq_ sq srv ownConnInfo params_ subMode withStore' c $ \db -> acceptInvitation db invId ownConnInfo pure r @@ -2013,7 +2000,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN (JRInvitation enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrvAsync c connId (Left (enableNtfs, cReq, pqEnc)) connInfo subMode srv + sqSecured <- joinConnSrvAsync c connId (JIRInvitation enableNtfs cReq pqEnc) connInfo subMode srv notify $ JOINED sqSecured -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. @@ -2022,12 +2009,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo Nothing pqEnc subMode srv notify $ JOINED sqSecured - -- address DR accept: same shape as the invitation join above, sending no X3DH params; the reply queue's - -- server is excluded so our own reply queue is created elsewhere. startJoinInvitation makes this resume-safe. JOIN (JRAddressDR dr@DRRequest {replyQueue}) subMode ownCInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do - sqSecured <- joinConnSrvAsync c connId (Right dr) ownCInfo subMode srv + sqSecured <- joinConnSrvAsync c connId (JIRAddressDR dr) ownCInfo subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK @@ -3535,15 +3520,24 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let ConnData {pqSupport} = toConnData conn' case status of New -> case (conn', e2eEncryption) of - -- party initiating connection - (RcvConnection _ _, Just e2eSndParams) -> do - keys <- withStore c (`getRatchetX3dhKeys` connId) - RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport'} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo - case agentMsgBody_ of + -- initiating party (Just: seed the receive ratchet from X3DH), or DR requester (Nothing: reuse the ratchet built in join) + (RcvConnection _ _, _) -> do + init_ <- case e2eEncryption of + Just e2eSndParams -> do + keys <- withStore c (`getRatchetX3dhKeys` connId) + RcvRatchetInit {decrypted, ratchet, connPQSupport} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + pure $ Just (decrypted, ratchet, connPQSupport) + Nothing -> withStore' c (`getRatchet` connId) >>= \case + Left _ -> Nothing <$ prohibited "conf: incorrect state" + Right rc -> do + g <- asks random + (decrypted, rc', _) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + pure $ Just (decrypted, rc', pqSupport) + forM_ init_ $ \(agentMsgBody_, rc', pqSupport') -> case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do - processConf agentVersion pqSupport pqSupport' rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo + processConf agentVersion pqSupport pqSupport' rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2 _ -> prohibited "conf: decrypt error" @@ -3564,29 +3558,12 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar notify $ CON pqEncryption withStore' c $ \db -> setRcvQueueStatus db rq' Active _ -> prohibited "conf: not AgentConnInfo" - -- DR requester: the reply arrives with the ratchet already established (built in join) - (RcvConnection _ _, Nothing) -> - withStore' c (`getRatchet` connId) >>= \case - Left _ -> prohibited "conf: incorrect state" - Right rc -> do - g <- asks random - (agentMsgBody_, rc', _) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo - case agentMsgBody_ of - Right agentMsgBody -> - parseMessage agentMsgBody >>= \case - AgentConnInfoReply smpQueues connInfo -> do - processConf agentVersion pqSupport pqSupport rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} connInfo - withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) - _ -> prohibited "conf: not AgentConnInfoReply" - _ -> prohibited "conf: decrypt error" _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - -- persists the established ratchet and the negotiated pqSupport, records the confirmation, and - -- notifies the user with CONF; shared by the connection initiator and the address DR requester. - -- pqSupport is the connection's current support, agreedPQSupport the value negotiated for the ratchet. - processConf :: VersionSMPA -> PQSupport -> PQSupport -> CR.RatchetX448 -> SMPConfirmation -> ConnInfo -> AM () - processConf agentVersion pqSupport agreedPQSupport rc' senderConf connInfo = do + -- pqSupport is the connection's current support, agreedPQSupport the value negotiated for the ratchet + processConf :: VersionSMPA -> PQSupport -> PQSupport -> CR.RatchetX448 -> SMPConfirmation -> AM () + processConf agentVersion pqSupport agreedPQSupport rc' senderConf@SMPConfirmation {connInfo} = do let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} g <- asks random confId <- withStore c $ \db -> do @@ -3752,14 +3729,12 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} (EREADY lastExternalSndId) -- owner receiving a contact request: a classic AgentInvitation, or an address DR AgentConfirmation - -- (message 1, ratchetKeyId set) that establishes the ratchet now. Both store a ContactRequest and REQ. + -- (message 1, ratchetKeyId set) that establishes the ratchet now smpInvitation :: SMP.MsgId -> Connection c -> AgentMsgEnvelope -> VersionSMPC -> AM () smpInvitation srvMsgId conn' envelope phVer = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId case conn' of ContactConnection {} -> do - -- compute (request, PQ capability reported in REQ, servers, requester info) per flow, then - -- share the store + notify; REQ reports the connection PQ capability, not the owner's enable choice req_ <- case envelope of AgentInvitation {connReq = connReq@(CRInvitationUri crData _), connInfo} -> do -- show connection request even if invitation via contact address is not compatible. @@ -3769,10 +3744,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar AgentConfirmation {agentVersion, e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo} -> do checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' - withStore' c (\db -> getAddressRatchetKeys db connId rkId) >>= \case - Left _ -> Nothing <$ prohibited "addr conf: unknown ratchetKeyId" - Right keys -> do - RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case + Right (rkId', pk1, pk2, pKem) | rkId' == rkId -> do + RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case @@ -3781,6 +3755,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar in pure $ Just (CRConfirmation dr, pqCapability, qServer replyQInfo :| [], reqConnInfo) _ -> Nothing <$ prohibited "addr conf: not AgentConnInfoReply" _ -> Nothing <$ prohibited "addr conf: decrypt error" + _ -> Nothing <$ prohibited "addr conf: unknown ratchetKeyId" _ -> Nothing <$ prohibited "conf: incorrect state" forM_ req_ $ \(contactReq, reqPQ, srvs, recipientConnInfo) -> do g <- asks random diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index bfd3ccbf0..06fd1376d 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1913,14 +1913,14 @@ sendConfirmation c nm sq@SndQueue {userId, server, connId, sndId, queueMode, snd sendOrProxySMPMessage c nm userId server connId "" spKey sndId (MsgFlags {notification = True}) msg sendConfirmation _ _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database" --- sends an agent envelope to a contact address queue, encrypted only with per-queue E2E, not the double --- ratchet: a classic AgentInvitation, or an address-DR AgentConfirmation (message 1) that establishes the ratchet -sendInvitation :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> AgentMsgEnvelope -> AM (Maybe SMPServer) -sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) agentEnvelope = do +sendInvitation :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> SndInvOrConf -> AM (Maybe SMPServer) +sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) invOrConf = do msg <- agentCbEncryptOnce v dhPublicKey . smpEncode $ SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) sendOrProxySMPMessage c nm userId smpServer connId label Nothing senderId (MsgFlags {notification = True}) msg where - label = case agentEnvelope of AgentConfirmation {} -> ""; _ -> "" + (agentEnvelope, label) = case invOrConf of + SndInvitation connReq connInfo -> (AgentInvitation {agentVersion, connReq, connInfo}, "") + SndConfirmation e2eSndParams rkId encConnInfo -> (AgentConfirmation {agentVersion, e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo}, "") getQueueMessage :: AgentClient -> RcvQueue -> AM (Maybe SMPMsgMeta) getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 6789ff846..dc31025a3 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -82,6 +82,7 @@ module Simplex.Messaging.Agent.Protocol RatchetSyncState (..), SMPConfirmation (..), AgentMsgEnvelope (..), + SndInvOrConf (..), AgentMessage (..), AgentMessageType (..), APrivHeader (..), @@ -327,8 +328,6 @@ sndAuthKeySMPAgentVersion = VersionSMPA 6 ratchetOnConfSMPAgentVersion :: VersionSMPA ratchetOnConfSMPAgentVersion = VersionSMPA 7 --- | The address advertises the owner's X3DH keys in link data, and a requester --- establishes the double ratchet from its first message (a confirmation with ratchetKeyId). addressDRSMPAgentVersion :: VersionSMPA addressDRSMPAgentVersion = VersionSMPA 8 @@ -865,6 +864,11 @@ data AgentMsgEnvelope } deriving (Show) +-- what a requester sends: a classic invitation, or an address-DR confirmation (message 1) +data SndInvOrConf + = SndInvitation (ConnectionRequestUri 'CMInvitation) ConnInfo + | SndConfirmation (SndE2ERatchetParams 'C.X448) RatchetKeyId ByteString + instance Encoding AgentMsgEnvelope where smpEncode = \case AgentConfirmation {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} @@ -1417,52 +1421,46 @@ sameQAddress :: (SMPServer, SMP.QueueId) -> (SMPServer, SMP.QueueId) -> Bool sameQAddress (srv, qId) (srv', qId') = sameSrvAddr srv srv' && qId == qId' {-# INLINE sameQAddress #-} -strEncodeSMPQueue :: StrEncoding v => (v -> VersionSMPC) -> v -> SMPQueueAddress -> ByteString -strEncodeSMPQueue minVer v SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, queueMode} - | minVer v >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams - | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam) - where - query = strEncode . QSP QEscape - queryParams = [("v", strEncode v), ("dh", strEncode dhPublicKey)] <> queueModeParam <> sndSecureParam - where - queueModeParam = case queueMode of - Just QMMessaging -> [("q", "m")] - Just QMContact -> [("q", "c")] - Nothing -> [] - sndSecureParam = [("k", "s") | senderCanSecure queueMode && minVer v < shortLinksSMPClientVersion] - srvParam = [("srv", strEncode $ TransportHosts_ hs) | not (null hs)] - hs = L.tail $ host srv - -strPSMPQueue :: StrEncoding v => v -> (v -> VersionSMPC) -> A.Parser (v, SMPQueueAddress) -strPSMPQueue defaultVer maxVer = do - srv@ProtocolServer {host = h :| host} <- strP <* A.char '/' - senderId <- strP <* optional (A.char '/') <* A.char '#' - (ver, hs, dhPublicKey, queueMode) <- versioned <|> unversioned - let srv' = srv {host = h :| host <> hs} - smpServer = if maxVer ver < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv' - pure (ver, SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}) - where - unversioned = (defaultVer,[],,Nothing) <$> strP <* A.endOfInput - versioned = do - dhKey_ <- optional strP - query <- optional (A.char '/') *> A.char '?' *> strP - ver <- queryParam "v" query - dhKey <- maybe (queryParam "dh" query) pure dhKey_ - hs_ <- queryParam_ "srv" query - let queueMode = case queryParamStr "q" query of - Just "m" -> Just QMMessaging - Just "c" -> Just QMContact - _ | queryParamStr "k" query == Just "s" -> Just QMMessaging - _ -> Nothing - pure (ver, maybe [] thList_ hs_, dhKey, queueMode) - instance StrEncoding SMPQueueUri where - strEncode (SMPQueueUri vr addr) = strEncodeSMPQueue minVersion vr addr - strP = uncurry SMPQueueUri <$> strPSMPQueue (versionToRange initialSMPClientVersion) maxVersion + strEncode (SMPQueueUri vr SMPQueueAddress {smpServer = srv, senderId = qId, dhPublicKey, queueMode}) + | minVersion vr >= srvHostnamesSMPClientVersion = strEncode srv <> "/" <> strEncode qId <> "#/?" <> query queryParams + | otherwise = legacyStrEncodeServer srv <> "/" <> strEncode qId <> "#/?" <> query (queryParams <> srvParam) + where + query = strEncode . QSP QEscape + queryParams = [("v", strEncode vr), ("dh", strEncode dhPublicKey)] <> queueModeParam <> sndSecureParam + where + queueModeParam = case queueMode of + Just QMMessaging -> [("q", "m")] + Just QMContact -> [("q", "c")] + Nothing -> [] + sndSecureParam = [("k", "s") | senderCanSecure queueMode && minVersion vr < shortLinksSMPClientVersion] + srvParam = [("srv", strEncode $ TransportHosts_ hs) | not (null hs)] + hs = L.tail $ host srv + strP = do + srv@ProtocolServer {host = h :| host} <- strP <* A.char '/' + senderId <- strP <* optional (A.char '/') <* A.char '#' + (vr, hs, dhPublicKey, queueMode) <- versioned <|> unversioned + let srv' = srv {host = h :| host <> hs} + smpServer = if maxVersion vr < srvHostnamesSMPClientVersion then updateSMPServerHosts srv' else srv' + pure $ SMPQueueUri vr SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode} + where + unversioned = (versionToRange initialSMPClientVersion,[],,Nothing) <$> strP <* A.endOfInput + versioned = do + dhKey_ <- optional strP + query <- optional (A.char '/') *> A.char '?' *> strP + vr <- queryParam "v" query + dhKey <- maybe (queryParam "dh" query) pure dhKey_ + hs_ <- queryParam_ "srv" query + let queueMode = case queryParamStr "q" query of + Just "m" -> Just QMMessaging + Just "c" -> Just QMContact + _ | queryParamStr "k" query == Just "s" -> Just QMMessaging + _ -> Nothing + pure (vr, maybe [] thList_ hs_, dhKey, queueMode) instance StrEncoding SMPQueueInfo where - strEncode (SMPQueueInfo v addr) = strEncodeSMPQueue id v addr - strP = uncurry SMPQueueInfo <$> strPSMPQueue initialSMPClientVersion id + strEncode (SMPQueueInfo v addr) = strEncode (SMPQueueUri (versionToRange v) addr) + strP = (\(SMPQueueUri vr addr) -> SMPQueueInfo (maxVersion vr) addr) <$> strP instance Encoding SMPQueueUri where smpEncode (SMPQueueUri clientVRange@(VersionRange minV maxV) SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}) @@ -1818,12 +1816,7 @@ deriving instance Show (ConnLinkData c) newtype RatchetKeyId = RatchetKeyId ByteString deriving (Eq, Show) - -instance Encoding RatchetKeyId where - smpEncode (RatchetKeyId s) = smpEncode s - {-# INLINE smpEncode #-} - smpP = RatchetKeyId <$> smpP - {-# INLINE smpP #-} + deriving newtype (Encoding) data AddressRatchetKeys = AddressRatchetKeys { ratchetKeyId :: RatchetKeyId, @@ -1833,13 +1826,10 @@ data AddressRatchetKeys = AddressRatchetKeys instance Encoding AddressRatchetKeys where smpEncode AddressRatchetKeys {ratchetKeyId, e2eParams} = smpEncode (ratchetKeyId, e2eParams) - smpP = do - (ratchetKeyId, e2eParams) <- smpP - pure AddressRatchetKeys {ratchetKeyId, e2eParams} + smpP = uncurry AddressRatchetKeys <$> smpP -- | The double-ratchet request an address owner receives in message 1 and later accepts: the ratchet the -- owner established from that message, the requester's reply queue, and the negotiated version and PQ support. --- Kept here (not in Agent.Store) so JOIN commands can carry it; Agent.Store re-exports it. data DRRequest = DRRequest { ratchetState :: RatchetX448, replyQueue :: SMPQueueInfo, @@ -1848,12 +1838,9 @@ data DRRequest = DRRequest } deriving (Show) --- | What a JOIN command joins or accepts. Each variant carries only its own parameters; SubscriptionMode and --- ConnInfo are needed by both and stay on JOIN itself. See JOIN's serialization for the backward-compatible --- encoding (a JRInvitation is byte-identical to the pre-DR JOIN). data JoinRequest - = JRInvitation {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} - | JRAddressDR DRRequest -- accepting an address double-ratchet request (owner side) + = JRInvitation Bool AConnectionRequestUri PQSupport + | JRAddressDR DRRequest deriving (Show) data UserContactData = UserContactData @@ -2191,19 +2178,15 @@ cryptoErrToSyncState = \case $(J.deriveJSON defaultJSON ''DRRequest) --- JoinRequest encodes itself, so JOIN's field order (see serializeCommand/commandP below) is fixed and never --- depends on the variant. Backward compatibility: the pre-DR JOIN serialized "ntfs cReq pqSup subMode --- ", and a JRInvitation serializes to "ntfs cReq pqSup", so JOIN (JRInvitation ...) subMode --- connInfo is byte-for-byte the old JOIN - old and new clients read each other's classic JOINs. JRAddressDR is --- new, a length-prefixed JSON DRRequest; the parser tells them apart because a JRInvitation starts with the --- ntfs Bool (T/F) and a DR blob with its length digit. +-- JRInvitation must stay byte-identical to the pre-DR JOIN "ntfs cReq pqSup" for old/new client interop; pqSup +-- and subMode still default when a legacy command omits them. instance StrEncoding JoinRequest where strEncode = \case JRInvitation ntfs cReq pqSup -> B.unwords [strEncode ntfs, strEncode cReq, strEncode pqSup] JRAddressDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = - (JRInvitation <$> strP_ <*> strP_ <*> strP) - <|> (JRAddressDR <$> ((A.take =<< (A.decimal <* A.char '\n')) >>= either fail pure . J'.eitherDecodeStrict')) + (JRInvitation <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff)) + <|> (JRAddressDR <$> ((A.take =<< (A.decimal <* A.char '\n')) >>= either fail pure . J'.eitherDecodeStrict') <* A.space) -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) dbCommandP :: Parser ACommand @@ -2238,7 +2221,7 @@ commandP binaryP = NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe)) LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP)) LGET_ -> s (LGET <$> strP) - JOIN_ -> s (JOIN <$> strP_ <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) + JOIN_ -> s (JOIN <$> strP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP) ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP)) SWCH_ -> pure SWCH diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index b5dedc988..254ed3d51 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -12,7 +12,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} module Simplex.Messaging.Agent.Store @@ -110,11 +109,9 @@ import Simplex.Messaging.Agent.Store.Entity import Simplex.Messaging.Agent.Store.Interface (createDBStore) import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations) import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..)) -import qualified Data.Aeson.TH as J import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448) import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol ( MsgBody, MsgFlags, @@ -645,7 +642,6 @@ data Invitation = Invitation } -- | A classic connection request URI, or a double-ratchet confirmation received at a DR address. --- DRRequest is defined in Agent.Protocol (re-exported here) so JOIN commands can carry it. data ContactRequest = CRInvitation (ConnectionRequestUri 'CMInvitation) | CRConfirmation DRRequest diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index bcb5a86a7..c5d5804b2 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -153,7 +153,6 @@ module Simplex.Messaging.Agent.Store.AgentStore getRatchetX3dhKeys, setRatchetX3dhKeys, createAddressRatchetKeys, - getAddressRatchetKeys, getAddressRatchetKeysByConnId, createSndRatchet, getSndRatchet, @@ -1389,30 +1388,17 @@ setRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem = |] (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem, connId) -createAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> UTCTime -> IO () -createAddressRatchetKeys db connId ratchetKeyId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem createdAt = +createAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO () +createAddressRatchetKeys db connId ratchetKeyId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem = DB.execute db [sql| INSERT INTO address_ratchet_keys - (conn_id, ratchet_key_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem, created_at) - VALUES (?, ?, ?, ?, ?, ?) + (conn_id, ratchet_key_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem) + VALUES (?, ?, ?, ?, ?) |] - (connId, ratchetKeyId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem, createdAt) + (connId, ratchetKeyId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) -getAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) -getAddressRatchetKeys db connId ratchetKeyId = - firstRow id SEX3dhKeysNotFound $ - DB.query - db - [sql| - SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem - FROM address_ratchet_keys - WHERE conn_id = ? AND ratchet_key_id = ? - |] - (connId, ratchetKeyId) - --- the address's current advertised key set, read by conn only, to preserve it across short-link data updates getAddressRatchetKeysByConnId :: DB.Connection -> ConnId -> IO (Either StoreError (RatchetKeyId, C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) getAddressRatchetKeysByConnId db connId = firstRow id SEX3dhKeysNotFound $ diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs index 72ff754fd..8ce1ff4db 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs @@ -15,8 +15,7 @@ CREATE TABLE address_ratchet_keys( ratchet_key_id BYTEA NOT NULL, x3dh_priv_key_1 BYTEA NOT NULL, x3dh_priv_key_2 BYTEA NOT NULL, - pq_priv_kem BYTEA, - created_at TEXT NOT NULL + pq_priv_kem BYTEA ); CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs index 2597c7003..dca0897f4 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs @@ -14,8 +14,7 @@ CREATE TABLE address_ratchet_keys( ratchet_key_id BLOB NOT NULL, x3dh_priv_key_1 BLOB NOT NULL, x3dh_priv_key_2 BLOB NOT NULL, - pq_priv_kem BLOB, - created_at TEXT NOT NULL + pq_priv_kem BLOB ) STRICT; CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index bd7c4e378..b98e57f1f 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -471,8 +471,7 @@ CREATE TABLE address_ratchet_keys( ratchet_key_id BLOB NOT NULL, x3dh_priv_key_1 BLOB NOT NULL, x3dh_priv_key_2 BLOB NOT NULL, - pq_priv_kem BLOB, - created_at TEXT NOT NULL + pq_priv_kem BLOB ) STRICT; CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id); CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id); diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index b8acc1e8a..8832d6d5d 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -262,11 +262,13 @@ connectionRequestTests = -- the pre-DR JOIN wire format: "JOIN " oldJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode PQSupportOff <> " " <> strEncode SMSubscribe <> " 2\nhi" serializeCommand cmd `shouldBe` oldJoin - -- an old-format JOIN string decodes to a JRInvitation and re-serializes unchanged case parseAll dbCommandP oldJoin of Right (JOIN JRInvitation {} _ _) -> pure () r -> expectationFailure $ "expected JOIN JRInvitation, got " <> show r (serializeCommand <$> parseAll dbCommandP oldJoin) `shouldBe` Right oldJoin + -- a legacy JOIN omitting pqSup parses with the PQSupportOff default (re-serializing with pqSup present) + let legacyJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode SMSubscribe <> " 2\nhi" + (serializeCommand <$> parseAll dbCommandP legacyJoin) `shouldBe` Right oldJoin it "should serialize and parse connection invitations and contact addresses" $ do connectionRequest #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) connectionRequest #== ("https://simplex.chat/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index d62c21baa..890e2a2b0 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -1000,13 +1000,16 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b where msgId = subtract baseId . fst --- Establish a connection via a DR-advertising contact address (short-link data includes ratchetKeys). --- addrIK drives the advertised bundle and the owner's PQ; useDR chooses the DR path (pass the fetched --- keys) or the classic path (ignore them); bPQ is the joiner's PQSupport. -runAgentClientContactDRTest :: HasCallStack => InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () -runAgentClientContactDRTest = runAgentClientContactDRTest_ False +allowConfirmGreet :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ConfirmationId -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO () +allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc = do + allowConnection bob aliceId confId "bob's connInfo" + get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") + get alice ##> ("", bobId, A.CON pqEnc) + get bob ##> ("", aliceId, A.CON pqEnc) + exchangeGreetings_ pqEnc alice bobId bob aliceId --- asyncAccept True exercises the ACPT command path (acceptContactAsync); False uses synchronous acceptContact. +-- DR-advertising contact address test. Args: asyncAccept (JOIN vs sync accept), addrIK (advertised bundle + owner +-- PQ), useDR (DR path vs classic/ignore keys), bPQ (joiner PQSupport). runAgentClientContactDRTest_ :: HasCallStack => Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do g <- C.newRandom @@ -1018,7 +1021,7 @@ runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ runRight_ $ do (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK (Just addrIK) SMSubscribe + _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK True SMSubscribe (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink -- the advertised DR bundle includes a KEM iff the owner's PQ is on, so a PQ requester gets PQ from message 1 liftIO $ case ratchetKeys userCtData' of @@ -1030,7 +1033,7 @@ runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False ("", _, A.REQ invId reqPQ _ "bob's connInfo") <- get alice - liftIO $ reqPQ `shouldBe` PQSupportOn -- REQ reports the connection PQ capability (On when versions support PQ); same for DR and classic paths + liftIO $ reqPQ `shouldBe` PQSupportOn bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) if asyncAccept then do @@ -1038,39 +1041,24 @@ runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps get alice =##> \case ("accept", c, A.JOINED _) -> c == bobId; _ -> False else void $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe ("", _, A.CONF confId confPQ _ "alice's connInfo") <- get bob - liftIO $ confPQ `shouldBe` bPQ -- CONF reports the joiner's own connection PQ support - allowConnection bob aliceId confId "bob's connInfo" - get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") - get alice ##> ("", bobId, A.CON pqEnc) - get bob ##> ("", aliceId, A.CON pqEnc) - exchangeGreetings_ pqEnc alice bobId bob aliceId + liftIO $ confPQ `shouldBe` bPQ + allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc testContactDRMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> Spec testContactDRMatrix ps = do - describe "DR join (ratchet from the invitation)" $ do - it "IKPQOff, dh join" $ runAgentClientContactDRTest IKPQOff True PQSupportOff ps - it "IKPQOff, pq join" $ runAgentClientContactDRTest IKPQOff True PQSupportOn ps - it "IKPQOn, dh join" $ runAgentClientContactDRTest IKPQOn True PQSupportOff ps - it "IKPQOn, pq join" $ runAgentClientContactDRTest IKPQOn True PQSupportOn ps - it "IKUsePQ, dh join" $ runAgentClientContactDRTest IKUsePQ True PQSupportOff ps - it "IKUsePQ, pq join" $ runAgentClientContactDRTest IKUsePQ True PQSupportOn ps - describe "classic join, ratchet keys ignored" $ do - it "IKPQOff, dh join" $ runAgentClientContactDRTest IKPQOff False PQSupportOff ps - it "IKPQOff, pq join" $ runAgentClientContactDRTest IKPQOff False PQSupportOn ps - it "IKPQOn, dh join" $ runAgentClientContactDRTest IKPQOn False PQSupportOff ps - it "IKPQOn, pq join" $ runAgentClientContactDRTest IKPQOn False PQSupportOn ps - it "IKUsePQ, dh join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOff ps - it "IKUsePQ, pq join" $ runAgentClientContactDRTest IKUsePQ False PQSupportOn ps - describe "DR join, async accept (JOIN command)" $ do - it "IKPQOff, dh join" $ runAgentClientContactDRTest_ True IKPQOff True PQSupportOff ps - it "IKPQOff, pq join" $ runAgentClientContactDRTest_ True IKPQOff True PQSupportOn ps - it "IKPQOn, dh join" $ runAgentClientContactDRTest_ True IKPQOn True PQSupportOff ps - it "IKPQOn, pq join" $ runAgentClientContactDRTest_ True IKPQOn True PQSupportOn ps - it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ True IKUsePQ True PQSupportOff ps - it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ True IKUsePQ True PQSupportOn ps - --- Defect A: updating the mutable short-link data of a DR-advertising address must preserve the stored --- ratchet keys (re-read from the DB), so requesters fetching the updated link can still establish DR. + describe "DR join (ratchet from the invitation)" $ drRows True False + describe "classic join, ratchet keys ignored" $ drRows False False + describe "DR join, async accept (JOIN command)" $ drRows True True + where + drRows useDR async = do + it "IKPQOff, dh join" $ runAgentClientContactDRTest_ async IKPQOff useDR PQSupportOff ps + it "IKPQOff, pq join" $ runAgentClientContactDRTest_ async IKPQOff useDR PQSupportOn ps + it "IKPQOn, dh join" $ runAgentClientContactDRTest_ async IKPQOn useDR PQSupportOff ps + it "IKPQOn, pq join" $ runAgentClientContactDRTest_ async IKPQOn useDR PQSupportOn ps + it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ async IKUsePQ useDR PQSupportOff ps + it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ async IKUsePQ useDR PQSupportOn ps + +-- updating a DR address's mutable link data must preserve the stored ratchet keys, so requesters can still establish DR testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do g <- C.newRandom @@ -1083,17 +1071,15 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ runRight_ $ do (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK (Just addrIK) SMSubscribe - -- the published link advertises generated ratchet keys + addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK True SMSubscribe (_, ContactLinkData _ published) <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys published `shouldSatisfy` isJust - -- update the mutable data passing ratchetKeys = Nothing; the stored keys must be preserved, not dropped + -- update passing ratchetKeys = Nothing; the stored keys must be preserved let updatedCtData = userCtData {userData = UserLinkData "updated", ratchetKeys = Nothing} shortLink' <- setConnShortLink alice addrConnId SCMContact (UserContactLinkData updatedCtData) Nothing liftIO $ shortLink' `shouldBe` shortLink (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ updated) <- getConnShortLink bob 1 shortLink - liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published -- preserved exactly (same id and public params) - -- and the preserved keys still establish a DR connection end to end + liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" (ratchetKeys updated) bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False @@ -1101,15 +1087,10 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob - allowConnection bob aliceId confId "bob's connInfo" - get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") - get alice ##> ("", bobId, A.CON pqEnc) - get bob ##> ("", aliceId, A.CON pqEnc) - exchangeGreetings_ pqEnc alice bobId bob aliceId + allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc --- Resume-safety regression: if the sync accept of a DR request fails at the network step after the send queue --- and ratchet were already committed (SndConnection), retrying the accept must reuse them (startAcceptContactDR --- is resume-safe, mirroring joinConnSrv) and complete, not fail with SEBadConnType. +-- Resume-safety: if the sync accept of a DR request fails at the network step after committing the send queue and +-- ratchet, retrying the accept must reuse them and complete. testAcceptContactDRResumeAfterOffline :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do g <- C.newRandom @@ -1122,7 +1103,7 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do -- set up the DR address, bob joins, alice receives REQ and pre-creates the accept connection (server up) (bobId, invId, aliceId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK (Just addrIK) SMSubscribe + _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK True SMSubscribe (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink aId <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn _ <- A.joinConnection bob NRMInteractive 1 aId True connReq' "bob's connInfo" (ratchetKeys userCtData') PQSupportOn SMSubscribe @@ -1140,11 +1121,7 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do liftIO $ threadDelay 250000 _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob - allowConnection bob aliceId confId "bob's connInfo" - get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo") - get alice ##> ("", bobId, A.CON pqEnc) - get bob ##> ("", aliceId, A.CON pqEnc) - exchangeGreetings_ pqEnc alice bobId bob aliceId + allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do @@ -1817,7 +1794,7 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b (ccLink@(CCLink connReq (Just shortLink)), preparedParams) <- A.prepareConnectionLink a 1 rootKey linkEntId True Nothing Nothing liftIO $ strDecode (strEncode shortLink) `shouldBe` Right shortLink - _ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn Nothing SMSubscribe + _ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn False SMSubscribe (FixedLinkData {linkConnReq = connReq', linkEntityId}, ContactLinkData _ userCtData') <- getConnShortLink b 1 shortLink liftIO $ Just linkEntId `shouldBe` linkEntityId Right connReqDecoded <- pure $ smpDecode (smpEncode connReq) From 3159eaa248d55a0106039818203fbca14586a03d Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Thu, 16 Jul 2026 17:03:26 +0100 Subject: [PATCH 27/81] comment, type --- src/Simplex/Messaging/Agent/Protocol.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index dc31025a3..094f3f9d2 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -474,7 +474,6 @@ data ACommand | ACK AgentMsgId (Maybe MsgReceiptInfo) | SWCH | DEL - -- no Eq: JOIN's JRAddressDR carries a DRRequest with a RatchetX448, which has no Eq deriving (Show) data ACommandTag @@ -867,7 +866,7 @@ data AgentMsgEnvelope -- what a requester sends: a classic invitation, or an address-DR confirmation (message 1) data SndInvOrConf = SndInvitation (ConnectionRequestUri 'CMInvitation) ConnInfo - | SndConfirmation (SndE2ERatchetParams 'C.X448) RatchetKeyId ByteString + | SndConfirmation (SndE2ERatchetParams 'C.X448) RatchetKeyId ConnInfo instance Encoding AgentMsgEnvelope where smpEncode = \case From 2a98035cddd72691bc6c2afdcb6b5bc29baed0a8 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Thu, 16 Jul 2026 17:07:12 +0100 Subject: [PATCH 28/81] type --- src/Simplex/Messaging/Agent/Protocol.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 094f3f9d2..60d22e6d2 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -866,7 +866,7 @@ data AgentMsgEnvelope -- what a requester sends: a classic invitation, or an address-DR confirmation (message 1) data SndInvOrConf = SndInvitation (ConnectionRequestUri 'CMInvitation) ConnInfo - | SndConfirmation (SndE2ERatchetParams 'C.X448) RatchetKeyId ConnInfo + | SndConfirmation (SndE2ERatchetParams 'C.X448) RatchetKeyId ByteString instance Encoding AgentMsgEnvelope where smpEncode = \case From c636ca249a730017fcb50b7456e26a82e54a5804 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 16 Jul 2026 21:02:27 +0000 Subject: [PATCH 29/81] rename --- src/Simplex/Messaging/Agent.hs | 56 +++++++++---------- src/Simplex/Messaging/Agent/Client.hs | 10 +--- src/Simplex/Messaging/Agent/Protocol.hs | 50 ++++++++--------- src/Simplex/Messaging/Agent/Store.hs | 6 +- .../Messaging/Agent/Store/AgentStore.hs | 6 +- 5 files changed, 62 insertions(+), 66 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index cea4a26ac..381666b0e 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -901,7 +901,7 @@ acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMo Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId withStore' c $ \db -> acceptInvitation db invId ownConnInfo let joinCmd = case contactReq of - CRConfirmation dr -> enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRAddressDR dr) subMode ownConnInfo + CRInvitationDR dr -> enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitationDR dr) subMode ownConnInfo CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo pqSupport subMode joinCmd `catchAllErrors` \err -> do withStore' c (`unacceptInvitation` invId) @@ -1332,7 +1332,7 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do Invitation {contactReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId case contactReq of CRInvitation cReq -> newConnToJoin c userId connId enableNtfs cReq pqSup - CRConfirmation DRRequest {agentVersion, pqSupport} -> do + CRInvitationDR DRInvitation {agentVersion, pqSupport} -> do g <- asks random let cData = ConnData {userId, connId, connAgentVersion = agentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} withStore c $ \db -> createNewConn db g cData SCMInvitation @@ -1349,7 +1349,7 @@ connReqQueue = \case data JoinInvitationReq = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport - | JIRAddressDR DRRequest + | JIRInvitationDR DRInvitation -- Resume-safe: reuses the send queue, ratchet, and (on a duplex retry) the reply queue from a previous attempt, -- returning that reply queue so the caller does not open a duplicate. @@ -1396,7 +1396,7 @@ startJoinInvitation c connId joinReq = do sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ pure (sq', e2eSndParams) pure (cData, rq_, sq', Just e2eSndParams, lnkId_) - JIRAddressDR DRRequest {ratchetState, replyQueue} -> do + JIRInvitationDR DRInvitation {ratchetState, replyQueue} -> do sq <- case sq_ of Just sq -> pure sq Nothing -> do @@ -1429,9 +1429,8 @@ data RcvRatchetInit = RcvRatchetInit pqCapability :: PQSupport } --- completes the X3DH receive, initializes the receive ratchet, and decrypts the first inbound ratchet --- message (the peer's confirmation/request); shared by the connection initiator and the address DR owner, --- which differ only in the key source. +-- completes the X3DH receive, initializes the receive ratchet, and decrypts the first inbound ratchet message +-- (the initiator's confirmation reply, or the DR owner's received invitation); the two differ only in the key source. initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM RcvRatchetInit initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config @@ -1486,17 +1485,17 @@ joinConnSrv c nm _userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKey >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case - Just (qInfo, vrsn@(Compatible v)) -> + Just (qInfo, Compatible v) -> withInvLock c (strEncode cReqUri) "joinConnSrv" $ do SomeConn cType conn <- withStore c (`getConn` connId) - invOrConfirmation <- case addrKeys_ of + envelope <- case addrKeys_ of Nothing -> do let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup CCLink cReq _ <- case conn of NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType - pure $ SndInvitation cReq cInfo + pure AgentInvitation {agentVersion = v, connReq = cReq, connInfo = cInfo} Just AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} -> do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config @@ -1521,8 +1520,8 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys liftIO $ setConnPQSupport db connId pqSupport encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode sndReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) maxV pure (sndParams, encConnInfo) - pure $ SndConfirmation sndParams addrRKId encConnInfo - void $ sendInvitation c nm userId connId qInfo vrsn invOrConfirmation + pure AgentInvitationDR {agentVersion = v, e2eEncryption_ = Just sndParams, ratchetKeyId = addrRKId, encConnInfo} + void $ sendInvitation c nm userId connId qInfo envelope pure False where mkJoinInvitation rq pqInitKeys = do @@ -1582,9 +1581,9 @@ acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId r <- case contactReq of CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode - CRConfirmation dr@DRRequest {replyQueue} -> do + CRInvitationDR dr@DRInvitation {replyQueue} -> do srv <- getNextSMPServer c userId [qServer replyQueue] - (cData, rq_, sq, params_, _) <- startJoinInvitation c connId (JIRAddressDR dr) + (cData, rq_, sq, params_, _) <- startJoinInvitation c connId (JIRInvitationDR dr) secureConfirmQueue c nm cData rq_ sq srv ownConnInfo params_ subMode withStore' c $ \db -> acceptInvitation db invId ownConnInfo pure r @@ -2009,10 +2008,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo Nothing pqEnc subMode srv notify $ JOINED sqSecured - JOIN (JRAddressDR dr@DRRequest {replyQueue}) subMode ownCInfo -> noServer $ do + JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do - sqSecured <- joinConnSrvAsync c connId (JIRAddressDR dr) ownCInfo subMode srv + sqSecured <- joinConnSrvAsync c connId (JIRInvitationDR dr) ownCInfo subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK @@ -3292,7 +3291,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar decryptClientMessage e2eDh clientMsg >>= \case (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) -> smpConfirmation srvMsgId conn (Just senderKey) e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack - (SMP.PHEmpty, e@AgentConfirmation {ratchetKeyId = Just _}) -> + (SMP.PHEmpty, e@AgentInvitationDR {}) -> smpInvitation srvMsgId conn e phVer >> ack (SMP.PHEmpty, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) | senderCanSecure queueMode -> smpConfirmation srvMsgId conn Nothing e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack @@ -3423,8 +3422,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "msg: bad client msg" >> ack (Just e2eDh, Just _) -> decryptClientMessage e2eDh clientMsg >>= \case - -- this is a repeated confirmation delivery because ack failed to be sent + -- this is a repeated confirmation/invitation delivery because ack failed to be sent (_, AgentConfirmation {}) -> ack + (_, AgentInvitationDR {}) -> ack _ -> prohibited "msg: public header" >> ack (Nothing, Nothing) -> prohibited "msg: no keys" >> ack updateConnVersion :: Connection c -> ConnData -> VersionSMPA -> AM (Connection c) @@ -3728,8 +3728,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar when (isNothing rcSnd) . void $ enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} (EREADY lastExternalSndId) - -- owner receiving a contact request: a classic AgentInvitation, or an address DR AgentConfirmation - -- (message 1, ratchetKeyId set) that establishes the ratchet now + -- owner receiving a contact request: a classic AgentInvitation, or an address-DR AgentInvitationDR + -- (message 1) that establishes the ratchet now smpInvitation :: SMP.MsgId -> Connection c -> AgentMsgEnvelope -> VersionSMPC -> AM () smpInvitation srvMsgId conn' envelope phVer = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId @@ -3741,7 +3741,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- in case invitation not compatible, assume there is no PQ encryption support. reqPQ <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq pure $ Just (CRInvitation connReq, reqPQ, L.map qServer $ crSmpQueues crData, connInfo) - AgentConfirmation {agentVersion, e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo} -> do + AgentInvitationDR {agentVersion, e2eEncryption_ = Just e2eSndParams, ratchetKeyId = rkId, encConnInfo} -> do checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case @@ -3751,11 +3751,11 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply (replyQInfo :| _) reqConnInfo -> - let dr = DRRequest {ratchetState = rc', replyQueue = replyQInfo, agentVersion, pqSupport = pqSupport'} - in pure $ Just (CRConfirmation dr, pqCapability, qServer replyQInfo :| [], reqConnInfo) - _ -> Nothing <$ prohibited "addr conf: not AgentConnInfoReply" - _ -> Nothing <$ prohibited "addr conf: decrypt error" - _ -> Nothing <$ prohibited "addr conf: unknown ratchetKeyId" + let dr = DRInvitation {ratchetState = rc', replyQueue = replyQInfo, agentVersion, pqSupport = pqSupport'} + in pure $ Just (CRInvitationDR dr, pqCapability, qServer replyQInfo :| [], reqConnInfo) + _ -> Nothing <$ prohibited "addr inv: not AgentConnInfoReply" + _ -> Nothing <$ prohibited "addr inv: decrypt error" + _ -> Nothing <$ prohibited "addr inv: unknown ratchetKeyId" _ -> Nothing <$ prohibited "conf: incorrect state" forM_ req_ $ \(contactReq, reqPQ, srvs, recipientConnInfo) -> do g <- asks random @@ -3904,7 +3904,7 @@ secureConfirmQueue c nm cData@ConnData {connId, connAgentVersion, pqSupport} rq_ liftIO $ updateSndMsgHash db connId internalSndId (C.sha256Hash agentMsgBody) let pqEnc = CR.pqSupportToEnc pqSupport (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion - pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, ratchetKeyId = Nothing, encConnInfo} + pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo} agentSecureSndQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> AM SndQueueSecured agentSecureSndQueue c nm ConnData {connAgentVersion} sq@SndQueue {queueMode, status} @@ -3941,7 +3941,7 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq internalHash = C.sha256Hash agentMsgStr pqEnc = CR.pqSupportToEnc pqSupport (encConnInfo, pqEncryption) <- agentRatchetEncrypt db cData agentMsgStr e2eEncConnInfoLength (Just pqEnc) currentE2EVersion - let msgBody = smpEncode $ AgentConfirmation {agentVersion = v, e2eEncryption_, ratchetKeyId = Nothing, encConnInfo} + let msgBody = smpEncode $ AgentConfirmation {agentVersion = v, e2eEncryption_, encConnInfo} msgType = agentMessageType agentMsg msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing} liftIO $ createSndMsg db connId msgData diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 06fd1376d..55eac6ba6 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1913,14 +1913,10 @@ sendConfirmation c nm sq@SndQueue {userId, server, connId, sndId, queueMode, snd sendOrProxySMPMessage c nm userId server connId "" spKey sndId (MsgFlags {notification = True}) msg sendConfirmation _ _ _ _ = throwE $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database" -sendInvitation :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> Compatible VersionSMPA -> SndInvOrConf -> AM (Maybe SMPServer) -sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) (Compatible agentVersion) invOrConf = do +sendInvitation :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Compatible SMPQueueInfo -> AgentMsgEnvelope -> AM (Maybe SMPServer) +sendInvitation c nm userId connId (Compatible (SMPQueueInfo v SMPQueueAddress {smpServer, senderId, dhPublicKey})) agentEnvelope = do msg <- agentCbEncryptOnce v dhPublicKey . smpEncode $ SMP.ClientMessage SMP.PHEmpty (smpEncode agentEnvelope) - sendOrProxySMPMessage c nm userId smpServer connId label Nothing senderId (MsgFlags {notification = True}) msg - where - (agentEnvelope, label) = case invOrConf of - SndInvitation connReq connInfo -> (AgentInvitation {agentVersion, connReq, connInfo}, "") - SndConfirmation e2eSndParams rkId encConnInfo -> (AgentConfirmation {agentVersion, e2eEncryption_ = Just e2eSndParams, ratchetKeyId = Just rkId, encConnInfo}, "") + sendOrProxySMPMessage c nm userId smpServer connId "" Nothing senderId (MsgFlags {notification = True}) msg getQueueMessage :: AgentClient -> RcvQueue -> AM (Maybe SMPMsgMeta) getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 60d22e6d2..cb7461c41 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -47,7 +47,6 @@ module Simplex.Messaging.Agent.Protocol pqdrSMPAgentVersion, sndAuthKeySMPAgentVersion, ratchetOnConfSMPAgentVersion, - addressDRSMPAgentVersion, currentSMPAgentVersion, supportedSMPAgentVRange, e2eEncConnInfoLength, @@ -82,7 +81,6 @@ module Simplex.Messaging.Agent.Protocol RatchetSyncState (..), SMPConfirmation (..), AgentMsgEnvelope (..), - SndInvOrConf (..), AgentMessage (..), AgentMessageType (..), APrivHeader (..), @@ -123,7 +121,7 @@ module Simplex.Messaging.Agent.Protocol UserContactData (..), UserLinkData (..), AddressRatchetKeys (..), - DRRequest (..), + DRInvitation (..), RatchetKeyId (..), OwnerAuth (..), OwnerId, @@ -328,9 +326,6 @@ sndAuthKeySMPAgentVersion = VersionSMPA 6 ratchetOnConfSMPAgentVersion :: VersionSMPA ratchetOnConfSMPAgentVersion = VersionSMPA 7 -addressDRSMPAgentVersion :: VersionSMPA -addressDRSMPAgentVersion = VersionSMPA 8 - minSupportedSMPAgentVersion :: VersionSMPA minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion @@ -844,7 +839,6 @@ data AgentMsgEnvelope = AgentConfirmation { agentVersion :: VersionSMPA, e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), - ratchetKeyId :: Maybe RatchetKeyId, encConnInfo :: ByteString } | AgentMsgEnvelope @@ -856,6 +850,14 @@ data AgentMsgEnvelope connReq :: ConnectionRequestUri 'CMInvitation, connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet, } + | -- a requester's first message to a contact address that establishes the double ratchet from the address keys; + -- ratchetKeyId selects the owner's advertised key, encConnInfo is a ratchet-encrypted AgentConnInfoReply + AgentInvitationDR + { agentVersion :: VersionSMPA, + e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), + ratchetKeyId :: RatchetKeyId, + encConnInfo :: ByteString + } | AgentRatchetKey { agentVersion :: VersionSMPA, e2eEncryption :: RcvE2ERatchetParams 'C.X448, @@ -863,22 +865,16 @@ data AgentMsgEnvelope } deriving (Show) --- what a requester sends: a classic invitation, or an address-DR confirmation (message 1) -data SndInvOrConf - = SndInvitation (ConnectionRequestUri 'CMInvitation) ConnInfo - | SndConfirmation (SndE2ERatchetParams 'C.X448) RatchetKeyId ByteString - instance Encoding AgentMsgEnvelope where smpEncode = \case - AgentConfirmation {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} - | agentVersion >= addressDRSMPAgentVersion -> - smpEncode (agentVersion, 'C', e2eEncryption_, ratchetKeyId, Tail encConnInfo) - | otherwise -> - smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo) + AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} -> + smpEncode (agentVersion, 'C', e2eEncryption_, Tail encConnInfo) AgentMsgEnvelope {agentVersion, encAgentMessage} -> smpEncode (agentVersion, 'M', Tail encAgentMessage) AgentInvitation {agentVersion, connReq, connInfo} -> smpEncode (agentVersion, 'I', Large $ strEncode connReq, Tail connInfo) + AgentInvitationDR {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} -> + smpEncode (agentVersion, 'J', e2eEncryption_, ratchetKeyId, Tail encConnInfo) AgentRatchetKey {agentVersion, e2eEncryption, info} -> smpEncode (agentVersion, 'R', e2eEncryption, Tail info) smpP = do @@ -886,9 +882,8 @@ instance Encoding AgentMsgEnvelope where smpP >>= \case 'C' -> do e2eEncryption_ <- smpP - ratchetKeyId <- if agentVersion >= addressDRSMPAgentVersion then smpP else pure Nothing Tail encConnInfo <- smpP - pure AgentConfirmation {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} + pure AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} 'M' -> do Tail encAgentMessage <- smpP pure AgentMsgEnvelope {agentVersion, encAgentMessage} @@ -896,6 +891,11 @@ instance Encoding AgentMsgEnvelope where connReq <- strDecode . unLarge <$?> smpP Tail connInfo <- smpP pure AgentInvitation {agentVersion, connReq, connInfo} + 'J' -> do + e2eEncryption_ <- smpP + ratchetKeyId <- smpP + Tail encConnInfo <- smpP + pure AgentInvitationDR {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} 'R' -> do e2eEncryption <- smpP Tail info <- smpP @@ -1827,9 +1827,9 @@ instance Encoding AddressRatchetKeys where smpEncode AddressRatchetKeys {ratchetKeyId, e2eParams} = smpEncode (ratchetKeyId, e2eParams) smpP = uncurry AddressRatchetKeys <$> smpP --- | The double-ratchet request an address owner receives in message 1 and later accepts: the ratchet the +-- | The double-ratchet invitation an address owner receives in message 1 and later accepts: the ratchet the -- owner established from that message, the requester's reply queue, and the negotiated version and PQ support. -data DRRequest = DRRequest +data DRInvitation = DRInvitation { ratchetState :: RatchetX448, replyQueue :: SMPQueueInfo, agentVersion :: VersionSMPA, @@ -1839,7 +1839,7 @@ data DRRequest = DRRequest data JoinRequest = JRInvitation Bool AConnectionRequestUri PQSupport - | JRAddressDR DRRequest + | JRInvitationDR DRInvitation deriving (Show) data UserContactData = UserContactData @@ -2175,17 +2175,17 @@ cryptoErrToSyncState = \case RATCHET_SKIPPED _ -> RSRequired RATCHET_SYNC -> RSRequired -$(J.deriveJSON defaultJSON ''DRRequest) +$(J.deriveJSON defaultJSON ''DRInvitation) -- JRInvitation must stay byte-identical to the pre-DR JOIN "ntfs cReq pqSup" for old/new client interop; pqSup -- and subMode still default when a legacy command omits them. instance StrEncoding JoinRequest where strEncode = \case JRInvitation ntfs cReq pqSup -> B.unwords [strEncode ntfs, strEncode cReq, strEncode pqSup] - JRAddressDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) + JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = (JRInvitation <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff)) - <|> (JRAddressDR <$> ((A.take =<< (A.decimal <* A.char '\n')) >>= either fail pure . J'.eitherDecodeStrict') <* A.space) + <|> (JRInvitationDR <$> ((A.take =<< (A.decimal <* A.char '\n')) >>= either fail pure . J'.eitherDecodeStrict') <* A.space) -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) dbCommandP :: Parser ACommand diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 254ed3d51..55b504fff 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -46,7 +46,7 @@ module Simplex.Messaging.Agent.Store NewInvitation (..), Invitation (..), ContactRequest (..), - DRRequest (..), + DRInvitation (..), PrevExternalSndId, PrevRcvMsgHash, PrevSndMsgHash, @@ -641,10 +641,10 @@ data Invitation = Invitation accepted :: Bool } --- | A classic connection request URI, or a double-ratchet confirmation received at a DR address. +-- | A classic connection request URI, or a double-ratchet invitation received at a DR address. data ContactRequest = CRInvitation (ConnectionRequestUri 'CMInvitation) - | CRConfirmation DRRequest + | CRInvitationDR DRInvitation -- * Message integrity validation types diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index c5d5804b2..dfc84ffb3 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -2106,16 +2106,16 @@ instance ToField RatchetKeyId where toField (RatchetKeyId s) = toField $ Binary instance FromField RatchetKeyId where fromField = blobFieldDecoder $ Right . RatchetKeyId --- CRInvitation keeps the legacy URI (downgrade-safe); CRConfirmation is JSON, told apart by leading '{' +-- CRInvitation keeps the legacy URI (downgrade-safe); CRInvitationDR is JSON, told apart by leading '{' instance ToField ContactRequest where toField = toField . Binary . \case CRInvitation cr -> strEncode cr - CRConfirmation dr -> LB.toStrict $ J.encode dr + CRInvitationDR dr -> LB.toStrict $ J.encode dr instance FromField ContactRequest where fromField = blobFieldDecoder $ \bs -> if "{" `B.isPrefixOf` bs - then CRConfirmation <$> J.eitherDecodeStrict' bs + then CRInvitationDR <$> J.eitherDecodeStrict' bs else CRInvitation <$> strDecode bs instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode From d2223945ea0f444f8bca34b61b98f808dab365a8 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 16 Jul 2026 22:17:24 +0000 Subject: [PATCH 30/81] refactor more --- src/Simplex/Messaging/Agent.hs | 188 +++++++++++++----------- src/Simplex/Messaging/Agent/Protocol.hs | 17 +-- 2 files changed, 112 insertions(+), 93 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 381666b0e..9b06d6f4b 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -985,10 +985,6 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} pure (ccLink, params) -addAddressRatchetKeys :: CR.VersionRangeE2E -> UserConnLinkData 'CMContact -> RatchetKeyId -> CR.RcvE2ERatchetParams 'C.X448 -> UserConnLinkData 'CMContact -addAddressRatchetKeys e2eVR (UserContactLinkData ucd) ratchetKeyId e2eParams = - UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams = toVersionRangeT e2eParams e2eVR}} - -- | Create connection for prepared link (single network call). createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Bool -> SubscriptionMode -> AM ConnId createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys advertiseDR subMode = do @@ -1007,7 +1003,9 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.connPQEncryption pqInitKeys) ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem - pure $ addAddressRatchetKeys e2eVR userLinkData ratchetKeyId e2eRcvParams + let UserContactLinkData ucd = userLinkData + e2eParams = toVersionRangeT e2eRcvParams e2eVR + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams}} else pure userLinkData let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' @@ -1145,13 +1143,14 @@ setConnShortLink' c nm connId cMode userLinkData clientData = pure (rq, shortLinkId, sl, (linkEncFixedData, d)) Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation" preserveAddressRatchetKeys :: UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) - preserveAddressRatchetKeys ud = + preserveAddressRatchetKeys ud@(UserContactLinkData ucd) = withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case Left _ -> pure ud - Right (rkId, pk1, pk2, pKem) -> do + Right (ratchetKeyId, pk1, pk2, pKem) -> do e2eVR <- asks $ e2eEncryptVRange . config let e2eRcv = CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem) - pure $ addAddressRatchetKeys e2eVR ud rkId e2eRcv + e2eParams = toVersionRangeT e2eRcv e2eVR + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams}} deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM () deleteConnShortLink' c nm connId cMode = @@ -1353,61 +1352,54 @@ data JoinInvitationReq -- Resume-safe: reuses the send queue, ratchet, and (on a duplex retry) the reply queue from a previous attempt, -- returning that reply queue so the caller does not open a duplicate. -startJoinInvitation :: AgentClient -> ConnId -> JoinInvitationReq -> AM (ConnData, Maybe RcvQueue, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) -startJoinInvitation c connId joinReq = do - SomeConn cType conn <- withStore c (`getConn` connId) - let ConnData {userId} = toConnData conn - (rq_, sq_) <- case conn of - NewConnection _ -> pure (Nothing, Nothing) - SndConnection _ sq -> pure (Nothing, Just sq) - DuplexConnection _ (rq@RcvQueue {status = New} :| _) (sq@SndQueue {status = sqStatus} :| _) - | sqStatus == New || sqStatus == Secured -> pure (Just rq, Just sq) - _ -> throwE $ CMD PROHIBITED $ "startJoinInvitation: bad connection " <> show cType - case joinReq of - JIRInvitation enableNtfs cReqUri pqSup -> - lift (compatibleInvitationUri cReqUri) >>= \case - Nothing -> throwE $ AGENT A_VERSION - Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) - g <- asks random - maxSupported <- asks $ maxVersion . e2eEncryptVRange . config - let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} - case sq_ of - -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out - -- e2ePubKey is always present, it's Maybe historically - Just sq@SndQueue {e2ePubKey = Just _k} -> do - e2eSndParams <- withStore c $ \db -> do - lockConnForUpdate db connId - getSndRatchet db connId v >>= \case - Right r -> pure $ Right $ snd r - Left e -> do - nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) - runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - pure (cData, rq_, sq, Just e2eSndParams, Nothing) - _ -> do - let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo - invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId - let lnkId_ = fst <$> invLink_ - sndKey_ = snd <$> invLink_ - (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_ - (sq', e2eSndParams) <- withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (sq', e2eSndParams) - pure (cData, rq_, sq', Just e2eSndParams, lnkId_) - JIRInvitationDR DRInvitation {ratchetState, replyQueue} -> do - sq <- case sq_ of - Just sq -> pure sq - Nothing -> do - clientVRange <- asks $ smpClientVRange . config - qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange - (q, _) <- lift $ newSndQueue userId connId qInfo Nothing - withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - liftIO $ createRatchet db connId ratchetState - ExceptT $ updateNewConnSnd db connId q - pure (toConnData conn, rq_, sq, Nothing, Nothing) +startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> JoinInvitationReq -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) +startJoinInvitation c userId connId sq_ = \case + JIRInvitation enableNtfs cReqUri pqSup -> + lift (compatibleInvitationUri cReqUri) >>= \case + Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) + g <- asks random + maxSupported <- asks $ maxVersion . e2eEncryptVRange . config + let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} + case sq_ of + -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out + -- e2ePubKey is always present, it's Maybe historically + Just sq@SndQueue {e2ePubKey = Just _k} -> do + e2eSndParams <- withStore c $ \db -> do + lockConnForUpdate db connId + getSndRatchet db connId v >>= \case + Right r -> pure $ Right $ snd r + Left e -> do + nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) + runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams + pure (cData, sq, Just e2eSndParams, Nothing) + _ -> do + let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo + invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId + let lnkId_ = fst <$> invLink_ + sndKey_ = snd <$> invLink_ + (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_ + (sq', e2eSndParams) <- withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams + sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ + pure (sq', e2eSndParams) + pure (cData, sq', Just e2eSndParams, lnkId_) + Nothing -> throwE $ AGENT A_VERSION + -- DR accept: the ratchet is already established (in the received invitation), so just persist it and send Q_B + JIRInvitationDR DRInvitation {ratchetState, replyQueue} -> do + sq <- case sq_ of + Just sq -> pure sq + Nothing -> do + clientVRange <- asks $ smpClientVRange . config + qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange + (q, _) <- lift $ newSndQueue userId connId qInfo Nothing + withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + liftIO $ createRatchet db connId ratchetState + ExceptT $ updateNewConnSnd db connId q + SomeConn _ conn <- withStore c (`getConn` connId) + pure (toConnData conn, sq, Nothing, Nothing) createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do @@ -1478,11 +1470,21 @@ versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && ma {-# INLINE versionPQSupport_ #-} joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrv c nm _userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys pqSup subMode srv = +joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys pqSup subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do - (cData, rq_, sq, params_, lnkId_) <- startJoinInvitation c connId (JIRInvitation enableNtfs inv pqSup) - secureConfirmQueue c nm cData rq_ sq srv cInfo params_ subMode - >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) + SomeConn cType conn <- withStore c (`getConn` connId) + case conn of + NewConnection _ -> doJoin Nothing Nothing + SndConnection _ sq -> doJoin Nothing (Just sq) + DuplexConnection _ (rq@RcvQueue {status = New} :| _) (sq@SndQueue {status = sqStatus} :| _) + | sqStatus == New || sqStatus == Secured -> doJoin (Just rq) (Just sq) + _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType + where + doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured + doJoin rq_ sq_ = do + (cData, sq, params_, lnkId_) <- startJoinInvitation c userId connId sq_ (JIRInvitation enableNtfs inv pqSup) + secureConfirmQueue c nm cData rq_ sq srv cInfo params_ subMode + >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case Just (qInfo, Compatible v) -> @@ -1496,7 +1498,7 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType pure AgentInvitation {agentVersion = v, connReq = cReq, connInfo = cInfo} - Just AddressRatchetKeys {ratchetKeyId = addrRKId, e2eParams} -> do + Just AddressRatchetKeys {ratchetKeyId, e2eParams} -> do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config case e2eParams `compatibleVersion` e2eVR of @@ -1514,13 +1516,13 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys cData = (toConnData conn) {pqSupport} :: ConnData replyQInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) sndReply = AgentConnInfoReply (replyQInfo :| []) cInfo - (sndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do + (e2eSndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do liftIO $ lockConnForUpdate db connId - sndParams <- liftIO (getSndRatchet db connId e2eV) >>= either (const $ createRatchet_ db g connId maxV pqSupport e2eRcvParams) (pure . snd) + e2eSndParams <- liftIO (getSndRatchet db connId e2eV) >>= either (const $ createRatchet_ db g connId maxV pqSupport e2eRcvParams) (pure . snd) liftIO $ setConnPQSupport db connId pqSupport encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode sndReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) maxV - pure (sndParams, encConnInfo) - pure AgentInvitationDR {agentVersion = v, e2eEncryption_ = Just sndParams, ratchetKeyId = addrRKId, encConnInfo} + pure (e2eSndParams, encConnInfo) + pure AgentInvitationDR {agentVersion = v, e2eSndParams, ratchetKeyId, encConnInfo} void $ sendInvitation c nm userId connId qInfo envelope pure False where @@ -1548,11 +1550,23 @@ delInvSL c connId srv lnkId = withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e -> liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e)) -joinConnSrvAsync :: AgentClient -> ConnId -> JoinInvitationReq -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrvAsync c connId joinReq cInfo subMode srv = do - (cData, rq_, sq, params_, lnkId_) <- startJoinInvitation c connId joinReq - secureConfirmQueueAsync c cData rq_ sq srv cInfo params_ subMode - >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) +joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> JoinInvitationReq -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrvAsync c userId connId joinReq cInfo subMode srv = do + SomeConn cType conn <- withStore c (`getConn` connId) + case conn of + NewConnection _ -> doJoin Nothing Nothing + SndConnection _ sq -> doJoin Nothing (Just sq) + -- this branch should never be reached with async flow because once receive queue is created, + -- there are not more failure points (sending confirmation is asynchronous) + DuplexConnection _ (rq@RcvQueue {status = New} :| _) (sq@SndQueue {status = sqStatus} :| _) + | sqStatus == New || sqStatus == Secured -> doJoin (Just rq) (Just sq) + _ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType + where + doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured + doJoin rq_ sq_ = do + (cData, sq, params_, lnkId_) <- startJoinInvitation c userId connId sq_ joinReq + secureConfirmQueueAsync c cData rq_ sq srv cInfo params_ subMode + >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) createReplyQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo createReplyQueue c nm ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do @@ -1583,8 +1597,16 @@ acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode CRInvitationDR dr@DRInvitation {replyQueue} -> do srv <- getNextSMPServer c userId [qServer replyQueue] - (cData, rq_, sq, params_, _) <- startJoinInvitation c connId (JIRInvitationDR dr) - secureConfirmQueue c nm cData rq_ sq srv ownConnInfo params_ subMode + SomeConn cType conn <- withStore c (`getConn` connId) + let doJoin rq_ sq_ = do + (cData, sq, params_, _) <- startJoinInvitation c userId connId sq_ (JIRInvitationDR dr) + secureConfirmQueue c nm cData rq_ sq srv ownConnInfo params_ subMode + case conn of + NewConnection _ -> doJoin Nothing Nothing + SndConnection _ sq -> doJoin Nothing (Just sq) + DuplexConnection _ (rq@RcvQueue {status = New} :| _) (sq@SndQueue {status = sqStatus} :| _) + | sqStatus == New || sqStatus == Secured -> doJoin (Just rq) (Just sq) + _ -> throwE $ CMD PROHIBITED $ "acceptContact: bad connection " <> show cType withStore' c $ \db -> acceptInvitation db invId ownConnInfo pure r @@ -1999,7 +2021,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN (JRInvitation enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrvAsync c connId (JIRInvitation enableNtfs cReq pqEnc) connInfo subMode srv + sqSecured <- joinConnSrvAsync c userId connId (JIRInvitation enableNtfs cReq pqEnc) connInfo subMode srv notify $ JOINED sqSecured -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. @@ -2011,7 +2033,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do - sqSecured <- joinConnSrvAsync c connId (JIRInvitationDR dr) ownCInfo subMode srv + sqSecured <- joinConnSrvAsync c userId connId (JIRInvitationDR dr) ownCInfo subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK @@ -3741,11 +3763,11 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- in case invitation not compatible, assume there is no PQ encryption support. reqPQ <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq pure $ Just (CRInvitation connReq, reqPQ, L.map qServer $ crSmpQueues crData, connInfo) - AgentInvitationDR {agentVersion, e2eEncryption_ = Just e2eSndParams, ratchetKeyId = rkId, encConnInfo} -> do + AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} -> do checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case - Right (rkId', pk1, pk2, pKem) | rkId' == rkId -> do + Right (rkId', pk1, pk2, pKem) | rkId' == ratchetKeyId -> do RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index cb7461c41..410296759 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -854,7 +854,7 @@ data AgentMsgEnvelope -- ratchetKeyId selects the owner's advertised key, encConnInfo is a ratchet-encrypted AgentConnInfoReply AgentInvitationDR { agentVersion :: VersionSMPA, - e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448), + e2eSndParams :: SndE2ERatchetParams 'C.X448, ratchetKeyId :: RatchetKeyId, encConnInfo :: ByteString } @@ -873,16 +873,15 @@ instance Encoding AgentMsgEnvelope where smpEncode (agentVersion, 'M', Tail encAgentMessage) AgentInvitation {agentVersion, connReq, connInfo} -> smpEncode (agentVersion, 'I', Large $ strEncode connReq, Tail connInfo) - AgentInvitationDR {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} -> - smpEncode (agentVersion, 'J', e2eEncryption_, ratchetKeyId, Tail encConnInfo) + AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} -> + smpEncode (agentVersion, 'J', e2eSndParams, ratchetKeyId, Tail encConnInfo) AgentRatchetKey {agentVersion, e2eEncryption, info} -> smpEncode (agentVersion, 'R', e2eEncryption, Tail info) smpP = do agentVersion <- smpP smpP >>= \case 'C' -> do - e2eEncryption_ <- smpP - Tail encConnInfo <- smpP + (e2eEncryption_, Tail encConnInfo) <- smpP pure AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} 'M' -> do Tail encAgentMessage <- smpP @@ -892,10 +891,8 @@ instance Encoding AgentMsgEnvelope where Tail connInfo <- smpP pure AgentInvitation {agentVersion, connReq, connInfo} 'J' -> do - e2eEncryption_ <- smpP - ratchetKeyId <- smpP - Tail encConnInfo <- smpP - pure AgentInvitationDR {agentVersion, e2eEncryption_, ratchetKeyId, encConnInfo} + (e2eSndParams, ratchetKeyId, Tail encConnInfo) <- smpP + pure AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} 'R' -> do e2eEncryption <- smpP Tail info <- smpP @@ -1838,7 +1835,7 @@ data DRInvitation = DRInvitation deriving (Show) data JoinRequest - = JRInvitation Bool AConnectionRequestUri PQSupport + = JRInvitation {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} | JRInvitationDR DRInvitation deriving (Show) From 565a64dfac068b07c589de0c602d7fb5f6f5084a Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Thu, 16 Jul 2026 23:23:05 +0100 Subject: [PATCH 31/81] move type --- src/Simplex/Messaging/Agent.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 9b06d6f4b..e40c5cfb7 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1346,10 +1346,6 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q -data JoinInvitationReq - = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport - | JIRInvitationDR DRInvitation - -- Resume-safe: reuses the send queue, ratchet, and (on a duplex retry) the reply queue from a previous attempt, -- returning that reply queue so the caller does not open a duplicate. startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> JoinInvitationReq -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) @@ -1420,6 +1416,10 @@ data RcvRatchetInit = RcvRatchetInit connPQSupport :: PQSupport, pqCapability :: PQSupport } + +data JoinInvitationReq + = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport + | JIRInvitationDR DRInvitation -- completes the X3DH receive, initializes the receive ratchet, and decrypts the first inbound ratchet message -- (the initiator's confirmation reply, or the DR owner's received invitation); the two differ only in the key source. From cbc8bb4aec87040fc0abd802a54c20393048f9cb Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 06:06:32 +0000 Subject: [PATCH 32/81] refactor --- src/Simplex/Messaging/Agent.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index e40c5cfb7..ab2bbb002 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1374,12 +1374,7 @@ startJoinInvitation c userId connId sq_ = \case invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId let lnkId_ = fst <$> invLink_ sndKey_ = snd <$> invLink_ - (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_ - (sq', e2eSndParams) <- withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (sq', e2eSndParams) + (sq', e2eSndParams) <- createSndQueue "" qInfo sndKey_ $ \db -> createRatchet_ db g connId maxSupported pqSupport e2eRcvParams pure (cData, sq', Just e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION -- DR accept: the ratchet is already established (in the received invitation), so just persist it and send Q_B @@ -1389,13 +1384,19 @@ startJoinInvitation c userId connId sq_ = \case Nothing -> do clientVRange <- asks $ smpClientVRange . config qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange - (q, _) <- lift $ newSndQueue userId connId qInfo Nothing - withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - liftIO $ createRatchet db connId ratchetState - ExceptT $ updateNewConnSnd db connId q + fst <$> createSndQueue connId qInfo Nothing (\db -> liftIO $ createRatchet db connId ratchetState) SomeConn _ conn <- withStore c (`getConn` connId) pure (toConnData conn, sq, Nothing, Nothing) + where + -- create the send queue and establish the send ratchet in one locked transaction (reusing sq_ on retry) + createSndQueue :: ConnId -> Compatible SMPQueueInfo -> Maybe C.APrivateAuthKey -> (DB.Connection -> ExceptT StoreError IO r) -> AM (SndQueue, r) + createSndQueue qCid qInfo sndKey_ establishRatchet = do + (q, _) <- lift $ newSndQueue userId qCid qInfo sndKey_ + withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + r <- establishRatchet db + sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ + pure (sq', r) createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do From fa256bda97e8e42fb4b58ccf88db554f46fb643b Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 07:08:53 +0100 Subject: [PATCH 33/81] remove comment --- src/Simplex/Messaging/Agent.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index ab2bbb002..641d284a3 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1346,8 +1346,6 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q --- Resume-safe: reuses the send queue, ratchet, and (on a duplex retry) the reply queue from a previous attempt, --- returning that reply queue so the caller does not open a duplicate. startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> JoinInvitationReq -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) startJoinInvitation c userId connId sq_ = \case JIRInvitation enableNtfs cReqUri pqSup -> From 564e93e3509dd875e4f9ce0104b41ee4a7ef8f5e Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 07:48:52 +0100 Subject: [PATCH 34/81] diff --- src/Simplex/Messaging/Agent.hs | 23 ++++++++++--------- src/Simplex/Messaging/Agent/Store.hs | 4 ++-- .../Messaging/Agent/Store/AgentStore.hs | 8 +++---- 3 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 641d284a3..42925c20c 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -898,9 +898,9 @@ allowConnectionAsync' c corrId connId confId ownConnInfo = -- while marking invitation as accepted inside "lock level transaction" after successful `joinConnAsync`. acceptContactAsync' :: AgentClient -> ACorrId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM () acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMode = do - Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId + Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId withStore' c $ \db -> acceptInvitation db invId ownConnInfo - let joinCmd = case contactReq of + let joinCmd = case connReq of CRInvitationDR dr -> enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitationDR dr) subMode ownConnInfo CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo pqSupport subMode joinCmd `catchAllErrors` \err -> do @@ -1328,8 +1328,8 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> PQSupport -> AM ConnId newConnToAccept c userId connId enableNtfs invId pqSup = do - Invitation {contactReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId - case contactReq of + Invitation {connReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId + case connReq of CRInvitation cReq -> newConnToJoin c userId connId enableNtfs cReq pqSup CRInvitationDR DRInvitation {agentVersion, pqSupport} -> do g <- asks random @@ -1591,8 +1591,8 @@ allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConne -- | Accept contact (ACPT command) in Reader monad acceptContact' :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do - Invitation {contactReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId - r <- case contactReq of + Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId + r <- case connReq of CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode CRInvitationDR dr@DRInvitation {replyQueue} -> do srv <- getNextSMPServer c userId [qServer replyQueue] @@ -3760,8 +3760,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar AgentInvitation {connReq = connReq@(CRInvitationUri crData _), connInfo} -> do -- show connection request even if invitation via contact address is not compatible. -- in case invitation not compatible, assume there is no PQ encryption support. - reqPQ <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq - pure $ Just (CRInvitation connReq, reqPQ, L.map qServer $ crSmpQueues crData, connInfo) + pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq + pure $ Just (CRInvitation connReq, pqSupport, L.map qServer $ crSmpQueues crData, connInfo) AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} -> do checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' @@ -3778,10 +3778,11 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> Nothing <$ prohibited "addr inv: decrypt error" _ -> Nothing <$ prohibited "addr inv: unknown ratchetKeyId" _ -> Nothing <$ prohibited "conf: incorrect state" - forM_ req_ $ \(contactReq, reqPQ, srvs, recipientConnInfo) -> do + forM_ req_ $ \(connReq, pqSupport, srvs, cInfo) -> do g <- asks random - invId <- withStore c $ \db -> createInvitation db g NewInvitation {contactConnId = connId, contactReq, recipientConnInfo} - notify $ REQ invId reqPQ srvs recipientConnInfo + let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo} + invId <- withStore c $ \db -> createInvitation db g newInv + notify $ REQ invId pqSupport srvs cInfo _ -> prohibited "inv: sent to message conn" where pqSupported (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible agentVersion) = diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 55b504fff..0095757c6 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -628,14 +628,14 @@ data AcceptedConfirmation = AcceptedConfirmation data NewInvitation = NewInvitation { contactConnId :: ConnId, - contactReq :: ContactRequest, + connReq :: ContactRequest, recipientConnInfo :: ConnInfo } data Invitation = Invitation { invitationId :: InvitationId, contactConnId_ :: Maybe ConnId, - contactReq :: ContactRequest, + connReq :: ContactRequest, recipientConnInfo :: ConnInfo, ownConnInfo :: Maybe ConnInfo, accepted :: Bool diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index dfc84ffb3..b828196bc 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -872,7 +872,7 @@ removeConfirmations db connId = (Only connId) createInvitation :: DB.Connection -> TVar ChaChaDRG -> NewInvitation -> IO (Either StoreError InvitationId) -createInvitation db gVar NewInvitation {contactConnId, contactReq, recipientConnInfo} = +createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInfo} = createWithRandomId db gVar $ \invitationId -> DB.execute db @@ -880,7 +880,7 @@ createInvitation db gVar NewInvitation {contactConnId, contactReq, recipientConn INSERT INTO conn_invitations (invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0); |] - (Binary invitationId, contactConnId, contactReq, Binary recipientConnInfo) + (Binary invitationId, contactConnId, connReq, Binary recipientConnInfo) getInvitation :: DB.Connection -> String -> InvitationId -> IO (Either StoreError Invitation) getInvitation db cxt invitationId = @@ -895,8 +895,8 @@ getInvitation db cxt invitationId = |] (Only (Binary invitationId)) where - invitation (contactConnId_, contactReq, recipientConnInfo, ownConnInfo, BI accepted) = - Invitation {invitationId, contactConnId_, contactReq, recipientConnInfo, ownConnInfo, accepted} + invitation (contactConnId_, connReq, recipientConnInfo, ownConnInfo, BI accepted) = + Invitation {invitationId, contactConnId_, connReq, recipientConnInfo, ownConnInfo, accepted} acceptInvitation :: DB.Connection -> InvitationId -> ConnInfo -> IO () acceptInvitation db invitationId ownConnInfo = From 95de67a05245d0a447be4085f81f0977681215bd Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 07:42:47 +0000 Subject: [PATCH 35/81] refactor --- src/Simplex/Messaging/Agent.hs | 71 ++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 33 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 42925c20c..98c0ca975 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3312,13 +3312,13 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar decryptClientMessage e2eDh clientMsg >>= \case (SMP.PHConfirmation senderKey, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) -> smpConfirmation srvMsgId conn (Just senderKey) e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack - (SMP.PHEmpty, e@AgentInvitationDR {}) -> - smpInvitation srvMsgId conn e phVer >> ack (SMP.PHEmpty, AgentConfirmation {e2eEncryption_, encConnInfo, agentVersion}) | senderCanSecure queueMode -> smpConfirmation srvMsgId conn Nothing e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack | otherwise -> prohibited "handshake: missing sender key" >> ack - (SMP.PHEmpty, e@AgentInvitation {}) -> - smpInvitation srvMsgId conn e phVer >> ack + (SMP.PHEmpty, AgentInvitation {connReq, connInfo}) -> + smpInvitation srvMsgId conn connReq connInfo >> ack + (SMP.PHEmpty, AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo}) -> + smpInvitationDR srvMsgId conn agentVersion e2eSndParams ratchetKeyId encConnInfo phVer >> ack _ -> prohibited "handshake: incorrect state" >> ack (Just e2eDh, Nothing) -> do decryptClientMessage e2eDh clientMsg >>= \case @@ -3751,43 +3751,48 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- owner receiving a contact request: a classic AgentInvitation, or an address-DR AgentInvitationDR -- (message 1) that establishes the ratchet now - smpInvitation :: SMP.MsgId -> Connection c -> AgentMsgEnvelope -> VersionSMPC -> AM () - smpInvitation srvMsgId conn' envelope phVer = do + smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM () + smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData _) cInfo = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId case conn' of ContactConnection {} -> do - req_ <- case envelope of - AgentInvitation {connReq = connReq@(CRInvitationUri crData _), connInfo} -> do - -- show connection request even if invitation via contact address is not compatible. - -- in case invitation not compatible, assume there is no PQ encryption support. - pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq - pure $ Just (CRInvitation connReq, pqSupport, L.map qServer $ crSmpQueues crData, connInfo) - AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} -> do - checkConfVersions agentVersion phVer - let ConnData {pqSupport} = toConnData conn' - withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case - Right (rkId', pk1, pk2, pKem) | rkId' == ratchetKeyId -> do - RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo - case agentMsgBody_ of - Right agentMsgBody -> - parseMessage agentMsgBody >>= \case - AgentConnInfoReply (replyQInfo :| _) reqConnInfo -> - let dr = DRInvitation {ratchetState = rc', replyQueue = replyQInfo, agentVersion, pqSupport = pqSupport'} - in pure $ Just (CRInvitationDR dr, pqCapability, qServer replyQInfo :| [], reqConnInfo) - _ -> Nothing <$ prohibited "addr inv: not AgentConnInfoReply" - _ -> Nothing <$ prohibited "addr inv: decrypt error" - _ -> Nothing <$ prohibited "addr inv: unknown ratchetKeyId" - _ -> Nothing <$ prohibited "conf: incorrect state" - forM_ req_ $ \(connReq, pqSupport, srvs, cInfo) -> do - g <- asks random - let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo} - invId <- withStore c $ \db -> createInvitation db g newInv - notify $ REQ invId pqSupport srvs cInfo + -- show connection request even if invitaion via contact address is not compatible. + -- in case invitation not compatible, assume there is no PQ encryption support. + pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq + storeInvitation (CRInvitation connReq) pqSupport (L.map qServer $ crSmpQueues crData) cInfo _ -> prohibited "inv: sent to message conn" where pqSupported (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible agentVersion) = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just v) + storeInvitation :: ContactRequest -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AM () + storeInvitation connReq pqSupport srvs cInfo = do + g <- asks random + let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo} + invId <- withStore c $ \db -> createInvitation db g newInv + notify $ REQ invId pqSupport srvs cInfo + + smpInvitationDR :: SMP.MsgId -> Connection c -> VersionSMPA -> CR.SndE2ERatchetParams 'C.X448 -> RatchetKeyId -> ByteString -> VersionSMPC -> AM () + smpInvitationDR srvMsgId conn' agentVersion e2eSndParams ratchetKeyId encConnInfo phVer = do + logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId + case conn' of + ContactConnection {} -> do + checkConfVersions agentVersion phVer + let ConnData {pqSupport} = toConnData conn' + withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case + Right (rkId', pk1, pk2, pKem) | rkId' == ratchetKeyId -> do + RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo + case agentMsgBody_ of + Right agentMsgBody -> + parseMessage agentMsgBody >>= \case + AgentConnInfoReply (replyQInfo :| _) reqConnInfo -> + let dr = DRInvitation {ratchetState = rc', replyQueue = replyQInfo, agentVersion, pqSupport = pqSupport'} + in storeInvitation (CRInvitationDR dr) pqCapability (qServer replyQInfo :| []) reqConnInfo + _ -> prohibited "addr inv: not AgentConnInfoReply" + _ -> prohibited "addr inv: decrypt error" + _ -> prohibited "addr inv: unknown ratchetKeyId" + _ -> prohibited "inv: sent to message conn" + qDuplex :: Connection c -> String -> (Connection 'CDuplex -> AM a) -> AM a qDuplex conn' name action = case conn' of DuplexConnection {} -> action conn' From 7bc3523d1cb7c392ef9435ed6aee2f8275d79c75 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 08:44:11 +0100 Subject: [PATCH 36/81] comment --- src/Simplex/Messaging/Agent.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 98c0ca975..a33f2f443 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3749,8 +3749,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar when (isNothing rcSnd) . void $ enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} (EREADY lastExternalSndId) - -- owner receiving a contact request: a classic AgentInvitation, or an address-DR AgentInvitationDR - -- (message 1) that establishes the ratchet now smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM () smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData _) cInfo = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId From 7b98f398122043c52da9ac16415aad755e0b9241 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 09:22:34 +0100 Subject: [PATCH 37/81] puns --- src/Simplex/Messaging/Agent.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index a33f2f443..c8a104888 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1411,7 +1411,7 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar -- reports in REQ - independent of the enable choice). The ratchet is not yet persisted - the caller stores it. data RcvRatchetInit = RcvRatchetInit { decrypted :: Either C.CryptoError ByteString, - ratchet :: CR.RatchetX448, + ratchetState :: CR.RatchetX448, connPQSupport :: PQSupport, pqCapability :: PQSupport } @@ -1429,14 +1429,14 @@ initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetPar rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} pqCapability = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) - pqSupport' = pqSupport `CR.pqSupportAnd` pqCapability - rc = CR.initRcvRatchet rcVs pk2 rcParams pqSupport' + connPQSupport = pqSupport `CR.pqSupportAnd` pqCapability + rc = CR.initRcvRatchet rcVs pk2 rcParams connPQSupport g <- asks random - (agentMsgBody_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + (agentMsgBody_, ratchetState, skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo case skipped of CR.SMDNoChange -> pure () _ -> logWarn "conf: skipped confirmations" - pure RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} + pure RcvRatchetInit {decrypted = agentMsgBody_, ratchetState, connPQSupport, pqCapability} connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of @@ -3546,8 +3546,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar init_ <- case e2eEncryption of Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) - RcvRatchetInit {decrypted, ratchet, connPQSupport} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo - pure $ Just (decrypted, ratchet, connPQSupport) + RcvRatchetInit {decrypted, ratchetState, connPQSupport} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + pure $ Just (decrypted, ratchetState, connPQSupport) Nothing -> withStore' c (`getRatchet` connId) >>= \case Left _ -> Nothing <$ prohibited "conf: incorrect state" Right rc -> do @@ -3779,13 +3779,13 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let ConnData {pqSupport} = toConnData conn' withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case Right (rkId', pk1, pk2, pKem) | rkId' == ratchetKeyId -> do - RcvRatchetInit {decrypted = agentMsgBody_, ratchet = rc', connPQSupport = pqSupport', pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo + RcvRatchetInit {decrypted = agentMsgBody_, ratchetState, connPQSupport, pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case - AgentConnInfoReply (replyQInfo :| _) reqConnInfo -> - let dr = DRInvitation {ratchetState = rc', replyQueue = replyQInfo, agentVersion, pqSupport = pqSupport'} - in storeInvitation (CRInvitationDR dr) pqCapability (qServer replyQInfo :| []) reqConnInfo + AgentConnInfoReply (replyQueue :| _) reqConnInfo -> + let dr = DRInvitation {ratchetState, replyQueue, agentVersion, pqSupport = connPQSupport} + in storeInvitation (CRInvitationDR dr) pqCapability (qServer replyQueue :| []) reqConnInfo _ -> prohibited "addr inv: not AgentConnInfoReply" _ -> prohibited "addr inv: decrypt error" _ -> prohibited "addr inv: unknown ratchetKeyId" From 189403838998c2bc8d43c23f318df68c11eae72b Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 08:38:46 +0000 Subject: [PATCH 38/81] get correct key --- src/Simplex/Messaging/Agent.hs | 13 ++++--------- src/Simplex/Messaging/Agent/Store/AgentStore.hs | 13 +++++++++++++ 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index c8a104888..03b4a7945 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1406,9 +1406,6 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar liftIO $ createSndRatchet db connId rc e2eSndParams pure e2eSndParams --- the result of initRcvRatchetDecrypt. connPQSupport is the enable choice clamped to the negotiated versions --- (it seeds the ratchet); pqCapability is whether the versions support PQ at all (the value smpInvitation --- reports in REQ - independent of the enable choice). The ratchet is not yet persisted - the caller stores it. data RcvRatchetInit = RcvRatchetInit { decrypted :: Either C.CryptoError ByteString, ratchetState :: CR.RatchetX448, @@ -1420,8 +1417,6 @@ data JoinInvitationReq = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport | JIRInvitationDR DRInvitation --- completes the X3DH receive, initializes the receive ratchet, and decrypts the first inbound ratchet message --- (the initiator's confirmation reply, or the DR owner's received invitation); the two differ only in the key source. initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM RcvRatchetInit initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config @@ -3777,8 +3772,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar ContactConnection {} -> do checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' - withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case - Right (rkId', pk1, pk2, pKem) | rkId' == ratchetKeyId -> do + withStore' c (\db -> getAddressRatchetKeys db connId ratchetKeyId) >>= \case + Right (pk1, pk2, pKem) -> do RcvRatchetInit {decrypted = agentMsgBody_, ratchetState, connPQSupport, pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> @@ -3787,8 +3782,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let dr = DRInvitation {ratchetState, replyQueue, agentVersion, pqSupport = connPQSupport} in storeInvitation (CRInvitationDR dr) pqCapability (qServer replyQueue :| []) reqConnInfo _ -> prohibited "addr inv: not AgentConnInfoReply" - _ -> prohibited "addr inv: decrypt error" - _ -> prohibited "addr inv: unknown ratchetKeyId" + Left _ -> prohibited "addr inv: decrypt error" + Left _ -> prohibited "addr inv: unknown ratchetKeyId" _ -> prohibited "inv: sent to message conn" qDuplex :: Connection c -> String -> (Connection 'CDuplex -> AM a) -> AM a diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index b828196bc..2ef21f32b 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -154,6 +154,7 @@ module Simplex.Messaging.Agent.Store.AgentStore setRatchetX3dhKeys, createAddressRatchetKeys, getAddressRatchetKeysByConnId, + getAddressRatchetKeys, createSndRatchet, getSndRatchet, createRatchet, @@ -1411,6 +1412,18 @@ getAddressRatchetKeysByConnId db connId = |] (Only connId) +getAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) +getAddressRatchetKeys db connId ratchetKeyId = + firstRow id SEX3dhKeysNotFound $ + DB.query + db + [sql| + SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem + FROM address_ratchet_keys + WHERE conn_id = ? AND ratchet_key_id = ? + |] + (connId, ratchetKeyId) + createSndRatchet :: DB.Connection -> ConnId -> RatchetX448 -> CR.AE2ERatchetParams 'C.X448 -> IO () createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetParams _ x3dhPubKey1 x3dhPubKey2 pqPubKem)) = DB.execute From 50e681ec3bd472f7b60b249c28135e1c49ef1969 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 09:45:34 +0100 Subject: [PATCH 39/81] rename --- src/Simplex/Messaging/Agent.hs | 2 +- src/Simplex/Messaging/Agent/Store/AgentStore.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 03b4a7945..c365a8f0b 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1144,7 +1144,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData = Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation" preserveAddressRatchetKeys :: UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) preserveAddressRatchetKeys ud@(UserContactLinkData ucd) = - withStore' c (`getAddressRatchetKeysByConnId` connId) >>= \case + withStore' c (`getCurrentAddressRatchetKeys` connId) >>= \case Left _ -> pure ud Right (ratchetKeyId, pk1, pk2, pKem) -> do e2eVR <- asks $ e2eEncryptVRange . config diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 2ef21f32b..104b3cd37 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -153,7 +153,7 @@ module Simplex.Messaging.Agent.Store.AgentStore getRatchetX3dhKeys, setRatchetX3dhKeys, createAddressRatchetKeys, - getAddressRatchetKeysByConnId, + getCurrentAddressRatchetKeys, getAddressRatchetKeys, createSndRatchet, getSndRatchet, @@ -1400,8 +1400,8 @@ createAddressRatchetKeys db connId ratchetKeyId x3dhPrivKey1 x3dhPrivKey2 pqPriv |] (connId, ratchetKeyId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) -getAddressRatchetKeysByConnId :: DB.Connection -> ConnId -> IO (Either StoreError (RatchetKeyId, C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) -getAddressRatchetKeysByConnId db connId = +getCurrentAddressRatchetKeys :: DB.Connection -> ConnId -> IO (Either StoreError (RatchetKeyId, C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) +getCurrentAddressRatchetKeys db connId = firstRow id SEX3dhKeysNotFound $ DB.query db From 45c3192ce241f8556372efc18b1a3ac8e25b611e Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 10:01:37 +0000 Subject: [PATCH 40/81] add autoincrement --- src/Simplex/Messaging/Agent/Store/AgentStore.hs | 2 ++ .../Agent/Store/SQLite/Migrations/M20260712_address_dr.hs | 2 +- .../Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql | 2 +- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 104b3cd37..5dfd797a8 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -1409,6 +1409,8 @@ getCurrentAddressRatchetKeys db connId = SELECT ratchet_key_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem FROM address_ratchet_keys WHERE conn_id = ? + ORDER BY address_ratchet_key_id DESC + LIMIT 1 |] (Only connId) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs index dca0897f4..fa111f58e 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs @@ -9,7 +9,7 @@ m20260712_address_dr :: Query m20260712_address_dr = [sql| CREATE TABLE address_ratchet_keys( - address_ratchet_key_id INTEGER PRIMARY KEY, + address_ratchet_key_id INTEGER PRIMARY KEY AUTOINCREMENT, conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, ratchet_key_id BLOB NOT NULL, x3dh_priv_key_1 BLOB NOT NULL, diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index b98e57f1f..b349b18a2 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -466,7 +466,7 @@ CREATE TABLE client_services( FOREIGN KEY(host, port) REFERENCES servers ON UPDATE CASCADE ON DELETE RESTRICT ) STRICT; CREATE TABLE address_ratchet_keys( - address_ratchet_key_id INTEGER PRIMARY KEY, + address_ratchet_key_id INTEGER PRIMARY KEY AUTOINCREMENT, conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, ratchet_key_id BLOB NOT NULL, x3dh_priv_key_1 BLOB NOT NULL, From 559c9ad7b8a364ddfc0410ee00c929f88bb4f280 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 11:16:17 +0100 Subject: [PATCH 41/81] refactor --- src/Simplex/Messaging/Agent.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index c365a8f0b..52f78527b 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3752,18 +3752,19 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- show connection request even if invitaion via contact address is not compatible. -- in case invitation not compatible, assume there is no PQ encryption support. pqSupport <- lift $ maybe PQSupportOff pqSupported <$> compatibleInvitationUri connReq - storeInvitation (CRInvitation connReq) pqSupport (L.map qServer $ crSmpQueues crData) cInfo + invId <- storeInvitation (CRInvitation connReq) cInfo + let srvs = L.map qServer $ crSmpQueues crData + notify $ REQ invId pqSupport srvs cInfo _ -> prohibited "inv: sent to message conn" where pqSupported (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible agentVersion) = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just v) - storeInvitation :: ContactRequest -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AM () - storeInvitation connReq pqSupport srvs cInfo = do + storeInvitation :: ContactRequest -> ConnInfo -> AM InvitationId + storeInvitation connReq recipientConnInfo = do g <- asks random - let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo} - invId <- withStore c $ \db -> createInvitation db g newInv - notify $ REQ invId pqSupport srvs cInfo + let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo} + withStore c $ \db -> createInvitation db g newInv smpInvitationDR :: SMP.MsgId -> Connection c -> VersionSMPA -> CR.SndE2ERatchetParams 'C.X448 -> RatchetKeyId -> ByteString -> VersionSMPC -> AM () smpInvitationDR srvMsgId conn' agentVersion e2eSndParams ratchetKeyId encConnInfo phVer = do @@ -3778,9 +3779,10 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case - AgentConnInfoReply (replyQueue :| _) reqConnInfo -> + AgentConnInfoReply (replyQueue :| _) cInfo -> do let dr = DRInvitation {ratchetState, replyQueue, agentVersion, pqSupport = connPQSupport} - in storeInvitation (CRInvitationDR dr) pqCapability (qServer replyQueue :| []) reqConnInfo + invId <- storeInvitation (CRInvitationDR dr) cInfo + notify $ REQ invId pqCapability (qServer replyQueue :| []) cInfo _ -> prohibited "addr inv: not AgentConnInfoReply" Left _ -> prohibited "addr inv: decrypt error" Left _ -> prohibited "addr inv: unknown ratchetKeyId" From d8fb2c682a4c0a6573f3fba01a604138842dbfee Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 10:31:32 +0000 Subject: [PATCH 42/81] move --- src/Simplex/Messaging/Agent.hs | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 52f78527b..2484e43bf 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1417,22 +1417,6 @@ data JoinInvitationReq = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport | JIRInvitationDR DRInvitation -initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM RcvRatchetInit -initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do - e2eEncryptVRange <- asks $ e2eEncryptVRange . config - unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION - rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams - let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} - pqCapability = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) - connPQSupport = pqSupport `CR.pqSupportAnd` pqCapability - rc = CR.initRcvRatchet rcVs pk2 rcParams connPQSupport - g <- asks random - (agentMsgBody_, ratchetState, skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo - case skipped of - CR.SMDNoChange -> pure () - _ -> logWarn "conf: skipped confirmations" - pure RcvRatchetInit {decrypted = agentMsgBody_, ratchetState, connPQSupport, pqCapability} - connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of CRInvitationUri {} -> invPQSupported <$$> compatibleInvitationUri cReq @@ -3601,6 +3585,22 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let srvs = map qServer $ smpReplyQueues senderConf notify $ CONF confId agreedPQSupport srvs connInfo + initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM RcvRatchetInit + initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do + e2eEncryptVRange <- asks $ e2eEncryptVRange . config + unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION + rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams + let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} + pqCapability = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) + connPQSupport = pqSupport `CR.pqSupportAnd` pqCapability + rc = CR.initRcvRatchet rcVs pk2 rcParams connPQSupport + g <- asks random + (agentMsgBody_, ratchetState, skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + case skipped of + CR.SMDNoChange -> pure () + _ -> logWarn "conf: skipped confirmations" + pure RcvRatchetInit {decrypted = agentMsgBody_, ratchetState, connPQSupport, pqCapability} + helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId From 20a622915a8767d95b6f1589517082098bdb609c Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 17:43:43 +0100 Subject: [PATCH 43/81] move back --- src/Simplex/Messaging/Agent.hs | 48 ++++++++++++++++------------------ 1 file changed, 23 insertions(+), 25 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 2484e43bf..04cdf9e4b 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3537,9 +3537,31 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do - processConf agentVersion pqSupport pqSupport' rc' SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} + processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2 + where + processConf connInfo senderConf = do + let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} + g <- asks random + confId <- withStore c $ \db -> do + setConnAgentVersion db connId agentVersion + when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport' + -- / + -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), + -- initiating party initializes ratchet on processing confirmation; + -- previously, it initialized ratchet on allowConnection; + -- this is to support decryption of messages that may be received before allowConnection + liftIO $ do + createRatchet db connId rc' + let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq + SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf + dhSecret = C.dh' e2ePubKey' e2ePrivKey' + setRcvQueueConfirmedE2E db rq dhSecret $ min v v' + -- / + createConfirmation db g newConfirmation + let srvs = map qServer $ smpReplyQueues senderConf + notify $ CONF confId pqSupport' srvs connInfo _ -> prohibited "conf: decrypt error" -- party accepting connection (DuplexConnection _ (rq'@RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do @@ -3561,30 +3583,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - -- pqSupport is the connection's current support, agreedPQSupport the value negotiated for the ratchet - processConf :: VersionSMPA -> PQSupport -> PQSupport -> CR.RatchetX448 -> SMPConfirmation -> AM () - processConf agentVersion pqSupport agreedPQSupport rc' senderConf@SMPConfirmation {connInfo} = do - let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} - g <- asks random - confId <- withStore c $ \db -> do - setConnAgentVersion db connId agentVersion - when (pqSupport /= agreedPQSupport) $ setConnPQSupport db connId agreedPQSupport - -- / - -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), - -- initiating party initializes ratchet on processing confirmation; - -- previously, it initialized ratchet on allowConnection; - -- this is to support decryption of messages that may be received before allowConnection - liftIO $ do - createRatchet db connId rc' - let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq - SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf - dhSecret = C.dh' e2ePubKey' e2ePrivKey' - setRcvQueueConfirmedE2E db rq dhSecret $ min v v' - -- / - createConfirmation db g newConfirmation - let srvs = map qServer $ smpReplyQueues senderConf - notify $ CONF confId agreedPQSupport srvs connInfo - initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM RcvRatchetInit initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config From d4224eac5a34548192ba007dba453d24828bfcf6 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 18:35:50 +0100 Subject: [PATCH 44/81] simplify --- src/Simplex/Messaging/Agent.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 04cdf9e4b..bae8eb415 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3519,27 +3519,28 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar checkConfVersions agentVersion phVer let ConnData {pqSupport} = toConnData conn' case status of - New -> case (conn', e2eEncryption) of + New -> case conn' of -- initiating party (Just: seed the receive ratchet from X3DH), or DR requester (Nothing: reuse the ratchet built in join) - (RcvConnection _ _, _) -> do - init_ <- case e2eEncryption of + RcvConnection {} -> do + case e2eEncryption of Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) RcvRatchetInit {decrypted, ratchetState, connPQSupport} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo - pure $ Just (decrypted, ratchetState, connPQSupport) + processDecrypted decrypted ratchetState connPQSupport Nothing -> withStore' c (`getRatchet` connId) >>= \case - Left _ -> Nothing <$ prohibited "conf: incorrect state" + Left _ -> prohibited "conf: incorrect state" Right rc -> do g <- asks random - (decrypted, rc', _) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo - pure $ Just (decrypted, rc', pqSupport) - forM_ init_ $ \(agentMsgBody_, rc', pqSupport') -> case agentMsgBody_ of - Right agentMsgBody -> - parseMessage agentMsgBody >>= \case + (agentMsgBody_, rc', _) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + processDecrypted agentMsgBody_ rc' pqSupport + where + processDecrypted agentMsgBody_ rc' pqSupport' = case agentMsgBody_ of + Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2 + Left _ -> prohibited "conf: decrypt error" where processConf connInfo senderConf = do let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} @@ -3562,9 +3563,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar createConfirmation db g newConfirmation let srvs = map qServer $ smpReplyQueues senderConf notify $ CONF confId pqSupport' srvs connInfo - _ -> prohibited "conf: decrypt error" -- party accepting connection - (DuplexConnection _ (rq'@RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do + DuplexConnection _ (rq'@RcvQueue {smpClientVersion = v'} :| _) _ | isNothing e2eEncryption -> do g <- asks random (agentMsgBody, pqEncryption) <- withStore c $ \db -> runExceptT $ agentRatchetDecrypt g db connId encConnInfo parseMessage agentMsgBody >>= \case From 64566645f55e63b25bb2eb5c66c852c6e977e814 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 18:52:46 +0100 Subject: [PATCH 45/81] rename --- src/Simplex/Messaging/Agent.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index bae8eb415..8874e5e01 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1407,7 +1407,7 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar pure e2eSndParams data RcvRatchetInit = RcvRatchetInit - { decrypted :: Either C.CryptoError ByteString, + { agentMsgBody_ :: Either C.CryptoError ByteString, ratchetState :: CR.RatchetX448, connPQSupport :: PQSupport, pqCapability :: PQSupport @@ -3525,8 +3525,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case e2eEncryption of Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) - RcvRatchetInit {decrypted, ratchetState, connPQSupport} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo - processDecrypted decrypted ratchetState connPQSupport + RcvRatchetInit {agentMsgBody_, ratchetState, connPQSupport} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + processDecrypted agentMsgBody_ ratchetState connPQSupport Nothing -> withStore' c (`getRatchet` connId) >>= \case Left _ -> prohibited "conf: incorrect state" Right rc -> do @@ -3597,7 +3597,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case skipped of CR.SMDNoChange -> pure () _ -> logWarn "conf: skipped confirmations" - pure RcvRatchetInit {decrypted = agentMsgBody_, ratchetState, connPQSupport, pqCapability} + pure RcvRatchetInit {agentMsgBody_, ratchetState, connPQSupport, pqCapability} helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do @@ -3773,7 +3773,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let ConnData {pqSupport} = toConnData conn' withStore' c (\db -> getAddressRatchetKeys db connId ratchetKeyId) >>= \case Right (pk1, pk2, pKem) -> do - RcvRatchetInit {decrypted = agentMsgBody_, ratchetState, connPQSupport, pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo + RcvRatchetInit {agentMsgBody_, ratchetState, connPQSupport, pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case From ec6959afbc5abf580c804a8595e5215a791f5aa5 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 18:14:56 +0000 Subject: [PATCH 46/81] refactor --- src/Simplex/Messaging/Agent.hs | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 8874e5e01..7d5652148 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1406,13 +1406,6 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar liftIO $ createSndRatchet db connId rc e2eSndParams pure e2eSndParams -data RcvRatchetInit = RcvRatchetInit - { agentMsgBody_ :: Either C.CryptoError ByteString, - ratchetState :: CR.RatchetX448, - connPQSupport :: PQSupport, - pqCapability :: PQSupport - } - data JoinInvitationReq = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport | JIRInvitationDR DRInvitation @@ -3525,7 +3518,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case e2eEncryption of Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) - RcvRatchetInit {agentMsgBody_, ratchetState, connPQSupport} <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + (agentMsgBody_, ratchetState, connPQSupport) <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo processDecrypted agentMsgBody_ ratchetState connPQSupport Nothing -> withStore' c (`getRatchet` connId) >>= \case Left _ -> prohibited "conf: incorrect state" @@ -3583,21 +3576,20 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM RcvRatchetInit + initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} - pqCapability = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) - connPQSupport = pqSupport `CR.pqSupportAnd` pqCapability + connPQSupport = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) rc = CR.initRcvRatchet rcVs pk2 rcParams connPQSupport g <- asks random (agentMsgBody_, ratchetState, skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo case skipped of CR.SMDNoChange -> pure () _ -> logWarn "conf: skipped confirmations" - pure RcvRatchetInit {agentMsgBody_, ratchetState, connPQSupport, pqCapability} + pure (agentMsgBody_, ratchetState, connPQSupport) helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do @@ -3773,18 +3765,22 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let ConnData {pqSupport} = toConnData conn' withStore' c (\db -> getAddressRatchetKeys db connId ratchetKeyId) >>= \case Right (pk1, pk2, pKem) -> do - RcvRatchetInit {agentMsgBody_, ratchetState, connPQSupport, pqCapability} <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo + (agentMsgBody_, ratchetState, connPQSupport) <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply (replyQueue :| _) cInfo -> do let dr = DRInvitation {ratchetState, replyQueue, agentVersion, pqSupport = connPQSupport} invId <- storeInvitation (CRInvitationDR dr) cInfo - notify $ REQ invId pqCapability (qServer replyQueue :| []) cInfo + notify $ REQ invId pqSupported (qServer replyQueue :| []) cInfo _ -> prohibited "addr inv: not AgentConnInfoReply" Left _ -> prohibited "addr inv: decrypt error" Left _ -> prohibited "addr inv: unknown ratchetKeyId" _ -> prohibited "inv: sent to message conn" + where + pqSupported = case e2eSndParams of + CR.AE2ERatchetParams _ (CR.E2ERatchetParams e2eVersion _ _ _) -> + PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) qDuplex :: Connection c -> String -> (Connection 'CDuplex -> AM a) -> AM a qDuplex conn' name action = case conn' of From 76f7b03b520e5685fbd11c138057cb6a5c3ddd08 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 19:17:07 +0100 Subject: [PATCH 47/81] tuple --- src/Simplex/Messaging/Agent.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 7d5652148..21d326fb5 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3518,16 +3518,15 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case e2eEncryption of Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) - (agentMsgBody_, ratchetState, connPQSupport) <- initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo - processDecrypted agentMsgBody_ ratchetState connPQSupport + processDecrypted =<< initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo Nothing -> withStore' c (`getRatchet` connId) >>= \case Left _ -> prohibited "conf: incorrect state" Right rc -> do g <- asks random (agentMsgBody_, rc', _) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo - processDecrypted agentMsgBody_ rc' pqSupport + processDecrypted (agentMsgBody_, rc', pqSupport) where - processDecrypted agentMsgBody_ rc' pqSupport' = case agentMsgBody_ of + processDecrypted (agentMsgBody_, rc', pqSupport') = case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case AgentConnInfoReply smpQueues connInfo -> do processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} From cf3ef7677a0afd26d9a08d6d1534b1e09c6f65d3 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 19:56:38 +0100 Subject: [PATCH 48/81] comment --- src/Simplex/Messaging/Agent.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 21d326fb5..76a960647 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3513,13 +3513,13 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let ConnData {pqSupport} = toConnData conn' case status of New -> case conn' of - -- initiating party (Just: seed the receive ratchet from X3DH), or DR requester (Nothing: reuse the ratchet built in join) + -- party initiating connection RcvConnection {} -> do case e2eEncryption of - Just e2eSndParams -> do + Just e2eSndParams -> do -- create ratchet from sent invitation and received confirmation keys keys <- withStore c (`getRatchetX3dhKeys` connId) processDecrypted =<< initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo - Nothing -> withStore' c (`getRatchet` connId) >>= \case + Nothing -> withStore' c (`getRatchet` connId) >>= \case -- use ratchet initialized from published ratchet keys during invitation Left _ -> prohibited "conf: incorrect state" Right rc -> do g <- asks random From bb6e375461715c22d81c5f0e41beda38fcd0d813 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 19:08:52 +0000 Subject: [PATCH 49/81] split decryption --- src/Simplex/Messaging/Agent.hs | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 76a960647..7eb6a30e9 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3518,12 +3518,13 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case e2eEncryption of Just e2eSndParams -> do -- create ratchet from sent invitation and received confirmation keys keys <- withStore c (`getRatchetX3dhKeys` connId) - processDecrypted =<< initRcvRatchetDecrypt agentVersion pqSupport keys e2eSndParams encConnInfo + (rc, connPQSupport) <- initRcvRatchet_ agentVersion pqSupport keys e2eSndParams + (agentMsgBody_, rc') <- decryptConnInfo rc encConnInfo + processDecrypted (agentMsgBody_, rc', connPQSupport) Nothing -> withStore' c (`getRatchet` connId) >>= \case -- use ratchet initialized from published ratchet keys during invitation Left _ -> prohibited "conf: incorrect state" Right rc -> do - g <- asks random - (agentMsgBody_, rc', _) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + (agentMsgBody_, rc') <- decryptConnInfo rc encConnInfo processDecrypted (agentMsgBody_, rc', pqSupport) where processDecrypted (agentMsgBody_, rc', pqSupport') = case agentMsgBody_ of @@ -3575,20 +3576,24 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - initRcvRatchetDecrypt :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448, PQSupport) - initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) encConnInfo = do + initRcvRatchet_ :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> AM (CR.RatchetX448, PQSupport) + initRcvRatchet_ agentVersion pqSupport (pk1, pk2, pKem) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eSndParams let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange} connPQSupport = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion) rc = CR.initRcvRatchet rcVs pk2 rcParams connPQSupport + pure (rc, connPQSupport) + + decryptConnInfo :: CR.RatchetX448 -> ByteString -> AM (Either C.CryptoError ByteString, CR.RatchetX448) + decryptConnInfo rc encConnInfo = do g <- asks random - (agentMsgBody_, ratchetState, skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + (agentMsgBody_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo case skipped of CR.SMDNoChange -> pure () _ -> logWarn "conf: skipped confirmations" - pure (agentMsgBody_, ratchetState, connPQSupport) + pure (agentMsgBody_, rc') helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do @@ -3764,7 +3769,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar let ConnData {pqSupport} = toConnData conn' withStore' c (\db -> getAddressRatchetKeys db connId ratchetKeyId) >>= \case Right (pk1, pk2, pKem) -> do - (agentMsgBody_, ratchetState, connPQSupport) <- initRcvRatchetDecrypt agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams encConnInfo + (rc, connPQSupport) <- initRcvRatchet_ agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams + (agentMsgBody_, ratchetState) <- decryptConnInfo rc encConnInfo case agentMsgBody_ of Right agentMsgBody -> parseMessage agentMsgBody >>= \case From ce48e6b5598bdf7c0a4f54536d87d7053aa3ffa9 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 20:27:05 +0100 Subject: [PATCH 50/81] refactor --- src/Simplex/Messaging/Agent.hs | 26 ++++++++++++-------------- tests/AgentTests/FunctionalAPITests.hs | 18 +++++++++--------- 2 files changed, 21 insertions(+), 23 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 7eb6a30e9..41da7bc64 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -3518,24 +3518,22 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar case e2eEncryption of Just e2eSndParams -> do -- create ratchet from sent invitation and received confirmation keys keys <- withStore c (`getRatchetX3dhKeys` connId) - (rc, connPQSupport) <- initRcvRatchet_ agentVersion pqSupport keys e2eSndParams - (agentMsgBody_, rc') <- decryptConnInfo rc encConnInfo - processDecrypted (agentMsgBody_, rc', connPQSupport) + processConnInfo =<< initRcvRatchet_ agentVersion pqSupport keys e2eSndParams Nothing -> withStore' c (`getRatchet` connId) >>= \case -- use ratchet initialized from published ratchet keys during invitation Left _ -> prohibited "conf: incorrect state" - Right rc -> do - (agentMsgBody_, rc') <- decryptConnInfo rc encConnInfo - processDecrypted (agentMsgBody_, rc', pqSupport) + Right rc -> processConnInfo (rc, pqSupport) where - processDecrypted (agentMsgBody_, rc', pqSupport') = case agentMsgBody_ of - Right agentMsgBody -> parseMessage agentMsgBody >>= \case - AgentConnInfoReply smpQueues connInfo -> do - processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} - withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) - _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2 - Left _ -> prohibited "conf: decrypt error" + processConnInfo (rc, pqSupport') = do + (agentMsgBody_, rc') <- decryptConnInfo rc encConnInfo + case agentMsgBody_ of + Right agentMsgBody -> parseMessage agentMsgBody >>= \case + AgentConnInfoReply smpQueues connInfo -> do + processConf rc' connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion = phVer} + withStore' c $ \db -> updateRcvMsgHash db connId 1 (InternalRcvId 0) (C.sha256Hash agentMsgBody) + _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2 + Left _ -> prohibited "conf: decrypt error" where - processConf connInfo senderConf = do + processConf rc' connInfo senderConf = do let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'} g <- asks random confId <- withStore c $ \db -> do diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 890e2a2b0..6d9288c75 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -322,7 +322,7 @@ suspendConnection c = A.suspendConnection c NRMInteractive functionalAPITests :: (ASrvTransport, AStoreType) -> Spec functionalAPITests ps = do - describe "Establishing duplex connection" $ do + fdescribe "Establishing duplex connection" $ do testMatrix2 ps runAgentClientTest it "should connect when server with multiple identities is stored" $ withSmpServer ps testServerMultipleIdentities @@ -339,7 +339,7 @@ functionalAPITests ps = do testPQMatrix2 ps $ runAgentClientTestPQ False True describe "Establishing duplex connection v2, different Ratchet versions" $ testRatchetMatrix2 ps runAgentClientTest - describe "Establish duplex connection via contact address" $ + fdescribe "Establish duplex connection via contact address" $ testMatrix2 ps runAgentClientContactTest describe "Establish duplex connection via contact address, different PQ settings" $ do testPQMatrix2NoInv ps $ runAgentClientContactTestPQ False True PQSupportOn @@ -1050,13 +1050,13 @@ testContactDRMatrix ps = do describe "classic join, ratchet keys ignored" $ drRows False False describe "DR join, async accept (JOIN command)" $ drRows True True where - drRows useDR async = do - it "IKPQOff, dh join" $ runAgentClientContactDRTest_ async IKPQOff useDR PQSupportOff ps - it "IKPQOff, pq join" $ runAgentClientContactDRTest_ async IKPQOff useDR PQSupportOn ps - it "IKPQOn, dh join" $ runAgentClientContactDRTest_ async IKPQOn useDR PQSupportOff ps - it "IKPQOn, pq join" $ runAgentClientContactDRTest_ async IKPQOn useDR PQSupportOn ps - it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ async IKUsePQ useDR PQSupportOff ps - it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ async IKUsePQ useDR PQSupportOn ps + drRows useDR async' = do + it "IKPQOff, dh join" $ runAgentClientContactDRTest_ async' IKPQOff useDR PQSupportOff ps + it "IKPQOff, pq join" $ runAgentClientContactDRTest_ async' IKPQOff useDR PQSupportOn ps + it "IKPQOn, dh join" $ runAgentClientContactDRTest_ async' IKPQOn useDR PQSupportOff ps + it "IKPQOn, pq join" $ runAgentClientContactDRTest_ async' IKPQOn useDR PQSupportOn ps + it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ async' IKUsePQ useDR PQSupportOff ps + it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ async' IKUsePQ useDR PQSupportOn ps -- updating a DR address's mutable link data must preserve the stored ratchet keys, so requesters can still establish DR testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO () From 79a46838df3c6e9abcc8db864b2e5adf069c4901 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 19:54:15 +0000 Subject: [PATCH 51/81] rename --- src/Simplex/Messaging/Agent.hs | 8 ++++---- src/Simplex/Messaging/Agent/Protocol.hs | 8 ++++---- tests/AgentTests/ConnectionRequestTests.hs | 8 ++++---- tests/AgentTests/FunctionalAPITests.hs | 4 ++-- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 41da7bc64..b421d80ec 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -873,14 +873,14 @@ joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} c lift (compatibleInvitationUri cReqUri) >>= \case Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitation enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo Nothing -> throwE $ AGENT A_VERSION joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = lift (compatibleContactUri cReqUri) >>= \case Just (_, Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing when updateConn $ withStore' c $ \db -> updateNewConnJoin db connId connAgentVersion pqSupport enableNtfs - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitation enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo Nothing -> throwE $ AGENT A_VERSION allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM () @@ -1989,14 +1989,14 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do withServer' . tryCommand $ do (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink notify $ LDATA fixedData linkData - JOIN (JRInvitation enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do + JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do sqSecured <- joinConnSrvAsync c userId connId (JIRInvitation enableNtfs cReq pqEnc) connInfo subMode srv notify $ JOINED sqSecured -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. - JOIN (JRInvitation enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc) subMode connInfo -> noServer $ do + JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo Nothing pqEnc subMode srv diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 410296759..202c17656 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1835,7 +1835,7 @@ data DRInvitation = DRInvitation deriving (Show) data JoinRequest - = JRInvitation {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} + = JRConnReq {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} | JRInvitationDR DRInvitation deriving (Show) @@ -2174,14 +2174,14 @@ cryptoErrToSyncState = \case $(J.deriveJSON defaultJSON ''DRInvitation) --- JRInvitation must stay byte-identical to the pre-DR JOIN "ntfs cReq pqSup" for old/new client interop; pqSup +-- JRConnReq must stay byte-identical to the pre-DR JOIN "ntfs cReq pqSup" for old/new client interop; pqSup -- and subMode still default when a legacy command omits them. instance StrEncoding JoinRequest where strEncode = \case - JRInvitation ntfs cReq pqSup -> B.unwords [strEncode ntfs, strEncode cReq, strEncode pqSup] + JRConnReq ntfs cReq pqSup -> B.unwords [strEncode ntfs, strEncode cReq, strEncode pqSup] JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = - (JRInvitation <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff)) + (JRConnReq <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff)) <|> (JRInvitationDR <$> ((A.take =<< (A.decimal <* A.char '\n')) >>= either fail pure . J'.eitherDecodeStrict') <* A.space) -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 8832d6d5d..a341c1dd1 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -256,15 +256,15 @@ connectionRequestTests = queueV1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr) - it "JOIN command is backward compatible: JRInvitation is byte-identical to the pre-DR JOIN" $ do + it "JOIN command is backward compatible: JRConnReq is byte-identical to the pre-DR JOIN" $ do let uri = ACR SCMInvitation invConnRequest - cmd = JOIN (JRInvitation True uri PQSupportOff) SMSubscribe "hi" + cmd = JOIN (JRConnReq True uri PQSupportOff) SMSubscribe "hi" -- the pre-DR JOIN wire format: "JOIN " oldJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode PQSupportOff <> " " <> strEncode SMSubscribe <> " 2\nhi" serializeCommand cmd `shouldBe` oldJoin case parseAll dbCommandP oldJoin of - Right (JOIN JRInvitation {} _ _) -> pure () - r -> expectationFailure $ "expected JOIN JRInvitation, got " <> show r + Right (JOIN JRConnReq {} _ _) -> pure () + r -> expectationFailure $ "expected JOIN JRConnReq, got " <> show r (serializeCommand <$> parseAll dbCommandP oldJoin) `shouldBe` Right oldJoin -- a legacy JOIN omitting pqSup parses with the PQSupportOff default (re-serializing with pqSup present) let legacyJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode SMSubscribe <> " 2\nhi" diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 6d9288c75..93a899879 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -322,7 +322,7 @@ suspendConnection c = A.suspendConnection c NRMInteractive functionalAPITests :: (ASrvTransport, AStoreType) -> Spec functionalAPITests ps = do - fdescribe "Establishing duplex connection" $ do + describe "Establishing duplex connection" $ do testMatrix2 ps runAgentClientTest it "should connect when server with multiple identities is stored" $ withSmpServer ps testServerMultipleIdentities @@ -339,7 +339,7 @@ functionalAPITests ps = do testPQMatrix2 ps $ runAgentClientTestPQ False True describe "Establishing duplex connection v2, different Ratchet versions" $ testRatchetMatrix2 ps runAgentClientTest - fdescribe "Establish duplex connection via contact address" $ + describe "Establish duplex connection via contact address" $ testMatrix2 ps runAgentClientContactTest describe "Establish duplex connection via contact address, different PQ settings" $ do testPQMatrix2NoInv ps $ runAgentClientContactTestPQ False True PQSupportOn From 69f7c3fd7ffe2d450c0595587a2c163eda49e0a0 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 20:52:19 +0000 Subject: [PATCH 52/81] refactor --- src/Simplex/Messaging/Agent.hs | 113 +++++++++++++++++---------------- 1 file changed, 59 insertions(+), 54 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index b421d80ec..643842e69 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1346,55 +1346,54 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q -startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> JoinInvitationReq -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) -startJoinInvitation c userId connId sq_ = \case - JIRInvitation enableNtfs cReqUri pqSup -> - lift (compatibleInvitationUri cReqUri) >>= \case - Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) - g <- asks random - maxSupported <- asks $ maxVersion . e2eEncryptVRange . config - let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} - case sq_ of - -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out - -- e2ePubKey is always present, it's Maybe historically - Just sq@SndQueue {e2ePubKey = Just _k} -> do - e2eSndParams <- withStore c $ \db -> do - lockConnForUpdate db connId - getSndRatchet db connId v >>= \case - Right r -> pure $ Right $ snd r - Left e -> do - nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) - runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - pure (cData, sq, Just e2eSndParams, Nothing) - _ -> do - let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo - invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId - let lnkId_ = fst <$> invLink_ - sndKey_ = snd <$> invLink_ - (sq', e2eSndParams) <- createSndQueue "" qInfo sndKey_ $ \db -> createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - pure (cData, sq', Just e2eSndParams, lnkId_) - Nothing -> throwE $ AGENT A_VERSION - -- DR accept: the ratchet is already established (in the received invitation), so just persist it and send Q_B - JIRInvitationDR DRInvitation {ratchetState, replyQueue} -> do - sq <- case sq_ of - Just sq -> pure sq - Nothing -> do - clientVRange <- asks $ smpClientVRange . config - qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange - fst <$> createSndQueue connId qInfo Nothing (\db -> liftIO $ createRatchet db connId ratchetState) - SomeConn _ conn <- withStore c (`getConn` connId) - pure (toConnData conn, sq, Nothing, Nothing) - where - -- create the send queue and establish the send ratchet in one locked transaction (reusing sq_ on retry) - createSndQueue :: ConnId -> Compatible SMPQueueInfo -> Maybe C.APrivateAuthKey -> (DB.Connection -> ExceptT StoreError IO r) -> AM (SndQueue, r) - createSndQueue qCid qInfo sndKey_ establishRatchet = do - (q, _) <- lift $ newSndQueue userId qCid qInfo sndKey_ - withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - r <- establishRatchet db - sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (sq', r) +createSndQueue :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> ConnId -> Compatible SMPQueueInfo -> Maybe C.APrivateAuthKey -> (DB.Connection -> ExceptT StoreError IO r) -> AM (SndQueue, r) +createSndQueue c userId connId sq_ qCid qInfo sndKey_ establishRatchet = do + (q, _) <- lift $ newSndQueue userId qCid qInfo sndKey_ + withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + r <- establishRatchet db + sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ + pure (sq', r) + +startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Maybe SMP.LinkId) +startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = + lift (compatibleInvitationUri cReqUri) >>= \case + Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) + g <- asks random + maxSupported <- asks $ maxVersion . e2eEncryptVRange . config + let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} + case sq_ of + -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out + -- e2ePubKey is always present, it's Maybe historically + Just sq@SndQueue {e2ePubKey = Just _k} -> do + e2eSndParams <- withStore c $ \db -> do + lockConnForUpdate db connId + getSndRatchet db connId v >>= \case + Right r -> pure $ Right $ snd r + Left e -> do + nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) + runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams + pure (cData, sq, e2eSndParams, Nothing) + _ -> do + let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo + invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId + let lnkId_ = fst <$> invLink_ + sndKey_ = snd <$> invLink_ + (sq', e2eSndParams) <- createSndQueue c userId connId sq_ "" qInfo sndKey_ $ \db -> createRatchet_ db g connId maxSupported pqSupport e2eRcvParams + pure (cData, sq', e2eSndParams, lnkId_) + Nothing -> throwE $ AGENT A_VERSION + +startJoinInvitationDR :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> DRInvitation -> AM (ConnData, SndQueue) +startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue} = do + sq <- case sq_ of + Just sq -> pure sq + Nothing -> do + clientVRange <- asks $ smpClientVRange . config + qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange + fst <$> createSndQueue c userId connId sq_ connId qInfo Nothing (\db -> liftIO $ createRatchet db connId ratchetState) + SomeConn _ conn <- withStore c (`getConn` connId) + pure (toConnData conn, sq) createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do @@ -1453,8 +1452,8 @@ joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys where doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured doJoin rq_ sq_ = do - (cData, sq, params_, lnkId_) <- startJoinInvitation c userId connId sq_ (JIRInvitation enableNtfs inv pqSup) - secureConfirmQueue c nm cData rq_ sq srv cInfo params_ subMode + (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup + secureConfirmQueue c nm cData rq_ sq srv cInfo (Just e2eSndParams) subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case @@ -1535,7 +1534,13 @@ joinConnSrvAsync c userId connId joinReq cInfo subMode srv = do where doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured doJoin rq_ sq_ = do - (cData, sq, params_, lnkId_) <- startJoinInvitation c userId connId sq_ joinReq + (cData, sq, params_, lnkId_) <- case joinReq of + JIRInvitation enableNtfs inv pqSup -> do + (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup + pure (cData, sq, Just e2eSndParams, lnkId_) + JIRInvitationDR dr -> do + (cData, sq) <- startJoinInvitationDR c userId connId sq_ dr + pure (cData, sq, Nothing, Nothing) secureConfirmQueueAsync c cData rq_ sq srv cInfo params_ subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) @@ -1570,8 +1575,8 @@ acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode srv <- getNextSMPServer c userId [qServer replyQueue] SomeConn cType conn <- withStore c (`getConn` connId) let doJoin rq_ sq_ = do - (cData, sq, params_, _) <- startJoinInvitation c userId connId sq_ (JIRInvitationDR dr) - secureConfirmQueue c nm cData rq_ sq srv ownConnInfo params_ subMode + (cData, sq) <- startJoinInvitationDR c userId connId sq_ dr + secureConfirmQueue c nm cData rq_ sq srv ownConnInfo Nothing subMode case conn of NewConnection _ -> doJoin Nothing Nothing SndConnection _ sq -> doJoin Nothing (Just sq) From 1085b648a6cfccf9bcce200256fe2cfbb935fc58 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 22:00:07 +0100 Subject: [PATCH 53/81] move --- src/Simplex/Messaging/Agent.hs | 40 ++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 643842e69..1c4d40170 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1346,19 +1346,12 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q -createSndQueue :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> ConnId -> Compatible SMPQueueInfo -> Maybe C.APrivateAuthKey -> (DB.Connection -> ExceptT StoreError IO r) -> AM (SndQueue, r) -createSndQueue c userId connId sq_ qCid qInfo sndKey_ establishRatchet = do - (q, _) <- lift $ newSndQueue userId qCid qInfo sndKey_ - withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - r <- establishRatchet db - sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (sq', r) - startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Maybe SMP.LinkId) startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = lift (compatibleInvitationUri cReqUri) >>= \case Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do + -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out + -- e2ePubKey is always present, it's Maybe historically let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) g <- asks random maxSupported <- asks $ maxVersion . e2eEncryptVRange . config @@ -1384,16 +1377,14 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = pure (cData, sq', e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION -startJoinInvitationDR :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> DRInvitation -> AM (ConnData, SndQueue) -startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue} = do - sq <- case sq_ of - Just sq -> pure sq - Nothing -> do - clientVRange <- asks $ smpClientVRange . config - qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange - fst <$> createSndQueue c userId connId sq_ connId qInfo Nothing (\db -> liftIO $ createRatchet db connId ratchetState) - SomeConn _ conn <- withStore c (`getConn` connId) - pure (toConnData conn, sq) +createSndQueue :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> ConnId -> Compatible SMPQueueInfo -> Maybe C.APrivateAuthKey -> (DB.Connection -> ExceptT StoreError IO r) -> AM (SndQueue, r) +createSndQueue c userId connId sq_ qCid qInfo sndKey_ establishRatchet = do + (q, _) <- lift $ newSndQueue userId qCid qInfo sndKey_ + withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + r <- establishRatchet db + sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ + pure (sq', r) createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do @@ -1405,6 +1396,17 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar liftIO $ createSndRatchet db connId rc e2eSndParams pure e2eSndParams +startJoinInvitationDR :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> DRInvitation -> AM (ConnData, SndQueue) +startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue} = do + sq <- case sq_ of + Just sq -> pure sq + Nothing -> do + clientVRange <- asks $ smpClientVRange . config + qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange + fst <$> createSndQueue c userId connId sq_ connId qInfo Nothing (\db -> liftIO $ createRatchet db connId ratchetState) + SomeConn _ conn <- withStore c (`getConn` connId) + pure (toConnData conn, sq) + data JoinInvitationReq = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport | JIRInvitationDR DRInvitation From 64b3701fb23ed4f7023237b38cac2983d2d44e41 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Fri, 17 Jul 2026 21:09:12 +0000 Subject: [PATCH 54/81] remove createSndQueue --- src/Simplex/Messaging/Agent.hs | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 1c4d40170..26fbabf37 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1373,19 +1373,14 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId let lnkId_ = fst <$> invLink_ sndKey_ = snd <$> invLink_ - (sq', e2eSndParams) <- createSndQueue c userId connId sq_ "" qInfo sndKey_ $ \db -> createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - pure (cData, sq', e2eSndParams, lnkId_) + (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_ + withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams + sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ + pure (cData, sq', e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION -createSndQueue :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> ConnId -> Compatible SMPQueueInfo -> Maybe C.APrivateAuthKey -> (DB.Connection -> ExceptT StoreError IO r) -> AM (SndQueue, r) -createSndQueue c userId connId sq_ qCid qInfo sndKey_ establishRatchet = do - (q, _) <- lift $ newSndQueue userId qCid qInfo sndKey_ - withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - r <- establishRatchet db - sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (sq', r) - createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport) @@ -1403,7 +1398,11 @@ startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue Nothing -> do clientVRange <- asks $ smpClientVRange . config qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange - fst <$> createSndQueue c userId connId sq_ connId qInfo Nothing (\db -> liftIO $ createRatchet db connId ratchetState) + (q, _) <- lift $ newSndQueue userId connId qInfo Nothing + withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + liftIO $ createRatchet db connId ratchetState + ExceptT $ updateNewConnSnd db connId q SomeConn _ conn <- withStore c (`getConn` connId) pure (toConnData conn, sq) From dea95d92fe98dd6451c97da5535e523636a365ec Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 17 Jul 2026 22:10:07 +0100 Subject: [PATCH 55/81] remove comment --- src/Simplex/Messaging/Agent.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 26fbabf37..c78f09211 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1357,8 +1357,6 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = maxSupported <- asks $ maxVersion . e2eEncryptVRange . config let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} case sq_ of - -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out - -- e2ePubKey is always present, it's Maybe historically Just sq@SndQueue {e2ePubKey = Just _k} -> do e2eSndParams <- withStore c $ \db -> do lockConnForUpdate db connId From 6a4428dac7875edfe5e4f023ad95dc316468b8ea Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 18 Jul 2026 10:08:16 +0000 Subject: [PATCH 56/81] remove JoinInvitationReq --- src/Simplex/Messaging/Agent.hs | 30 +++++++++++------------------- 1 file changed, 11 insertions(+), 19 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index c78f09211..506881914 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1346,7 +1346,7 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q -startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Maybe SMP.LinkId) +startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = lift (compatibleInvitationUri cReqUri) >>= \case Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do @@ -1365,7 +1365,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = Left e -> do nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - pure (cData, sq, e2eSndParams, Nothing) + pure (cData, sq, Just e2eSndParams, Nothing) _ -> do let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId @@ -1376,7 +1376,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = liftIO $ lockConnForUpdate db connId e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (cData, sq', e2eSndParams, lnkId_) + pure (cData, sq', Just e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) @@ -1404,10 +1404,6 @@ startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue SomeConn _ conn <- withStore c (`getConn` connId) pure (toConnData conn, sq) -data JoinInvitationReq - = JIRInvitation Bool (ConnectionRequestUri 'CMInvitation) PQSupport - | JIRInvitationDR DRInvitation - connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of CRInvitationUri {} -> invPQSupported <$$> compatibleInvitationUri cReq @@ -1452,7 +1448,7 @@ joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured doJoin rq_ sq_ = do (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup - secureConfirmQueue c nm cData rq_ sq srv cInfo (Just e2eSndParams) subMode + secureConfirmQueue c nm cData rq_ sq srv cInfo e2eSndParams subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case @@ -1519,8 +1515,8 @@ delInvSL c connId srv lnkId = withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e -> liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e)) -joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> JoinInvitationReq -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrvAsync c userId connId joinReq cInfo subMode srv = do +joinConnSrvAsync :: AgentClient -> ConnId -> (Maybe SndQueue -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId)) -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrvAsync c connId startJoin cInfo subMode srv = do SomeConn cType conn <- withStore c (`getConn` connId) case conn of NewConnection _ -> doJoin Nothing Nothing @@ -1533,13 +1529,7 @@ joinConnSrvAsync c userId connId joinReq cInfo subMode srv = do where doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured doJoin rq_ sq_ = do - (cData, sq, params_, lnkId_) <- case joinReq of - JIRInvitation enableNtfs inv pqSup -> do - (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup - pure (cData, sq, Just e2eSndParams, lnkId_) - JIRInvitationDR dr -> do - (cData, sq) <- startJoinInvitationDR c userId connId sq_ dr - pure (cData, sq, Nothing, Nothing) + (cData, sq, params_, lnkId_) <- startJoin sq_ secureConfirmQueueAsync c cData rq_ sq srv cInfo params_ subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) @@ -1996,7 +1986,8 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrvAsync c userId connId (JIRInvitation enableNtfs cReq pqEnc) connInfo subMode srv + let startJoin sq_ = startJoinInvitation c userId connId sq_ enableNtfs cReq pqEnc + sqSecured <- joinConnSrvAsync c connId startJoin connInfo subMode srv notify $ JOINED sqSecured -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. @@ -2008,7 +1999,8 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do - sqSecured <- joinConnSrvAsync c userId connId (JIRInvitationDR dr) ownCInfo subMode srv + let startJoin sq_ = uncurry (,,Nothing,Nothing) <$> startJoinInvitationDR c userId connId sq_ dr + sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK From 08e726ca180d8cc30a7ed26fb10c884271c99428 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jul 2026 11:17:20 +0100 Subject: [PATCH 57/81] simplify --- src/Simplex/Messaging/Agent.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 506881914..0b79c76fc 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1346,7 +1346,7 @@ connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q -startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) +startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM ((ConnData, SndQueue), Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = lift (compatibleInvitationUri cReqUri) >>= \case Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do @@ -1365,7 +1365,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = Left e -> do nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e)) runExceptT $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams - pure (cData, sq, Just e2eSndParams, Nothing) + pure ((cData, sq), Just e2eSndParams, Nothing) _ -> do let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo invLink_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId @@ -1376,7 +1376,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = liftIO $ lockConnForUpdate db connId e2eSndParams <- createRatchet_ db g connId maxSupported pqSupport e2eRcvParams sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_ - pure (cData, sq', Just e2eSndParams, lnkId_) + pure ((cData, sq'), Just e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION createRatchet_ :: DB.Connection -> TVar ChaChaDRG -> ConnId -> CR.VersionE2E -> PQSupport -> CR.RcvE2ERatchetParams 'C.X448 -> ExceptT StoreError IO (CR.SndE2ERatchetParams 'C.X448) @@ -1447,7 +1447,7 @@ joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys where doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured doJoin rq_ sq_ = do - (cData, sq, e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup + ((cData, sq), e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup secureConfirmQueue c nm cData rq_ sq srv cInfo e2eSndParams subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = @@ -1515,7 +1515,7 @@ delInvSL c connId srv lnkId = withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e -> liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e)) -joinConnSrvAsync :: AgentClient -> ConnId -> (Maybe SndQueue -> AM (ConnData, SndQueue, Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId)) -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrvAsync :: AgentClient -> ConnId -> (Maybe SndQueue -> AM ((ConnData, SndQueue), Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId)) -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured joinConnSrvAsync c connId startJoin cInfo subMode srv = do SomeConn cType conn <- withStore c (`getConn` connId) case conn of @@ -1529,8 +1529,8 @@ joinConnSrvAsync c connId startJoin cInfo subMode srv = do where doJoin :: Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured doJoin rq_ sq_ = do - (cData, sq, params_, lnkId_) <- startJoin sq_ - secureConfirmQueueAsync c cData rq_ sq srv cInfo params_ subMode + ((cData, sq), e2eSndParams, lnkId_) <- startJoin sq_ + secureConfirmQueueAsync c cData rq_ sq srv cInfo e2eSndParams subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) createReplyQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo @@ -1999,7 +1999,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do - let startJoin sq_ = uncurry (,,Nothing,Nothing) <$> startJoinInvitationDR c userId connId sq_ dr + let startJoin sq_ = (,Nothing,Nothing) <$> startJoinInvitationDR c userId connId sq_ dr sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK From 9bb9ce5a205e082430174009f12d03b1cb731709 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jul 2026 11:38:23 +0100 Subject: [PATCH 58/81] rename --- src/Simplex/Messaging/Agent.hs | 29 +++++++++++-------------- src/Simplex/Messaging/Agent/Protocol.hs | 6 ++--- 2 files changed, 16 insertions(+), 19 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 0b79c76fc..52cfbf280 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1000,12 +1000,12 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP e2eVR <- asks $ e2eEncryptVRange . config -- the advertised bundle uses the connection's PQ, so its KEM is present iff the owner PQ is on, letting a -- PQ requester encrypt its first message (profile) with PQ from message 1 - (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.connPQEncryption pqInitKeys) + (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.connPQEncryption pqInitKeys) ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem let UserContactLinkData ucd = userLinkData - e2eParams = toVersionRangeT e2eRcvParams e2eVR - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams}} + e2eRcvParams = toVersionRangeT e2eParams e2eVR + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}} else pure userLinkData let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' @@ -1108,25 +1108,23 @@ setConnShortLink' c nm connId cMode userLinkData clientData = pure sl where prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData) - prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do + prepareContactLinkData rq@RcvQueue {shortLink} ud'@(UserContactLinkData d') = do liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d' g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config - -- the app never sees the advertised DR keys, so re-inject them from the database to keep the - -- address offering the same ratchet across updates (non-DR addresses are left unchanged) - ud' <- preserveAddressRatchetKeys ud + ud <- preserveAddressRatchetKeys ud' let cslContact = CSLContact SLSServer CCTContact (qServer rq) case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do let (linkId, k) = SL.contactShortLinkKdf shortLinkKey unless (shortLinkId == linkId) $ throwE $ INTERNAL "setConnShortLink: link ID is not derived from link" - d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud' + d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud pure (rq, linkId, cslContact shortLinkKey, (linkEncFixedData, d)) Nothing -> do sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact} connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData - (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud' + (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud (linkId, k) = SL.contactShortLinkKdf linkKey srvData <- liftError id $ SL.encryptLinkData g k linkData let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData) @@ -1148,9 +1146,8 @@ setConnShortLink' c nm connId cMode userLinkData clientData = Left _ -> pure ud Right (ratchetKeyId, pk1, pk2, pKem) -> do e2eVR <- asks $ e2eEncryptVRange . config - let e2eRcv = CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem) - e2eParams = toVersionRangeT e2eRcv e2eVR - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eParams}} + let e2eRcvParams = toVersionRangeT (CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem)) e2eVR + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}} deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM () deleteConnShortLink' c nm connId cMode = @@ -1463,12 +1460,12 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType pure AgentInvitation {agentVersion = v, connReq = cReq, connInfo = cInfo} - Just AddressRatchetKeys {ratchetKeyId, e2eParams} -> do + Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams} -> do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config - case e2eParams `compatibleVersion` e2eVR of + case e2eRcvParams `compatibleVersion` e2eVR of Nothing -> throwE $ AGENT A_VERSION - Just (Compatible e2eRcvParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do + Just (Compatible e2eParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) maxV = maxVersion e2eVR rq <- case conn of @@ -1483,7 +1480,7 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys sndReply = AgentConnInfoReply (replyQInfo :| []) cInfo (e2eSndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do liftIO $ lockConnForUpdate db connId - e2eSndParams <- liftIO (getSndRatchet db connId e2eV) >>= either (const $ createRatchet_ db g connId maxV pqSupport e2eRcvParams) (pure . snd) + e2eSndParams <- liftIO (getSndRatchet db connId e2eV) >>= either (const $ createRatchet_ db g connId maxV pqSupport e2eParams) (pure . snd) liftIO $ setConnPQSupport db connId pqSupport encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode sndReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) maxV pure (e2eSndParams, encConnInfo) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 202c17656..9486409df 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1816,13 +1816,13 @@ newtype RatchetKeyId = RatchetKeyId ByteString data AddressRatchetKeys = AddressRatchetKeys { ratchetKeyId :: RatchetKeyId, - e2eParams :: RcvE2ERatchetParamsUri 'C.X448 + e2eRcvParams :: RcvE2ERatchetParamsUri 'C.X448 } deriving (Eq, Show) instance Encoding AddressRatchetKeys where - smpEncode AddressRatchetKeys {ratchetKeyId, e2eParams} = smpEncode (ratchetKeyId, e2eParams) - smpP = uncurry AddressRatchetKeys <$> smpP + smpEncode AddressRatchetKeys {ratchetKeyId, e2eRcvParams} = smpEncode (ratchetKeyId, e2eRcvParams) + smpP = AddressRatchetKeys <$> smpP <*> smpP -- | The double-ratchet invitation an address owner receives in message 1 and later accepts: the ratchet the -- owner established from that message, the requester's reply queue, and the negotiated version and PQ support. From 64dad46e13c5f4b6ca58760cec017ccd5ba85755 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jul 2026 11:42:30 +0100 Subject: [PATCH 59/81] fix --- tests/AgentTests/FunctionalAPITests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 93a899879..920364110 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -1025,7 +1025,7 @@ runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink -- the advertised DR bundle includes a KEM iff the owner's PQ is on, so a PQ requester gets PQ from message 1 liftIO $ case ratchetKeys userCtData' of - Just AddressRatchetKeys {e2eParams = CR.E2ERatchetParamsUri _ _ _ kem_} -> + Just AddressRatchetKeys {e2eRcvParams = CR.E2ERatchetParamsUri _ _ _ kem_} -> isJust kem_ `shouldBe` supportPQ (CR.connPQEncryption addrIK) Nothing -> expectationFailure "address must advertise DR ratchet keys" let addrKeys_ = if useDR then ratchetKeys userCtData' else Nothing From 7b7042a726e9be604006cddec203eb091eaca8fd Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 18 Jul 2026 10:42:43 +0000 Subject: [PATCH 60/81] type synonim --- src/Simplex/Messaging/Agent.hs | 30 ++++++++++++------------- src/Simplex/Messaging/Agent/Protocol.hs | 3 +++ 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 52cfbf280..03826832e 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -430,7 +430,7 @@ prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData srv_ -- | Create connection for prepared link (single network call). -- Validates that server response matches the prepared link. -createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Bool -> SubscriptionMode -> AE ConnId +createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AE ConnId createConnectionForLink c nm userId enableNtfs = withAgentEnv c .::: createConnectionForLink' c nm userId enableNtfs {-# INLINE createConnectionForLink #-} @@ -986,7 +986,7 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo pure (ccLink, params) -- | Create connection for prepared link (single network call). -createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> Bool -> SubscriptionMode -> AM ConnId +createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AM ConnId createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys advertiseDR subMode = do g <- asks random AgentConfig {smpAgentVRange} <- asks config @@ -994,19 +994,7 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink" _ -> pure () connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys) - userLinkData' <- - if advertiseDR - then do - e2eVR <- asks $ e2eEncryptVRange . config - -- the advertised bundle uses the connection's PQ, so its KEM is present iff the owner PQ is on, letting a - -- PQ requester encrypt its first message (profile) with PQ from message 1 - (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.connPQEncryption pqInitKeys) - ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) - withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem - let UserContactLinkData ucd = userLinkData - e2eRcvParams = toVersionRangeT e2eParams e2eVR - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}} - else pure userLinkData + userLinkData' <- if advertiseDR then advertiseDRKeys g connId else pure userLinkData let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' linkData = (plpSignedFixedData, md) @@ -1017,6 +1005,18 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP let SMPQueueUri _ SMPQueueAddress {senderId = actualSndId} = qUri unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch" pure connId + where + advertiseDRKeys :: TVar ChaChaDRG -> ConnId -> AM (UserConnLinkData 'CMContact) + advertiseDRKeys g connId = do + e2eVR <- asks $ e2eEncryptVRange . config + -- the advertised bundle uses the connection's PQ, so its KEM is present iff the owner PQ is on, letting a + -- PQ requester encrypt its first message (profile) with PQ from message 1 + (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.connPQEncryption pqInitKeys) + ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) + withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem + let UserContactLinkData ucd = userLinkData + e2eRcvParams = toVersionRangeT e2eParams e2eVR + pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}} -- | Encrypt signed link data for contact mode. encryptContactLinkData :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> LinkKey -> SMP.SenderId -> (ByteString, ByteString) -> AM ClntQueueReqData diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 9486409df..c4fddcfc0 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -55,6 +55,7 @@ module Simplex.Messaging.Agent.Protocol -- * SMP agent protocol types ConnInfo, SndQueueSecured, + UseRatchetKeys, AEntityId, ACommand (..), JoinRequest (..), @@ -400,6 +401,8 @@ type ConnInfo = ByteString type SndQueueSecured = Bool +type UseRatchetKeys = Bool + -- | Parameterized type for SMP agent events data AEvent (e :: AEntity) where INV :: AConnectionRequestUri -> AEvent AEConn From c815e7f7532c7be472320f0c155a61d1cbefc11f Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 18 Jul 2026 15:12:02 +0000 Subject: [PATCH 61/81] getConnData --- src/Simplex/Messaging/Agent.hs | 4 ++-- src/Simplex/Messaging/Agent/Protocol.hs | 2 +- src/Simplex/Messaging/Agent/Store/AgentStore.hs | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 03826832e..535e6ed22 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1398,8 +1398,8 @@ startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue liftIO $ lockConnForUpdate db connId liftIO $ createRatchet db connId ratchetState ExceptT $ updateNewConnSnd db connId q - SomeConn _ conn <- withStore c (`getConn` connId) - pure (toConnData conn, sq) + cData <- withStore c $ \db -> maybe (Left SEConnNotFound) (Right . fst) <$> getConnData False False db connId + pure (cData, sq) connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index c4fddcfc0..96e1ad331 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -2185,7 +2185,7 @@ instance StrEncoding JoinRequest where JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = (JRConnReq <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff)) - <|> (JRInvitationDR <$> ((A.take =<< (A.decimal <* A.char '\n')) >>= either fail pure . J'.eitherDecodeStrict') <* A.space) + <|> (JRInvitationDR <$> (J'.eitherDecodeStrict' <$?> (A.take =<< (A.decimal <* "\n"))) <* A.space) -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) dbCommandP :: Parser ACommand diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 5dfd797a8..f229af048 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -66,6 +66,7 @@ module Simplex.Messaging.Agent.Store.AgentStore getConnSubs, getDeletedConns, getConnsData, + getConnData, lockConnForUpdate, setConnDeleted, setConnUserId, From f77d0fba7fff2d2e9afb29b579014751587b10f3 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jul 2026 16:23:26 +0100 Subject: [PATCH 62/81] simplify --- src/Simplex/Messaging/Agent.hs | 24 +++++++++---------- .../Messaging/Agent/Store/AgentStore.hs | 5 +++- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 535e6ed22..88c04c338 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1387,19 +1387,17 @@ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetPar pure e2eSndParams startJoinInvitationDR :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> DRInvitation -> AM (ConnData, SndQueue) -startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue} = do - sq <- case sq_ of - Just sq -> pure sq - Nothing -> do - clientVRange <- asks $ smpClientVRange . config - qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange - (q, _) <- lift $ newSndQueue userId connId qInfo Nothing - withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - liftIO $ createRatchet db connId ratchetState - ExceptT $ updateNewConnSnd db connId q - cData <- withStore c $ \db -> maybe (Left SEConnNotFound) (Right . fst) <$> getConnData False False db connId - pure (cData, sq) +startJoinInvitationDR c userId connId sq_ DRInvitation {ratchetState, replyQueue} = case sq_ of + Just sq -> (,sq) <$> withStore c (`getConnectionData` connId) + Nothing -> do + clientVRange <- asks $ smpClientVRange . config + qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange + (q, _) <- lift $ newSndQueue userId connId qInfo Nothing + withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + liftIO $ createRatchet db connId ratchetState + sq <- ExceptT $ updateNewConnSnd db connId q + (,sq) <$> ExceptT (getConnectionData db connId) connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index f229af048..596042d2f 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -66,7 +66,7 @@ module Simplex.Messaging.Agent.Store.AgentStore getConnSubs, getDeletedConns, getConnsData, - getConnData, + getConnectionData, lockConnForUpdate, setConnDeleted, setConnUserId, @@ -2636,6 +2636,9 @@ handleDBError :: E.SomeException -> IO (Either StoreError a) handleDBError = pure . Left . SEInternal . bshow #endif +getConnectionData :: DB.Connection -> ConnId -> IO (Either StoreError ConnData) +getConnectionData db connId = maybe (Left SEConnNotFound) (Right . fst) <$> getConnData False False db connId + getConnData :: Bool -> Bool -> DB.Connection -> ConnId -> IO (Maybe (ConnData, ConnectionMode)) getConnData deleted' forUpdate db connId' = maybeFirstRow rowToConnData $ From 6bf95937e3a05c5425bb4d3ee7599965b7032ff6 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jul 2026 16:26:30 +0100 Subject: [PATCH 63/81] move --- src/Simplex/Messaging/Agent.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 88c04c338..8c72f858e 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1978,6 +1978,12 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do withServer' . tryCommand $ do (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink notify $ LDATA fixedData linkData + JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do + triedHosts <- newTVarIO S.empty + tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do + let startJoin sq_ = (,Nothing,Nothing) <$> startJoinInvitationDR c userId connId sq_ dr + sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv + notify $ JOINED sqSecured JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do @@ -1991,12 +1997,6 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo Nothing pqEnc subMode srv notify $ JOINED sqSecured - JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do - triedHosts <- newTVarIO S.empty - tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do - let startJoin sq_ = (,Nothing,Nothing) <$> startJoinInvitationDR c userId connId sq_ dr - sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv - notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK SWCH -> From 79fd9b251ce83c47c28112f2d5c32aac8a5e21d7 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 18 Jul 2026 15:34:36 +0000 Subject: [PATCH 64/81] encoding --- src/Simplex/Messaging/Agent/Protocol.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 96e1ad331..0daeba7b7 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -2181,7 +2181,7 @@ $(J.deriveJSON defaultJSON ''DRInvitation) -- and subMode still default when a legacy command omits them. instance StrEncoding JoinRequest where strEncode = \case - JRConnReq ntfs cReq pqSup -> B.unwords [strEncode ntfs, strEncode cReq, strEncode pqSup] + JRConnReq ntfs cReq pqSup -> strEncode (ntfs, cReq, pqSup) JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = (JRConnReq <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff)) From 0aec7922f00c9165d7db15c814b1c70ea57943de Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jul 2026 16:36:34 +0100 Subject: [PATCH 65/81] version --- src/Simplex/Messaging/Agent/Protocol.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 0daeba7b7..aceda4821 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -331,7 +331,7 @@ minSupportedSMPAgentVersion :: VersionSMPA minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion currentSMPAgentVersion :: VersionSMPA -currentSMPAgentVersion = VersionSMPA 8 +currentSMPAgentVersion = VersionSMPA 7 supportedSMPAgentVRange :: VersionRangeSMPA supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion From b5a4c7026547a9404ce3c01e0862b7633e003dc2 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 18 Jul 2026 17:20:30 +0000 Subject: [PATCH 66/81] async join with ratchet keys --- src/Simplex/Messaging/Agent.hs | 26 +++++++------ src/Simplex/Messaging/Agent/Protocol.hs | 6 +-- tests/AgentTests/ConnectionRequestTests.hs | 2 +- tests/AgentTests/FunctionalAPITests.hs | 44 ++++++++++++---------- 4 files changed, 43 insertions(+), 35 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 8c72f858e..38b2d3443 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -380,8 +380,8 @@ getConnShortLinkAsync c = withAgentEnv c .:: getConnShortLinkAsync' c {-# INLINE getConnShortLinkAsync #-} -- | Enqueue JOIN command for a prepared connection. -joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE () -joinConnectionAsync c aCorrId updateConn connId enableNtfs = withAgentEnv c .:: joinConnAsync c aCorrId updateConn connId enableNtfs +joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AE () +joinConnectionAsync c aCorrId updateConn connId enableNtfs = withAgentEnv c .::. joinConnAsync c aCorrId updateConn connId enableNtfs {-# INLINE joinConnectionAsync #-} -- | Allow connection to continue after CONF notification (LET command), no synchronous response @@ -866,21 +866,22 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do -- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection, -- and join should retry, the same as 1-time invitation joins. -joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM () -joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do +joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AM () +joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} cInfo addrKeys_ pqSup subMode = do when updateConn $ throwE $ CMD PROHIBITED "joinConnAsync: updateConn not allowed for invitation URI" + when (isJust addrKeys_) $ throwE $ CMD PROHIBITED "joinConnAsync: address ratchet keys not allowed for invitation URI" withInvLock c (strEncode cReqUri) "joinConnAsync" $ lift (compatibleInvitationUri cReqUri) >>= \case Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport Nothing) subMode cInfo Nothing -> throwE $ AGENT A_VERSION -joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = +joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) cInfo addrKeys_ pqSup subMode = lift (compatibleContactUri cReqUri) >>= \case Just (_, Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing when updateConn $ withStore' c $ \db -> updateNewConnJoin db connId connAgentVersion pqSupport enableNtfs - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport addrKeys_) subMode cInfo Nothing -> throwE $ AGENT A_VERSION allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM () @@ -902,7 +903,7 @@ acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMo withStore' c $ \db -> acceptInvitation db invId ownConnInfo let joinCmd = case connReq of CRInvitationDR dr -> enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitationDR dr) subMode ownConnInfo - CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo pqSupport subMode + CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode joinCmd `catchAllErrors` \err -> do withStore' c (`unacceptInvitation` invId) throwE err @@ -1430,7 +1431,8 @@ versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && ma {-# INLINE versionPQSupport_ #-} joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo _addrKeys pqSup subMode srv = +joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo addrKeys_ pqSup subMode srv = do + when (isJust addrKeys_) $ throwE $ CMD PROHIBITED "joinConnSrv: address ratchet keys not allowed for invitation URI" withInvLock c (strEncode inv) "joinConnSrv" $ do SomeConn cType conn <- withStore c (`getConn` connId) case conn of @@ -1984,7 +1986,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do let startJoin sq_ = (,Nothing,Nothing) <$> startJoinInvitationDR c userId connId sq_ dr sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv notify $ JOINED sqSecured - JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do + JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc _) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do let startJoin sq_ = startJoinInvitation c userId connId sq_ enableNtfs cReq pqEnc @@ -1992,10 +1994,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do notify $ JOINED sqSecured -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. - JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc) subMode connInfo -> noServer $ do + JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc addrKeys_) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo Nothing pqEnc subMode srv + sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo addrKeys_ pqEnc subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index aceda4821..92a6c9f9b 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1838,7 +1838,7 @@ data DRInvitation = DRInvitation deriving (Show) data JoinRequest - = JRConnReq {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} + = JRConnReq {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport, addrRatchetKeys :: Maybe AddressRatchetKeys} | JRInvitationDR DRInvitation deriving (Show) @@ -2181,10 +2181,10 @@ $(J.deriveJSON defaultJSON ''DRInvitation) -- and subMode still default when a legacy command omits them. instance StrEncoding JoinRequest where strEncode = \case - JRConnReq ntfs cReq pqSup -> strEncode (ntfs, cReq, pqSup) + JRConnReq ntfs cReq pqSup addrKeys_ -> strEncode (ntfs, cReq, pqSup) <> maybe "" (B.cons ' ' . serializeBinary . smpEncode) addrKeys_ JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = - (JRConnReq <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff)) + (JRConnReq <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff) <*> optional (smpDecode <$?> (A.take =<< (A.decimal <* "\n")) <* A.space)) <|> (JRInvitationDR <$> (J'.eitherDecodeStrict' <$?> (A.take =<< (A.decimal <* "\n"))) <* A.space) -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index a341c1dd1..3cd6ed9c9 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -258,7 +258,7 @@ connectionRequestTests = queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr) it "JOIN command is backward compatible: JRConnReq is byte-identical to the pre-DR JOIN" $ do let uri = ACR SCMInvitation invConnRequest - cmd = JOIN (JRConnReq True uri PQSupportOff) SMSubscribe "hi" + cmd = JOIN (JRConnReq True uri PQSupportOff Nothing) SMSubscribe "hi" -- the pre-DR JOIN wire format: "JOIN " oldJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode PQSupportOff <> " " <> strEncode SMSubscribe <> " 2\nhi" serializeCommand cmd `shouldBe` oldJoin diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 920364110..9fc2b5531 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -1010,8 +1010,8 @@ allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc = do -- DR-advertising contact address test. Args: asyncAccept (JOIN vs sync accept), addrIK (advertised bundle + owner -- PQ), useDR (DR path vs classic/ignore keys), bPQ (joiner PQSupport). -runAgentClientContactDRTest_ :: HasCallStack => Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () -runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do +runAgentClientContactDRTest_ :: HasCallStack => Bool -> Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () +runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do g <- C.newRandom rootKey <- atomically $ C.generateKeyPair g linkEntId <- atomically $ C.randomBytes 32 g @@ -1030,8 +1030,13 @@ runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps Nothing -> expectationFailure "address must advertise DR ratchet keys" let addrKeys_ = if useDR then ratchetKeys userCtData' else Nothing aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe - liftIO $ sqSecuredJoin `shouldBe` False + if asyncJoin + then do + A.joinConnectionAsync bob "join" False aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe + get bob =##> \case ("join", c, A.JOINED sqSecured) -> c == aliceId && not sqSecured; _ -> False + else do + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe + liftIO $ sqSecuredJoin `shouldBe` False ("", _, A.REQ invId reqPQ _ "bob's connInfo") <- get alice liftIO $ reqPQ `shouldBe` PQSupportOn bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) @@ -1046,17 +1051,18 @@ runAgentClientContactDRTest_ asyncAccept addrIK useDR bPQ ps = withSmpServer ps testContactDRMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> Spec testContactDRMatrix ps = do - describe "DR join (ratchet from the invitation)" $ drRows True False - describe "classic join, ratchet keys ignored" $ drRows False False - describe "DR join, async accept (JOIN command)" $ drRows True True + describe "DR join (ratchet from the invitation)" $ drRows False True False + describe "classic join, ratchet keys ignored" $ drRows False False False + describe "DR join, async accept (JOIN command)" $ drRows True True False + describe "DR join, async join (JOIN command)" $ drRows False True True where - drRows useDR async' = do - it "IKPQOff, dh join" $ runAgentClientContactDRTest_ async' IKPQOff useDR PQSupportOff ps - it "IKPQOff, pq join" $ runAgentClientContactDRTest_ async' IKPQOff useDR PQSupportOn ps - it "IKPQOn, dh join" $ runAgentClientContactDRTest_ async' IKPQOn useDR PQSupportOff ps - it "IKPQOn, pq join" $ runAgentClientContactDRTest_ async' IKPQOn useDR PQSupportOn ps - it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ async' IKUsePQ useDR PQSupportOff ps - it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ async' IKUsePQ useDR PQSupportOn ps + drRows asyncAccept useDR asyncJoin = do + it "IKPQOff, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOff useDR PQSupportOff ps + it "IKPQOff, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOff useDR PQSupportOn ps + it "IKPQOn, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOn useDR PQSupportOff ps + it "IKPQOn, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOn useDR PQSupportOn ps + it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOff ps + it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOn ps -- updating a DR address's mutable link data must preserve the stored ratchet keys, so requesters can still establish DR testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO () @@ -1555,7 +1561,7 @@ testInvitationShortLinkAsync viaProxy a b = do linkUserData connData' `shouldBe` userData runRight $ do aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn - A.joinConnectionAsync b "123" False aId True connReq "bob's connInfo" PQSupportOn SMSubscribe + A.joinConnectionAsync b "123" False aId True connReq "bob's connInfo" Nothing PQSupportOn SMSubscribe get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" @@ -2820,7 +2826,7 @@ testAsyncCommands sqSecured alice bob baseId = ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId aliceId <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn - joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe ("2", aliceId', JOINED sqSecured') <- get bob liftIO $ do aliceId' `shouldBe` aliceId @@ -2911,7 +2917,7 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> liftIO $ qInfo' `shouldBe` qInfo liftIO $ userCtData' `shouldBe` userCtData -- join connection async using connId from getConnShortLinkAsync - joinConnectionAsync bob "2" True newId True qInfo' "bob's connInfo" PQSupportOn SMSubscribe + joinConnectionAsync bob "2" True newId True qInfo' "bob's connInfo" Nothing PQSupportOn SMSubscribe let aliceId = newId ("2", aliceId', JOINED False) <- get bob liftIO $ aliceId' `shouldBe` aliceId @@ -3224,7 +3230,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn - joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) @@ -3271,7 +3277,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn - joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe + joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) From 3a2d673194b8cb6d23f0855ce66950d881afe3e6 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jul 2026 21:16:03 +0100 Subject: [PATCH 67/81] fix encoding --- src/Simplex/Messaging/Agent/Protocol.hs | 15 +++++++-------- src/Simplex/Messaging/Encoding.hs | 7 +++++++ 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 92a6c9f9b..8a05730f2 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1928,10 +1928,11 @@ validateLinkOwners rootKey = go [] instance ConnectionModeI c => Encoding (FixedLinkData c) where smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} = - smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId + smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId -- TODO replace with smpEncode (fromMaybe "" linkEntityId) - safe to do it in 2027 smpP = do (agentVRange, rootKey, linkConnReq) <- smpP - linkEntityId <- optional smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding + linkEntityId <- optional smpP -- TODO replace with (smpP <|> pure Nothing) + _ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding (added in January 2026) pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} instance ConnectionModeI c => Encoding (ConnLinkData c) where @@ -1979,13 +1980,11 @@ instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where instance Encoding UserContactData where smpEncode UserContactData {direct, owners, relays, userData, ratchetKeys} = - B.concat [smpEncode direct, smpEncodeList owners, smpEncodeList relays, smpEncode userData, maybe "" smpEncode ratchetKeys] + smpEncode (direct, EncList owners, EncList relays, userData, ratchetKeys) smpP = do - direct <- smpP - owners <- smpListP - relays <- smpListP - userData <- smpP - ratchetKeys <- optional smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding + (direct, EncList owners, EncList relays, userData) <- smpP + ratchetKeys <- smpP <|> pure Nothing + _ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding pure UserContactData {direct, owners, relays, userData, ratchetKeys} instance Encoding UserLinkData where diff --git a/src/Simplex/Messaging/Encoding.hs b/src/Simplex/Messaging/Encoding.hs index d069e5518..9e7ecd29c 100644 --- a/src/Simplex/Messaging/Encoding.hs +++ b/src/Simplex/Messaging/Encoding.hs @@ -11,6 +11,7 @@ module Simplex.Messaging.Encoding ( Encoding (..), Tail (..), Large (..), + EncList (..), _smpP, smpEncodeList, smpListP, @@ -177,6 +178,12 @@ instance Encoding a => Encoding (L.NonEmpty a) where 0 -> fail "empty list" n -> L.fromList <$> A.count n smpP +newtype EncList a = EncList [a] + +instance Encoding a => Encoding (EncList a) where + smpEncode (EncList xs) = smpEncodeList xs + smpP = EncList <$> smpListP + instance (Encoding a, Encoding b) => Encoding (a, b) where smpEncode (a, b) = smpEncode a <> smpEncode b {-# INLINE smpEncode #-} From fb08d40b6974109a44bec50cd41b78b02d57e67f Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 19 Jul 2026 06:59:55 +0000 Subject: [PATCH 68/81] rotate address ratchet keys --- src/Simplex/Messaging/Agent.hs | 68 +++++++++++-------- src/Simplex/Messaging/Agent/Env/SQLite.hs | 2 + .../Messaging/Agent/Store/AgentStore.hs | 18 +++++ .../Migrations/M20260712_address_dr.hs | 3 +- .../SQLite/Migrations/M20260712_address_dr.hs | 3 +- .../Store/SQLite/Migrations/agent_schema.sql | 3 +- tests/AgentTests/FunctionalAPITests.hs | 60 +++++++++++++++- 7 files changed, 125 insertions(+), 32 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 38b2d3443..bc42a79fe 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -435,8 +435,8 @@ createConnectionForLink c nm userId enableNtfs = withAgentEnv c .::: createConne {-# INLINE createConnectionForLink #-} -- | Create or update user's contact connection short link -setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c) -setConnShortLink c = withAgentEnv c .::. setConnShortLink' c +setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> Bool -> AE (ConnShortLink c) +setConnShortLink c = withAgentEnv c .::: setConnShortLink' c {-# INLINE setConnShortLink #-} deleteConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AE () @@ -995,7 +995,7 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink" _ -> pure () connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys) - userLinkData' <- if advertiseDR then advertiseDRKeys g connId else pure userLinkData + userLinkData' <- if advertiseDR then advertiseDRKeys connId else pure userLinkData let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' linkData = (plpSignedFixedData, md) @@ -1007,17 +1007,33 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch" pure connId where - advertiseDRKeys :: TVar ChaChaDRG -> ConnId -> AM (UserConnLinkData 'CMContact) - advertiseDRKeys g connId = do - e2eVR <- asks $ e2eEncryptVRange . config + advertiseDRKeys :: ConnId -> AM (UserConnLinkData 'CMContact) + advertiseDRKeys connId = do -- the advertised bundle uses the connection's PQ, so its KEM is present iff the owner PQ is on, letting a -- PQ requester encrypt its first message (profile) with PQ from message 1 - (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.connPQEncryption pqInitKeys) - ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) - withStore' c $ \db -> createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem + arKeys <- newAddressRatchetKeys c connId (CR.connPQEncryption pqInitKeys) let UserContactLinkData ucd = userLinkData - e2eRcvParams = toVersionRangeT e2eParams e2eVR - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}} + pure $ UserContactLinkData ucd {ratchetKeys = Just arKeys} + +newAddressRatchetKeys :: AgentClient -> ConnId -> PQSupport -> AM AddressRatchetKeys +newAddressRatchetKeys c connId pqSupport = do + g <- asks random + e2eVR <- asks $ e2eEncryptVRange . config + keep <- asks $ addressRatchetKeysToKeep . config + (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqSupport + ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) + withStore' c $ \db -> do + createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem + deleteOldAddressRatchetKeys db connId keep + pure AddressRatchetKeys {ratchetKeyId, e2eRcvParams = toVersionRangeT e2eParams e2eVR} + +currentAddressRatchetKeys :: AgentClient -> ConnId -> AM (Maybe AddressRatchetKeys) +currentAddressRatchetKeys c connId = + withStore' c (`getCurrentAddressRatchetKeys` connId) >>= \case + Left _ -> pure Nothing + Right (ratchetKeyId, pk1, pk2, pKem) -> do + e2eVR <- asks $ e2eEncryptVRange . config + pure $ Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams = toVersionRangeT (CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem)) e2eVR} -- | Encrypt signed link data for contact mode. encryptContactLinkData :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> LinkKey -> SMP.SenderId -> (ByteString, ByteString) -> AM ClntQueueReqData @@ -1097,24 +1113,28 @@ getConnShortLinkAsync' c userId corrId connId_ shortLink@(CSLContact _ _ srv _) } createNewConn db g cData SCMInvitation -setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c) -setConnShortLink' c nm connId cMode userLinkData clientData = +setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> Bool -> AM (ConnShortLink c) +setConnShortLink' c nm connId cMode userLinkData clientData rotate = withConnLock c connId "setConnShortLink" $ do SomeConn _ conn <- withStore c (`getConn` connId) (rq, lnkId, sl, d) <- case (conn, cMode, userLinkData) of - (ContactConnection _ rq, SCMContact, d@UserContactLinkData {}) -> prepareContactLinkData rq d + (ContactConnection cData rq, SCMContact, d@UserContactLinkData {}) -> prepareContactLinkData cData rq d (RcvConnection _ rq, SCMInvitation, d@UserInvLinkData {}) -> prepareInvLinkData rq d _ -> throwE $ CMD PROHIBITED "setConnShortLink: invalid connection or mode" addQueueLink c nm rq lnkId d pure sl where - prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData) - prepareContactLinkData rq@RcvQueue {shortLink} ud'@(UserContactLinkData d') = do - liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d' + prepareContactLinkData :: ConnData -> RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData) + prepareContactLinkData ConnData {pqSupport} rq@RcvQueue {shortLink} (UserContactLinkData ucd) = do + liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink ucd g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config - ud <- preserveAddressRatchetKeys ud' - let cslContact = CSLContact SLSServer CCTContact (qServer rq) + ratchetKeys <- + if rotate + then Just <$> newAddressRatchetKeys c connId pqSupport + else currentAddressRatchetKeys c connId + let ud = UserContactLinkData ucd {ratchetKeys} + cslContact = CSLContact SLSServer CCTContact (qServer rq) case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do let (linkId, k) = SL.contactShortLinkKdf shortLinkKey @@ -1141,14 +1161,6 @@ setConnShortLink' c nm connId cMode userLinkData clientData = let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey pure (rq, shortLinkId, sl, (linkEncFixedData, d)) Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation" - preserveAddressRatchetKeys :: UserConnLinkData 'CMContact -> AM (UserConnLinkData 'CMContact) - preserveAddressRatchetKeys ud@(UserContactLinkData ucd) = - withStore' c (`getCurrentAddressRatchetKeys` connId) >>= \case - Left _ -> pure ud - Right (ratchetKeyId, pk1, pk2, pKem) -> do - e2eVR <- asks $ e2eEncryptVRange . config - let e2eRcvParams = toVersionRangeT (CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem)) e2eVR - pure $ UserContactLinkData ucd {ratchetKeys = Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}} deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM () deleteConnShortLink' c nm connId cMode = @@ -1974,7 +1986,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do notify $ INV (ACR cMode cReq) LSET userLinkData clientData -> withServer' . tryCommand $ do - link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData + link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData False notify $ LINK link userLinkData LGET shortLink -> withServer' . tryCommand $ do diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index aba4a898a..620821e9b 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -170,6 +170,7 @@ data AgentConfig = AgentConfig xftpConsecutiveRetries :: Int, xftpMaxRecipientsPerRequest :: Int, deleteErrorCount :: Int, + addressRatchetKeysToKeep :: Int, ntfCron :: Word16, ntfBatchSize :: Int, ntfSubFirstCheckInterval :: NominalDiffTime, @@ -245,6 +246,7 @@ defaultAgentConfig = xftpConsecutiveRetries = 3, xftpMaxRecipientsPerRequest = 200, deleteErrorCount = 10, + addressRatchetKeysToKeep = 3, ntfCron = 20, -- minutes ntfBatchSize = 150, ntfSubFirstCheckInterval = nominalDay, diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 596042d2f..8072c7925 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -156,6 +156,7 @@ module Simplex.Messaging.Agent.Store.AgentStore createAddressRatchetKeys, getCurrentAddressRatchetKeys, getAddressRatchetKeys, + deleteOldAddressRatchetKeys, createSndRatchet, getSndRatchet, createRatchet, @@ -1427,6 +1428,23 @@ getAddressRatchetKeys db connId ratchetKeyId = |] (connId, ratchetKeyId) +deleteOldAddressRatchetKeys :: DB.Connection -> ConnId -> Int -> IO () +deleteOldAddressRatchetKeys db connId keep = + DB.execute + db + [sql| + DELETE FROM address_ratchet_keys + WHERE conn_id = ? + AND address_ratchet_key_id NOT IN ( + SELECT address_ratchet_key_id + FROM address_ratchet_keys + WHERE conn_id = ? + ORDER BY address_ratchet_key_id DESC + LIMIT ? + ) + |] + (connId, connId, keep) + createSndRatchet :: DB.Connection -> ConnId -> RatchetX448 -> CR.AE2ERatchetParams 'C.X448 -> IO () createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetParams _ x3dhPubKey1 x3dhPubKey2 pqPubKem)) = DB.execute diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs index 8ce1ff4db..00506b1d2 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs @@ -15,7 +15,8 @@ CREATE TABLE address_ratchet_keys( ratchet_key_id BYTEA NOT NULL, x3dh_priv_key_1 BYTEA NOT NULL, x3dh_priv_key_2 BYTEA NOT NULL, - pq_priv_kem BYTEA + pq_priv_kem BYTEA, + created_at TIMESTAMPTZ NOT NULL DEFAULT (now()) ); CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs index fa111f58e..2da05ea42 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs @@ -14,7 +14,8 @@ CREATE TABLE address_ratchet_keys( ratchet_key_id BLOB NOT NULL, x3dh_priv_key_1 BLOB NOT NULL, x3dh_priv_key_2 BLOB NOT NULL, - pq_priv_kem BLOB + pq_priv_kem BLOB, + created_at TEXT NOT NULL DEFAULT(datetime('now')) ) STRICT; CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index b349b18a2..460600f4c 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -471,7 +471,8 @@ CREATE TABLE address_ratchet_keys( ratchet_key_id BLOB NOT NULL, x3dh_priv_key_1 BLOB NOT NULL, x3dh_priv_key_2 BLOB NOT NULL, - pq_priv_kem BLOB + pq_priv_kem BLOB, + created_at TEXT NOT NULL DEFAULT(datetime('now')) ) STRICT; CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id); CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id); diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 9fc2b5531..ff7baf6ad 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -315,7 +315,7 @@ getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkDat getConnShortLink c = A.getConnShortLink c NRMInteractive setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c) -setConnShortLink c = A.setConnShortLink c NRMInteractive +setConnShortLink c connId cMode uld cd = A.setConnShortLink c NRMInteractive connId cMode uld cd False suspendConnection :: AgentClient -> ConnId -> AE () suspendConnection c = A.suspendConnection c NRMInteractive @@ -351,6 +351,10 @@ functionalAPITests ps = do testContactDRMatrix ps it "should preserve address DR keys when the link data is updated" $ testAddressUpdatePreservesDRKeys ps + it "should rotate address DR keys, keeping old keys for stale requesters until pruned" $ + testAddressKeyRotation ps + it "should add DR keys to an existing address via setConnShortLink" $ + testAddDRViaSetConnShortLink ps it "should resume DR accept after a transient failure (reuse the send queue and ratchet)" $ testAcceptContactDRResumeAfterOffline ps it "should support rejecting contact request" $ @@ -1064,6 +1068,60 @@ testContactDRMatrix ps = do it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOff ps it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOn ps +joinContactDR :: HasCallStack => AgentClient -> AgentClient -> ConnectionRequestUri 'CMContact -> Maybe AddressRatchetKeys -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO () +joinContactDR alice requester connReq addrKeys_ addrIK pqEnc = do + aliceId <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn + void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq "bob's connInfo" addrKeys_ PQSupportOn SMSubscribe + ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice + reqId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + void $ acceptContact alice 1 reqId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + ("", _, A.CONF confId _ _ "alice's connInfo") <- get requester + allowConfirmGreet alice reqId requester aliceId confId addrIK pqEnc + +testAddressKeyRotation :: HasCallStack => (ASrvTransport, AStoreType) -> IO () +testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob carol -> do + g <- C.newRandom + rootKey <- atomically $ C.generateKeyPair g + linkEntId <- atomically $ C.randomBytes 32 g + let addrIK = IKPQOn + userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} + connIK = IKLinkPQ (CR.connPQEncryption addrIK) + pqEnc = PQEncryption $ pqConnectionMode addrIK PQSupportOn + runRight_ $ do + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing + addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK True SMSubscribe + (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ ctData1) <- getConnShortLink bob 1 shortLink + let key1 = ratchetKeys ctData1 + liftIO $ key1 `shouldSatisfy` isJust + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True + (_, ContactLinkData _ ctData2) <- getConnShortLink carol 1 shortLink + let key2 = ratchetKeys ctData2 + liftIO $ (key1 == key2) `shouldBe` False + joinContactDR alice bob connReq key1 addrIK pqEnc + joinContactDR alice carol connReq key2 addrIK pqEnc + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True + aId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn + void $ A.joinConnection bob NRMInteractive 1 aId True connReq "bob's connInfo" key1 PQSupportOn SMSubscribe + get alice =##> \case ("", _, A.ERR _) -> True; _ -> False + +testAddDRViaSetConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO () +testAddDRViaSetConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do + g <- C.newRandom + rootKey <- atomically $ C.generateKeyPair g + linkEntId <- atomically $ C.randomBytes 32 g + let addrIK = IKPQOn + userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} + connIK = IKLinkPQ (CR.connPQEncryption addrIK) + runRight_ $ do + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing + addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK False SMSubscribe + (_, ContactLinkData _ cd0) <- getConnShortLink bob 1 shortLink + liftIO $ ratchetKeys cd0 `shouldBe` Nothing + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True + (_, ContactLinkData _ cd1) <- getConnShortLink bob 1 shortLink + liftIO $ ratchetKeys cd1 `shouldSatisfy` isJust + -- updating a DR address's mutable link data must preserve the stored ratchet keys, so requesters can still establish DR testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do From e7d0a7328f6d30b49546ecf5c0fbd1839d76c9cb Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 19 Jul 2026 08:34:59 +0100 Subject: [PATCH 69/81] rename, parameter order --- src/Simplex/Messaging/Agent.hs | 30 ++++++------- src/Simplex/Messaging/Agent/Env/SQLite.hs | 4 +- tests/AgentTests/FunctionalAPITests.hs | 52 +++++++++++------------ tests/SMPProxyTests.hs | 8 ++-- 4 files changed, 47 insertions(+), 47 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index bc42a79fe..63ac1426f 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -380,7 +380,7 @@ getConnShortLinkAsync c = withAgentEnv c .:: getConnShortLinkAsync' c {-# INLINE getConnShortLinkAsync #-} -- | Enqueue JOIN command for a prepared connection. -joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AE () +joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AE () joinConnectionAsync c aCorrId updateConn connId enableNtfs = withAgentEnv c .::. joinConnAsync c aCorrId updateConn connId enableNtfs {-# INLINE joinConnectionAsync #-} @@ -484,7 +484,7 @@ prepareConnectionToAccept c userId enableNtfs = withAgentEnv c .: newConnToAccep {-# INLINE prepareConnectionToAccept #-} -- | Join SMP agent connection (JOIN command). -joinConnection :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AE SndQueueSecured +joinConnection :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured joinConnection c nm userId connId enableNtfs = withAgentEnv c .::. joinConn c nm userId connId enableNtfs {-# INLINE joinConnection #-} @@ -866,8 +866,8 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do -- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection, -- and join should retry, the same as 1-time invitation joins. -joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AM () -joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} cInfo addrKeys_ pqSup subMode = do +joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AM () +joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} addrKeys_ cInfo pqSup subMode = do when updateConn $ throwE $ CMD PROHIBITED "joinConnAsync: updateConn not allowed for invitation URI" when (isJust addrKeys_) $ throwE $ CMD PROHIBITED "joinConnAsync: address ratchet keys not allowed for invitation URI" withInvLock c (strEncode cReqUri) "joinConnAsync" $ @@ -876,7 +876,7 @@ joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} c let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport Nothing) subMode cInfo Nothing -> throwE $ AGENT A_VERSION -joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) cInfo addrKeys_ pqSup subMode = +joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) addrKeys_ cInfo pqSup subMode = lift (compatibleContactUri cReqUri) >>= \case Just (_, Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing @@ -903,7 +903,7 @@ acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMo withStore' c $ \db -> acceptInvitation db invId ownConnInfo let joinCmd = case connReq of CRInvitationDR dr -> enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitationDR dr) subMode ownConnInfo - CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode + CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq Nothing ownConnInfo pqSupport subMode joinCmd `catchAllErrors` \err -> do withStore' c (`unacceptInvitation` invId) throwE err @@ -1019,7 +1019,7 @@ newAddressRatchetKeys :: AgentClient -> ConnId -> PQSupport -> AM AddressRatchet newAddressRatchetKeys c connId pqSupport = do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config - keep <- asks $ addressRatchetKeysToKeep . config + keep <- asks $ keepAddressKeys . config (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqSupport ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) withStore' c $ \db -> do @@ -1346,10 +1346,10 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do let cData = ConnData {userId, connId, connAgentVersion = agentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} withStore c $ \db -> createNewConn db g cData SCMInvitation -joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> AM SndQueueSecured -joinConn c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSupport subMode = do +joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured +joinConn c nm userId connId enableNtfs cReq addrKeys_ cInfo pqSupport subMode = do srv <- getNextSMPServer c userId [qServer $ connReqQueue cReq] - joinConnSrv c nm userId connId enableNtfs cReq cInfo addrKeys_ pqSupport subMode srv + joinConnSrv c nm userId connId enableNtfs cReq addrKeys_ cInfo pqSupport subMode srv connReqQueue :: ConnectionRequestUri c -> SMPQueueUri connReqQueue = \case @@ -1442,8 +1442,8 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} -joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> Maybe AddressRatchetKeys -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo addrKeys_ pqSup subMode srv = do +joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} addrKeys_ cInfo pqSup subMode srv = do when (isJust addrKeys_) $ throwE $ CMD PROHIBITED "joinConnSrv: address ratchet keys not allowed for invitation URI" withInvLock c (strEncode inv) "joinConnSrv" $ do SomeConn cType conn <- withStore c (`getConn` connId) @@ -1459,7 +1459,7 @@ joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo addrKeys_ ((cData, sq), e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup secureConfirmQueue c nm cData rq_ sq srv cInfo e2eSndParams subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) -joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo addrKeys_ pqSup subMode srv = +joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} addrKeys_ cInfo pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case Just (qInfo, Compatible v) -> withInvLock c (strEncode cReqUri) "joinConnSrv" $ do @@ -1568,7 +1568,7 @@ acceptContact' :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId r <- case connReq of - CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo Nothing pqSupport subMode + CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq Nothing ownConnInfo pqSupport subMode CRInvitationDR dr@DRInvitation {replyQueue} -> do srv <- getNextSMPServer c userId [qServer replyQueue] SomeConn cType conn <- withStore c (`getConn` connId) @@ -2009,7 +2009,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc addrKeys_) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo addrKeys_ pqEnc subMode srv + sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq addrKeys_ connInfo pqEnc subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 620821e9b..47073f6b4 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -170,7 +170,7 @@ data AgentConfig = AgentConfig xftpConsecutiveRetries :: Int, xftpMaxRecipientsPerRequest :: Int, deleteErrorCount :: Int, - addressRatchetKeysToKeep :: Int, + keepAddressKeys :: Int, ntfCron :: Word16, ntfBatchSize :: Int, ntfSubFirstCheckInterval :: NominalDiffTime, @@ -246,7 +246,7 @@ defaultAgentConfig = xftpConsecutiveRetries = 3, xftpMaxRecipientsPerRequest = 200, deleteErrorCount = 10, - addressRatchetKeysToKeep = 3, + keepAddressKeys = 3, ntfCron = 20, -- minutes ntfBatchSize = 150, ntfSubFirstCheckInterval = nominalDay, diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index ff7baf6ad..a22264dbc 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -290,7 +290,7 @@ createConnection c userId enableNtfs cMode clientData subMode = do joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured) joinConnection c userId enableNtfs cReq connInfo subMode = do connId <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn - sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq connInfo Nothing PQSupportOn subMode + sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq Nothing connInfo PQSupportOn subMode pure (connId, sndSecure) acceptContact :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured @@ -735,7 +735,7 @@ runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId = runRight_ $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ - sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing bPQ SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ @@ -964,7 +964,7 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b runRight_ $ do (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing bPQ SMSubscribe + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` reqPQSupport @@ -1036,10 +1036,10 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ if asyncJoin then do - A.joinConnectionAsync bob "join" False aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe + A.joinConnectionAsync bob "join" False aliceId True connReq' addrKeys_ "bob's connInfo" bPQ SMSubscribe get bob =##> \case ("join", c, A.JOINED sqSecured) -> c == aliceId && not sqSecured; _ -> False else do - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" addrKeys_ bPQ SMSubscribe + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' addrKeys_ "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False ("", _, A.REQ invId reqPQ _ "bob's connInfo") <- get alice liftIO $ reqPQ `shouldBe` PQSupportOn @@ -1071,7 +1071,7 @@ testContactDRMatrix ps = do joinContactDR :: HasCallStack => AgentClient -> AgentClient -> ConnectionRequestUri 'CMContact -> Maybe AddressRatchetKeys -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO () joinContactDR alice requester connReq addrKeys_ addrIK pqEnc = do aliceId <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn - void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq "bob's connInfo" addrKeys_ PQSupportOn SMSubscribe + void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq addrKeys_ "bob's connInfo" PQSupportOn SMSubscribe ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice reqId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) void $ acceptContact alice 1 reqId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe @@ -1102,7 +1102,7 @@ testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob ca void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True aId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn - void $ A.joinConnection bob NRMInteractive 1 aId True connReq "bob's connInfo" key1 PQSupportOn SMSubscribe + void $ A.joinConnection bob NRMInteractive 1 aId True connReq key1 "bob's connInfo" PQSupportOn SMSubscribe get alice =##> \case ("", _, A.ERR _) -> True; _ -> False testAddDRViaSetConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO () @@ -1145,7 +1145,7 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ updated) <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" (ratchetKeys updated) bPQ SMSubscribe + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' (ratchetKeys updated) "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) @@ -1170,7 +1170,7 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK True SMSubscribe (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink aId <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn - _ <- A.joinConnection bob NRMInteractive 1 aId True connReq' "bob's connInfo" (ratchetKeys userCtData') PQSupportOn SMSubscribe + _ <- A.joinConnection bob NRMInteractive 1 aId True connReq' (ratchetKeys userCtData') "bob's connInfo" PQSupportOn SMSubscribe ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) pure (bId, invId, aId) @@ -1198,7 +1198,7 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId msgId = subtract baseId . fst connectViaContact b pq qInfo = do aId <- A.prepareConnectionToJoin b 1 True qInfo pq - sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" Nothing pq SMSubscribe + sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo Nothing "bob's connInfo" pq SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -1244,7 +1244,7 @@ testRejectContactRequest = withAgentClients2 $ \alice bob -> runRight_ $ do (_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice rejectContact alice invId @@ -1257,7 +1257,7 @@ testUpdateConnectionUserId = newUserId <- createUser alice False [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer] _ <- changeConnectionUser alice 1 connId newUserId aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured' `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -1417,13 +1417,13 @@ testInvitationErrors ps restart = do ("", "", DOWN _ [_]) <- nGet a aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to secure the queue on testPort - BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe + BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe (testPort `isSuffixOf` srv) `shouldBe` True withServer1 ps $ do ("", "", UP _ [_]) <- nGet a let loopSecure = do -- secures the queue on testPort, but fails to create reply queue on testPort2 - BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe + BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe unless (testPort2 `isSuffixOf` srv2) $ putStrLn "retrying secure" >> threadDelay 200000 >> loopSecure loopSecure ("", "", DOWN _ [_]) <- nGet a @@ -1431,7 +1431,7 @@ testInvitationErrors ps restart = do threadDelay 200000 let loopCreate = do -- creates the reply queue on testPort2, but fails to send it to testPort - BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe + BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create" >> threadDelay 200000 >> loopCreate loopCreate restartAgentB restart b [aId] @@ -1440,7 +1440,7 @@ testInvitationErrors ps restart = do ("", "", UP _ [_]) <- nGet a threadDelay 200000 let loopConfirm n = - runExceptT (A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe) >>= \case + runExceptT (A.joinConnection b' NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe) >>= \case Right True -> pure n Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying confirm" >> threadDelay 200000 >> loopConfirm (n + 1) @@ -1487,12 +1487,12 @@ testContactErrors ps restart = do ("", "", DOWN _ [_]) <- nGet a aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to create queue on testPort2 - BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe + BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe (testPort2 `isSuffixOf` srv2) `shouldBe` True b' <- restartAgentB restart b [aId] let loopCreate2 = do -- creates the reply queue on testPort2, but fails to send invitation to testPort - BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe + BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b' NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create 2" >> threadDelay 200000 >> loopCreate2 b'' <- withServer2 ps $ do loopCreate2 @@ -1502,7 +1502,7 @@ testContactErrors ps restart = do ("", "", UP _ [_]) <- nGet a let loopSend = do -- sends the invitation to testPort - runExceptT (A.joinConnection b'' NRMInteractive 1 aId True cReq "bob's connInfo" Nothing PQSupportOn SMSubscribe) >>= \case + runExceptT (A.joinConnection b'' NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe) >>= \case Right False -> pure () Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying send" >> threadDelay 200000 >> loopSend @@ -1591,7 +1591,7 @@ testInvitationShortLink viaProxy a b = 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 NRMInteractive 1 aId True connReq "bob's connInfo" Nothing PQSupportOn SMSubscribe + sndSecure' <- A.joinConnection b NRMInteractive 1 aId True connReq Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` sndSecure ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" @@ -1619,7 +1619,7 @@ testInvitationShortLinkAsync viaProxy a b = do linkUserData connData' `shouldBe` userData runRight $ do aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn - A.joinConnectionAsync b "123" False aId True connReq "bob's connInfo" Nothing PQSupportOn SMSubscribe + A.joinConnectionAsync b "123" False aId True connReq Nothing "bob's connInfo" PQSupportOn SMSubscribe get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" @@ -2602,7 +2602,7 @@ makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> Agent makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) SMSubscribe aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport - sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" Nothing pqSupport SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo Nothing "bob's connInfo" pqSupport SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` pqSupport @@ -2884,7 +2884,7 @@ testAsyncCommands sqSecured alice bob baseId = ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId aliceId <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn - joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + joinConnectionAsync bob "2" False aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe ("2", aliceId', JOINED sqSecured') <- get bob liftIO $ do aliceId' `shouldBe` aliceId @@ -2975,7 +2975,7 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> liftIO $ qInfo' `shouldBe` qInfo liftIO $ userCtData' `shouldBe` userCtData -- join connection async using connId from getConnShortLinkAsync - joinConnectionAsync bob "2" True newId True qInfo' "bob's connInfo" Nothing PQSupportOn SMSubscribe + joinConnectionAsync bob "2" True newId True qInfo' Nothing "bob's connInfo" PQSupportOn SMSubscribe let aliceId = newId ("2", aliceId', JOINED False) <- get bob liftIO $ aliceId' `shouldBe` aliceId @@ -3288,7 +3288,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn - joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + joinConnectionAsync b "2" False aId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) @@ -3335,7 +3335,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn - joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + joinConnectionAsync b "2" False aId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 1a928a836..f580e15a2 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -234,7 +234,7 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -290,7 +290,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs = prePair alice bob = do (bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True confId <- get alice >>= \case @@ -341,7 +341,7 @@ agentViaProxyVersionError = withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do (_bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe pure () where servers srvs = (initAgentServersProxy_ SPMUnknown SPFProhibit) {smp = userServers srvs} @@ -361,7 +361,7 @@ agentViaProxyRetryOffline = do (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" Nothing PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn From 068d7d9fc00c8d4896e897f3df8854d9a3f55f37 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 19 Jul 2026 14:24:06 +0000 Subject: [PATCH 70/81] refactor, include ratchet keys into ConnectionRequestUri --- src/Simplex/Messaging/Agent.hs | 301 ++++++++++++--------- src/Simplex/Messaging/Agent/Protocol.hs | 116 ++++++-- src/Simplex/Messaging/Crypto/ShortLink.hs | 8 +- tests/AgentTests/ConnectionRequestTests.hs | 79 +++--- tests/AgentTests/EqInstances.hs | 9 +- tests/AgentTests/FunctionalAPITests.hs | 248 ++++++++--------- tests/AgentTests/SQLiteTests.hs | 2 +- tests/AgentTests/ShortLinkTests.hs | 8 +- tests/SMPProxyTests.hs | 20 +- 9 files changed, 454 insertions(+), 337 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 63ac1426f..f39b795f9 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -365,8 +365,8 @@ prepareConnectionToCreate c userId enableNtfs = withAgentEnv c .: newConnNoQueue {-# INLINE prepareConnectionToCreate #-} -- | Enqueue NEW command for a prepared connection. -createConnectionAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AE () -createConnectionAsync c aCorrId connId enableNtfs = withAgentEnv c .:. newConnAsync c aCorrId connId enableNtfs +createConnectionAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AE () +createConnectionAsync c aCorrId connId enableNtfs = withAgentEnv c .:: newConnAsync c aCorrId connId enableNtfs {-# INLINE createConnectionAsync #-} -- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response @@ -380,8 +380,8 @@ getConnShortLinkAsync c = withAgentEnv c .:: getConnShortLinkAsync' c {-# INLINE getConnShortLinkAsync #-} -- | Enqueue JOIN command for a prepared connection. -joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AE () -joinConnectionAsync c aCorrId updateConn connId enableNtfs = withAgentEnv c .::. joinConnAsync c aCorrId updateConn connId enableNtfs +joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE () +joinConnectionAsync c aCorrId updateConn connId enableNtfs = withAgentEnv c .:: joinConnAsync c aCorrId updateConn connId enableNtfs {-# INLINE joinConnectionAsync #-} -- | Allow connection to continue after CONF notification (LET command), no synchronous response @@ -415,27 +415,27 @@ deleteConnectionsAsync c waitDelivery = withAgentEnv c . deleteConnectionsAsync' {-# INLINE deleteConnectionsAsync #-} -- | Create SMP agent connection (NEW command) -createConnection :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, CreatedConnLink c) -createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::. newConn c nm userId enableNtfs checkNotices +createConnection :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AE (ConnId, CreatedConnLink c) +createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::: newConn c nm userId enableNtfs checkNotices {-# INLINE createConnection #-} -- | Prepare connection link for contact mode (no network call). -- Caller provides root signing key pair and link entity ID. -- Returns the created link and internal params. -- The link address is fully determined at this point. -prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams) -prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData srv_ = - withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData srv_ +prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams) +prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData pqInitKeys advertiseDR srv_ = + withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys advertiseDR srv_ {-# INLINE prepareConnectionLink #-} -- | Create connection for prepared link (single network call). -- Validates that server response matches the prepared link. -createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AE ConnId -createConnectionForLink c nm userId enableNtfs = withAgentEnv c .::: createConnectionForLink' c nm userId enableNtfs +createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AE ConnId +createConnectionForLink c nm userId enableNtfs = withAgentEnv c .:: createConnectionForLink' c nm userId enableNtfs {-# INLINE createConnectionForLink #-} -- | Create or update user's contact connection short link -setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> Bool -> AE (ConnShortLink c) +setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> AE (ConnShortLink c) setConnShortLink c = withAgentEnv c .::: setConnShortLink' c {-# INLINE setConnShortLink #-} @@ -444,7 +444,7 @@ deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c {-# INLINE deleteConnShortLink #-} -- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries -getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c) +getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c, ConnectionRequestUri c) getConnShortLink c = withAgentEnv c .:. getConnShortLink' c {-# INLINE getConnShortLink #-} @@ -484,8 +484,8 @@ prepareConnectionToAccept c userId enableNtfs = withAgentEnv c .: newConnToAccep {-# INLINE prepareConnectionToAccept #-} -- | Join SMP agent connection (JOIN command). -joinConnection :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured -joinConnection c nm userId connId enableNtfs = withAgentEnv c .::. joinConn c nm userId connId enableNtfs +joinConnection :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured +joinConnection c nm userId connId enableNtfs = withAgentEnv c .:: joinConn c nm userId connId enableNtfs {-# INLINE joinConnection #-} -- | Allow connection to continue after CONF notification (LET command) @@ -852,9 +852,9 @@ setUserService' c userId enable = do unless ok $ throwE $ CMD PROHIBITED "setUserService" when (changed && not enable) $ withStore' c (`deleteClientServices` userId) -newConnAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AM () -newConnAsync c corrId connId enableNtfs cMode pqInitKeys subMode = - enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode +newConnAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AM () +newConnAsync c corrId connId enableNtfs cMode pqInitKeys advertiseDR subMode = + enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode advertiseDR {-# INLINE newConnAsync #-} newConnNoQueues :: AgentClient -> UserId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId @@ -866,22 +866,21 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do -- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection, -- and join should retry, the same as 1-time invitation joins. -joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AM () -joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} addrKeys_ cInfo pqSup subMode = do +joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM () +joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do when updateConn $ throwE $ CMD PROHIBITED "joinConnAsync: updateConn not allowed for invitation URI" - when (isJust addrKeys_) $ throwE $ CMD PROHIBITED "joinConnAsync: address ratchet keys not allowed for invitation URI" withInvLock c (strEncode cReqUri) "joinConnAsync" $ lift (compatibleInvitationUri cReqUri) >>= \case Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport Nothing) subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo Nothing -> throwE $ AGENT A_VERSION -joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) addrKeys_ cInfo pqSup subMode = +joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode = lift (compatibleContactUri cReqUri) >>= \case - Just (_, Compatible connAgentVersion) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing + Just (_, ratchet_, Compatible connAgentVersion) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (addrKeysE2EVersion ratchet_) when updateConn $ withStore' c $ \db -> updateNewConnJoin db connId connAgentVersion pqSupport enableNtfs - enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport addrKeys_) subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo Nothing -> throwE $ AGENT A_VERSION allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM () @@ -903,7 +902,7 @@ acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMo withStore' c $ \db -> acceptInvitation db invId ownConnInfo let joinCmd = case connReq of CRInvitationDR dr -> enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRInvitationDR dr) subMode ownConnInfo - CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq Nothing ownConnInfo pqSupport subMode + CRInvitation cReq -> joinConnAsync c corrId False connId enableNtfs cReq ownConnInfo pqSupport subMode joinCmd `catchAllErrors` \err -> do withStore' c (`unacceptInvitation` invId) throwE err @@ -959,44 +958,53 @@ switchConnectionAsync' c corrId connId = connectionStats c $ DuplexConnection cData rqs' sqs _ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex" -newConn :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, CreatedConnLink c) -newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKeys subMode = do +newConn :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AM (ConnId, CreatedConnLink c) +newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKeys advertiseDR subMode = do srv <- getSMPServer c userId when (checkNotices && connMode cMode == CMContact) $ checkClientNotices c srv connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys) (connId,) - <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv + <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys advertiseDR subMode srv `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e -- | Prepare connection link for contact mode (no network, no database). -- Caller provides root signing key pair and link entity ID. -prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams) -prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData srv_ = do +prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams) +prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData pqInitKeys advertiseDR srv_ = do + case pqInitKeys of + CR.IKUsePQ -> throwE $ CMD PROHIBITED "prepareConnectionLink" + _ -> pure () g <- asks random plpSrvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_ when checkNotices $ checkClientNotices c plpSrvWithAuth AgentConfig {smpClientVRange, smpAgentVRange} <- asks config plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g + -- when opted in, generate the advertised DR keys in memory so the returned connReq carries them; the private + -- half is persisted later in createConnectionForLink. The bundle uses the connection's PQ, so its KEM is present + -- iff owner PQ is on, letting a PQ requester encrypt its first message (profile) with PQ from message 1. + addrKeys_ <- if advertiseDR then Just <$> generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) else pure Nothing let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact) - connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData + connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) (fst <$> addrKeys_) (plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq (Just linkEntityId) ccLink = CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey - params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} + params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys = pqInitKeys, plpAddressKeys = snd <$> addrKeys_} pure (ccLink, params) -- | Create connection for prepared link (single network call). -createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AM ConnId -createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys advertiseDR subMode = do +createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AM ConnId +createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys, plpAddressKeys} userLinkData subMode = do g <- asks random AgentConfig {smpAgentVRange} <- asks config - case pqInitKeys of - CR.IKUsePQ -> throwE $ CMD PROHIBITED "createConnectionForLink" - _ -> pure () - connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption pqInitKeys) - userLinkData' <- if advertiseDR then advertiseDRKeys connId else pure userLinkData - let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq + connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption plpInitKeys) + -- persist the private half of the advertised keys (generated in prepareConnectionLink) so the owner can complete + -- the ratchet when a requester joins; the public half rides in the connReq and goes into the mutable link data + mapM_ (storeAddressRatchetKeys c connId) plpAddressKeys + let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} addrKeys_ = connReq + userLinkData' = case addrKeys_ of + Just arKeys -> let UserContactLinkData ucd = userLinkData in UserContactLinkData ucd {ratchetKeys = Just arKeys} + Nothing -> userLinkData md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData' linkData = (plpSignedFixedData, md) qd <- encryptContactLinkData g plpRootPrivKey plpLinkKey sndId linkData @@ -1006,26 +1014,33 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP let SMPQueueUri _ SMPQueueAddress {senderId = actualSndId} = qUri unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch" pure connId - where - advertiseDRKeys :: ConnId -> AM (UserConnLinkData 'CMContact) - advertiseDRKeys connId = do - -- the advertised bundle uses the connection's PQ, so its KEM is present iff the owner PQ is on, letting a - -- PQ requester encrypt its first message (profile) with PQ from message 1 - arKeys <- newAddressRatchetKeys c connId (CR.connPQEncryption pqInitKeys) - let UserContactLinkData ucd = userLinkData - pure $ UserContactLinkData ucd {ratchetKeys = Just arKeys} -newAddressRatchetKeys :: AgentClient -> ConnId -> PQSupport -> AM AddressRatchetKeys -newAddressRatchetKeys c connId pqSupport = do +-- Generate a fresh address ratchet key set in memory (no DB): the advertised public part and the private half to persist. +generateAddressRatchetKeys :: PQSupport -> AM (AddressRatchetKeys, StoredAddressRatchetKeys) +generateAddressRatchetKeys pqSupport = do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config - keep <- asks $ keepAddressKeys . config (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqSupport ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) + pure + ( AddressRatchetKeys {ratchetKeyId, e2eRcvParams = toVersionRangeT e2eParams e2eVR}, + StoredAddressRatchetKeys {saRatchetKeyId = ratchetKeyId, saRcvPrivKey1 = pk1, saRcvPrivKey2 = pk2, saRcvPrivKem = pKem} + ) + +-- Persist the private half (keyed by connId + ratchetKeyId) and prune old keys. +storeAddressRatchetKeys :: AgentClient -> ConnId -> StoredAddressRatchetKeys -> AM () +storeAddressRatchetKeys c connId StoredAddressRatchetKeys {saRatchetKeyId, saRcvPrivKey1, saRcvPrivKey2, saRcvPrivKem} = do + keep <- asks $ keepAddressKeys . config withStore' c $ \db -> do - createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem + createAddressRatchetKeys db connId saRatchetKeyId saRcvPrivKey1 saRcvPrivKey2 saRcvPrivKem deleteOldAddressRatchetKeys db connId keep - pure AddressRatchetKeys {ratchetKeyId, e2eRcvParams = toVersionRangeT e2eParams e2eVR} + +-- Generate + persist, used for rotation via setConnShortLink where the connId already exists. +newAddressRatchetKeys :: AgentClient -> ConnId -> PQSupport -> AM AddressRatchetKeys +newAddressRatchetKeys c connId pqSupport = do + (arKeys, stored) <- generateAddressRatchetKeys pqSupport + storeAddressRatchetKeys c connId stored + pure arKeys currentAddressRatchetKeys :: AgentClient -> ConnId -> AM (Maybe AddressRatchetKeys) currentAddressRatchetKeys c connId = @@ -1113,7 +1128,7 @@ getConnShortLinkAsync' c userId corrId connId_ shortLink@(CSLContact _ _ srv _) } createNewConn db g cData SCMInvitation -setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> Bool -> AM (ConnShortLink c) +setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> AM (ConnShortLink c) setConnShortLink' c nm connId cMode userLinkData clientData rotate = withConnLock c connId "setConnShortLink" $ do SomeConn _ conn <- withStore c (`getConn` connId) @@ -1144,7 +1159,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotate = Nothing -> do sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact} - connReq = CRContactUri $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData + connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) ratchetKeys (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud (linkId, k) = SL.contactShortLinkKdf linkKey srvData <- liftError id $ SL.encryptLinkData g k linkData @@ -1180,7 +1195,7 @@ getConnLinkPrivKey' c connId = do _ -> Nothing -- TODO [short links] remove 1-time invitation data and link ID from the server after the message is sent. -getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (FixedLinkData c, ConnLinkData c) +getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (FixedLinkData c, ConnLinkData c, ConnectionRequestUri c) getConnShortLink' c nm userId = \case CSLInvitation _ srv linkId linkKey -> do g <- asks random @@ -1201,22 +1216,29 @@ getConnShortLink' c nm userId = \case ld <- getQueueLink c nm userId srv linkId decryptData srv linkKey k ld where - decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c) + decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c, ConnectionRequestUri c) decryptData srv linkKey k (sndId, d) = do - r@(fd, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d - let (srv', sndId') = qAddress (connReqQueue $ linkConnReq fd) + (fd0, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d + -- merge the keys-less fixed-data connReq with the mutable ratchet keys, so callers get the full address connReq + let connReq0 = connReqWithKeys (linkConnReq fd0) (clRatchetKeys clData) + (srv', sndId') = qAddress (connReqQueue connReq0) unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address" - pure $ if srv' == srv then r else (updateConnReqServer srv fd, clData) + let fd = if srv' == srv then fd0 else updateConnReqServer srv fd0 + pure (fd, clData, connReqWithKeys (linkConnReq fd) (clRatchetKeys clData)) sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c updateConnReqServer srv fd = let connReq' = case linkConnReq fd of - CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams - CRContactUri crData -> CRContactUri $ updateQueues crData + BCRInvitationUri crData e2eParams -> BCRInvitationUri (updateQueues crData) e2eParams + BCRContactUri crData -> BCRContactUri $ updateQueues crData in fd {linkConnReq = connReq'} where updateQueues crData@(ConnReqUriData {crSmpQueues = SMPQueueUri vr addr :| qs}) = crData {crSmpQueues = SMPQueueUri vr addr {smpServer = srv} :| qs} + clRatchetKeys :: ConnLinkData c -> Maybe AddressRatchetKeys + clRatchetKeys = \case + InvitationLinkData {} -> Nothing + ContactLinkData _ UserContactData {ratchetKeys} -> ratchetKeys deleteLocalInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM () deleteLocalInvShortLink' c (CSLInvitation _ srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId @@ -1236,38 +1258,50 @@ changeConnectionUser' c oldUserId connId newUserId = do where updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId -newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink c) -newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do +newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink c) +newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqInitKeys advertiseDR subMode srvWithAuth@(ProtoServerWithAuth srv _) = do case (cMode, pqInitKeys) of (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" _ -> pure () + -- when opted in, generate + persist the advertised DR keys for a contact address; the public half goes into the + -- connReq and the mutable link data so requesters can start the ratchet from message 1 + addrKeys_ <- case cMode of + SCMContact | advertiseDR -> do + (arKeys, stored) <- generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) + storeAddressRatchetKeys c connId stored + pure $ Just arKeys + _ -> pure Nothing e2eKeys <- atomically . C.generateKeyPair =<< asks random case userLinkData_ of Just d -> do - (nonce, qUri, cReq, qd) <- prepareLinkData d $ fst e2eKeys + (nonce, qUri, cReq, qd) <- prepareLinkData addrKeys_ (setLinkDataRatchetKeys addrKeys_ d) $ fst e2eKeys (rq, qUri') <- createRcvQueue c nm userId connId srvWithAuth enableNtfs subMode (Just nonce) qd e2eKeys - ccLink <- connReqWithShortLink qUri cReq qUri' (shortLink rq) - pure ccLink + connReqWithShortLink qUri cReq qUri' (shortLink rq) Nothing -> do let qd = case cMode of SCMContact -> CQRContact Nothing; SCMInvitation -> CQRMessaging Nothing (_rq, qUri) <- createRcvQueue c nm userId connId srvWithAuth enableNtfs subMode Nothing qd e2eKeys - cReq <- createConnReq qUri + cReq <- createConnReq addrKeys_ qUri pure $ CCLink cReq Nothing where - createConnReq :: SMPQueueUri -> AM (ConnectionRequestUri c) - createConnReq qUri = do + createConnReq :: Maybe AddressRatchetKeys -> SMPQueueUri -> AM (ConnectionRequestUri c) + createConnReq addrKeys_ qUri = do AgentConfig {smpAgentVRange, e2eEncryptVRange} <- asks config let crData = ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData case cMode of - SCMContact -> pure $ CRContactUri crData + SCMContact -> pure $ CRContactUri crData addrKeys_ SCMInvitation -> do g <- asks random let pqEnc = CR.initialPQEncryption (isJust userLinkData_) pqInitKeys (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange - prepareLinkData :: UserConnLinkData c -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData) - prepareLinkData userLinkData e2eDhKey = do + -- inject the agent-generated advertised keys into the contact mutable link data (requesters fetch them here) + setLinkDataRatchetKeys :: Maybe AddressRatchetKeys -> UserConnLinkData c -> UserConnLinkData c + setLinkDataRatchetKeys ks = \case + UserContactLinkData ucd -> UserContactLinkData ucd {ratchetKeys = ks} + d@UserInvLinkData {} -> d + prepareLinkData :: Maybe AddressRatchetKeys -> UserConnLinkData c -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData) + prepareLinkData addrKeys_ userLinkData e2eDhKey = do g <- asks random nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g @@ -1276,7 +1310,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId qm = case cMode of SCMContact -> QMContact; SCMInvitation -> QMMessaging qUri = SMPQueueUri vr $ SMPQueueAddress srv sndId e2eDhKey (Just qm) - connReq <- createConnReq qUri + connReq <- createConnReq addrKeys_ qUri let (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing userLinkData qd <- case cMode of SCMContact -> encryptContactLinkData g privSigKey linkKey sndId linkData @@ -1289,7 +1323,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey} | qUri == qUri' -> pure $ case cReq of - CRContactUri _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey + CRContactUri _ _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) -> let cReq' = case pqInitKeys of CR.IKPQOn -> CRInvitationUri crData $ CR.E2ERatchetParamsUri vr k1 k2 Nothing -- remove PQ keys @@ -1299,7 +1333,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni Nothing -> let updated (ConnReqUriData _ vr _ _) = (ConnReqUriData SSSimplex vr [qUri'] clientData) cReq' = case cReq of - CRContactUri crData -> CRContactUri (updated crData) + CRContactUri crData rk -> CRContactUri (updated crData) rk CRInvitationUri crData e2eParams -> CRInvitationUri (updated crData) e2eParams in pure $ CCLink cReq' Nothing @@ -1326,7 +1360,7 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of Nothing -> throwE $ AGENT A_VERSION CRContactUri {} -> lift (compatibleContactUri cReq) >>= \case - Just (_, aVersion) -> create aVersion Nothing + Just (_, ratchet_, aVersion) -> create aVersion (addrKeysE2EVersion ratchet_) Nothing -> throwE $ AGENT A_VERSION where create :: Compatible VersionSMPA -> Maybe CR.VersionE2E -> AM ConnId @@ -1346,15 +1380,16 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do let cData = ConnData {userId, connId, connAgentVersion = agentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} withStore c $ \db -> createNewConn db g cData SCMInvitation -joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured -joinConn c nm userId connId enableNtfs cReq addrKeys_ cInfo pqSupport subMode = do +joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured +joinConn c nm userId connId enableNtfs cReq cInfo pqSupport subMode = do srv <- getNextSMPServer c userId [qServer $ connReqQueue cReq] - joinConnSrv c nm userId connId enableNtfs cReq addrKeys_ cInfo pqSupport subMode srv + joinConnSrv c nm userId connId enableNtfs cReq cInfo pqSupport subMode srv +-- a queue is addressed by server + sender-ID + DH key; the advertised DR keys are not part of that address connReqQueue :: ConnectionRequestUri c -> SMPQueueUri connReqQueue = \case CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q - CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q + CRContactUri ConnReqUriData {crSmpQueues = q :| _} _ -> q startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM ((ConnData, SndQueue), Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = @@ -1419,7 +1454,7 @@ connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of invPQSupported (_, Compatible (CR.E2ERatchetParams e2eV _ _ _), Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV (Just e2eV)) CRContactUri {} -> ctPQSupported <$$> compatibleContactUri cReq where - ctPQSupported (_, Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV Nothing) + ctPQSupported (_, ratchet_, Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV (addrKeysE2EVersion ratchet_)) compatibleInvitationUri :: ConnectionRequestUri 'CMInvitation -> AM' (Maybe (Compatible SMPQueueInfo, Compatible (CR.RcvE2ERatchetParams 'C.X448), Compatible VersionSMPA)) compatibleInvitationUri (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) = do @@ -1430,21 +1465,31 @@ compatibleInvitationUri (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQue <*> (e2eRcvParamsUri `compatibleVersion` e2eEncryptVRange) <*> (crAgentVRange `compatibleVersion` smpAgentVRange) -compatibleContactUri :: ConnectionRequestUri 'CMContact -> AM' (Maybe (Compatible SMPQueueInfo, Compatible VersionSMPA)) -compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)}) = do - AgentConfig {smpClientVRange, smpAgentVRange} <- asks config - pure $ - (,) - <$> (qUri `compatibleVersion` smpClientVRange) - <*> (crAgentVRange `compatibleVersion` smpAgentVRange) +-- | A contact address advertising DR keys must have version-compatible e2e ratchet params too; the returned +-- Compatible params (and ratchetKeyId) are what joinConnSrv/connRequestPQSupport use, so the check lives here. +compatibleContactUri :: ConnectionRequestUri 'CMContact -> AM' (Maybe (Compatible SMPQueueInfo, Maybe (RatchetKeyId, Compatible (CR.RcvE2ERatchetParams 'C.X448)), Compatible VersionSMPA)) +compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} addrKeys_) = do + AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config + pure $ do + q <- qUri `compatibleVersion` smpClientVRange + v <- crAgentVRange `compatibleVersion` smpAgentVRange + -- an advertised DR bundle must be version-compatible, otherwise the whole address is incompatible + ratchet_ <- case addrKeys_ of + Nothing -> Just Nothing + Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams} -> + Just . (ratchetKeyId,) <$> (e2eRcvParams `compatibleVersion` e2eEncryptVRange) + pure (q, ratchet_, v) versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} -joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> Maybe AddressRatchetKeys -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} addrKeys_ cInfo pqSup subMode srv = do - when (isJust addrKeys_) $ throwE $ CMD PROHIBITED "joinConnSrv: address ratchet keys not allowed for invitation URI" +-- | e2e ratchet version of a contact address's compatible advertised DR keys (if any), for PQ-support calculation. +addrKeysE2EVersion :: Maybe (RatchetKeyId, Compatible (CR.RcvE2ERatchetParams 'C.X448)) -> Maybe CR.VersionE2E +addrKeysE2EVersion = fmap $ \(_, Compatible (CR.E2ERatchetParams e2eV _ _ _)) -> e2eV + +joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured +joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do SomeConn cType conn <- withStore c (`getConn` connId) case conn of @@ -1459,44 +1504,42 @@ joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} addrKeys_ cInfo ((cData, sq), e2eSndParams, lnkId_) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup secureConfirmQueue c nm cData rq_ sq srv cInfo e2eSndParams subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) -joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} addrKeys_ cInfo pqSup subMode srv = +joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case - Just (qInfo, Compatible v) -> + Just (qInfo, ratchet_, Compatible v) -> withInvLock c (strEncode cReqUri) "joinConnSrv" $ do SomeConn cType conn <- withStore c (`getConn` connId) - envelope <- case addrKeys_ of + envelope <- case ratchet_ of Nothing -> do let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup CCLink cReq _ <- case conn of - NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv + NewConnection _ -> newRcvConnSrv c NRMBackground userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys False subMode srv RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType pure AgentInvitation {agentVersion = v, connReq = cReq, connInfo = cInfo} - Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams} -> do + -- the advertised keys' e2e version was already checked by compatibleContactUri; use the compatible params + Just (ratchetKeyId, Compatible e2eParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config - case e2eRcvParams `compatibleVersion` e2eVR of - Nothing -> throwE $ AGENT A_VERSION - Just (Compatible e2eParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) - maxV = maxVersion e2eVR - rq <- case conn of - NewConnection _ -> do - e2eKeys <- atomically $ C.generateKeyPair g - fst <$> createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys - RcvConnection _ rq -> pure rq - _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType - let RcvQueue {smpClientVersion = rqV} = rq - cData = (toConnData conn) {pqSupport} :: ConnData - replyQInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) - sndReply = AgentConnInfoReply (replyQInfo :| []) cInfo - (e2eSndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do - liftIO $ lockConnForUpdate db connId - e2eSndParams <- liftIO (getSndRatchet db connId e2eV) >>= either (const $ createRatchet_ db g connId maxV pqSupport e2eParams) (pure . snd) - liftIO $ setConnPQSupport db connId pqSupport - encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode sndReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) maxV - pure (e2eSndParams, encConnInfo) - pure AgentInvitationDR {agentVersion = v, e2eSndParams, ratchetKeyId, encConnInfo} + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ v (Just e2eV) + maxV = maxVersion e2eVR + rq <- case conn of + NewConnection _ -> do + e2eKeys <- atomically $ C.generateKeyPair g + fst <$> createRcvQueue c NRMBackground userId connId srv enableNtfs subMode Nothing (CQRMessaging Nothing) e2eKeys + RcvConnection _ rq -> pure rq + _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType + let RcvQueue {smpClientVersion = rqV} = rq + cData = (toConnData conn) {pqSupport} :: ConnData + replyQInfo = SMPQueueInfo rqV (rcvSMPQueueAddress rq) + sndReply = AgentConnInfoReply (replyQInfo :| []) cInfo + (e2eSndParams, encConnInfo) <- withStore c $ \db -> runExceptT $ do + liftIO $ lockConnForUpdate db connId + e2eSndParams <- liftIO (getSndRatchet db connId e2eV) >>= either (const $ createRatchet_ db g connId maxV pqSupport e2eParams) (pure . snd) + liftIO $ setConnPQSupport db connId pqSupport + encConnInfo <- fst <$> agentRatchetEncrypt db cData (smpEncode sndReply) e2eEncConnInfoLength (Just $ CR.pqSupportToEnc pqSupport) maxV + pure (e2eSndParams, encConnInfo) + pure AgentInvitationDR {agentVersion = v, e2eSndParams, ratchetKeyId, encConnInfo} void $ sendInvitation c nm userId connId qInfo envelope pure False where @@ -1568,7 +1611,7 @@ acceptContact' :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool acceptContact' c nm userId connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId r <- case connReq of - CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq Nothing ownConnInfo pqSupport subMode + CRInvitation cReq -> joinConn c nm userId connId enableNtfs cReq ownConnInfo pqSupport subMode CRInvitationDR dr@DRInvitation {replyQueue} -> do srv <- getNextSMPServer c userId [qServer replyQueue] SomeConn cType conn <- withStore c (`getConn` connId) @@ -1979,10 +2022,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do processCmd :: RetryInterval -> PendingCommand -> TVar [ATransmission] -> AM () processCmd ri PendingCommand {cmdId, corrId, userId, command} pendingCmds = case command of AClientCommand cmd -> case cmd of - NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do + NEW enableNtfs (ACM cMode) pqEnc subMode advertiseDR -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do - CCLink cReq _ <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv + CCLink cReq _ <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc advertiseDR subMode srv notify $ INV (ACR cMode cReq) LSET userLinkData clientData -> withServer' . tryCommand $ do @@ -1990,15 +2033,15 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do notify $ LINK link userLinkData LGET shortLink -> withServer' . tryCommand $ do - (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink - notify $ LDATA fixedData linkData + (fixedData, linkData, connReq) <- getConnShortLink' c NRMBackground userId shortLink + notify $ LDATA fixedData linkData connReq JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do let startJoin sq_ = (,Nothing,Nothing) <$> startJoinInvitationDR c userId connId sq_ dr sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv notify $ JOINED sqSecured - JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc _) subMode connInfo -> noServer $ do + JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do let startJoin sq_ = startJoinInvitation c userId connId sq_ enableNtfs cReq pqEnc @@ -2006,10 +2049,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do notify $ JOINED sqSecured -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. - JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc addrKeys_) subMode connInfo -> noServer $ do + JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do - sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq addrKeys_ connInfo pqEnc subMode srv + sqSecured <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 8a05730f2..1ad950709 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -110,6 +110,10 @@ module Simplex.Messaging.Agent.Protocol ConnectionModeI (..), ConnectionRequestUri (..), AConnectionRequestUri (..), + BinaryConnectionRequestUri (..), + ABinaryConnectionRequestUri (..), + binaryConnReq, + connReqWithKeys, ShortLinkCreds (..), ConnReqUriData (..), CRClientData, @@ -122,6 +126,8 @@ module Simplex.Messaging.Agent.Protocol UserContactData (..), UserLinkData (..), AddressRatchetKeys (..), + StoredAddressRatchetKeys (..), + NewRatchetKeys, DRInvitation (..), RatchetKeyId (..), OwnerAuth (..), @@ -240,6 +246,7 @@ import Simplex.Messaging.Crypto.Ratchet RatchetX448, RcvE2ERatchetParams, RcvE2ERatchetParamsUri, + RcvPrivRKEMParams, SndE2ERatchetParams, pattern PQSupportOff, pattern PQSupportOn, @@ -407,7 +414,7 @@ type UseRatchetKeys = Bool data AEvent (e :: AEntity) where INV :: AConnectionRequestUri -> AEvent AEConn LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn - LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn + LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> ConnectionRequestUri 'CMContact -> AEvent AEConn CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender INFO :: PQSupport -> ConnInfo -> AEvent AEConn @@ -464,7 +471,7 @@ instance Eq AEvtTag where deriving instance Show AEvtTag data ACommand - = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV + = NEW Bool AConnectionMode InitialKeys SubscriptionMode UseRatchetKeys -- response INV; UseRatchetKeys advertises address DR keys (contact mode) | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK | LGET (ConnShortLink 'CMContact) -- response LDATA | JOIN JoinRequest SubscriptionMode ConnInfo @@ -1154,11 +1161,12 @@ instance Encoding AMessageReceipt where instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where strEncode = \case - CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams) - CRContactUri crData -> crEncode "contact" crData Nothing + CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams) Nothing + CRContactUri crData Nothing -> crEncode "contact" crData Nothing Nothing + CRContactUri crData (Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}) -> crEncode "contact" crData (Just e2eRcvParams) (Just ratchetKeyId) where - crEncode :: ByteString -> ConnReqUriData -> Maybe (RcvE2ERatchetParamsUri 'C.X448) -> ByteString - crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} e2eParams = + crEncode :: ByteString -> ConnReqUriData -> Maybe (RcvE2ERatchetParamsUri 'C.X448) -> Maybe RatchetKeyId -> ByteString + crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} e2eParams rk = strEncode crScheme <> "/" <> crMode <> "#/?" <> queryStr where queryStr = @@ -1166,23 +1174,24 @@ instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames [("v", strEncode crAgentVRange), ("smp", B.intercalate ";" $ map strEncode $ L.toList crSmpQueues)] <> maybe [] (\e2e -> [("e2e", strEncode e2e)]) e2eParams + <> maybe [] (\k -> [("rk", strEncode k)]) rk <> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData strP = connReqUriP' (Just SSSimplex) -instance ConnectionModeI m => Encoding (ConnectionRequestUri m) where +instance ConnectionModeI m => Encoding (BinaryConnectionRequestUri m) where smpEncode = \case - CRInvitationUri crData e2eParams -> smpEncode (CMInvitation, crData, e2eParams) - CRContactUri crData -> smpEncode (CMContact, crData) - smpP = (\(ACR _ cr) -> checkConnMode cr) <$?> smpP + BCRInvitationUri crData e2eParams -> smpEncode (CMInvitation, crData, e2eParams) + BCRContactUri crData -> smpEncode (CMContact, crData) + smpP = (\(ABCR _ cr) -> checkConnMode cr) <$?> smpP {-# INLINE smpP #-} -instance Encoding AConnectionRequestUri where - smpEncode (ACR _ cr) = smpEncode cr +instance Encoding ABinaryConnectionRequestUri where + smpEncode (ABCR _ cr) = smpEncode cr {-# INLINE smpEncode #-} smpP = smpP >>= \case - CMInvitation -> ACR SCMInvitation <$> (CRInvitationUri <$> smpP <*> smpP) - CMContact -> ACR SCMContact . CRContactUri <$> smpP + CMInvitation -> ABCR SCMInvitation <$> (BCRInvitationUri <$> smpP <*> smpP) + CMContact -> ABCR SCMContact . BCRContactUri <$> smpP instance Encoding ConnReqUriData where smpEncode ConnReqUriData {crAgentVRange, crSmpQueues, crClientData} = @@ -1225,7 +1234,10 @@ connReqUriP overrideScheme = do pure . ACR SCMInvitation $ CRInvitationUri crData crE2eParams -- contact links are adjusted to the minimum version supported by the agent -- to preserve compatibility with the old links published online - CMContact -> pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange} + CMContact -> do + e2e_ <- queryParam_ "e2e" query + rk_ <- queryParam_ "rk" query + pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange} (AddressRatchetKeys <$> rk_ <*> e2e_) where crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames @@ -1480,16 +1492,35 @@ instance Encoding SMPQueueUri where queueModeP :: Parser (Maybe QueueMode) queueModeP = Just <$> smpP <|> optional ((\case True -> QMMessaging; _ -> QMContact) <$> smpP) +data BinaryConnectionRequestUri (m :: ConnectionMode) where + BCRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> BinaryConnectionRequestUri CMInvitation + BCRContactUri :: ConnReqUriData -> BinaryConnectionRequestUri CMContact + +deriving instance Eq (BinaryConnectionRequestUri m) + +deriving instance Show (BinaryConnectionRequestUri m) + +data ABinaryConnectionRequestUri = forall m. ConnectionModeI m => ABCR (SConnectionMode m) (BinaryConnectionRequestUri m) + data ConnectionRequestUri (m :: ConnectionMode) where CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation - -- contact connection request does NOT contain E2E encryption parameters for double ratchet - - -- they are passed in AgentInvitation message - CRContactUri :: ConnReqUriData -> ConnectionRequestUri CMContact + -- optional address DR keys enable the ratchet from message 1; absent in BinaryConnectionRequestUri (link fixed data) so they can rotate via mutable data + CRContactUri :: ConnReqUriData -> Maybe AddressRatchetKeys -> ConnectionRequestUri CMContact simplexConnReqUri :: ConnectionRequestUri m -> ConnectionRequestUri m simplexConnReqUri = \case CRInvitationUri crData e2eParams -> CRInvitationUri crData {crScheme = SSSimplex} e2eParams - CRContactUri crData -> CRContactUri crData {crScheme = SSSimplex} + CRContactUri crData rk -> CRContactUri crData {crScheme = SSSimplex} rk + +binaryConnReq :: ConnectionRequestUri m -> BinaryConnectionRequestUri m +binaryConnReq = \case + CRInvitationUri crData e2eParams -> BCRInvitationUri crData e2eParams + CRContactUri crData _ -> BCRContactUri crData + +connReqWithKeys :: BinaryConnectionRequestUri m -> Maybe AddressRatchetKeys -> ConnectionRequestUri m +connReqWithKeys cr rk = case cr of + BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams + BCRContactUri crData -> CRContactUri crData rk deriving instance Eq (ConnectionRequestUri m) @@ -1547,7 +1578,12 @@ data PreparedLinkParams = PreparedLinkParams -- | smpEncode of FixedLinkData (includes linkEntityId) plpSignedFixedData :: ByteString, -- | Server with basic auth (not stored in link) - plpSrvWithAuth :: SMPServerWithAuth + plpSrvWithAuth :: SMPServerWithAuth, + -- | Connection initial keys (decided in prepareConnectionLink, used to create the connection) + plpInitKeys :: InitialKeys, + -- | Private half of the advertised address ratchet keys, generated in prepareConnectionLink and + -- persisted in createConnectionForLink; present iff the address advertises DR keys + plpAddressKeys :: Maybe StoredAddressRatchetKeys } deriving (Show) @@ -1761,7 +1797,7 @@ findPresetServer ProtocolServer {host = h :| _} = find (\ProtocolServer {host = {-# INLINE findPresetServer #-} sameConnReqContact :: ConnectionRequestUri 'CMContact -> ConnectionRequestUri 'CMContact -> Bool -sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs}) (CRContactUri ConnReqUriData {crSmpQueues = qs'}) = +sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs} _) (CRContactUri ConnReqUriData {crSmpQueues = qs'} _) = L.length qs == L.length qs' && all same (L.zip qs qs') where same (q, q') = sameQAddress (qAddress q) (qAddress q') @@ -1800,7 +1836,7 @@ type CRClientData = Text data FixedLinkData c = FixedLinkData { agentVRange :: VersionRangeSMPA, rootKey :: C.PublicKeyEd25519, - linkConnReq :: ConnectionRequestUri c, + linkConnReq :: BinaryConnectionRequestUri c, linkEntityId :: Maybe ByteString } deriving (Eq, Show) @@ -1815,7 +1851,7 @@ deriving instance Show (ConnLinkData c) newtype RatchetKeyId = RatchetKeyId ByteString deriving (Eq, Show) - deriving newtype (Encoding) + deriving newtype (Encoding, StrEncoding) data AddressRatchetKeys = AddressRatchetKeys { ratchetKeyId :: RatchetKeyId, @@ -1827,6 +1863,23 @@ instance Encoding AddressRatchetKeys where smpEncode AddressRatchetKeys {ratchetKeyId, e2eRcvParams} = smpEncode (ratchetKeyId, e2eRcvParams) smpP = AddressRatchetKeys <$> smpP <*> smpP +-- | The private half of an AddressRatchetKeys bundle: generated together with the advertised public part in +-- prepareConnectionLink and persisted by the owner (keyed by connId + ratchetKeyId) in createConnectionForLink, +-- so the ratchet can be completed when a requester joins with that ratchetKeyId. +data StoredAddressRatchetKeys = StoredAddressRatchetKeys + { saRatchetKeyId :: RatchetKeyId, + saRcvPrivKey1 :: C.PrivateKeyX448, + saRcvPrivKey2 :: C.PrivateKeyX448, + saRcvPrivKem :: Maybe RcvPrivRKEMParams + } + +-- private key material is redacted (and RcvPrivRKEMParams has no Show) +instance Show StoredAddressRatchetKeys where + show StoredAddressRatchetKeys {saRatchetKeyId} = "StoredAddressRatchetKeys {saRatchetKeyId = " <> show saRatchetKeyId <> ", }" + +-- | Whether setConnShortLink should generate a fresh address ratchet key set, rotating the advertised keys. +type NewRatchetKeys = Bool + -- | The double-ratchet invitation an address owner receives in message 1 and later accepts: the ratchet the -- owner established from that message, the requester's reply queue, and the negotiated version and PQ support. data DRInvitation = DRInvitation @@ -1838,7 +1891,7 @@ data DRInvitation = DRInvitation deriving (Show) data JoinRequest - = JRConnReq {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport, addrRatchetKeys :: Maybe AddressRatchetKeys} + = JRConnReq {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} | JRInvitationDR DRInvitation deriving (Show) @@ -2180,11 +2233,13 @@ $(J.deriveJSON defaultJSON ''DRInvitation) -- and subMode still default when a legacy command omits them. instance StrEncoding JoinRequest where strEncode = \case - JRConnReq ntfs cReq pqSup addrKeys_ -> strEncode (ntfs, cReq, pqSup) <> maybe "" (B.cons ' ' . serializeBinary . smpEncode) addrKeys_ + JRConnReq ntfs cReq pqSup -> strEncode (ntfs, cReq, pqSup) JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = - (JRConnReq <$> strP_ <*> strP_ <*> (strP_ <|> pure PQSupportOff) <*> optional (smpDecode <$?> (A.take =<< (A.decimal <* "\n")) <* A.space)) - <|> (JRInvitationDR <$> (J'.eitherDecodeStrict' <$?> (A.take =<< (A.decimal <* "\n"))) <* A.space) + -- self-contained: fields are separated by leading spaces and JoinRequest consumes no trailing space, so it + -- round-trips on its own; the space before the next JOIN field is consumed by the JOIN command parser + (JRConnReq <$> strP <*> (A.space *> strP) <*> ((A.space *> strP) <|> pure PQSupportOff)) + <|> (JRInvitationDR <$> (J'.eitherDecodeStrict' <$?> (A.take =<< (A.decimal <* "\n")))) -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) dbCommandP :: Parser ACommand @@ -2216,10 +2271,11 @@ commandP :: Parser ByteString -> Parser ACommand commandP binaryP = strP >>= \case - NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe)) + -- advertiseDR is a trailing field defaulting to False, so NEW persisted before it was added still parses + NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe) <*> ((A.space *> strP) <|> pure False)) LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP)) LGET_ -> s (LGET <$> strP) - JOIN_ -> s (JOIN <$> strP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) + JOIN_ -> s (JOIN <$> strP_ <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP) ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP)) SWCH_ -> pure SWCH @@ -2233,7 +2289,7 @@ commandP binaryP = -- | Serialize SMP agent command. serializeCommand :: ACommand -> ByteString serializeCommand = \case - NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode) + NEW ntfs cMode pqIK subMode advertiseDR -> s (NEW_, ntfs, cMode, pqIK, subMode) <> B.cons ' ' (strEncode advertiseDR) LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_ LGET sl -> s (LGET_, sl) JOIN joinReq subMode cInfo -> s (JOIN_, joinReq, subMode, Str $ serializeBinary cInfo) diff --git a/src/Simplex/Messaging/Crypto/ShortLink.hs b/src/Simplex/Messaging/Crypto/ShortLink.hs index 013559fd1..af365ebfe 100644 --- a/src/Simplex/Messaging/Crypto/ShortLink.hs +++ b/src/Simplex/Messaging/Crypto/ShortLink.hs @@ -53,14 +53,14 @@ invShortLinkKdf :: LinkKey -> C.SbKey invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32 encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> Maybe ByteString -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString)) -encodeSignLinkData keys@(_, pk) agentVRange linkConnReq linkEntityId userData = - let (linkKey, fd) = encodeSignFixedData keys agentVRange linkConnReq linkEntityId +encodeSignLinkData keys@(_, pk) agentVRange connReq linkEntityId userData = + let (linkKey, fd) = encodeSignFixedData keys agentVRange connReq linkEntityId md = encodeSignUserData (sConnectionMode @c) pk agentVRange userData in (linkKey, (fd, md)) encodeSignFixedData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> Maybe ByteString -> (LinkKey, ByteString) -encodeSignFixedData (rootKey, pk) agentVRange linkConnReq linkEntityId = - let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} +encodeSignFixedData (rootKey, pk) agentVRange connReq linkEntityId = + let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq = binaryConnReq connReq, linkEntityId} in (LinkKey (C.sha3_256 fd), encodeSign pk fd) encodeSignUserData :: ConnectionModeI c => SConnectionMode c -> C.PrivateKeyEd25519 -> VersionRangeSMPA -> UserConnLinkData c -> ByteString diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 3cd6ed9c9..09b195c12 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -18,6 +18,7 @@ module AgentTests.ConnectionRequestTests invConnRequest, ) where +import AgentTests.EqInstances () import Data.ByteString (ByteString) import Network.HTTP.Types (urlEncode) import Simplex.Messaging.Agent.Protocol @@ -177,7 +178,7 @@ connectionRequestNoQM :: AConnectionRequestUri connectionRequestNoQM = ACR SCMInvitation $ CRInvitationUri connReqDataNoQM testE2ERatchetParams connectionRequestContact :: AConnectionRequestUri -connectionRequestContact = ACR SCMContact $ CRContactUri connReqDataContact +connectionRequestContact = ACR SCMContact $ CRContactUri connReqDataContact Nothing connectionRequestV1 :: AConnectionRequestUri connectionRequestV1 = ACR SCMInvitation $ CRInvitationUri connReqDataV1 testE2ERatchetParams @@ -195,13 +196,13 @@ contactAddress :: AConnectionRequestUri contactAddress = ACR SCMContact $ contactConnRequest contactConnRequest :: ConnectionRequestUri 'CMContact -contactConnRequest = CRContactUri connReqData +contactConnRequest = CRContactUri connReqData Nothing contactAddressV2 :: AConnectionRequestUri -contactAddressV2 = ACR SCMContact $ CRContactUri connReqDataV2 +contactAddressV2 = ACR SCMContact $ CRContactUri connReqDataV2 Nothing contactAddressNew :: AConnectionRequestUri -contactAddressNew = ACR SCMContact $ CRContactUri connReqDataNew +contactAddressNew = ACR SCMContact $ CRContactUri connReqDataNew Nothing connectionRequest2queues :: AConnectionRequestUri connectionRequest2queues = ACR SCMInvitation $ CRInvitationUri connReqData {crSmpQueues = [queue, queue]} testE2ERatchetParams @@ -210,16 +211,20 @@ connectionRequest2queuesNew :: AConnectionRequestUri connectionRequest2queuesNew = ACR SCMInvitation $ CRInvitationUri connReqDataNew {crSmpQueues = [queueNew, queueNew]} testE2ERatchetParams contactAddress2queues :: AConnectionRequestUri -contactAddress2queues = ACR SCMContact $ CRContactUri connReqData {crSmpQueues = [queue, queue]} +contactAddress2queues = ACR SCMContact $ CRContactUri connReqData {crSmpQueues = [queue, queue]} Nothing contactAddress2queuesNew :: AConnectionRequestUri -contactAddress2queuesNew = ACR SCMContact $ CRContactUri connReqDataNew {crSmpQueues = [queueNew, queueNew]} +contactAddress2queuesNew = ACR SCMContact $ CRContactUri connReqDataNew {crSmpQueues = [queueNew, queueNew]} Nothing connectionRequestClientDataEmpty :: AConnectionRequestUri connectionRequestClientDataEmpty = ACR SCMInvitation $ CRInvitationUri connReqData {crClientData = Just "{}"} testE2ERatchetParams contactAddressClientData :: AConnectionRequestUri -contactAddressClientData = ACR SCMContact $ CRContactUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"} +contactAddressClientData = ACR SCMContact $ CRContactUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"} Nothing + +-- binary encoding is defined only for BinaryConnectionRequestUri (link fixed data); drop the address keys for the round-trip +aBinaryConnReq :: AConnectionRequestUri -> ABinaryConnectionRequestUri +aBinaryConnReq (ACR m cr) = ABCR m (binaryConnReq cr) url :: ByteString -> ByteString url = urlEncode True @@ -258,7 +263,7 @@ connectionRequestTests = queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr) it "JOIN command is backward compatible: JRConnReq is byte-identical to the pre-DR JOIN" $ do let uri = ACR SCMInvitation invConnRequest - cmd = JOIN (JRConnReq True uri PQSupportOff Nothing) SMSubscribe "hi" + cmd = JOIN (JRConnReq True uri PQSupportOff) SMSubscribe "hi" -- the pre-DR JOIN wire format: "JOIN " oldJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode PQSupportOff <> " " <> strEncode SMSubscribe <> " 2\nhi" serializeCommand cmd `shouldBe` oldJoin @@ -270,26 +275,26 @@ connectionRequestTests = let legacyJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode SMSubscribe <> " 2\nhi" (serializeCommand <$> parseAll dbCommandP legacyJoin) `shouldBe` Right oldJoin it "should serialize and parse connection invitations and contact addresses" $ do - connectionRequest #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest #== ("https://simplex.chat/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestNoQM #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStrNoQM <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest1 #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest2queues #==# ("simplex:/invitation#/?v=2-8&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestNew #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-8&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest #== ("https://simplex.chat/invitation#/?v=2-7&smp=" <> url queueStr <> "&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) + connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-8&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}") - contactAddress #==# ("simplex:/contact#/?v=2-8&smp=" <> url queueStr) - contactAddress #== ("https://simplex.chat/contact#/?v=2-8&smp=" <> url queueStr) - contactAddress2queues #==# ("simplex:/contact#/?v=2-8&smp=" <> url (queueStr <> ";" <> queueStr)) - contactAddressNew #==# ("simplex:/contact#/?v=2-8&smp=" <> url queueNewStr) - contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-8&smp=" <> url (queueNewStr <> ";" <> queueNewStr)) + connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}") + contactAddress #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr) + contactAddress #== ("https://simplex.chat/contact#/?v=2-7&smp=" <> url queueStr) + contactAddress2queues #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr)) + contactAddressNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueNewStr) + contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr)) contactAddressV2 #==# ("simplex:/contact#/?v=2&smp=" <> url queueStr) contactAddressV2 #== ("https://simplex.chat/contact#/?v=1&smp=" <> url queueStr) -- adjusted to v2 contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2 contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr) - contactAddressClientData #==# ("simplex:/contact#/?v=2-8&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}") + 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 queueNoQM -- this passes, no queue mode patch in SMPQueueUri encoding @@ -301,21 +306,21 @@ connectionRequestTests = smpEncodingTest queueNew1NoPort smpEncodingTest queueV1 smpEncodingTest queueV1NoPort - smpEncodingTest connectionRequest + smpEncodingTest (aBinaryConnReq connectionRequest) -- 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 - smpEncodingTest connectionRequestNew1 - smpEncodingTest connectionRequest2queuesNew - smpEncodingTest connectionRequestClientDataEmpty - smpEncodingTest contactAddress - smpEncodingTest contactAddress2queues - smpEncodingTest contactAddressNew - smpEncodingTest contactAddress2queuesNew - smpEncodingTest contactAddressV2 - smpEncodingTest contactAddressClientData + smpEncodingTest (aBinaryConnReq connectionRequestContact) -- this passes because of queue mode patch in ConnReqUriData encoding + smpEncodingTest (aBinaryConnReq connectionRequest1) + smpEncodingTest (aBinaryConnReq connectionRequest2queues) + smpEncodingTest (aBinaryConnReq connectionRequestNew) + smpEncodingTest (aBinaryConnReq connectionRequestNew1) + smpEncodingTest (aBinaryConnReq connectionRequest2queuesNew) + smpEncodingTest (aBinaryConnReq connectionRequestClientDataEmpty) + smpEncodingTest (aBinaryConnReq contactAddress) + smpEncodingTest (aBinaryConnReq contactAddress2queues) + smpEncodingTest (aBinaryConnReq contactAddressNew) + smpEncodingTest (aBinaryConnReq contactAddress2queuesNew) + smpEncodingTest (aBinaryConnReq contactAddressV2) + smpEncodingTest (aBinaryConnReq contactAddressClientData) it "should serialize / parse short links" $ do 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" diff --git a/tests/AgentTests/EqInstances.hs b/tests/AgentTests/EqInstances.hs index b01174343..de83c6df1 100644 --- a/tests/AgentTests/EqInstances.hs +++ b/tests/AgentTests/EqInstances.hs @@ -5,7 +5,7 @@ module AgentTests.EqInstances where import Data.Type.Equality -import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..)) +import Simplex.Messaging.Agent.Protocol (ABinaryConnectionRequestUri (..), ShortLinkCreds (..)) import Simplex.Messaging.Agent.Store import Simplex.Messaging.Client (ProxiedRelay (..)) @@ -31,3 +31,10 @@ deriving instance Eq ShortLinkCreds deriving instance Show ProxiedRelay deriving instance Eq ProxiedRelay + +instance Eq ABinaryConnectionRequestUri where + ABCR m cr == ABCR m' cr' = case testEquality m m' of + Just Refl -> cr == cr' + _ -> False + +deriving instance Show ABinaryConnectionRequestUri diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index a22264dbc..4a696bf92 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -284,13 +284,13 @@ inAnyOrder g rs = withFrozenCallStack $ do createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c) createConnection c userId enableNtfs cMode clientData subMode = do - (connId, CCLink cReq _) <- A.createConnection c NRMInteractive userId enableNtfs True cMode Nothing clientData IKPQOn subMode + (connId, CCLink cReq _) <- A.createConnection c NRMInteractive userId enableNtfs True cMode Nothing clientData IKPQOn False subMode pure (connId, cReq) joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured) joinConnection c userId enableNtfs cReq connInfo subMode = do connId <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn - sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq Nothing connInfo PQSupportOn subMode + sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq connInfo PQSupportOn subMode pure (connId, sndSecure) acceptContact :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured @@ -311,7 +311,7 @@ deleteConnection c = A.deleteConnection c NRMInteractive deleteConnections :: AgentClient -> [ConnId] -> AE (M.Map ConnId (Either AgentErrorType ())) deleteConnections c = A.deleteConnections c NRMInteractive -getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c) +getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c, ConnectionRequestUri c) getConnShortLink c = A.getConnShortLink c NRMInteractive setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c) @@ -596,18 +596,18 @@ testMatrix2 ps runTest = do it "current, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 agentCfg agentCfg initAgentServersProxy 1 $ runTest PQSupportOn True True it "v8, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 initAgentServersProxy 3 $ runTest PQSupportOn False True it "current" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False - it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfgVPrev 1 $ runTest PQSupportOff True False - it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfg 1 $ runTest PQSupportOff True False - it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrev 1 $ runTest PQSupportOff True False + it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfgVPrev 1 $ runTest PQSupportOff False False + it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfg 1 $ runTest PQSupportOff False False + it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrev 1 $ runTest PQSupportOff False False testMatrix2Stress :: HasCallStack => (ASrvTransport, AStoreType) -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testMatrix2Stress ps runTest = do it "current, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 aCfg aCfg initAgentServersProxy 1 $ runTest PQSupportOn True True it "v8, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 initAgentServersProxy 1 $ runTest PQSupportOn False True it "current" $ withSmpServer ps $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn True False - it "prev" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfgVPrev 1 $ runTest PQSupportOff True False - it "prev to current" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfg 1 $ runTest PQSupportOff True False - it "current to prev" $ withSmpServer ps $ runTestCfg2 aCfg aCfgVPrev 1 $ runTest PQSupportOff True False + it "prev" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfgVPrev 1 $ runTest PQSupportOff False False + it "prev to current" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfg 1 $ runTest PQSupportOff False False + it "current to prev" $ withSmpServer ps $ runTestCfg2 aCfg aCfgVPrev 1 $ runTest PQSupportOff False False where aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval} aProxyCfgV8 = agentProxyCfgV8 {messageRetryInterval = fastMessageRetryInterval} @@ -616,9 +616,9 @@ testMatrix2Stress ps runTest = do testBasicMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testBasicMatrix2 ps runTest = do it "current" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfg 1 $ runTest True - it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 1 $ runTest True - it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfg 1 $ runTest True - it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrevPQ 1 $ runTest True + it "prev" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 1 $ runTest False + it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfg 1 $ runTest False + it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrevPQ 1 $ runTest False testRatchetMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testRatchetMatrix2 ps runTest = do @@ -733,9 +733,9 @@ runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId = runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId = runRight_ $ do - (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ False SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ - sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" bPQ SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ @@ -962,9 +962,9 @@ runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId = runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId = runRight_ $ do - (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ SMSubscribe + (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" bPQ SMSubscribe + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` reqPQSupport @@ -1024,22 +1024,23 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp connIK = IKLinkPQ (CR.connPQEncryption addrIK) -- owner connection PQ (never IKUsePQ) pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ runRight_ $ do - (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK True SMSubscribe - (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing + _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe + (_, ContactLinkData _ userCtData', connReq') <- getConnShortLink bob 1 shortLink -- the advertised DR bundle includes a KEM iff the owner's PQ is on, so a PQ requester gets PQ from message 1 liftIO $ case ratchetKeys userCtData' of Just AddressRatchetKeys {e2eRcvParams = CR.E2ERatchetParamsUri _ _ _ kem_} -> isJust kem_ `shouldBe` supportPQ (CR.connPQEncryption addrIK) Nothing -> expectationFailure "address must advertise DR ratchet keys" - let addrKeys_ = if useDR then ratchetKeys userCtData' else Nothing - aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ + -- classic (non-DR) join drops the address keys from the request + let connReqJoin = if useDR then connReq' else case connReq' of CRContactUri d _ -> CRContactUri d Nothing + aliceId <- A.prepareConnectionToJoin bob 1 True connReqJoin bPQ if asyncJoin then do - A.joinConnectionAsync bob "join" False aliceId True connReq' addrKeys_ "bob's connInfo" bPQ SMSubscribe + A.joinConnectionAsync bob "join" False aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe get bob =##> \case ("join", c, A.JOINED sqSecured) -> c == aliceId && not sqSecured; _ -> False else do - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' addrKeys_ "bob's connInfo" bPQ SMSubscribe + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False ("", _, A.REQ invId reqPQ _ "bob's connInfo") <- get alice liftIO $ reqPQ `shouldBe` PQSupportOn @@ -1068,10 +1069,10 @@ testContactDRMatrix ps = do it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOff ps it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOn ps -joinContactDR :: HasCallStack => AgentClient -> AgentClient -> ConnectionRequestUri 'CMContact -> Maybe AddressRatchetKeys -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO () -joinContactDR alice requester connReq addrKeys_ addrIK pqEnc = do +joinContactDR :: HasCallStack => AgentClient -> AgentClient -> ConnectionRequestUri 'CMContact -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO () +joinContactDR alice requester connReq addrIK pqEnc = do aliceId <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn - void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq addrKeys_ "bob's connInfo" PQSupportOn SMSubscribe + void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice reqId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) void $ acceptContact alice 1 reqId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe @@ -1088,21 +1089,21 @@ testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob ca connIK = IKLinkPQ (CR.connPQEncryption addrIK) pqEnc = PQEncryption $ pqConnectionMode addrIK PQSupportOn runRight_ $ do - (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK True SMSubscribe - (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ ctData1) <- getConnShortLink bob 1 shortLink + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing + addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe + (_, ContactLinkData _ ctData1, connReq1) <- getConnShortLink bob 1 shortLink let key1 = ratchetKeys ctData1 liftIO $ key1 `shouldSatisfy` isJust void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True - (_, ContactLinkData _ ctData2) <- getConnShortLink carol 1 shortLink + (_, ContactLinkData _ ctData2, connReq2) <- getConnShortLink carol 1 shortLink let key2 = ratchetKeys ctData2 liftIO $ (key1 == key2) `shouldBe` False - joinContactDR alice bob connReq key1 addrIK pqEnc - joinContactDR alice carol connReq key2 addrIK pqEnc + joinContactDR alice bob connReq1 addrIK pqEnc + joinContactDR alice carol connReq2 addrIK pqEnc void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True - aId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn - void $ A.joinConnection bob NRMInteractive 1 aId True connReq key1 "bob's connInfo" PQSupportOn SMSubscribe + aId <- A.prepareConnectionToJoin bob 1 True connReq1 PQSupportOn + void $ A.joinConnection bob NRMInteractive 1 aId True connReq1 "bob's connInfo" PQSupportOn SMSubscribe get alice =##> \case ("", _, A.ERR _) -> True; _ -> False testAddDRViaSetConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO () @@ -1114,12 +1115,12 @@ testAddDRViaSetConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \alice userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} connIK = IKLinkPQ (CR.connPQEncryption addrIK) runRight_ $ do - (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData connIK False SMSubscribe - (_, ContactLinkData _ cd0) <- getConnShortLink bob 1 shortLink + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK False Nothing + addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe + (_, ContactLinkData _ cd0, _) <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys cd0 `shouldBe` Nothing void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True - (_, ContactLinkData _ cd1) <- getConnShortLink bob 1 shortLink + (_, ContactLinkData _ cd1, _) <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys cd1 `shouldSatisfy` isJust -- updating a DR address's mutable link data must preserve the stored ratchet keys, so requesters can still establish DR @@ -1134,18 +1135,18 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al bPQ = PQSupportOn pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ runRight_ $ do - (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK True SMSubscribe - (_, ContactLinkData _ published) <- getConnShortLink bob 1 shortLink + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing + addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe + (_, ContactLinkData _ published, _) <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys published `shouldSatisfy` isJust -- update passing ratchetKeys = Nothing; the stored keys must be preserved let updatedCtData = userCtData {userData = UserLinkData "updated", ratchetKeys = Nothing} shortLink' <- setConnShortLink alice addrConnId SCMContact (UserContactLinkData updatedCtData) Nothing liftIO $ shortLink' `shouldBe` shortLink - (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ updated) <- getConnShortLink bob 1 shortLink + (_, ContactLinkData _ updated, connReq') <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ - sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' (ratchetKeys updated) "bob's connInfo" bPQ SMSubscribe + sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) @@ -1166,11 +1167,11 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do pqEnc = PQEncryption $ pqConnectionMode addrIK PQSupportOn -- set up the DR address, bob joins, alice receives REQ and pre-creates the accept connection (server up) (bobId, invId, aliceId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do - (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing Nothing - _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) connIK True SMSubscribe - (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing + _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe + (_, _, connReq') <- getConnShortLink bob 1 shortLink aId <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn - _ <- A.joinConnection bob NRMInteractive 1 aId True connReq' (ratchetKeys userCtData') "bob's connInfo" PQSupportOn SMSubscribe + _ <- A.joinConnection bob NRMInteractive 1 aId True connReq' "bob's connInfo" PQSupportOn SMSubscribe ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) pure (bId, invId, aId) @@ -1189,7 +1190,7 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do - (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ SMSubscribe + (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe (bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo sentMessages abPQEnc alice bobId bob bAliceId (tAliceId, tomId, atPQEnc) <- connectViaContact tom tPQ qInfo @@ -1198,7 +1199,7 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId msgId = subtract baseId . fst connectViaContact b pq qInfo = do aId <- A.prepareConnectionToJoin b 1 True qInfo pq - sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo Nothing "bob's connInfo" pq SMSubscribe + sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" pq SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -1242,9 +1243,9 @@ noMessages_ ingoreQCONT c err = tryGet `shouldReturn` () testRejectContactRequest :: HasCallStack => IO () testRejectContactRequest = withAgentClients2 $ \alice bob -> runRight_ $ do - (_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe + (_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice rejectContact alice invId @@ -1257,7 +1258,7 @@ testUpdateConnectionUserId = newUserId <- createUser alice False [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer] _ <- changeConnectionUser alice 1 connId newUserId aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured' `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -1417,13 +1418,13 @@ testInvitationErrors ps restart = do ("", "", DOWN _ [_]) <- nGet a aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to secure the queue on testPort - BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe (testPort `isSuffixOf` srv) `shouldBe` True withServer1 ps $ do ("", "", UP _ [_]) <- nGet a let loopSecure = do -- secures the queue on testPort, but fails to create reply queue on testPort2 - BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe unless (testPort2 `isSuffixOf` srv2) $ putStrLn "retrying secure" >> threadDelay 200000 >> loopSecure loopSecure ("", "", DOWN _ [_]) <- nGet a @@ -1431,7 +1432,7 @@ testInvitationErrors ps restart = do threadDelay 200000 let loopCreate = do -- creates the reply queue on testPort2, but fails to send it to testPort - BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create" >> threadDelay 200000 >> loopCreate loopCreate restartAgentB restart b [aId] @@ -1440,7 +1441,7 @@ testInvitationErrors ps restart = do ("", "", UP _ [_]) <- nGet a threadDelay 200000 let loopConfirm n = - runExceptT (A.joinConnection b' NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe) >>= \case + runExceptT (A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe) >>= \case Right True -> pure n Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying confirm" >> threadDelay 200000 >> loopConfirm (n + 1) @@ -1487,12 +1488,12 @@ testContactErrors ps restart = do ("", "", DOWN _ [_]) <- nGet a aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to create queue on testPort2 - BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe (testPort2 `isSuffixOf` srv2) `shouldBe` True b' <- restartAgentB restart b [aId] let loopCreate2 = do -- creates the reply queue on testPort2, but fails to send invitation to testPort - BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b' NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe + BROKER srv' (NETWORK _) <- runLeft $ A.joinConnection b' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe unless (testPort `isSuffixOf` srv') $ putStrLn "retrying create 2" >> threadDelay 200000 >> loopCreate2 b'' <- withServer2 ps $ do loopCreate2 @@ -1502,7 +1503,7 @@ testContactErrors ps restart = do ("", "", UP _ [_]) <- nGet a let loopSend = do -- sends the invitation to testPort - runExceptT (A.joinConnection b'' NRMInteractive 1 aId True cReq Nothing "bob's connInfo" PQSupportOn SMSubscribe) >>= \case + runExceptT (A.joinConnection b'' NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe) >>= \case Right False -> pure () Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying send" >> threadDelay 200000 >> loopSend @@ -1569,13 +1570,13 @@ testInvitationShortLink viaProxy a b = withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData - (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe - (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink + (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ False SMSubscribe + (_, connData', connReq') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData -- same user can get invitation link again - (FixedLinkData {linkConnReq = connReq2}, connData2) <- runRight $ getConnShortLink b 1 shortLink + (_, connData2, connReq2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq linkUserData connData2 `shouldBe` userData -- another user cannot get the same invitation link @@ -1591,7 +1592,7 @@ testInvitationShortLink viaProxy a b = 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 NRMInteractive 1 aId True connReq Nothing "bob's connInfo" PQSupportOn SMSubscribe + sndSecure' <- A.joinConnection b NRMInteractive 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" @@ -1605,21 +1606,21 @@ testInvitationShortLinkPrev viaProxy sndSecure a b = runRight_ $ do let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData -- can't create short link with previous version - (bId, CCLink connReq Nothing) <- A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKPQOn SMSubscribe + (bId, CCLink connReq Nothing) <- A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKPQOn False SMSubscribe testJoinConn_ viaProxy sndSecure a bId b connReq testInvitationShortLinkAsync :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO () testInvitationShortLinkAsync viaProxy a b = do let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData - (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe - (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink + (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ False SMSubscribe + (_, connData', connReq') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData runRight $ do aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn - A.joinConnectionAsync b "123" False aId True connReq Nothing "bob's connInfo" PQSupportOn SMSubscribe + A.joinConnectionAsync b "123" False aId True connReq "bob's connInfo" PQSupportOn SMSubscribe get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" @@ -1640,18 +1641,20 @@ testContactShortLink viaProxy a b = let userData = UserLinkData "some user data" userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData - (contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe - Right connReq <- pure $ smpDecode (smpEncode connReq0) - (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn False SMSubscribe + -- normalize through binary fixed-data encoding (queue mode patch); the extended type has no binary encoding + Right connReqBin <- pure $ smpDecode (smpEncode (binaryConnReq connReq0)) + let connReq = connReqWithKeys connReqBin Nothing + (_, ContactLinkData _ userCtData', connReq') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq userCtData' `shouldBe` userCtData -- same user can get contact link again - (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink + (_, ContactLinkData _ userCtData2, connReq2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq userCtData2 `shouldBe` userCtData -- another user can get the same contact link - (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink + (_, ContactLinkData _ userCtData3, connReq3) <- runRight $ getConnShortLink c 1 shortLink connReq3 `shouldBe` connReq userCtData3 `shouldBe` userCtData runRight $ do @@ -1673,7 +1676,7 @@ testContactShortLink viaProxy a b = userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink - (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink + (_, ContactLinkData _ updatedCtData', connReq4) <- runRight $ getConnShortLink c 1 shortLink connReq4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData -- one more time @@ -1687,22 +1690,24 @@ testContactShortLink viaProxy a b = testAddContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO () testAddContactShortLink viaProxy a b = withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do - (contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe - Right connReq <- pure $ smpDecode (smpEncode connReq0) -- + (contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMSubscribe + -- normalize through binary fixed-data encoding (queue mode patch); the extended type has no binary encoding + Right connReqBin <- pure $ smpDecode (smpEncode (binaryConnReq connReq0)) + let connReq = connReqWithKeys connReqBin Nothing let userData = UserLinkData "some user data" userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing - (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (_, ContactLinkData _ userCtData', connReq') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq userCtData' `shouldBe` userCtData -- same user can get contact link again - (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink + (_, ContactLinkData _ userCtData2, connReq2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq userCtData2 `shouldBe` userCtData -- another user can get the same contact link - (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink + (_, ContactLinkData _ userCtData3, connReq3) <- runRight $ getConnShortLink c 1 shortLink connReq3 `shouldBe` connReq userCtData3 `shouldBe` userCtData runRight $ do @@ -1724,7 +1729,7 @@ testAddContactShortLink viaProxy a b = userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink - (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink + (_, ContactLinkData _ updatedCtData', connReq4) <- runRight $ getConnShortLink c 1 shortLink connReq4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData @@ -1733,10 +1738,10 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData (bId, CCLink connReq (Just shortLink)) <- withSmpServer ps $ - runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMOnlyCreate + runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ False SMOnlyCreate withSmpServer ps $ do runRight_ $ subscribeConnection a bId - (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink + (_, connData', connReq') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData @@ -1747,13 +1752,13 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData (contactId, CCLink connReq0 (Just shortLink)) <- withSmpServer ps $ - runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMOnlyCreate - Right connReq <- pure $ smpDecode (smpEncode connReq0) + runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn False SMOnlyCreate + Right connReq <- pure $ smpDecode (smpEncode (binaryConnReq connReq0)) let updatedData = UserLinkData "updated user data" updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing} updatedLinkData = UserContactLinkData updatedCtData withSmpServer ps $ do - (fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (fd', ContactLinkData _ userCtData', _) <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink linkConnReq fd' `shouldBe` connReq userCtData' `shouldBe` userCtData @@ -1761,7 +1766,7 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing shortLink' `shouldBe` shortLink withSmpServer ps $ do - (fd4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink + (fd4, ContactLinkData _ updatedCtData', _) <- runRight $ getConnShortLink b 1 shortLink linkConnReq fd4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData @@ -1771,14 +1776,14 @@ testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData ((contactId, CCLink connReq0 Nothing), shortLink) <- withSmpServer ps $ runRight $ do - r@(contactId, _) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate + r@(contactId, _) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMOnlyCreate (r,) <$> setConnShortLink a contactId SCMContact newLinkData Nothing - Right connReq <- pure $ smpDecode (smpEncode connReq0) + Right connReq <- pure $ smpDecode (smpEncode (binaryConnReq connReq0)) let updatedData = UserLinkData "updated user data" updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing} updatedLinkData = UserContactLinkData updatedCtData withSmpServer ps $ do - (fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (fd', ContactLinkData _ userCtData', _) <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink linkConnReq fd' `shouldBe` connReq userCtData' `shouldBe` userCtData @@ -1786,14 +1791,14 @@ testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing shortLink' `shouldBe` shortLink withSmpServer ps $ do - (fd4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink + (fd4, ContactLinkData _ updatedCtData', _) <- runRight $ getConnShortLink b 1 shortLink linkConnReq fd4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData testOldContactQueueShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do (contactId, CCLink connReq Nothing) <- withSmpServer ps $ runRight $ - A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate + A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMOnlyCreate -- make it an "old" queue let updateStoreLog f = replaceSubstringInFile f " queue_mode=C" "" #if defined(dbServerPostgres) @@ -1825,9 +1830,9 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} userLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing - (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData', _) <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink - connReq' `shouldBe` connReq + connReq' `shouldBe` binaryConnReq connReq userCtData' `shouldBe` userCtData -- update user data let updatedData = UserLinkData "updated user data" @@ -1836,8 +1841,8 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink -- check updated - (FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink - connReq'' `shouldBe` connReq + (FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData', _) <- runRight $ getConnShortLink b 1 shortLink + connReq'' `shouldBe` binaryConnReq connReq updatedCtData' `shouldBe` updatedCtData replaceSubstringInFile :: FilePath -> T.Text -> T.Text -> IO () @@ -1856,12 +1861,13 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b linkEntId <- atomically $ C.randomBytes 32 g runRight $ do (ccLink@(CCLink connReq (Just shortLink)), preparedParams) <- - A.prepareConnectionLink a 1 rootKey linkEntId True Nothing Nothing + A.prepareConnectionLink a 1 rootKey linkEntId True Nothing CR.IKPQOn False Nothing liftIO $ strDecode (strEncode shortLink) `shouldBe` Right shortLink - _ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn False SMSubscribe - (FixedLinkData {linkConnReq = connReq', linkEntityId}, ContactLinkData _ userCtData') <- getConnShortLink b 1 shortLink + _ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe + (FixedLinkData {linkEntityId}, ContactLinkData _ userCtData', connReq') <- getConnShortLink b 1 shortLink liftIO $ Just linkEntId `shouldBe` linkEntityId - Right connReqDecoded <- pure $ smpDecode (smpEncode connReq) + Right connReqBin <- pure $ smpDecode (smpEncode (binaryConnReq connReq)) + let connReqDecoded = connReqWithKeys connReqBin Nothing liftIO $ connReq' `shouldBe` connReqDecoded liftIO $ userCtData' `shouldBe` userCtData (bId, sndSecure) <- joinConnection b 1 True connReq' "bob's connInfo" SMSubscribe @@ -2600,9 +2606,9 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do - (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) False SMSubscribe aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport - sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo Nothing "bob's connInfo" pqSupport SMSubscribe + sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` pqSupport @@ -2880,11 +2886,11 @@ testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId testAsyncCommands sqSecured alice bob baseId = runRight_ $ do bobId <- prepareConnectionToCreate alice 1 True SCMInvitation PQSupportOn - createConnectionAsync alice "1" bobId True SCMInvitation IKPQOn SMSubscribe + createConnectionAsync alice "1" bobId True SCMInvitation IKPQOn False SMSubscribe ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId aliceId <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn - joinConnectionAsync bob "2" False aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe ("2", aliceId', JOINED sqSecured') <- get bob liftIO $ do aliceId' `shouldBe` aliceId @@ -2935,9 +2941,9 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> let userData = UserLinkData "test user data" userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData - (cId, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe + (cId, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn False SMSubscribe -- verify initial link data - (_, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink + (_, ContactLinkData _ userCtData', _) <- getConnShortLink bob 1 shortLink liftIO $ userCtData' `shouldBe` userCtData -- update link data async let updatedData = UserLinkData "updated user data" @@ -2948,7 +2954,7 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> liftIO $ shortLink' `shouldBe` shortLink liftIO $ updatedCtData' `shouldBe` updatedCtData -- verify updated link data - (_, ContactLinkData _ updatedCtData'') <- getConnShortLink bob 1 shortLink' + (_, ContactLinkData _ updatedCtData'', _) <- getConnShortLink bob 1 shortLink' liftIO $ updatedCtData'' `shouldBe` updatedCtData -- complete connection via contact address (aliceId, _) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe @@ -2967,15 +2973,15 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> let userData = UserLinkData "test user data" userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing} newLinkData = UserContactLinkData userCtData - (_, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe + (_, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn False SMSubscribe -- get link data async - creates new connection for bob newId <- getConnShortLinkAsync bob 1 "1" Nothing shortLink - ("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData')) <- get bob + ("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData') connReq') <- get bob liftIO $ newId' `shouldBe` newId - liftIO $ qInfo' `shouldBe` qInfo + liftIO $ qInfo' `shouldBe` binaryConnReq qInfo liftIO $ userCtData' `shouldBe` userCtData - -- join connection async using connId from getConnShortLinkAsync - joinConnectionAsync bob "2" True newId True qInfo' Nothing "bob's connInfo" PQSupportOn SMSubscribe + -- join connection async using connId from getConnShortLinkAsync and the merged connReq from LDATA + joinConnectionAsync bob "2" True newId True connReq' "bob's connInfo" PQSupportOn SMSubscribe let aliceId = newId ("2", aliceId', JOINED False) <- get bob liftIO $ aliceId' `shouldBe` aliceId @@ -2994,7 +3000,7 @@ testAsyncCommandsRestore ps = do alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB bobId <- runRight $ do connId <- prepareConnectionToCreate alice 1 True SCMInvitation PQSupportOn - createConnectionAsync alice "1" connId True SCMInvitation IKPQOn SMSubscribe + createConnectionAsync alice "1" connId True SCMInvitation IKPQOn False SMSubscribe pure connId liftIO $ noMessages alice "alice doesn't receive INV because server is down" disposeAgentClient alice @@ -3284,11 +3290,11 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do withAgent 2 cfg' initAgentServersSrv2 testDB2 $ \b -> do (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do bId <- prepareConnectionToCreate a 1 True SCMInvitation PQSupportOn - createConnectionAsync a "1" bId True SCMInvitation IKPQOn SMSubscribe + createConnectionAsync a "1" bId True SCMInvitation IKPQOn False SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn - joinConnectionAsync b "2" False aId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) @@ -3331,11 +3337,11 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do bId <- prepareConnectionToCreate a 1 True SCMInvitation PQSupportOn - createConnectionAsync a "1" bId True SCMInvitation IKPQOn SMSubscribe + createConnectionAsync a "1" bId True SCMInvitation IKPQOn False SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn - joinConnectionAsync b "2" False aId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) @@ -4636,7 +4642,7 @@ testClientNotice :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testClientNotice ps = do withAgent 1 agentCfg initAgentServers testDB $ \c -> do (cId, _) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ - A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe + A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe ("", "", DOWN _ [_]) <- nGet c addNotice c cId $ Just 1 @@ -4645,7 +4651,7 @@ testClientNotice ps = do subscribedWithErrors c 1 testNotice c True threadDelay 1000000 - runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe + runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe ("", "", DOWN _ [_]) <- nGet c addNotice c cId' $ Just 1 @@ -4656,7 +4662,7 @@ testClientNotice ps = do threadDelay 1000000 testNotice c True threadDelay 1000000 - runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe + runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe addNotice c cId'' $ Just 1 @@ -4668,7 +4674,7 @@ testClientNotice ps = do threadDelay 2000000 testNotice c True threadDelay 1000000 - runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe + runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe ("", "", DOWN _ [_]) <- nGet c addNotice c cId3 Nothing @@ -4683,7 +4689,7 @@ testClientNotice ps = do withSmpServerStoreLogOn ps testPort $ \_ -> do runRight_ $ subscribeAllConnections c False Nothing subscribedWithErrors c 4 - void $ runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe + void $ runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe where addNotice c cId ttl = logNotice c cId $ Just ClientNotice {ttl} removeNotice c cId = logNotice c cId Nothing @@ -4699,7 +4705,7 @@ testClientNotice ps = do r -> expectationFailure $ "unexpected event: " <> show r testNotice :: HasCallStack => AgentClient -> Bool -> IO () testNotice c willExpire = do - NOTICE "localhost" False expiresAt_ <- runLeft $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe + NOTICE "localhost" False expiresAt_ <- runLeft $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe isJust expiresAt_ `shouldBe` willExpire noNetworkDelay :: AgentClient -> IO () diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index c52f5c5bd..c94b1921b 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -696,7 +696,7 @@ testGetPendingServerCommand st = do Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db connId (Just smpServer1) corrId' `shouldBe` "4" where - command = AClientCommand $ NEW True (ACM SCMInvitation) IKPQOn SMSubscribe + command = AClientCommand $ NEW True (ACM SCMInvitation) IKPQOn SMSubscribe False corruptCmd :: DB.Connection -> ByteString -> ConnId -> IO () corruptCmd db corrId connId = DB.execute db "UPDATE commands SET command = cast('bad' as blob) WHERE conn_id = ? AND corr_id = ?" (connId, corrId) diff --git a/tests/AgentTests/ShortLinkTests.hs b/tests/AgentTests/ShortLinkTests.hs index 9ca7d2d14..252da4fc2 100644 --- a/tests/AgentTests/ShortLinkTests.hs +++ b/tests/AgentTests/ShortLinkTests.hs @@ -49,7 +49,7 @@ testInvShortLink = do Right srvData <- runExceptT $ SL.encryptLinkData g k linkData -- decrypt Right (FixedLinkData {linkConnReq = connReq}, connData') <- pure $ SL.decryptLinkData linkKey k srvData - connReq `shouldBe` invConnRequest + connReq `shouldBe` binaryConnReq invConnRequest linkUserData connData' `shouldBe` userData testInvShortLinkBadDataHash :: IO () @@ -87,7 +87,7 @@ testContactShortLink = do Right srvData <- runExceptT $ SL.encryptLinkData g k linkData -- decrypt Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData - connReq `shouldBe` contactConnRequest + connReq `shouldBe` binaryConnReq contactConnRequest userCtData' `shouldBe` userCtData testUpdateContactShortLink :: IO () @@ -109,7 +109,7 @@ testUpdateContactShortLink = do Right ud' <- runExceptT $ SL.encryptUserData g k signed -- decrypt Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud') - connReq `shouldBe` contactConnRequest + connReq `shouldBe` binaryConnReq contactConnRequest userCtData'' `shouldBe` userCtData' testContactShortLinkBadDataHash :: IO () @@ -184,7 +184,7 @@ testEncDec g pk (fd, linkKey, k) ctData = do let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData Right ud <- runExceptT $ SL.encryptUserData g k signed Right (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud) - connReq' `shouldBe` contactConnRequest + connReq' `shouldBe` binaryConnReq contactConnRequest ctData' `shouldBe` ctData testContactShortLinkManyOwners :: IO () diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index f580e15a2..f63ff5aa9 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -232,9 +232,9 @@ agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 baseId = withAgent 1 aCfg (servers aTestCfg) testDB $ \alice -> withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do - (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -288,9 +288,9 @@ agentDeliverMessagesViaProxyConc agentServers msgs = -- agent connections have to be set up in advance -- otherwise the CONF messages would get mixed with MSG prePair alice bob = do - (bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe + (bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True confId <- get alice >>= \case @@ -339,9 +339,9 @@ agentViaProxyVersionError = withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do Left (A.BROKER _ (TRANSPORT TEVersion)) <- withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do - (_bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe + (_bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe pure () where servers srvs = (initAgentServersProxy_ SPMUnknown SPFProhibit) {smp = userServers srvs} @@ -359,9 +359,9 @@ agentViaProxyRetryOffline = do let pqEnc = CR.PQEncOn withServer $ \_ -> do (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do - (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn - sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo Nothing "bob's connInfo" PQSupportOn SMSubscribe + sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn @@ -520,14 +520,14 @@ testAgentClientReconnectAfterCancel :: IO () testAgentClientReconnectAfterCancel = withAgent 1 agentCfg agentServersLeak testDB $ \a -> do withStallingServerOn testPort2 $ do - t <- async $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe + t <- async $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe threadDelay 1000000 -- let the connect to the stalling relay start, then kill it mid-flight cancel t withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ -> do testSMPClient_ "127.0.0.1" testPort2 proxyVRangeV8 Nothing $ \(th :: THandleSMP TLS 'TClient) -> do (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PING) reply `shouldBe` Right SMP.PONG -- the relay is up and reachable, so a timeout can only be the poisoned var - r <- timeout 8000000 $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe + r <- timeout 8000000 $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe case r of Just (Right _) -> pure () _ -> expectationFailure $ "agent failed to connect after a cancelled connect; got: " <> show r From 6913d6d68a2908dd39ee7e46d585dad3e8728cd4 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 19 Jul 2026 15:39:01 +0100 Subject: [PATCH 71/81] simplify --- src/Simplex/Messaging/Agent.hs | 27 +++++++++++-------------- src/Simplex/Messaging/Agent/Protocol.hs | 17 ++++++---------- tests/AgentTests/FunctionalAPITests.hs | 9 +++++++-- 3 files changed, 25 insertions(+), 28 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index f39b795f9..463bb3eec 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1219,12 +1219,16 @@ getConnShortLink' c nm userId = \case decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c, ConnectionRequestUri c) decryptData srv linkKey k (sndId, d) = do (fd0, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d - -- merge the keys-less fixed-data connReq with the mutable ratchet keys, so callers get the full address connReq - let connReq0 = connReqWithKeys (linkConnReq fd0) (clRatchetKeys clData) - (srv', sndId') = qAddress (connReqQueue connReq0) + let crData = case linkConnReq fd0 of + BCRInvitationUri d _ -> d + BCRContactUri d -> d + (srv', sndId') = qAddress $ L.head $ crSmpQueues crData unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address" let fd = if srv' == srv then fd0 else updateConnReqServer srv fd0 - pure (fd, clData, connReqWithKeys (linkConnReq fd) (clRatchetKeys clData)) + connReq = case (linkConnReq fd, clData) of + (BCRInvitationUri d e2eParams, _) -> CRInvitationUri d e2eParams + (BCRContactUri d, ContactLinkData _ UserContactData {ratchetKeys}) -> CRContactUri d ratchetKeys + pure (fd, clData, connReq) sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c updateConnReqServer srv fd = @@ -1235,10 +1239,6 @@ getConnShortLink' c nm userId = \case where updateQueues crData@(ConnReqUriData {crSmpQueues = SMPQueueUri vr addr :| qs}) = crData {crSmpQueues = SMPQueueUri vr addr {smpServer = srv} :| qs} - clRatchetKeys :: ConnLinkData c -> Maybe AddressRatchetKeys - clRatchetKeys = \case - InvitationLinkData {} -> Nothing - ContactLinkData _ UserContactData {ratchetKeys} -> ratchetKeys deleteLocalInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM () deleteLocalInvShortLink' c (CSLInvitation _ srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId @@ -1382,15 +1382,12 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured joinConn c nm userId connId enableNtfs cReq cInfo pqSupport subMode = do - srv <- getNextSMPServer c userId [qServer $ connReqQueue cReq] + let crData = case cReq of + CRInvitationUri d _ -> d + CRContactUri d _ -> d + srv <- getNextSMPServer c userId [qServer $ L.head $ crSmpQueues crData] joinConnSrv c nm userId connId enableNtfs cReq cInfo pqSupport subMode srv --- a queue is addressed by server + sender-ID + DH key; the advertised DR keys are not part of that address -connReqQueue :: ConnectionRequestUri c -> SMPQueueUri -connReqQueue = \case - CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q - CRContactUri ConnReqUriData {crSmpQueues = q :| _} _ -> q - startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM ((ConnData, SndQueue), Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId) startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup = lift (compatibleInvitationUri cReqUri) >>= \case diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 1ad950709..285ba005d 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -113,7 +113,6 @@ module Simplex.Messaging.Agent.Protocol BinaryConnectionRequestUri (..), ABinaryConnectionRequestUri (..), binaryConnReq, - connReqWithKeys, ShortLinkCreds (..), ConnReqUriData (..), CRClientData, @@ -1161,12 +1160,13 @@ instance Encoding AMessageReceipt where instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where strEncode = \case - CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams) Nothing - CRContactUri crData Nothing -> crEncode "contact" crData Nothing Nothing - CRContactUri crData (Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams}) -> crEncode "contact" crData (Just e2eRcvParams) (Just ratchetKeyId) + CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams, Nothing) + CRContactUri crData rks -> crEncode "contact" crData $ case rks of + Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams} -> (Just e2eRcvParams, Just ratchetKeyId) + Nothing -> (Nothing, Nothing) where - crEncode :: ByteString -> ConnReqUriData -> Maybe (RcvE2ERatchetParamsUri 'C.X448) -> Maybe RatchetKeyId -> ByteString - crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} e2eParams rk = + crEncode :: ByteString -> ConnReqUriData -> (Maybe (RcvE2ERatchetParamsUri 'C.X448), Maybe RatchetKeyId) -> ByteString + crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} (e2eParams, rk) = strEncode crScheme <> "/" <> crMode <> "#/?" <> queryStr where queryStr = @@ -1517,11 +1517,6 @@ binaryConnReq = \case CRInvitationUri crData e2eParams -> BCRInvitationUri crData e2eParams CRContactUri crData _ -> BCRContactUri crData -connReqWithKeys :: BinaryConnectionRequestUri m -> Maybe AddressRatchetKeys -> ConnectionRequestUri m -connReqWithKeys cr rk = case cr of - BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams - BCRContactUri crData -> CRContactUri crData rk - deriving instance Eq (ConnectionRequestUri m) deriving instance Show (ConnectionRequestUri m) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 4a696bf92..30b5972e1 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -1883,6 +1883,11 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b get b ##> ("", bId, CON) exchangeGreetings a aId b bId +connReqWithKeys :: BinaryConnectionRequestUri m -> Maybe AddressRatchetKeys -> ConnectionRequestUri m +connReqWithKeys cr rk = case cr of + BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams + BCRContactUri crData -> CRContactUri crData rk + testIncreaseConnAgentVersion :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testIncreaseConnAgentVersion ps = do alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB @@ -3901,8 +3906,8 @@ testDeliveryReceiptsVersion ps = do subscribeConnection a' bId subscribeConnection b' aId exchangeGreetingsMsgId_ PQEncOff 4 a' bId b' aId - checkVersion a' bId 8 - checkVersion b' aId 8 + checkVersion a' bId 7 + checkVersion b' aId 7 (6, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello" get a' ##> ("", bId, SENT 6) get b' =##> \case ("", c, Msg' 6 PQEncOff "hello") -> c == aId; _ -> False From 6060be452c267e4c24ef2ec4e48be96632592f83 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 19 Jul 2026 15:31:16 +0000 Subject: [PATCH 72/81] remove records --- src/Simplex/Messaging/Agent.hs | 17 +++++------ src/Simplex/Messaging/Agent/Protocol.hs | 39 +++++-------------------- tests/AgentTests/FunctionalAPITests.hs | 2 +- 3 files changed, 16 insertions(+), 42 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 463bb3eec..38446c886 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1016,23 +1016,20 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP pure connId -- Generate a fresh address ratchet key set in memory (no DB): the advertised public part and the private half to persist. -generateAddressRatchetKeys :: PQSupport -> AM (AddressRatchetKeys, StoredAddressRatchetKeys) +generateAddressRatchetKeys :: PQSupport -> AM (AddressRatchetKeys, (RatchetKeyId, (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams))) generateAddressRatchetKeys pqSupport = do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqSupport ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) - pure - ( AddressRatchetKeys {ratchetKeyId, e2eRcvParams = toVersionRangeT e2eParams e2eVR}, - StoredAddressRatchetKeys {saRatchetKeyId = ratchetKeyId, saRcvPrivKey1 = pk1, saRcvPrivKey2 = pk2, saRcvPrivKem = pKem} - ) + pure ((ratchetKeyId, toVersionRangeT e2eParams e2eVR), (ratchetKeyId, (pk1, pk2, pKem))) -- Persist the private half (keyed by connId + ratchetKeyId) and prune old keys. -storeAddressRatchetKeys :: AgentClient -> ConnId -> StoredAddressRatchetKeys -> AM () -storeAddressRatchetKeys c connId StoredAddressRatchetKeys {saRatchetKeyId, saRcvPrivKey1, saRcvPrivKey2, saRcvPrivKem} = do +storeAddressRatchetKeys :: AgentClient -> ConnId -> (RatchetKeyId, (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) -> AM () +storeAddressRatchetKeys c connId (ratchetKeyId, (pk1, pk2, pKem)) = do keep <- asks $ keepAddressKeys . config withStore' c $ \db -> do - createAddressRatchetKeys db connId saRatchetKeyId saRcvPrivKey1 saRcvPrivKey2 saRcvPrivKem + createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem deleteOldAddressRatchetKeys db connId keep -- Generate + persist, used for rotation via setConnShortLink where the connId already exists. @@ -1048,7 +1045,7 @@ currentAddressRatchetKeys c connId = Left _ -> pure Nothing Right (ratchetKeyId, pk1, pk2, pKem) -> do e2eVR <- asks $ e2eEncryptVRange . config - pure $ Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams = toVersionRangeT (CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem)) e2eVR} + pure $ Just (ratchetKeyId, toVersionRangeT (CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem)) e2eVR) -- | Encrypt signed link data for contact mode. encryptContactLinkData :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> LinkKey -> SMP.SenderId -> (ByteString, ByteString) -> AM ClntQueueReqData @@ -1473,7 +1470,7 @@ compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = -- an advertised DR bundle must be version-compatible, otherwise the whole address is incompatible ratchet_ <- case addrKeys_ of Nothing -> Just Nothing - Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams} -> + Just (ratchetKeyId, e2eRcvParams) -> Just . (ratchetKeyId,) <$> (e2eRcvParams `compatibleVersion` e2eEncryptVRange) pure (q, ratchet_, v) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 285ba005d..4c681a5ad 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -124,8 +124,7 @@ module Simplex.Messaging.Agent.Protocol UserConnLinkData (..), UserContactData (..), UserLinkData (..), - AddressRatchetKeys (..), - StoredAddressRatchetKeys (..), + AddressRatchetKeys, NewRatchetKeys, DRInvitation (..), RatchetKeyId (..), @@ -1162,7 +1161,7 @@ instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where strEncode = \case CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams, Nothing) CRContactUri crData rks -> crEncode "contact" crData $ case rks of - Just AddressRatchetKeys {ratchetKeyId, e2eRcvParams} -> (Just e2eRcvParams, Just ratchetKeyId) + Just (ratchetKeyId, e2eRcvParams) -> (Just e2eRcvParams, Just ratchetKeyId) Nothing -> (Nothing, Nothing) where crEncode :: ByteString -> ConnReqUriData -> (Maybe (RcvE2ERatchetParamsUri 'C.X448), Maybe RatchetKeyId) -> ByteString @@ -1237,7 +1236,7 @@ connReqUriP overrideScheme = do CMContact -> do e2e_ <- queryParam_ "e2e" query rk_ <- queryParam_ "rk" query - pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange} (AddressRatchetKeys <$> rk_ <*> e2e_) + pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange} ((,) <$> rk_ <*> e2e_) where crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames @@ -1576,11 +1575,10 @@ data PreparedLinkParams = PreparedLinkParams plpSrvWithAuth :: SMPServerWithAuth, -- | Connection initial keys (decided in prepareConnectionLink, used to create the connection) plpInitKeys :: InitialKeys, - -- | Private half of the advertised address ratchet keys, generated in prepareConnectionLink and - -- persisted in createConnectionForLink; present iff the address advertises DR keys - plpAddressKeys :: Maybe StoredAddressRatchetKeys + -- | The ratchetKeyId and private rcv ratchet keys of the advertised address DR keys, generated in + -- prepareConnectionLink and persisted in createConnectionForLink; present iff the address advertises DR keys + plpAddressKeys :: Maybe (RatchetKeyId, (C.PrivateKeyX448, C.PrivateKeyX448, Maybe RcvPrivRKEMParams)) } - deriving (Show) instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode @@ -1848,29 +1846,8 @@ newtype RatchetKeyId = RatchetKeyId ByteString deriving (Eq, Show) deriving newtype (Encoding, StrEncoding) -data AddressRatchetKeys = AddressRatchetKeys - { ratchetKeyId :: RatchetKeyId, - e2eRcvParams :: RcvE2ERatchetParamsUri 'C.X448 - } - deriving (Eq, Show) - -instance Encoding AddressRatchetKeys where - smpEncode AddressRatchetKeys {ratchetKeyId, e2eRcvParams} = smpEncode (ratchetKeyId, e2eRcvParams) - smpP = AddressRatchetKeys <$> smpP <*> smpP - --- | The private half of an AddressRatchetKeys bundle: generated together with the advertised public part in --- prepareConnectionLink and persisted by the owner (keyed by connId + ratchetKeyId) in createConnectionForLink, --- so the ratchet can be completed when a requester joins with that ratchetKeyId. -data StoredAddressRatchetKeys = StoredAddressRatchetKeys - { saRatchetKeyId :: RatchetKeyId, - saRcvPrivKey1 :: C.PrivateKeyX448, - saRcvPrivKey2 :: C.PrivateKeyX448, - saRcvPrivKem :: Maybe RcvPrivRKEMParams - } - --- private key material is redacted (and RcvPrivRKEMParams has no Show) -instance Show StoredAddressRatchetKeys where - show StoredAddressRatchetKeys {saRatchetKeyId} = "StoredAddressRatchetKeys {saRatchetKeyId = " <> show saRatchetKeyId <> ", }" +-- | The advertised address DR keys: the id selecting the owner's stored key set, and the public rcv ratchet params. +type AddressRatchetKeys = (RatchetKeyId, RcvE2ERatchetParamsUri 'C.X448) -- | Whether setConnShortLink should generate a fresh address ratchet key set, rotating the advertised keys. type NewRatchetKeys = Bool diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 30b5972e1..20432ab18 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -1029,7 +1029,7 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp (_, ContactLinkData _ userCtData', connReq') <- getConnShortLink bob 1 shortLink -- the advertised DR bundle includes a KEM iff the owner's PQ is on, so a PQ requester gets PQ from message 1 liftIO $ case ratchetKeys userCtData' of - Just AddressRatchetKeys {e2eRcvParams = CR.E2ERatchetParamsUri _ _ _ kem_} -> + Just (_, CR.E2ERatchetParamsUri _ _ _ kem_) -> isJust kem_ `shouldBe` supportPQ (CR.connPQEncryption addrIK) Nothing -> expectationFailure "address must advertise DR ratchet keys" -- classic (non-DR) join drops the address keys from the request From 14ed6794ef2ea433cfc98e9b3ee1c04ff2ea9d18 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 19 Jul 2026 18:51:50 +0100 Subject: [PATCH 73/81] refactor --- src/Simplex/Messaging/Agent.hs | 22 +++++++++---------- src/Simplex/Messaging/Agent/Protocol.hs | 4 ++-- .../Messaging/Agent/Store/AgentStore.hs | 10 ++++----- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index b81aa27ca..fde98a1f0 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1016,7 +1016,7 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP pure connId -- Generate a fresh address ratchet key set in memory (no DB): the advertised public part and the private half to persist. -generateAddressRatchetKeys :: PQSupport -> AM (AddressRatchetKeys, (RatchetKeyId, (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams))) +generateAddressRatchetKeys :: PQSupport -> AM (AddressRatchetKeys, (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) generateAddressRatchetKeys pqSupport = do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config @@ -1025,11 +1025,11 @@ generateAddressRatchetKeys pqSupport = do pure ((ratchetKeyId, toVersionRangeT e2eParams e2eVR), (ratchetKeyId, pks)) -- Persist the private half (keyed by connId + ratchetKeyId) and prune old keys. -storeAddressRatchetKeys :: AgentClient -> ConnId -> (RatchetKeyId, (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) -> AM () -storeAddressRatchetKeys c connId (ratchetKeyId, (pk1, pk2, pKem)) = do +storeAddressRatchetKeys :: AgentClient -> ConnId -> (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448) -> AM () +storeAddressRatchetKeys c connId rks = do keep <- asks $ keepAddressKeys . config withStore' c $ \db -> do - createAddressRatchetKeys db connId ratchetKeyId pk1 pk2 pKem + createAddressRatchetKeys db connId rks deleteOldAddressRatchetKeys db connId keep -- Generate + persist, used for rotation via setConnShortLink where the connId already exists. @@ -1043,9 +1043,9 @@ currentAddressRatchetKeys :: AgentClient -> ConnId -> AM (Maybe AddressRatchetKe currentAddressRatchetKeys c connId = withStore' c (`getCurrentAddressRatchetKeys` connId) >>= \case Left _ -> pure Nothing - Right (ratchetKeyId, pk1, pk2, pKem) -> do + Right (ratchetKeyId, pks) -> do e2eVR <- asks $ e2eEncryptVRange . config - pure $ Just (ratchetKeyId, toVersionRangeT (CR.mkRcvE2ERatchetParams (maxVersion e2eVR) (pk1, pk2, pKem)) e2eVR) + pure $ Just (ratchetKeyId, toVersionRangeT (CR.mkRcvE2ERatchetParams (maxVersion e2eVR) pks) e2eVR) -- | Encrypt signed link data for contact mode. encryptContactLinkData :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> LinkKey -> SMP.SenderId -> (ByteString, ByteString) -> AM ClntQueueReqData @@ -1217,14 +1217,14 @@ getConnShortLink' c nm userId = \case decryptData srv linkKey k (sndId, d) = do (fd0, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d let crData = case linkConnReq fd0 of - BCRInvitationUri d _ -> d - BCRContactUri d -> d + BCRInvitationUri crd _ -> crd + BCRContactUri crd -> crd (srv', sndId') = qAddress $ L.head $ crSmpQueues crData unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address" let fd = if srv' == srv then fd0 else updateConnReqServer srv fd0 connReq = case (linkConnReq fd, clData) of - (BCRInvitationUri d e2eParams, _) -> CRInvitationUri d e2eParams - (BCRContactUri d, ContactLinkData _ UserContactData {ratchetKeys}) -> CRContactUri d ratchetKeys + (BCRInvitationUri crd e2eParams, _) -> CRInvitationUri crd e2eParams + (BCRContactUri crd, ContactLinkData _ UserContactData {ratchetKeys}) -> CRContactUri crd ratchetKeys pure (fd, clData, connReq) sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c @@ -3616,7 +3616,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" - initRcvRatchet_ :: VersionSMPA -> PQSupport -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> CR.SndE2ERatchetParams 'C.X448 -> AM (CR.RatchetX448, PQSupport) + initRcvRatchet_ :: VersionSMPA -> PQSupport -> CR.RcvE2EPrivRatchetParams 'C.X448 -> CR.SndE2ERatchetParams 'C.X448 -> AM (CR.RatchetX448, PQSupport) initRcvRatchet_ agentVersion pqSupport pks@(_, pk2, _) (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _)) = do e2eEncryptVRange <- asks $ e2eEncryptVRange . config unless (e2eVersion `isCompatible` e2eEncryptVRange) $ throwE $ AGENT A_VERSION diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 4c681a5ad..52c67c933 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -244,8 +244,8 @@ import Simplex.Messaging.Crypto.Ratchet RatchetX448, RcvE2ERatchetParams, RcvE2ERatchetParamsUri, - RcvPrivRKEMParams, SndE2ERatchetParams, + RcvE2EPrivRatchetParams, pattern PQSupportOff, pattern PQSupportOn, ) @@ -1577,7 +1577,7 @@ data PreparedLinkParams = PreparedLinkParams plpInitKeys :: InitialKeys, -- | The ratchetKeyId and private rcv ratchet keys of the advertised address DR keys, generated in -- prepareConnectionLink and persisted in createConnectionForLink; present iff the address advertises DR keys - plpAddressKeys :: Maybe (RatchetKeyId, (C.PrivateKeyX448, C.PrivateKeyX448, Maybe RcvPrivRKEMParams)) + plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448) } instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index bf73aa156..1e275b1e8 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -1391,8 +1391,8 @@ setRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) = |] (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem, connId) -createAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO () -createAddressRatchetKeys db connId ratchetKeyId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem = +createAddressRatchetKeys :: DB.Connection -> ConnId -> (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448) -> IO () +createAddressRatchetKeys db connId (ratchetKeyId, (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem)) = DB.execute db [sql| @@ -1402,9 +1402,9 @@ createAddressRatchetKeys db connId ratchetKeyId x3dhPrivKey1 x3dhPrivKey2 pqPriv |] (connId, ratchetKeyId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) -getCurrentAddressRatchetKeys :: DB.Connection -> ConnId -> IO (Either StoreError (RatchetKeyId, C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) +getCurrentAddressRatchetKeys :: DB.Connection -> ConnId -> IO (Either StoreError (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) getCurrentAddressRatchetKeys db connId = - firstRow id SEX3dhKeysNotFound $ + firstRow (\(Only rkId :. pks) -> (rkId, pks)) SEX3dhKeysNotFound $ DB.query db [sql| @@ -1416,7 +1416,7 @@ getCurrentAddressRatchetKeys db connId = |] (Only connId) -getAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)) +getAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> IO (Either StoreError (CR.RcvE2EPrivRatchetParams 'C.X448)) getAddressRatchetKeys db connId ratchetKeyId = firstRow id SEX3dhKeysNotFound $ DB.query From 7e6b4fbf9d83c4d2d5aa264d936838f91fa78710 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 19 Jul 2026 19:19:49 +0100 Subject: [PATCH 74/81] rename, encoding --- src/Simplex/Messaging/Agent.hs | 24 ++++++++++++------------ src/Simplex/Messaging/Agent/Protocol.hs | 15 ++++++--------- 2 files changed, 18 insertions(+), 21 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index fde98a1f0..ca57dd613 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -424,8 +424,8 @@ createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::: newCo -- Returns the created link and internal params. -- The link address is fully determined at this point. prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams) -prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData pqInitKeys advertiseDR srv_ = - withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys advertiseDR srv_ +prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ = + withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ {-# INLINE prepareConnectionLink #-} -- | Create connection for prepared link (single network call). @@ -853,8 +853,8 @@ setUserService' c userId enable = do when (changed && not enable) $ withStore' c (`deleteClientServices` userId) newConnAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AM () -newConnAsync c corrId connId enableNtfs cMode pqInitKeys advertiseDR subMode = - enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode advertiseDR +newConnAsync c corrId connId enableNtfs cMode pqInitKeys useDR subMode = + enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode useDR {-# INLINE newConnAsync #-} newConnNoQueues :: AgentClient -> UserId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId @@ -959,18 +959,18 @@ switchConnectionAsync' c corrId connId = _ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex" newConn :: ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> Bool -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> AM (ConnId, CreatedConnLink c) -newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKeys advertiseDR subMode = do +newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKeys useDR subMode = do srv <- getSMPServer c userId when (checkNotices && connMode cMode == CMContact) $ checkClientNotices c srv connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys) (connId,) - <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys advertiseDR subMode srv + <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys useDR subMode srv `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e -- | Prepare connection link for contact mode (no network, no database). -- Caller provides root signing key pair and link entity ID. prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams) -prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData pqInitKeys advertiseDR srv_ = do +prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do case pqInitKeys of CR.IKUsePQ -> throwE $ CMD PROHIBITED "prepareConnectionLink" _ -> pure () @@ -983,7 +983,7 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo -- when opted in, generate the advertised DR keys in memory so the returned connReq carries them; the private -- half is persisted later in createConnectionForLink. The bundle uses the connection's PQ, so its KEM is present -- iff owner PQ is on, letting a PQ requester encrypt its first message (profile) with PQ from message 1. - addrKeys_ <- if advertiseDR then Just <$> generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) else pure Nothing + addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) else pure Nothing let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact) connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) (fst <$> addrKeys_) @@ -1256,14 +1256,14 @@ changeConnectionUser' c oldUserId connId newUserId = do updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink c) -newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqInitKeys advertiseDR subMode srvWithAuth@(ProtoServerWithAuth srv _) = do +newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqInitKeys useDR subMode srvWithAuth@(ProtoServerWithAuth srv _) = do case (cMode, pqInitKeys) of (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" _ -> pure () -- when opted in, generate + persist the advertised DR keys for a contact address; the public half goes into the -- connReq and the mutable link data so requesters can start the ratchet from message 1 addrKeys_ <- case cMode of - SCMContact | advertiseDR -> do + SCMContact | useDR -> do (arKeys, stored) <- generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) storeAddressRatchetKeys c connId stored pure $ Just arKeys @@ -2016,10 +2016,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do processCmd :: RetryInterval -> PendingCommand -> TVar [ATransmission] -> AM () processCmd ri PendingCommand {cmdId, corrId, userId, command} pendingCmds = case command of AClientCommand cmd -> case cmd of - NEW enableNtfs (ACM cMode) pqEnc subMode advertiseDR -> noServer $ do + NEW enableNtfs (ACM cMode) pqEnc subMode useDR -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do - CCLink cReq _ <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc advertiseDR subMode srv + CCLink cReq _ <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc useDR subMode srv notify $ INV (ACR cMode cReq) LSET userLinkData clientData -> withServer' . tryCommand $ do diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 52c67c933..e57898323 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1956,7 +1956,7 @@ instance ConnectionModeI c => Encoding (FixedLinkData c) where smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId -- TODO replace with smpEncode (fromMaybe "" linkEntityId) - safe to do it in 2027 smpP = do (agentVRange, rootKey, linkConnReq) <- smpP - linkEntityId <- optional smpP -- TODO replace with (smpP <|> pure Nothing) + linkEntityId <- ((\s -> if B.null s then Nothing else Just s) =<<) <$> optional smpP _ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding (added in January 2026) pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} @@ -2201,16 +2201,13 @@ cryptoErrToSyncState = \case $(J.deriveJSON defaultJSON ''DRInvitation) --- JRConnReq must stay byte-identical to the pre-DR JOIN "ntfs cReq pqSup" for old/new client interop; pqSup --- and subMode still default when a legacy command omits them. +-- JRConnReq is identical to JOIN before DR support for old/new client compatibility instance StrEncoding JoinRequest where strEncode = \case JRConnReq ntfs cReq pqSup -> strEncode (ntfs, cReq, pqSup) JRInvitationDR dr -> serializeBinary $ LB.toStrict (J'.encode dr) strP = - -- self-contained: fields are separated by leading spaces and JoinRequest consumes no trailing space, so it - -- round-trips on its own; the space before the next JOIN field is consumed by the JOIN command parser - (JRConnReq <$> strP <*> (A.space *> strP) <*> ((A.space *> strP) <|> pure PQSupportOff)) + (JRConnReq <$> strP <*> _strP <*> (_strP <|> pure PQSupportOff)) <|> (JRInvitationDR <$> (J'.eitherDecodeStrict' <$?> (A.take =<< (A.decimal <* "\n")))) -- | SMP agent command and response parser for commands stored in db (fully parses binary bodies) @@ -2243,8 +2240,8 @@ commandP :: Parser ByteString -> Parser ACommand commandP binaryP = strP >>= \case - -- advertiseDR is a trailing field defaulting to False, so NEW persisted before it was added still parses - NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe) <*> ((A.space *> strP) <|> pure False)) + -- useDR is a trailing field defaulting to False, so NEW persisted before it was added still parses + NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe) <*> (_strP <|> pure False)) LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP)) LGET_ -> s (LGET <$> strP) JOIN_ -> s (JOIN <$> strP_ <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) @@ -2261,7 +2258,7 @@ commandP binaryP = -- | Serialize SMP agent command. serializeCommand :: ACommand -> ByteString serializeCommand = \case - NEW ntfs cMode pqIK subMode advertiseDR -> s (NEW_, ntfs, cMode, pqIK, subMode) <> B.cons ' ' (strEncode advertiseDR) + NEW ntfs cMode pqIK subMode useDR -> s (NEW_, ntfs, cMode, pqIK, subMode, useDR) LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_ LGET sl -> s (LGET_, sl) JOIN joinReq subMode cInfo -> s (JOIN_, joinReq, subMode, Str $ serializeBinary cInfo) From f8a117b52146b7a3960e6013d506c62f61706c19 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 19 Jul 2026 18:46:29 +0000 Subject: [PATCH 75/81] clean up --- src/Simplex/Messaging/Agent.hs | 29 ++++------------------ tests/AgentTests/ConnectionRequestTests.hs | 13 ---------- 2 files changed, 5 insertions(+), 37 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index ca57dd613..838cdbb0d 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -980,9 +980,6 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo AgentConfig {smpClientVRange, smpAgentVRange} <- asks config plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g - -- when opted in, generate the advertised DR keys in memory so the returned connReq carries them; the private - -- half is persisted later in createConnectionForLink. The bundle uses the connection's PQ, so its KEM is present - -- iff owner PQ is on, letting a PQ requester encrypt its first message (profile) with PQ from message 1. addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) else pure Nothing let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact) @@ -998,8 +995,6 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP g <- asks random AgentConfig {smpAgentVRange} <- asks config connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption plpInitKeys) - -- persist the private half of the advertised keys (generated in prepareConnectionLink) so the owner can complete - -- the ratchet when a requester joins; the public half rides in the connReq and goes into the mutable link data mapM_ (storeAddressRatchetKeys c connId) plpAddressKeys let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} addrKeys_ = connReq userLinkData' = case addrKeys_ of @@ -1015,7 +1010,6 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch" pure connId --- Generate a fresh address ratchet key set in memory (no DB): the advertised public part and the private half to persist. generateAddressRatchetKeys :: PQSupport -> AM (AddressRatchetKeys, (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) generateAddressRatchetKeys pqSupport = do g <- asks random @@ -1024,7 +1018,6 @@ generateAddressRatchetKeys pqSupport = do ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) pure ((ratchetKeyId, toVersionRangeT e2eParams e2eVR), (ratchetKeyId, pks)) --- Persist the private half (keyed by connId + ratchetKeyId) and prune old keys. storeAddressRatchetKeys :: AgentClient -> ConnId -> (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448) -> AM () storeAddressRatchetKeys c connId rks = do keep <- asks $ keepAddressKeys . config @@ -1032,13 +1025,6 @@ storeAddressRatchetKeys c connId rks = do createAddressRatchetKeys db connId rks deleteOldAddressRatchetKeys db connId keep --- Generate + persist, used for rotation via setConnShortLink where the connId already exists. -newAddressRatchetKeys :: AgentClient -> ConnId -> PQSupport -> AM AddressRatchetKeys -newAddressRatchetKeys c connId pqSupport = do - (arKeys, stored) <- generateAddressRatchetKeys pqSupport - storeAddressRatchetKeys c connId stored - pure arKeys - currentAddressRatchetKeys :: AgentClient -> ConnId -> AM (Maybe AddressRatchetKeys) currentAddressRatchetKeys c connId = withStore' c (`getCurrentAddressRatchetKeys` connId) >>= \case @@ -1143,7 +1129,10 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotate = AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config ratchetKeys <- if rotate - then Just <$> newAddressRatchetKeys c connId pqSupport + then do + (arKeys, stored) <- generateAddressRatchetKeys pqSupport + storeAddressRatchetKeys c connId stored + pure $ Just arKeys else currentAddressRatchetKeys c connId let ud = UserContactLinkData ucd {ratchetKeys} cslContact = CSLContact SLSServer CCTContact (qServer rq) @@ -1260,8 +1249,6 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni case (cMode, pqInitKeys) of (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" _ -> pure () - -- when opted in, generate + persist the advertised DR keys for a contact address; the public half goes into the - -- connReq and the mutable link data so requesters can start the ratchet from message 1 addrKeys_ <- case cMode of SCMContact | useDR -> do (arKeys, stored) <- generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) @@ -1292,7 +1279,6 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni (pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc withStore' c $ \db -> createRatchetX3dhKeys db connId pks pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange - -- inject the agent-generated advertised keys into the contact mutable link data (requesters fetch them here) setLinkDataRatchetKeys :: Maybe AddressRatchetKeys -> UserConnLinkData c -> UserConnLinkData c setLinkDataRatchetKeys ks = \case UserContactLinkData ucd -> UserContactLinkData ucd {ratchetKeys = ks} @@ -1459,15 +1445,12 @@ compatibleInvitationUri (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQue <*> (e2eRcvParamsUri `compatibleVersion` e2eEncryptVRange) <*> (crAgentVRange `compatibleVersion` smpAgentVRange) --- | A contact address advertising DR keys must have version-compatible e2e ratchet params too; the returned --- Compatible params (and ratchetKeyId) are what joinConnSrv/connRequestPQSupport use, so the check lives here. compatibleContactUri :: ConnectionRequestUri 'CMContact -> AM' (Maybe (Compatible SMPQueueInfo, Maybe (RatchetKeyId, Compatible (CR.RcvE2ERatchetParams 'C.X448)), Compatible VersionSMPA)) compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} addrKeys_) = do AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config pure $ do q <- qUri `compatibleVersion` smpClientVRange v <- crAgentVRange `compatibleVersion` smpAgentVRange - -- an advertised DR bundle must be version-compatible, otherwise the whole address is incompatible ratchet_ <- case addrKeys_ of Nothing -> Just Nothing Just (ratchetKeyId, e2eRcvParams) -> @@ -1478,7 +1461,6 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} --- | e2e ratchet version of a contact address's compatible advertised DR keys (if any), for PQ-support calculation. addrKeysE2EVersion :: Maybe (RatchetKeyId, Compatible (CR.RcvE2ERatchetParams 'C.X448)) -> Maybe CR.VersionE2E addrKeysE2EVersion = fmap $ \(_, Compatible (CR.E2ERatchetParams e2eV _ _ _)) -> e2eV @@ -1511,7 +1493,6 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup su RcvConnection _ rq -> mkJoinInvitation rq pqInitKeys _ -> throwE $ CMD PROHIBITED $ "joinConnSrv: bad connection " <> show cType pure AgentInvitation {agentVersion = v, connReq = cReq, connInfo = cInfo} - -- the advertised keys' e2e version was already checked by compatibleContactUri; use the compatible params Just (ratchetKeyId, Compatible e2eParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config @@ -3457,7 +3438,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "msg: bad client msg" >> ack (Just e2eDh, Just _) -> decryptClientMessage e2eDh clientMsg >>= \case - -- this is a repeated confirmation/invitation delivery because ack failed to be sent + -- this is a repeated confirmation delivery because ack failed to be sent (_, AgentConfirmation {}) -> ack (_, AgentInvitationDR {}) -> ack _ -> prohibited "msg: public header" >> ack diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 09b195c12..f587c29f0 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -261,19 +261,6 @@ connectionRequestTests = queueV1NoPort #==# ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr) - it "JOIN command is backward compatible: JRConnReq is byte-identical to the pre-DR JOIN" $ do - let uri = ACR SCMInvitation invConnRequest - cmd = JOIN (JRConnReq True uri PQSupportOff) SMSubscribe "hi" - -- the pre-DR JOIN wire format: "JOIN " - oldJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode PQSupportOff <> " " <> strEncode SMSubscribe <> " 2\nhi" - serializeCommand cmd `shouldBe` oldJoin - case parseAll dbCommandP oldJoin of - Right (JOIN JRConnReq {} _ _) -> pure () - r -> expectationFailure $ "expected JOIN JRConnReq, got " <> show r - (serializeCommand <$> parseAll dbCommandP oldJoin) `shouldBe` Right oldJoin - -- a legacy JOIN omitting pqSup parses with the PQSupportOff default (re-serializing with pqSup present) - let legacyJoin = "JOIN " <> strEncode True <> " " <> strEncode uri <> " " <> strEncode SMSubscribe <> " 2\nhi" - (serializeCommand <$> parseAll dbCommandP legacyJoin) `shouldBe` Right oldJoin 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) From 151deacc2bab343144315084ba10c3bec300503f Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 19 Jul 2026 19:51:09 +0100 Subject: [PATCH 76/81] refactor --- src/Simplex/Messaging/Agent.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 838cdbb0d..2f72e8478 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1025,6 +1025,12 @@ storeAddressRatchetKeys c connId rks = do createAddressRatchetKeys db connId rks deleteOldAddressRatchetKeys db connId keep +newAddressRatchetKeys :: AgentClient -> ConnId -> PQSupport -> AM AddressRatchetKeys +newAddressRatchetKeys c connId pqSupport = do + (ks, pks) <- generateAddressRatchetKeys pqSupport + storeAddressRatchetKeys c connId pks + pure ks + currentAddressRatchetKeys :: AgentClient -> ConnId -> AM (Maybe AddressRatchetKeys) currentAddressRatchetKeys c connId = withStore' c (`getCurrentAddressRatchetKeys` connId) >>= \case @@ -1129,10 +1135,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotate = AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config ratchetKeys <- if rotate - then do - (arKeys, stored) <- generateAddressRatchetKeys pqSupport - storeAddressRatchetKeys c connId stored - pure $ Just arKeys + then Just <$> newAddressRatchetKeys c connId pqSupport else currentAddressRatchetKeys c connId let ud = UserContactLinkData ucd {ratchetKeys} cslContact = CSLContact SLSServer CCTContact (qServer rq) @@ -1250,10 +1253,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" _ -> pure () addrKeys_ <- case cMode of - SCMContact | useDR -> do - (arKeys, stored) <- generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) - storeAddressRatchetKeys c connId stored - pure $ Just arKeys + SCMContact | useDR -> Just <$> newAddressRatchetKeys c connId (CR.connPQEncryption pqInitKeys) _ -> pure Nothing e2eKeys <- atomically . C.generateKeyPair =<< asks random case userLinkData_ of From dc1449fc8498aa75bb50dbdca6cd9cef45ac97df Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 19 Jul 2026 20:02:16 +0100 Subject: [PATCH 77/81] compatible --- src/Simplex/Messaging/Agent.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 2f72e8478..7b7e6c3c2 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1448,14 +1448,16 @@ compatibleInvitationUri (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQue compatibleContactUri :: ConnectionRequestUri 'CMContact -> AM' (Maybe (Compatible SMPQueueInfo, Maybe (RatchetKeyId, Compatible (CR.RcvE2ERatchetParams 'C.X448)), Compatible VersionSMPA)) compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} addrKeys_) = do AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config - pure $ do - q <- qUri `compatibleVersion` smpClientVRange - v <- crAgentVRange `compatibleVersion` smpAgentVRange - ratchet_ <- case addrKeys_ of + pure $ + (,,) + <$> (qUri `compatibleVersion` smpClientVRange) + <*> compatibleRatchetKeys e2eEncryptVRange + <*> (crAgentVRange `compatibleVersion` smpAgentVRange) + where + compatibleRatchetKeys e2eVR = case addrKeys_ of Nothing -> Just Nothing Just (ratchetKeyId, e2eRcvParams) -> - Just . (ratchetKeyId,) <$> (e2eRcvParams `compatibleVersion` e2eEncryptVRange) - pure (q, ratchet_, v) + Just . (ratchetKeyId,) <$> (e2eRcvParams `compatibleVersion` e2eVR) versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ From 38093bbedd5b31b750a01c9174ba9e84409b93eb Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 19 Jul 2026 20:07:26 +0100 Subject: [PATCH 78/81] addrKeysE2EVersion --- src/Simplex/Messaging/Agent.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 7b7e6c3c2..2f8f0f83a 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -877,8 +877,8 @@ joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} c Nothing -> throwE $ AGENT A_VERSION joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode = lift (compatibleContactUri cReqUri) >>= \case - Just (_, ratchet_, Compatible connAgentVersion) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (addrKeysE2EVersion ratchet_) + Just (_, rks_, Compatible connAgentVersion) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (addrKeysE2EVersion <$> rks_) when updateConn $ withStore' c $ \db -> updateNewConnJoin db connId connAgentVersion pqSupport enableNtfs enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) subMode cInfo Nothing -> throwE $ AGENT A_VERSION @@ -1343,7 +1343,7 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of Nothing -> throwE $ AGENT A_VERSION CRContactUri {} -> lift (compatibleContactUri cReq) >>= \case - Just (_, ratchet_, aVersion) -> create aVersion (addrKeysE2EVersion ratchet_) + Just (_, rks_, aVersion) -> create aVersion (addrKeysE2EVersion <$> rks_) Nothing -> throwE $ AGENT A_VERSION where create :: Compatible VersionSMPA -> Maybe CR.VersionE2E -> AM ConnId @@ -1434,7 +1434,7 @@ connRequestPQSupport c pqSup cReq = withAgentEnv' c $ case cReq of invPQSupported (_, Compatible (CR.E2ERatchetParams e2eV _ _ _), Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV (Just e2eV)) CRContactUri {} -> ctPQSupported <$$> compatibleContactUri cReq where - ctPQSupported (_, ratchet_, Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV (addrKeysE2EVersion ratchet_)) + ctPQSupported (_, rks_, Compatible agentV) = (agentV, pqSup `CR.pqSupportAnd` versionPQSupport_ agentV (addrKeysE2EVersion <$> rks_)) compatibleInvitationUri :: ConnectionRequestUri 'CMInvitation -> AM' (Maybe (Compatible SMPQueueInfo, Compatible (CR.RcvE2ERatchetParams 'C.X448), Compatible VersionSMPA)) compatibleInvitationUri (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) = do @@ -1463,8 +1463,8 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} -addrKeysE2EVersion :: Maybe (RatchetKeyId, Compatible (CR.RcvE2ERatchetParams 'C.X448)) -> Maybe CR.VersionE2E -addrKeysE2EVersion = fmap $ \(_, Compatible (CR.E2ERatchetParams e2eV _ _ _)) -> e2eV +addrKeysE2EVersion :: (RatchetKeyId, Compatible (CR.RcvE2ERatchetParams 'C.X448)) -> CR.VersionE2E +addrKeysE2EVersion (_, Compatible (CR.E2ERatchetParams e2eV _ _ _)) = e2eV joinConnSrv :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv = From 75dc1ced41e67bf7e9bca4646b7af65fd99d7646 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Mon, 20 Jul 2026 06:15:35 +0000 Subject: [PATCH 79/81] support IKUsePQ for contact addresses --- plans/2026-07-12-address-dr-implementation.md | 23 ++++---- src/Simplex/Messaging/Agent.hs | 42 ++++++-------- src/Simplex/Messaging/Agent/Protocol.hs | 18 ++---- src/Simplex/Messaging/Agent/Store.hs | 1 - .../Messaging/Agent/Store/AgentStore.hs | 1 - tests/AgentTests/ConnectionRequestTests.hs | 6 +- tests/AgentTests/FunctionalAPITests.hs | 58 ++++++++++++++----- 7 files changed, 82 insertions(+), 67 deletions(-) diff --git a/plans/2026-07-12-address-dr-implementation.md b/plans/2026-07-12-address-dr-implementation.md index 6ba55b159..6e8138c33 100644 --- a/plans/2026-07-12-address-dr-implementation.md +++ b/plans/2026-07-12-address-dr-implementation.md @@ -216,16 +216,16 @@ Three readers of the widened `connReq` field (all via `getInvitation`) branch on Storage: `cr_invitation`'s `ToField`/`FromField` encode `CRInvitation` as the legacy `strEncode` URI (unchanged from before, so the format is downgrade-safe) and `CRConfirmation` as JSON (`J.encode` of `DRRequest`). `FromField` peeks the first byte: `{` → JSON `CRConfirmation`, else `strDecode` → `CRInvitation` (a URI never starts with `{`). `DRRequest` uses manual `ToJSON`/`FromJSON` (extensible), and `SMPQueueInfo` gets a base64 `StrEncoding` + JSON to sit inside it. `smpInvitation` (Agent.hs:3618) wraps its `connReq` in `CRInvitation`; `smpAddressConfirmation` (O2') writes `CRConfirmation`. -## Part 4 - key rotation (separate concern) +## Part 4 - key rotation (client-driven) -Rotation is required but independent of the handshake above. The whole ratchet-keys bundle - both X448 keys and the KEM - rotates on a schedule, generated fresh each time. +Rotation is independent of the handshake above and is driven by the client app, not the agent. The agent never rotates on its own - it lacks the app's intent and the mutable link data (profile/badge and other short-link data). The app rotates by calling `setConnShortLink` with the rotate flag; the whole ratchet-keys bundle - both X448 keys and the KEM - is generated fresh each time. ### Schema ```sql --- one row per ratchet-keys generation for an address; current plus retired-within-window. +-- one row per ratchet-keys generation for an address; the current generation plus the most recent retained ones. -- private side of the advertised RcvE2ERatchetParamsUri - same shape as the ratchets x3dh --- columns and createRatchetX3dhKeys (AgentStore.hs:1362-1367). +-- columns and createRatchetX3dhKeys (AgentStore.hs). CREATE TABLE address_ratchet_keys( address_ratchet_key_id INTEGER PRIMARY KEY AUTOINCREMENT, conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, @@ -233,8 +233,7 @@ CREATE TABLE address_ratchet_keys( x3dh_priv_key_1 BLOB NOT NULL, -- X448 x3dh_priv_key_2 BLOB NOT NULL, -- X448 pq_priv_kem BLOB, -- RcvPrivRKEMParams (sntrup761 keypair); NULL when PQ is off for this address - created_at TEXT NOT NULL, - retired_at TEXT -- set on rotation + created_at TEXT NOT NULL DEFAULT(datetime('now')) ); CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ratchet_key_id); @@ -247,17 +246,15 @@ CREATE UNIQUE INDEX idx_address_ratchet_keys ON address_ratchet_keys(conn_id, ra ### Rotation logic -`rotateRatchetKeys` (new), run on address subscription, at most every 2 weeks (skip if the current generation is younger): +The app rotates by calling `setConnShortLink` with the rotate flag; there is no automatic, agent-driven rotation. On rotation: -1. `generateRcvE2EParams` (Ratchet.hs:439) for a fresh generation - two X448 keys, and an sntrup761 keypair only if PQ is on for this address - with a fresh `ratchetKeyId`. +1. `generateRcvE2EParams` for a fresh generation - two X448 keys, and an sntrup761 keypair only if PQ is on for this address - with a fresh `ratchetKeyId`. 2. Recompute mutable link data with the new `AddressRatchetKeys` (the public `e2eParams`), re-sign with the root key (`encodeSignUserData`, key from `rcv_queues.link_priv_sig_key`), and `LSET` it to the address queue (`setConnShortLink` path). -3. Insert the new `address_ratchet_keys` row (`x3dh_priv_key_1`, `x3dh_priv_key_2`, `pq_priv_kem`); set `retired_at` on the previous row. +3. Insert the new `address_ratchet_keys` row (`x3dh_priv_key_1`, `x3dh_priv_key_2`, `pq_priv_kem`). -Retention window equals queue message retention (`storedMsgDataTTL`, Env/SQLite.hs:237), covering a request that used a just-retired bundle and is still in the address queue. The 2-week cadence bounds how long a recorded first message stays decryptable after a compromise of the current private keys - a retired generation is deleted after the window and then decrypts nothing. +### Retention -### Cleanup - -`cleanupManager` (Agent.hs:2994) gains one step: delete `address_ratchet_keys` rows with `retired_at` older than the window, batched like `deleteRcvMsgHashesExpired` (Agent.hs:3001). Unaccepted DR request rows in `conn_invitations` are handled exactly like unaccepted classic invitation requests - no DR-specific cleanup (a DR request is one `conn_invitations` row, the same class of state as a classic contact request). +Retention is count-based, not time-based: on each rotation `deleteOldAddressRatchetKeys` keeps the newest `keepAddressKeys` generations per address (default 3, ordered by `address_ratchet_key_id`) and deletes older ones. There is no `retired_at` column, no time window, and no `cleanupManager` step. A request that used a recently-retired bundle still decrypts while that generation is retained; how long a recorded first message stays decryptable after a compromise of the current private keys is therefore bounded by the retained-generation count and the app's rotation cadence (both app-controlled). Unaccepted DR request rows in `conn_invitations` are handled exactly like unaccepted classic invitation requests - no DR-specific cleanup (a DR request is one `conn_invitations` row, the same class of state as a classic contact request). ## Part 5 - backward compatibility diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 2f8f0f83a..d79f7cd94 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -435,8 +435,8 @@ createConnectionForLink c nm userId enableNtfs = withAgentEnv c .:: createConnec {-# INLINE createConnectionForLink #-} -- | Create or update user's contact connection short link -setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> AE (ConnShortLink c) -setConnShortLink c = withAgentEnv c .::: setConnShortLink' c +setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> Maybe CR.InitialKeys -> AE (ConnShortLink c) +setConnShortLink c nm connId cMode uld cd rotate ik = withAgentEnv c $ setConnShortLink' c nm connId cMode uld cd rotate ik {-# INLINE setConnShortLink #-} deleteConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AE () @@ -971,16 +971,13 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey -- Caller provides root signing key pair and link entity ID. prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams) prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do - case pqInitKeys of - CR.IKUsePQ -> throwE $ CMD PROHIBITED "prepareConnectionLink" - _ -> pure () g <- asks random plpSrvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_ when checkNotices $ checkClientNotices c plpSrvWithAuth AgentConfig {smpClientVRange, smpAgentVRange} <- asks config plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g - addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys (CR.connPQEncryption pqInitKeys) else pure Nothing + addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys pqInitKeys else pure Nothing let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact) connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) (fst <$> addrKeys_) @@ -1010,10 +1007,11 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch" pure connId -generateAddressRatchetKeys :: PQSupport -> AM (AddressRatchetKeys, (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) -generateAddressRatchetKeys pqSupport = do +generateAddressRatchetKeys :: CR.InitialKeys -> AM (AddressRatchetKeys, (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) +generateAddressRatchetKeys pqInitKeys = do g <- asks random e2eVR <- asks $ e2eEncryptVRange . config + let pqSupport = case pqInitKeys of CR.IKUsePQ -> PQSupportOn; _ -> PQSupportOff (pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqSupport ratchetKeyId <- RatchetKeyId <$> atomically (C.randomBytes 16 g) pure ((ratchetKeyId, toVersionRangeT e2eParams e2eVR), (ratchetKeyId, pks)) @@ -1025,9 +1023,9 @@ storeAddressRatchetKeys c connId rks = do createAddressRatchetKeys db connId rks deleteOldAddressRatchetKeys db connId keep -newAddressRatchetKeys :: AgentClient -> ConnId -> PQSupport -> AM AddressRatchetKeys -newAddressRatchetKeys c connId pqSupport = do - (ks, pks) <- generateAddressRatchetKeys pqSupport +newAddressRatchetKeys :: AgentClient -> ConnId -> CR.InitialKeys -> AM AddressRatchetKeys +newAddressRatchetKeys c connId pqInitKeys = do + (ks, pks) <- generateAddressRatchetKeys pqInitKeys storeAddressRatchetKeys c connId pks pure ks @@ -1117,8 +1115,8 @@ getConnShortLinkAsync' c userId corrId connId_ shortLink@(CSLContact _ _ srv _) } createNewConn db g cData SCMInvitation -setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> AM (ConnShortLink c) -setConnShortLink' c nm connId cMode userLinkData clientData rotate = +setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> Maybe CR.InitialKeys -> AM (ConnShortLink c) +setConnShortLink' c nm connId cMode userLinkData clientData rotate pqInitKeys_ = withConnLock c connId "setConnShortLink" $ do SomeConn _ conn <- withStore c (`getConn` connId) (rq, lnkId, sl, d) <- case (conn, cMode, userLinkData) of @@ -1129,14 +1127,15 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotate = pure sl where prepareContactLinkData :: ConnData -> RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData) - prepareContactLinkData ConnData {pqSupport} rq@RcvQueue {shortLink} (UserContactLinkData ucd) = do + prepareContactLinkData ConnData {} rq@RcvQueue {shortLink} (UserContactLinkData ucd) = do liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink ucd g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config + -- rotate makes fresh keys from InitialKeys; otherwise keep current keys, creating from InitialKeys only when none exist ratchetKeys <- if rotate - then Just <$> newAddressRatchetKeys c connId pqSupport - else currentAddressRatchetKeys c connId + then maybe (currentAddressRatchetKeys c connId) (fmap Just . newAddressRatchetKeys c connId) pqInitKeys_ + else currentAddressRatchetKeys c connId >>= maybe (mapM (newAddressRatchetKeys c connId) pqInitKeys_) (pure . Just) let ud = UserContactLinkData ucd {ratchetKeys} cslContact = CSLContact SLSServer CCTContact (qServer rq) case shortLink of @@ -1249,11 +1248,8 @@ changeConnectionUser' c oldUserId connId newUserId = do newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe (UserConnLinkData c) -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink c) newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqInitKeys useDR subMode srvWithAuth@(ProtoServerWithAuth srv _) = do - case (cMode, pqInitKeys) of - (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" - _ -> pure () addrKeys_ <- case cMode of - SCMContact | useDR -> Just <$> newAddressRatchetKeys c connId (CR.connPQEncryption pqInitKeys) + SCMContact | useDR -> Just <$> newAddressRatchetKeys c connId pqInitKeys _ -> pure Nothing e2eKeys <- atomically . C.generateKeyPair =<< asks random case userLinkData_ of @@ -2006,7 +2002,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do notify $ INV (ACR cMode cReq) LSET userLinkData clientData -> withServer' . tryCommand $ do - link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData False + link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData False Nothing notify $ LINK link userLinkData LGET shortLink -> withServer' . tryCommand $ do @@ -3541,10 +3537,10 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- party initiating connection RcvConnection {} -> do case e2eEncryption of - Just e2eSndParams -> do -- create ratchet from sent invitation and received confirmation keys + Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) processConnInfo =<< initRcvRatchet_ agentVersion pqSupport keys e2eSndParams - Nothing -> withStore' c (`getRatchet` connId) >>= \case -- use ratchet initialized from published ratchet keys during invitation + Nothing -> withStore' c (`getRatchet` connId) >>= \case Left _ -> prohibited "conf: incorrect state" Right rc -> processConnInfo (rc, pqSupport) where diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index e57898323..8c3cc7df0 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -469,7 +469,7 @@ instance Eq AEvtTag where deriving instance Show AEvtTag data ACommand - = NEW Bool AConnectionMode InitialKeys SubscriptionMode UseRatchetKeys -- response INV; UseRatchetKeys advertises address DR keys (contact mode) + = NEW Bool AConnectionMode InitialKeys SubscriptionMode UseRatchetKeys -- response INV | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK | LGET (ConnShortLink 'CMContact) -- response LDATA | JOIN JoinRequest SubscriptionMode ConnInfo @@ -858,9 +858,7 @@ data AgentMsgEnvelope connReq :: ConnectionRequestUri 'CMInvitation, connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet, } - | -- a requester's first message to a contact address that establishes the double ratchet from the address keys; - -- ratchetKeyId selects the owner's advertised key, encConnInfo is a ratchet-encrypted AgentConnInfoReply - AgentInvitationDR + | AgentInvitationDR { agentVersion :: VersionSMPA, e2eSndParams :: SndE2ERatchetParams 'C.X448, ratchetKeyId :: RatchetKeyId, @@ -1503,7 +1501,6 @@ data ABinaryConnectionRequestUri = forall m. ConnectionModeI m => ABCR (SConnect data ConnectionRequestUri (m :: ConnectionMode) where CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation - -- optional address DR keys enable the ratchet from message 1; absent in BinaryConnectionRequestUri (link fixed data) so they can rotate via mutable data CRContactUri :: ConnReqUriData -> Maybe AddressRatchetKeys -> ConnectionRequestUri CMContact simplexConnReqUri :: ConnectionRequestUri m -> ConnectionRequestUri m @@ -1573,10 +1570,7 @@ data PreparedLinkParams = PreparedLinkParams plpSignedFixedData :: ByteString, -- | Server with basic auth (not stored in link) plpSrvWithAuth :: SMPServerWithAuth, - -- | Connection initial keys (decided in prepareConnectionLink, used to create the connection) plpInitKeys :: InitialKeys, - -- | The ratchetKeyId and private rcv ratchet keys of the advertised address DR keys, generated in - -- prepareConnectionLink and persisted in createConnectionForLink; present iff the address advertises DR keys plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448) } @@ -1846,14 +1840,10 @@ newtype RatchetKeyId = RatchetKeyId ByteString deriving (Eq, Show) deriving newtype (Encoding, StrEncoding) --- | The advertised address DR keys: the id selecting the owner's stored key set, and the public rcv ratchet params. type AddressRatchetKeys = (RatchetKeyId, RcvE2ERatchetParamsUri 'C.X448) --- | Whether setConnShortLink should generate a fresh address ratchet key set, rotating the advertised keys. type NewRatchetKeys = Bool --- | The double-ratchet invitation an address owner receives in message 1 and later accepts: the ratchet the --- owner established from that message, the requester's reply queue, and the negotiated version and PQ support. data DRInvitation = DRInvitation { ratchetState :: RatchetX448, replyQueue :: SMPQueueInfo, @@ -1953,11 +1943,11 @@ validateLinkOwners rootKey = go [] instance ConnectionModeI c => Encoding (FixedLinkData c) where smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} = - smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId -- TODO replace with smpEncode (fromMaybe "" linkEntityId) - safe to do it in 2027 + smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId smpP = do (agentVRange, rootKey, linkConnReq) <- smpP linkEntityId <- ((\s -> if B.null s then Nothing else Just s) =<<) <$> optional smpP - _ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding (added in January 2026) + _ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} instance ConnectionModeI c => Encoding (ConnLinkData c) where diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 0095757c6..49a842cf0 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -641,7 +641,6 @@ data Invitation = Invitation accepted :: Bool } --- | A classic connection request URI, or a double-ratchet invitation received at a DR address. data ContactRequest = CRInvitation (ConnectionRequestUri 'CMInvitation) | CRInvitationDR DRInvitation diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index 1e275b1e8..da00533dc 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -2140,7 +2140,6 @@ instance ToField RatchetKeyId where toField (RatchetKeyId s) = toField $ Binary instance FromField RatchetKeyId where fromField = blobFieldDecoder $ Right . RatchetKeyId --- CRInvitation keeps the legacy URI (downgrade-safe); CRInvitationDR is JSON, told apart by leading '{' instance ToField ContactRequest where toField = toField . Binary . \case CRInvitation cr -> strEncode cr diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index f587c29f0..7b27feaf8 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -198,6 +198,9 @@ contactAddress = ACR SCMContact $ contactConnRequest contactConnRequest :: ConnectionRequestUri 'CMContact contactConnRequest = CRContactUri connReqData Nothing +contactAddressDR :: AConnectionRequestUri +contactAddressDR = ACR SCMContact $ CRContactUri connReqData (Just (RatchetKeyId "0123456789abcdef", testE2ERatchetParams)) + contactAddressV2 :: AConnectionRequestUri contactAddressV2 = ACR SCMContact $ CRContactUri connReqDataV2 Nothing @@ -222,7 +225,7 @@ connectionRequestClientDataEmpty = ACR SCMInvitation $ CRInvitationUri connReqDa contactAddressClientData :: AConnectionRequestUri contactAddressClientData = ACR SCMContact $ CRContactUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"} Nothing --- binary encoding is defined only for BinaryConnectionRequestUri (link fixed data); drop the address keys for the round-trip +-- binary encoding is defined only for BinaryConnectionRequestUri; drop the address keys for the round-trip aBinaryConnReq :: AConnectionRequestUri -> ABinaryConnectionRequestUri aBinaryConnReq (ACR m cr) = ABCR m (binaryConnReq cr) @@ -273,6 +276,7 @@ connectionRequestTests = connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}") contactAddress #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr) + contactAddressDR #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&rk=MDEyMzQ1Njc4OWFiY2RlZg%3D%3D") contactAddress #== ("https://simplex.chat/contact#/?v=2-7&smp=" <> url queueStr) contactAddress2queues #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr)) contactAddressNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueNewStr) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 20432ab18..32750ef58 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -315,7 +315,7 @@ getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkDat getConnShortLink c = A.getConnShortLink c NRMInteractive setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c) -setConnShortLink c connId cMode uld cd = A.setConnShortLink c NRMInteractive connId cMode uld cd False +setConnShortLink c connId cMode uld cd = A.setConnShortLink c NRMInteractive connId cMode uld cd False Nothing suspendConnection :: AgentClient -> ConnId -> AE () suspendConnection c = A.suspendConnection c NRMInteractive @@ -349,6 +349,11 @@ functionalAPITests ps = do testPQMatrix3 ps $ runAgentClientContactTestPQ3 True describe "Establish duplex connection via contact address with DR" $ testContactDRMatrix ps + describe "Establish duplex connection creating contact address with DR" $ do + it "createConnection, IKPQOn" $ runCreateConnectionDRTest_ False IKPQOn PQSupportOn ps + it "createConnection, IKUsePQ" $ runCreateConnectionDRTest_ False IKUsePQ PQSupportOn ps + it "createConnectionAsync, IKPQOn" $ runCreateConnectionDRTest_ True IKPQOn PQSupportOn ps + it "createConnectionAsync, IKUsePQ" $ runCreateConnectionDRTest_ True IKUsePQ PQSupportOn ps it "should preserve address DR keys when the link data is updated" $ testAddressUpdatePreservesDRKeys ps it "should rotate address DR keys, keeping old keys for stale requesters until pruned" $ @@ -1012,8 +1017,7 @@ allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc = do get bob ##> ("", aliceId, A.CON pqEnc) exchangeGreetings_ pqEnc alice bobId bob aliceId --- DR-advertising contact address test. Args: asyncAccept (JOIN vs sync accept), addrIK (advertised bundle + owner --- PQ), useDR (DR path vs classic/ignore keys), bPQ (joiner PQSupport). +-- DR-advertising contact address, across accept/join modes, InitialKeys, and joiner PQ runAgentClientContactDRTest_ :: HasCallStack => Bool -> Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO () runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do g <- C.newRandom @@ -1021,16 +1025,15 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp linkEntId <- atomically $ C.randomBytes 32 g let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} userLinkData = UserContactLinkData userCtData - connIK = IKLinkPQ (CR.connPQEncryption addrIK) -- owner connection PQ (never IKUsePQ) pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ runRight_ $ do - (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing + (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing addrIK True Nothing _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe (_, ContactLinkData _ userCtData', connReq') <- getConnShortLink bob 1 shortLink - -- the advertised DR bundle includes a KEM iff the owner's PQ is on, so a PQ requester gets PQ from message 1 + -- the advertised bundle carries a KEM only for IKUsePQ (PQ from message 1) liftIO $ case ratchetKeys userCtData' of Just (_, CR.E2ERatchetParamsUri _ _ _ kem_) -> - isJust kem_ `shouldBe` supportPQ (CR.connPQEncryption addrIK) + isJust kem_ `shouldBe` supportPQ (CR.initialPQEncryption False addrIK) Nothing -> expectationFailure "address must advertise DR ratchet keys" -- classic (non-DR) join drops the address keys from the request let connReqJoin = if useDR then connReq' else case connReq' of CRContactUri d _ -> CRContactUri d Nothing @@ -1054,6 +1057,34 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp liftIO $ confPQ `shouldBe` bPQ allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc +-- DR advertising via createConnection (sync) and createConnectionAsync (async NEW), reaching newRcvConnSrv +runCreateConnectionDRTest_ :: HasCallStack => Bool -> InitialKeys -> PQSupport -> (ASrvTransport, AStoreType) -> IO () +runCreateConnectionDRTest_ asyncNew addrIK bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do + let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} + pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ + runRight_ $ do + connReq <- + if asyncNew + then do + addrConnId <- prepareConnectionToCreate alice 1 True SCMContact (CR.connPQEncryption addrIK) + createConnectionAsync alice "1" addrConnId True SCMContact addrIK True SMSubscribe + ("1", _, INV (ACR SCMContact cReq)) <- get alice + pure cReq + else do + (_, CCLink cReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing addrIK True SMSubscribe + pure cReq + let CRContactUri _ addrKeys_ = connReq + liftIO $ case addrKeys_ of + Just (_, CR.E2ERatchetParamsUri _ _ _ kem_) -> isJust kem_ `shouldBe` supportPQ (CR.initialPQEncryption False addrIK) + Nothing -> expectationFailure "createConnection must advertise DR ratchet keys" + aliceId <- A.prepareConnectionToJoin bob 1 True connReq bPQ + void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" bPQ SMSubscribe + ("", _, A.REQ invId _ _ "bob's connInfo") <- get alice + bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + void $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe + ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob + allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc + testContactDRMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> Spec testContactDRMatrix ps = do describe "DR join (ratchet from the invitation)" $ drRows False True False @@ -1094,14 +1125,14 @@ testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob ca (_, ContactLinkData _ ctData1, connReq1) <- getConnShortLink bob 1 shortLink let key1 = ratchetKeys ctData1 liftIO $ key1 `shouldSatisfy` isJust - void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK) (_, ContactLinkData _ ctData2, connReq2) <- getConnShortLink carol 1 shortLink let key2 = ratchetKeys ctData2 liftIO $ (key1 == key2) `shouldBe` False joinContactDR alice bob connReq1 addrIK pqEnc joinContactDR alice carol connReq2 addrIK pqEnc - void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True - void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK) + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK) aId <- A.prepareConnectionToJoin bob 1 True connReq1 PQSupportOn void $ A.joinConnection bob NRMInteractive 1 aId True connReq1 "bob's connInfo" PQSupportOn SMSubscribe get alice =##> \case ("", _, A.ERR _) -> True; _ -> False @@ -1119,11 +1150,11 @@ testAddDRViaSetConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \alice addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe (_, ContactLinkData _ cd0, _) <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys cd0 `shouldBe` Nothing - void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True + void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing False (Just addrIK) (_, ContactLinkData _ cd1, _) <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys cd1 `shouldSatisfy` isJust --- updating a DR address's mutable link data must preserve the stored ratchet keys, so requesters can still establish DR +-- updating a DR address's link data must preserve the stored ratchet keys testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do g <- C.newRandom @@ -1154,8 +1185,7 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc --- Resume-safety: if the sync accept of a DR request fails at the network step after committing the send queue and --- ratchet, retrying the accept must reuse them and complete. +-- a DR accept that fails at the network step after committing send queue + ratchet must resume on retry testAcceptContactDRResumeAfterOffline :: HasCallStack => (ASrvTransport, AStoreType) -> IO () testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do g <- C.newRandom From 8d847fff5dd138318a1fac9cc9aeed5de1d35c8e Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Mon, 20 Jul 2026 07:44:18 +0100 Subject: [PATCH 80/81] comments, refactor condition --- src/Simplex/Messaging/Agent.hs | 18 +++++++++++------- src/Simplex/Messaging/Agent/Protocol.hs | 11 +++++++++-- 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index d79f7cd94..55707bc0f 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -436,7 +436,7 @@ createConnectionForLink c nm userId enableNtfs = withAgentEnv c .:: createConnec -- | Create or update user's contact connection short link setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> Maybe CR.InitialKeys -> AE (ConnShortLink c) -setConnShortLink c nm connId cMode uld cd rotate ik = withAgentEnv c $ setConnShortLink' c nm connId cMode uld cd rotate ik +setConnShortLink c = withAgentEnv c .:::. setConnShortLink' c {-# INLINE setConnShortLink #-} deleteConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AE () @@ -1116,7 +1116,7 @@ getConnShortLinkAsync' c userId corrId connId_ shortLink@(CSLContact _ _ srv _) createNewConn db g cData SCMInvitation setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> Maybe CR.InitialKeys -> AM (ConnShortLink c) -setConnShortLink' c nm connId cMode userLinkData clientData rotate pqInitKeys_ = +setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ = withConnLock c connId "setConnShortLink" $ do SomeConn _ conn <- withStore c (`getConn` connId) (rq, lnkId, sl, d) <- case (conn, cMode, userLinkData) of @@ -1131,11 +1131,13 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotate pqInitKeys_ = liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink ucd g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config - -- rotate makes fresh keys from InitialKeys; otherwise keep current keys, creating from InitialKeys only when none exist - ratchetKeys <- - if rotate - then maybe (currentAddressRatchetKeys c connId) (fmap Just . newAddressRatchetKeys c connId) pqInitKeys_ - else currentAddressRatchetKeys c connId >>= maybe (mapM (newAddressRatchetKeys c connId) pqInitKeys_) (pure . Just) + -- rotate makes fresh keys from InitialKeys; otherwise keep current keys or create based on InitialKeys if there are no ratchet keys + let currKeys = currentAddressRatchetKeys c connId + ratchetKeys <- case pqKeys_ of + Just pqKeys -> + let newKeys = newAddressRatchetKeys c connId pqKeys + in Just <$> if rotateKeys then newKeys else currKeys >>= maybe newKeys pure + Nothing -> currKeys let ud = UserContactLinkData ucd {ratchetKeys} cslContact = CSLContact SLSServer CCTContact (qServer rq) case shortLink of @@ -3537,9 +3539,11 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar -- party initiating connection RcvConnection {} -> do case e2eEncryption of + -- create ratchet from sent invitation and received confirmation keys Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) processConnInfo =<< initRcvRatchet_ agentVersion pqSupport keys e2eSndParams + -- use ratchet initialized from contract address ratchet keys during invitation Nothing -> withStore' c (`getRatchet` connId) >>= \case Left _ -> prohibited "conf: incorrect state" Right rc -> processConnInfo (rc, pqSupport) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 8c3cc7df0..dced40c2f 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -858,7 +858,7 @@ data AgentMsgEnvelope connReq :: ConnectionRequestUri 'CMInvitation, connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet, } - | AgentInvitationDR + | AgentInvitationDR -- invitation establishing double ratchet e2e with the contact address that included DR keys { agentVersion :: VersionSMPA, e2eSndParams :: SndE2ERatchetParams 'C.X448, ratchetKeyId :: RatchetKeyId, @@ -1501,6 +1501,7 @@ data ABinaryConnectionRequestUri = forall m. ConnectionModeI m => ABCR (SConnect data ConnectionRequestUri (m :: ConnectionMode) where CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation + -- optional contact address DR keys for double ratchet e2e from message 1 CRContactUri :: ConnReqUriData -> Maybe AddressRatchetKeys -> ConnectionRequestUri CMContact simplexConnReqUri :: ConnectionRequestUri m -> ConnectionRequestUri m @@ -1570,7 +1571,9 @@ data PreparedLinkParams = PreparedLinkParams plpSignedFixedData :: ByteString, -- | Server with basic auth (not stored in link) plpSrvWithAuth :: SMPServerWithAuth, + -- | Initial PQ keys plpInitKeys :: InitialKeys, + -- | Contact address double ratchet keys plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448) } @@ -1840,10 +1843,13 @@ newtype RatchetKeyId = RatchetKeyId ByteString deriving (Eq, Show) deriving newtype (Encoding, StrEncoding) +-- | double ratchet keys in contact address type AddressRatchetKeys = (RatchetKeyId, RcvE2ERatchetParamsUri 'C.X448) +-- | Whether to rotate double ratchet keys in contact address type NewRatchetKeys = Bool +-- | stored inviation with double ratchet keys data DRInvitation = DRInvitation { ratchetState :: RatchetX448, replyQueue :: SMPQueueInfo, @@ -1943,11 +1949,12 @@ validateLinkOwners rootKey = go [] instance ConnectionModeI c => Encoding (FixedLinkData c) where smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} = + -- TODO this encoding is not extensible, replace with smpEncode (fromMaybe "" linkEntityId) - safe to do it in 2027 smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId smpP = do (agentVRange, rootKey, linkConnReq) <- smpP linkEntityId <- ((\s -> if B.null s then Nothing else Just s) =<<) <$> optional smpP - _ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding + _ <- A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding (added in January 2026) pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} instance ConnectionModeI c => Encoding (ConnLinkData c) where From 699694d479f40d03971584466043c5deb0a645b1 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Mon, 20 Jul 2026 08:52:46 +0100 Subject: [PATCH 81/81] typos --- src/Simplex/Messaging/Agent.hs | 4 ++-- src/Simplex/Messaging/Agent/Protocol.hs | 2 +- src/Simplex/Messaging/Client.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 55707bc0f..3e85b34b7 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1134,7 +1134,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ = -- rotate makes fresh keys from InitialKeys; otherwise keep current keys or create based on InitialKeys if there are no ratchet keys let currKeys = currentAddressRatchetKeys c connId ratchetKeys <- case pqKeys_ of - Just pqKeys -> + Just pqKeys -> let newKeys = newAddressRatchetKeys c connId pqKeys in Just <$> if rotateKeys then newKeys else currKeys >>= maybe newKeys pure Nothing -> currKeys @@ -3543,7 +3543,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar Just e2eSndParams -> do keys <- withStore c (`getRatchetX3dhKeys` connId) processConnInfo =<< initRcvRatchet_ agentVersion pqSupport keys e2eSndParams - -- use ratchet initialized from contract address ratchet keys during invitation + -- use ratchet initialized from contact address ratchet keys during invitation Nothing -> withStore' c (`getRatchet` connId) >>= \case Left _ -> prohibited "conf: incorrect state" Right rc -> processConnInfo (rc, pqSupport) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index dced40c2f..cd983407c 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1849,7 +1849,7 @@ type AddressRatchetKeys = (RatchetKeyId, RcvE2ERatchetParamsUri 'C.X448) -- | Whether to rotate double ratchet keys in contact address type NewRatchetKeys = Bool --- | stored inviation with double ratchet keys +-- | stored invitation with double ratchet keys data DRInvitation = DRInvitation { ratchetState :: RatchetX448, replyQueue :: SMPQueueInfo, diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index dc811fa0b..8139a0a35 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -974,7 +974,7 @@ deleteSMPQueueLink :: SMPClient -> NetworkRequestMode -> RcvPrivateAuthKey -> Re deleteSMPQueueLink = okSMPCommand LDEL {-# INLINE deleteSMPQueueLink #-} --- | Get 1-time inviation SMP queue link data and secure the queue via queue link ID. +-- | Get 1-time invitation SMP queue link data and secure the queue via queue link ID. secureGetSMPQueueLink :: SMPClient -> NetworkRequestMode -> SndPrivateAuthKey -> LinkId -> ExceptT SMPClientError IO (SenderId, QueueLinkData) secureGetSMPQueueLink c nm spKey lnkId = sendSMPCommand c nm (Just spKey) lnkId (LKEY $ C.toPublic spKey) >>= \case