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..d3529f141 --- /dev/null +++ b/plans/2026-07-11-service-rpc-implementation.md @@ -0,0 +1,205 @@ +# Service RPC implementation plan + +RFC: [../rfcs/2026-07-11-service-rpc.md](../rfcs/2026-07-11-service-rpc.md) + +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. + +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. + +## Versions + +- `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. + +`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'). + +## Service address + +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. + +The subtype distinguishes RPC from a normal connection and drives the owner's handling. Reuse the `ContactConnType` char slot: + +```haskell +data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay | CCTService +ctTypeChar CCTService = 'S' -- 's' in links +ctTypeP 'S' = pure CCTService +``` + +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. + +## RPC messages + +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 +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)) +``` + +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. + +The request hash used for idempotency is `SHA3-256` of the decrypted request payload (the `MsgBody` in `AgentServiceRequest`). + +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. + +## Ratchet establishment - reuse of the address-DR flow + +Request (client), reusing the address-DR requester path (R2'/R3'): + +- 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. + +Request (service), reusing the address-DR owner path (O1'/O2'): + +- `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. + +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. + +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 queue - the requester's DR 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 + +One migration (`M20260712_service_rpc`), on top of the address-DR migration. SQLite shown, PostgreSQL mirrors it. + +```sql +-- 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 (RcvConnection) with the ratchet + deadline TEXT NOT NULL, + created_at TEXT NOT NULL +); + +-- 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, + 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 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(address_conn_id, request_hash); + +-- 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, + 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_responses ON rcv_service_responses(rcv_service_request_id, response_seq); + +-- 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, + 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 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) + +-- 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 () +``` + +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 be a `CCTService` DR-advertising address): + +```haskell +-- 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 -> + MsgBody -> (ServiceResponse -> IO ()) -> AE ServiceResponse + +cancelServiceRequest :: AgentClient -> ConnId -> AE () + +data ServiceResponse = ServiceResponse {bodies :: NonEmpty MsgBody, final :: Bool} +``` + +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 event (`AEvent`, entity is the service address connection): + +```haskell +SREQ :: ServiceRequestRef -> MsgBody -> AEvent AEConn -- request payload for the bot +``` + +`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 + +Client side: + +- `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 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). + +## Idempotency + +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 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, 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: `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. 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..6e8138c33 --- /dev/null +++ b/plans/2026-07-12-address-dr-implementation.md @@ -0,0 +1,279 @@ +# 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. + +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. + +### 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. +- `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. + +**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 + +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`. + +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 + +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`, 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: + +- 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 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 _` **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 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). + +### 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: + +- 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 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. + +`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. + +### The four communication layers, per message (verified against code) + +Layers, outermost (server-visible) first: + +- **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). + +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 +newtype RatchetKeyId = RatchetKeyId ByteString -- opaque short id; one Encoding instance, shared below + +data AddressRatchetKeys = AddressRatchetKeys + { 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 -- whole bundle optional, one Encoding instance + } +``` + +`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): + +- `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 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 `AddressRatchetKeys` bundle the requester used, so the owner selects the matching private keys: + +```haskell +AgentConfirmation + { agentVersion :: VersionSMPA, + 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 + } +``` + +`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 + +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 + 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` 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 (client-driven) + +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; 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). +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 + 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 DEFAULT(datetime('now')) +); +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. +``` + +`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 + +The app rotates by calling `setConnShortLink` with the rotate flag; there is no automatic, agent-driven rotation. On rotation: + +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`). + +### Retention + +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 + +- 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` 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 + +- 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 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: `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: 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. diff --git a/rfcs/2026-07-11-service-rpc.md b/rfcs/2026-07-11-service-rpc.md new file mode 100644 index 000000000..2fc18520c --- /dev/null +++ b/rfcs/2026-07-11-service-rpc.md @@ -0,0 +1,114 @@ +--- +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: to follow, after this and the address-DR RFC are reviewed. + +## 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 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. + +## 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 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 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. 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 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 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`. + +### Correlation and chat + +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. + +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, shaped like `AgentConfirmation` (X3DH parameters to establish the ratchet, plus a body encrypted under it): + +```abnf +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 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. + +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 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" 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 +``` + +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. + +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. + +### Rejection + +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 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 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. + +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. +- 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. +- Name resolution: existing addressing layer. + +[1]: https://tools.ietf.org/html/rfc5234 +[2]: https://tools.ietf.org/html/rfc7405 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..dad2bb76d --- /dev/null +++ b/rfcs/2026-07-12-address-pqdr-keys.md @@ -0,0 +1,83 @@ +--- +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. + +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. + +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. + +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 + +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 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 e2eParams) +ratchetKeyId = shortString ; identifies this bundle, changes on rotation, echoed in the request +e2eParams = +``` + +`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 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 + +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: + +```abnf +agentConfirmation =/ ratchetKeyId ; the bundle the requester used, echoed; absent on other confirmations +``` + +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 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 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-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. + +[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 diff --git a/simplexmq.cabal b/simplexmq.cabal index e40aabdcb..b52bc5e41 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -190,6 +190,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 @@ -242,6 +243,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 b0ce9b620..3e85b34b7 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 @@ -415,28 +415,28 @@ 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 useDR srv_ = + withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR 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 -> 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 -> 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 = withAgentEnv c .:::. setConnShortLink' c {-# INLINE setConnShortLink #-} deleteConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AE () @@ -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 #-} @@ -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 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 @@ -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 (JRConnReq enableNtfs (ACR sConnectionMode cReqUri) pqSupport) 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 pqSup subMode = lift (compatibleContactUri cReqUri) >>= \case - Just (_, Compatible connAgentVersion) -> do - let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing + 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 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 () @@ -900,7 +900,10 @@ 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 withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConnAsync c corrId False connId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do + 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 withStore' c (`unacceptInvitation` invId) throwE err @@ -955,44 +958,46 @@ 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 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 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 -> 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 useDR srv_ = do 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 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 -> SubscriptionMode -> AM ConnId -createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth} userLinkData pqInitKeys 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) - let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} = connReq - md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData + connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption plpInitKeys) + 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 (_, qUri) <- @@ -1002,6 +1007,36 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch" pure connId +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)) + +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 rks + deleteOldAddressRatchetKeys db connId keep + +newAddressRatchetKeys :: AgentClient -> ConnId -> CR.InitialKeys -> AM AddressRatchetKeys +newAddressRatchetKeys c connId pqInitKeys = do + (ks, pks) <- generateAddressRatchetKeys pqInitKeys + storeAddressRatchetKeys c connId pks + pure ks + +currentAddressRatchetKeys :: AgentClient -> ConnId -> AM (Maybe AddressRatchetKeys) +currentAddressRatchetKeys c connId = + withStore' c (`getCurrentAddressRatchetKeys` connId) >>= \case + Left _ -> pure Nothing + Right (ratchetKeyId, pks) -> do + e2eVR <- asks $ e2eEncryptVRange . config + 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 encryptContactLinkData g privSigKey linkKey sndId linkData = do @@ -1080,23 +1115,31 @@ 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 -> NewRatchetKeys -> Maybe CR.InitialKeys -> AM (ConnShortLink c) +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 - (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 {} rq@RcvQueue {shortLink} (UserContactLinkData ucd) = do + liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink ucd g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config - let cslContact = CSLContact SLSServer CCTContact (qServer rq) + -- 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 Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do let (linkId, k) = SL.contactShortLinkKdf shortLinkKey @@ -1106,7 +1149,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData = 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 @@ -1142,7 +1185,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 @@ -1163,18 +1206,25 @@ 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 + let crData = case linkConnReq fd0 of + 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" - pure $ if srv' == srv then r else (updateConnReqServer srv fd, clData) + let fd = if srv' == srv then fd0 else updateConnReqServer srv fd0 + connReq = case (linkConnReq fd, clData) of + (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 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}) = @@ -1198,38 +1248,41 @@ 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 - case (cMode, pqInitKeys) of - (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" - _ -> pure () +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 + addrKeys_ <- case cMode of + SCMContact | useDR -> Just <$> newAddressRatchetKeys c connId pqInitKeys + _ -> 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 (pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc withStore' c $ \db -> createRatchetX3dhKeys db connId pks pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange - prepareLinkData :: UserConnLinkData c -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData) - prepareLinkData userLinkData e2eDhKey = do + 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 @@ -1238,7 +1291,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 @@ -1251,7 +1304,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 @@ -1261,7 +1314,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 @@ -1288,7 +1341,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 (_, rks_, aVersion) -> create aVersion (addrKeysE2EVersion <$> rks_) Nothing -> throwE $ AGENT A_VERSION where create :: Compatible VersionSMPA -> Maybe CR.VersionE2E -> AM ConnId @@ -1301,19 +1354,22 @@ 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 + 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 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 -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, 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 @@ -1331,8 +1387,8 @@ 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 - pure (cData, sq, e2eSndParams, Nothing) + 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 @@ -1341,19 +1397,33 @@ 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_) + pure ((cData, sq'), Just e2eSndParams, lnkId_) Nothing -> throwE $ AGENT A_VERSION - where - createRatchet_ db g maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do - (pks, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport) - (_, rcDHRs) <- atomically $ C.generateKeyPair g - rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pks 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 + (pks, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport) + (_, rcDHRs) <- atomically $ C.generateKeyPair g + rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pks e2eRcvParams + let rcVs = CR.RatchetVersions {current = v, maxSupported} + rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams + 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} = 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 @@ -1362,7 +1432,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 (_, 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 @@ -1373,18 +1443,27 @@ 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 +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 $ - (,) + (,,) <$> (qUri `compatibleVersion` smpClientVRange) + <*> compatibleRatchetKeys e2eEncryptVRange <*> (crAgentVRange `compatibleVersion` smpAgentVRange) + where + compatibleRatchetKeys e2eVR = case addrKeys_ of + Nothing -> Just Nothing + Just (ratchetKeyId, e2eRcvParams) -> + Just . (ratchetKeyId,) <$> (e2eRcvParams `compatibleVersion` e2eVR) versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} +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 = withInvLock c (strEncode inv) "joinConnSrv" $ do @@ -1398,20 +1477,45 @@ joinConnSrv c nm userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup sub 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 + ((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 pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case - Just (qInfo, vrsn@(Compatible v)) -> + Just (qInfo, ratchet_, 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 + 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 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 (ratchetKeyId, Compatible e2eParams@(CR.E2ERatchetParams e2eV _ _ _)) -> do + g <- asks random + e2eVR <- asks $ e2eEncryptVRange . config + 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 mkJoinInvitation rq pqInitKeys = do @@ -1438,8 +1542,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 -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured -joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport 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 @@ -1452,11 +1556,9 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo 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 + ((cData, sq), e2eSndParams, lnkId_) <- startJoin sq_ + secureConfirmQueueAsync c cData rq_ sq srv cInfo e2eSndParams subMode >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) -joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do - throwE $ CMD PROHIBITED "joinConnSrvAsync" createReplyQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo createReplyQueue c nm ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do @@ -1483,7 +1585,20 @@ 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 pqSupport subMode + CRInvitationDR dr@DRInvitation {replyQueue} -> do + srv <- getNextSMPServer c userId [qServer replyQueue] + SomeConn cType conn <- withStore c (`getConn` connId) + let doJoin rq_ sq_ = do + (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) + 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 @@ -1882,27 +1997,34 @@ 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 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 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 - link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData + link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData False Nothing notify $ LINK link userLinkData LGET shortLink -> withServer' . tryCommand $ do - (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink - notify $ LDATA fixedData linkData - JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do + (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 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 + 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. - JOIN 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 pqEnc subMode srv @@ -3190,6 +3312,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar | otherwise -> prohibited "handshake: missing sender key" >> 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 @@ -3316,6 +3440,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar decryptClientMessage e2eDh clientMsg >>= \case -- this is a repeated confirmation 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) @@ -3395,41 +3520,47 @@ 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 + New -> case conn' of -- party initiating connection - (RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _))) -> do - unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION) - pks@(_, rcDHRs, _) <- withStore c (`getRatchetX3dhKeys` connId) - rcParams <- liftError cryptoError $ CR.pqX3dhRcv pks 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" - 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 + 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 contact address ratchet keys during invitation + Nothing -> withStore' c (`getRatchet` connId) >>= \case + Left _ -> prohibited "conf: incorrect state" + Right rc -> processConnInfo (rc, pqSupport) + where + 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 setConnAgentVersion db connId agentVersion when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport' @@ -3448,9 +3579,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 @@ -3469,6 +3599,25 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar _ -> prohibited "conf: incorrect state" _ -> prohibited "conf: status /= new" + 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 + rcParams <- liftError cryptoError $ CR.pqX3dhRcv pks 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_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo + case skipped of + CR.SMDNoChange -> pure () + _ -> logWarn "conf: skipped confirmations" + pure (agentMsgBody_, rc') + helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM () helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId @@ -3620,9 +3769,7 @@ 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 - g <- asks random - let newInv = NewInvitation {contactConnId = connId, connReq, recipientConnInfo = cInfo} - invId <- withStore c $ \db -> createInvitation db g newInv + invId <- storeInvitation (CRInvitation connReq) cInfo let srvs = L.map qServer $ crSmpQueues crData notify $ REQ invId pqSupport srvs cInfo _ -> prohibited "inv: sent to message conn" @@ -3630,6 +3777,39 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar pqSupported (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible agentVersion) = PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just v) + storeInvitation :: ContactRequest -> ConnInfo -> AM InvitationId + storeInvitation connReq recipientConnInfo = do + g <- asks random + 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 + logServer "<--" c srv rId $ "MSG :" <> logSecret' srvMsgId + case conn' of + ContactConnection {} -> do + checkConfVersions agentVersion phVer + let ConnData {pqSupport} = toConnData conn' + withStore' c (\db -> getAddressRatchetKeys db connId ratchetKeyId) >>= \case + Right (pk1, pk2, pKem) -> do + (rc, connPQSupport) <- initRcvRatchet_ agentVersion pqSupport (pk1, pk2, pKem) e2eSndParams + (agentMsgBody_, ratchetState) <- decryptConnInfo rc 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 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 DuplexConnection {} -> action conn' diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index bb4f1a950..55eac6ba6 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1913,17 +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 -> 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 +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 - 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) getQueueMessage :: AgentClient -> RcvQueue -> AM (Maybe SMPMsgMeta) getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index aba4a898a..47073f6b4 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, + keepAddressKeys :: Int, ntfCron :: Word16, ntfBatchSize :: Int, ntfSubFirstCheckInterval :: NominalDiffTime, @@ -245,6 +246,7 @@ defaultAgentConfig = xftpConsecutiveRetries = 3, xftpMaxRecipientsPerRequest = 200, deleteErrorCount = 10, + keepAddressKeys = 3, ntfCron = 20, -- minutes ntfBatchSize = 150, ntfSubFirstCheckInterval = nominalDay, diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index c4310414e..cd983407c 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 #-} @@ -54,8 +55,10 @@ module Simplex.Messaging.Agent.Protocol -- * SMP agent protocol types ConnInfo, SndQueueSecured, + UseRatchetKeys, AEntityId, ACommand (..), + JoinRequest (..), AEvent (..), AEvt (..), ACommandTag (..), @@ -107,6 +110,9 @@ module Simplex.Messaging.Agent.Protocol ConnectionModeI (..), ConnectionRequestUri (..), AConnectionRequestUri (..), + BinaryConnectionRequestUri (..), + ABinaryConnectionRequestUri (..), + binaryConnReq, ShortLinkCreds (..), ConnReqUriData (..), CRClientData, @@ -118,6 +124,10 @@ module Simplex.Messaging.Agent.Protocol UserConnLinkData (..), UserContactData (..), UserLinkData (..), + AddressRatchetKeys, + NewRatchetKeys, + DRInvitation (..), + RatchetKeyId (..), OwnerAuth (..), OwnerId, ConnectionLink (..), @@ -200,6 +210,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 (($>)) @@ -230,9 +241,11 @@ import Simplex.Messaging.Crypto.Ratchet ( InitialKeys (..), PQEncryption (..), PQSupport, + RatchetX448, RcvE2ERatchetParams, RcvE2ERatchetParamsUri, SndE2ERatchetParams, + RcvE2EPrivRatchetParams, pattern PQSupportOff, pattern PQSupportOn, ) @@ -393,11 +406,13 @@ type ConnInfo = ByteString type SndQueueSecured = Bool +type UseRatchetKeys = Bool + -- | Parameterized type for SMP agent events 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 @@ -454,15 +469,15 @@ 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 | 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) + deriving (Show) data ACommandTag = NEW_ @@ -843,6 +858,12 @@ data AgentMsgEnvelope connReq :: ConnectionRequestUri 'CMInvitation, connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet, } + | AgentInvitationDR -- invitation establishing double ratchet e2e with the contact address that included DR keys + { agentVersion :: VersionSMPA, + e2eSndParams :: SndE2ERatchetParams 'C.X448, + ratchetKeyId :: RatchetKeyId, + encConnInfo :: ByteString + } | AgentRatchetKey { agentVersion :: VersionSMPA, e2eEncryption :: RcvE2ERatchetParams 'C.X448, @@ -858,6 +879,8 @@ instance Encoding AgentMsgEnvelope where smpEncode (agentVersion, 'M', Tail encAgentMessage) AgentInvitation {agentVersion, connReq, connInfo} -> smpEncode (agentVersion, 'I', Large $ strEncode connReq, Tail connInfo) + AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} -> + smpEncode (agentVersion, 'J', e2eSndParams, ratchetKeyId, Tail encConnInfo) AgentRatchetKey {agentVersion, e2eEncryption, info} -> smpEncode (agentVersion, 'R', e2eEncryption, Tail info) smpP = do @@ -873,6 +896,9 @@ instance Encoding AgentMsgEnvelope where connReq <- strDecode . unLarge <$?> smpP Tail connInfo <- smpP pure AgentInvitation {agentVersion, connReq, connInfo} + 'J' -> do + (e2eSndParams, ratchetKeyId, Tail encConnInfo) <- smpP + pure AgentInvitationDR {agentVersion, e2eSndParams, ratchetKeyId, encConnInfo} 'R' -> do e2eEncryption <- smpP Tail info <- smpP @@ -1131,11 +1157,13 @@ 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 rks -> crEncode "contact" crData $ case rks of + Just (ratchetKeyId, e2eRcvParams) -> (Just e2eRcvParams, Just ratchetKeyId) + Nothing -> (Nothing, Nothing) 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 = @@ -1143,23 +1171,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} = @@ -1202,7 +1231,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} ((,) <$> rk_ <*> e2e_) where crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames @@ -1328,6 +1360,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}) @@ -1433,6 +1466,10 @@ instance StrEncoding SMPQueueUri where _ -> Nothing pure (vr, maybe [] thList_ hs_, dhKey, queueMode) +instance StrEncoding SMPQueueInfo where + 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}) -- The condition is for minVersion as earlier clients won't be able to support it. @@ -1452,16 +1489,30 @@ 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 contact address DR keys for double ratchet e2e from message 1 + 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 deriving instance Eq (ConnectionRequestUri m) @@ -1519,9 +1570,12 @@ data PreparedLinkParams = PreparedLinkParams -- | smpEncode of FixedLinkData (includes linkEntityId) plpSignedFixedData :: ByteString, -- | Server with basic auth (not stored in link) - plpSrvWithAuth :: SMPServerWithAuth + plpSrvWithAuth :: SMPServerWithAuth, + -- | Initial PQ keys + plpInitKeys :: InitialKeys, + -- | Contact address double ratchet keys + plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448) } - deriving (Show) instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode @@ -1733,7 +1787,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') @@ -1772,7 +1826,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) @@ -1785,6 +1839,30 @@ deriving instance Eq (ConnLinkData c) deriving instance Show (ConnLinkData c) +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 invitation with double ratchet keys +data DRInvitation = DRInvitation + { ratchetState :: RatchetX448, + replyQueue :: SMPQueueInfo, + agentVersion :: VersionSMPA, + pqSupport :: PQSupport + } + deriving (Show) + +data JoinRequest + = JRConnReq {enableNtfs :: Bool, joinConnReq :: AConnectionRequestUri, joinPQSupport :: PQSupport} + | JRInvitationDR DRInvitation + deriving (Show) + data UserContactData = UserContactData { -- direct connection via connReq in fixed data is allowed. direct :: Bool, @@ -1792,7 +1870,8 @@ data UserContactData = UserContactData owners :: [OwnerAuth], -- alternative addresses of chat relays that receive requests for this contact address. relays :: [ConnShortLink 'CMContact], - userData :: UserLinkData + userData :: UserLinkData, + ratchetKeys :: Maybe AddressRatchetKeys } deriving (Eq, Show) @@ -1870,10 +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 <- optional smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding + 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} instance ConnectionModeI c => Encoding (ConnLinkData c) where @@ -1920,14 +2001,13 @@ 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} = + smpEncode (direct, EncList owners, EncList relays, userData, 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} + (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 smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s) @@ -2116,6 +2196,17 @@ cryptoErrToSyncState = \case RATCHET_SKIPPED _ -> RSRequired RATCHET_SYNC -> RSRequired +$(J.deriveJSON defaultJSON ''DRInvitation) + +-- 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 = + (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) dbCommandP :: Parser ACommand dbCommandP = commandP $ A.take =<< (A.decimal <* "\n") @@ -2146,10 +2237,11 @@ commandP :: Parser ByteString -> Parser ACommand commandP binaryP = strP >>= \case - NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe)) + -- 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_ <*> 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 @@ -2159,16 +2251,14 @@ 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 serializeCommand = \case - NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode) + 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 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 605a07e78..49a842cf0 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 (..), + DRInvitation (..), PrevExternalSndId, PrevRcvMsgHash, PrevSndMsgHash, @@ -626,19 +628,23 @@ 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 } +data ContactRequest + = CRInvitation (ConnectionRequestUri 'CMInvitation) + | CRInvitationDR DRInvitation + -- * 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 918e320e6..da00533dc 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, + getConnectionData, lockConnForUpdate, setConnDeleted, setConnUserId, @@ -152,6 +153,10 @@ module Simplex.Messaging.Agent.Store.AgentStore createRatchetX3dhKeys, getRatchetX3dhKeys, setRatchetX3dhKeys, + createAddressRatchetKeys, + getCurrentAddressRatchetKeys, + getAddressRatchetKeys, + deleteOldAddressRatchetKeys, createSndRatchet, getSndRatchet, createRatchet, @@ -278,9 +283,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) @@ -1384,6 +1391,60 @@ setRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) = |] (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem, connId) +createAddressRatchetKeys :: DB.Connection -> ConnId -> (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448) -> 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) + VALUES (?, ?, ?, ?, ?) + |] + (connId, ratchetKeyId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) + +getCurrentAddressRatchetKeys :: DB.Connection -> ConnId -> IO (Either StoreError (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) +getCurrentAddressRatchetKeys db connId = + firstRow (\(Only rkId :. pks) -> (rkId, pks)) 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 = ? + ORDER BY address_ratchet_key_id DESC + LIMIT 1 + |] + (Only connId) + +getAddressRatchetKeys :: DB.Connection -> ConnId -> RatchetKeyId -> IO (Either StoreError (CR.RcvE2EPrivRatchetParams 'C.X448)) +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) + +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 @@ -2075,6 +2136,21 @@ 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 . \case + CRInvitation cr -> strEncode cr + CRInvitationDR dr -> LB.toStrict $ J.encode dr + +instance FromField ContactRequest where + fromField = blobFieldDecoder $ \bs -> + if "{" `B.isPrefixOf` bs + then CRInvitationDR <$> J.eitherDecodeStrict' bs + else CRInvitation <$> strDecode bs + instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode instance FromField ConnectionMode where fromField = fromTextField_ connModeT @@ -2577,6 +2653,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 $ 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..00506b1d2 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260712_address_dr.hs @@ -0,0 +1,30 @@ +{-# 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 TIMESTAMPTZ NOT NULL DEFAULT (now()) +); + +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..2da05ea42 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260712_address_dr.hs @@ -0,0 +1,29 @@ +{-# 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 AUTOINCREMENT, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + 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 DEFAULT(datetime('now')) +) 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/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index e77582b92..460600f4c 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,15 @@ 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 AUTOINCREMENT, + conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + 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 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); CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id); @@ -615,6 +624,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 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 diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs index 2d3a5a205..b66b4a519 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, 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/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 #-} diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 13ee3e156..7b27feaf8 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 @@ -25,7 +26,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) @@ -176,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 @@ -194,13 +196,16 @@ contactAddress :: AConnectionRequestUri contactAddress = ACR SCMContact $ contactConnRequest contactConnRequest :: ConnectionRequestUri 'CMContact -contactConnRequest = CRContactUri connReqData +contactConnRequest = CRContactUri connReqData Nothing + +contactAddressDR :: AConnectionRequestUri +contactAddressDR = ACR SCMContact $ CRContactUri connReqData (Just (RatchetKeyId "0123456789abcdef", testE2ERatchetParams)) 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 @@ -209,16 +214,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; 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 @@ -267,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) @@ -287,21 +297,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 7b95c71bf..32750ef58 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -284,7 +284,7 @@ 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) @@ -311,11 +311,11 @@ 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) -setConnShortLink c = A.setConnShortLink c NRMInteractive +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 @@ -347,6 +347,21 @@ 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 + 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" $ + 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" $ withSmpServer ps testRejectContactRequest describe "Changing connection user id" $ do @@ -723,7 +738,7 @@ 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 "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured @@ -952,7 +967,7 @@ 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 "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection @@ -994,9 +1009,218 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b where msgId = subtract baseId . fst +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 + +-- 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 + 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 + pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ + runRight_ $ do + (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 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.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 + aliceId <- A.prepareConnectionToJoin bob 1 True connReqJoin bPQ + if asyncJoin + then do + 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 connReqJoin "bob's connInfo" 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) + 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 + 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 + 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 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 + +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 "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 + ("", _, 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 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 (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 (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 + +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 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 False (Just addrIK) + (_, ContactLinkData _ cd1, _) <- getConnShortLink bob 1 shortLink + liftIO $ ratchetKeys cd1 `shouldSatisfy` isJust + +-- 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 + 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 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 + (_, 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' "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) + _ <- 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 + +-- 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 + 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 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' "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) + ("", "", 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 + 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 - (_, 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 @@ -1049,7 +1273,7 @@ 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 "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` False -- joining via contact address connection @@ -1376,13 +1600,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 @@ -1412,15 +1636,15 @@ 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 @@ -1445,20 +1669,22 @@ 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) - (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 @@ -1476,11 +1702,11 @@ 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 - (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 @@ -1494,22 +1720,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} + 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 @@ -1527,11 +1755,11 @@ 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 - (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink + (_, ContactLinkData _ updatedCtData', connReq4) <- runRight $ getConnShortLink c 1 shortLink connReq4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData @@ -1540,10 +1768,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 @@ -1551,16 +1779,16 @@ 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) + 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} + 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 @@ -1568,24 +1796,24 @@ 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 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@(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} + 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 @@ -1593,14 +1821,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) @@ -1629,22 +1857,22 @@ 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 + (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" - 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 -- 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 () @@ -1656,19 +1884,20 @@ 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 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 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 @@ -1684,6 +1913,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 @@ -2407,7 +2641,7 @@ 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 "bob's connInfo" pqSupport SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured @@ -2687,7 +2921,7 @@ 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 @@ -2740,22 +2974,22 @@ 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 + (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" - 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 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 @@ -2772,17 +3006,17 @@ 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 + (_, 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' "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 @@ -2801,7 +3035,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 @@ -3091,7 +3325,7 @@ 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 @@ -3138,7 +3372,7 @@ 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 @@ -4443,7 +4677,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 @@ -4452,7 +4686,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 @@ -4463,7 +4697,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 @@ -4475,7 +4709,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 @@ -4490,7 +4724,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 @@ -4506,7 +4740,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 edffaa3d9..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 () @@ -80,14 +80,14 @@ 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 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 () @@ -96,20 +96,20 @@ 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 -- 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 () @@ -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 @@ -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 () @@ -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 88525eac0..f63ff5aa9 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -232,7 +232,7 @@ 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 "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True @@ -288,7 +288,7 @@ 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 "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True @@ -339,7 +339,7 @@ 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 "bob's connInfo" PQSupportOn SMSubscribe pure () @@ -359,7 +359,7 @@ 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 "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True @@ -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