present entitlements in handshake

protocol/push-notifications.md

@@ -1,11 +1,12 @@
-Version 3, 2025-01-24
+Version 4, 2026-09-11
 
 # Overview of push notifications for SimpleX Messaging Routers
 
-This document describes Notification Router protocol version 3. Version history:
+This document describes Notification Router protocol version 4. Version history:
 - v1: initial version
 - v2: authenticated commands, command batching
 - v3: detailed invalid token reason
+- v4: entitlement proof in client handshake
 
 ## Table of contents
 
@@ -94,7 +95,7 @@ This diagram shows the process of subscription to notifications, notification de
 
 To manage notification subscriptions to SMP routers, SimpleX Notification Router provides an RPC protocol with a similar design to SimpleX Messaging Protocol router.
 
-This protocol sends requests and responses in a fixed size blocks of 512 bytes over TLS, uses the same [syntax of protocol transmissions](./simplex-messaging.md#smp-transmission-and-transport-block-structure) as SMP protocol, and has the same transport [handshake syntax](./simplex-messaging.md#transport-handshake) (except the router certificate is not included in the handshake).
+This protocol sends requests and responses in a fixed size blocks of 512 bytes over TLS, uses the same [syntax of protocol transmissions](./simplex-messaging.md#smp-transmission-and-transport-block-structure) as SMP protocol, and has the same transport [handshake syntax](./simplex-messaging.md#transport-handshake) (except the router certificate is not included in the handshake). The client handshake carries the protocol version, the router key hash and, from v4, the optional `entitlementProof` with the same syntax and session binding as in SMP.
 
 The client and router use ALPN extension with `ntf/1` protocol name to agree handshake version.
 

protocol/simplex-messaging.md

@@ -86,7 +86,7 @@ It's designed with the focus on communication security and integrity, under the
 
 It is designed as a low level protocol for other application protocols to solve the problem of secure and private message transmission, making [MITM attack][1] very difficult at any part of the message transmission system.
 
-This document describes SMP protocol version 20. Versions 1-5 are discontinued. The version history:
+This document describes SMP protocol version 22. Versions 1-5 are discontinued. The version history:
 
 - v1: binary protocol encoding
 - v2: message flags (used to control notifications)
@@ -108,6 +108,7 @@ This document describes SMP protocol version 20. Versions 1-5 are discontinued.
 - v19: service subscriptions to messages (SUBS, NSUBS, SOKS, ENDS, ALLS commands)
 - v20: public namespaces resolver (RSLV command, RNAME response) — direct or forwarded via PFWD
 - v21: server public information in handshake
+- v22: entitlement proof in client handshake
 
 ## Introduction
 
@@ -1633,7 +1634,7 @@ cert = originalLength x509encoded
 signedRouterKey = originalLength x509encoded ; X25519 key signed by router certificate
 
 paddedClientHello = <padded(clientHello, 16384)>
-clientHello = smpVersion keyHash [clientKey] proxyRouter optClientService ignoredPart
+clientHello = smpVersion keyHash [clientKey] proxyRouter optClientService optEntitlementProof ignoredPart
 ; chosen SMP protocol version - it must be the maximum supported version
 ; within the range offered by the router
 keyHash = shortString ; router identity - CA certificate fingerprint
@@ -1645,7 +1646,21 @@ serviceRole = %s"M" / %s"N" / %s"P" ; Messaging / Notifier / Proxy
 serviceCertKey = certChain signedServiceKey
 signedServiceKey = originalLength x509encoded ; Ed25519 key signed by service certificate
 
+optEntitlementProof = %s"0" / (%s"1" entitlementProof)
+; proof of the user entitlement, encoded from v22, bound to sessionIdentifier
+entitlementProof = issuerKeyIndex bbsProof entitlement
+issuerKeyIndex = 2*2OCTET ; Word16 index of the issuer public key
+bbsProof = largeString
+entitlement = entExpires entName entExtra
+entExpires = shortString ; expiration as an ISO8601 UTC timestamp
+entName = shortString ; e.g. "supporter", "legend"
+entExtra = largeString ; opaque to the router
+
 smpVersion = 2*2OCTET ; Word16 version number
+shortString = length *OCTET
+largeString = length2 *OCTET
+length = 1*1OCTET
+length2 = 2*2OCTET ; Word16, network byte order
 originalLength = 2*2OCTET
 count = 1*1OCTET
 ignoredPart = *OCTET
@@ -1667,6 +1682,8 @@ serviceId = shortString
 handshakeError = transportError
 ```
 
+`entitlementProof` (v22+) presents the entitlement of the user - its name, expiration and an opaque extra string - as the disclosed content of a BBS proof over the presentation header `sessionIdentifier`, so a proof presented on another session does not verify. The holder secret and the issuer signature remain with the client. Clients send it only to their own routers, identified by the key hash pinned in TLS.
+
 `ignoredPart` in handshake allows to add additional parameters in handshake without changing protocol version - the client and routers must ignore any extra bytes within the original block length.
 
 For TLS transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `routerHello` block to allow communication over some other transport protocol (possibly, with another channel binding).

rfcs/2026-09-11-proof-of-work.md

@@ -2,13 +2,15 @@
 
 ## Summary
 
-A client presents a proof of work when it asks a server to create a resource: an SMP queue, an XFTP file chunk, a notification token. The required effort is the price of the resource. The price rises with the cost of the resource and with server load, and is divided by a configured factor for a client that presented an entitlement proof in the handshake.
+A client presents a proof of work when it asks a server to create a resource: an SMP queue, an XFTP file chunk, a notification token. The required effort is the price of the resource: its cost in units multiplied by the price per unit.
+
+The server sets one price per unit for each tier: sessions without an entitlement, and sessions of each entitlement name. The prices are independent, so a flood in one tier raises the price of that tier alone.
 
 The proof is bound to the transport session, so it is valid on one connection to one server, and single use within it.
 
 ## Interaction
 
-The exchange adds no round trip. The server handshake states the price and the server time, the session id is the challenge input that both sides already hold, and the client attaches a proof to the command that creates the resource.
+The exchange adds no round trip. The server handshake states the prices and the server time, the session id is the challenge input that both sides already hold, and the client attaches a proof to the command that creates the resource.
 
 Nothing is sent back for the price alone: it rides the messages that already exist.
 
@@ -16,7 +18,7 @@ Nothing is sent back for the price alone: it rides the messages that already exi
 
 A proof states the minute it was made for, and expires after a few minutes.
 
-Without an expiry a client mints proofs for as long as a session lasts and spends the stock in one burst. The stock is minted at the idle price, so the rising price reaches the burst after it lands, and an hour of one machine arrives in seconds. The expiry bounds the stock to the work of one window, a few periods of the price estimator.
+Without an expiry a client mints proofs for as long as a session lasts and spends the stock in one burst. The stock is minted at the idle price, so a rising price reaches the burst after it lands, and an hour of one machine arrives in seconds. The expiry bounds the stock to the work of one window.
 
 ```
 powEpoch = 4*4 OCTET    ; Word32, minutes of server time
@@ -24,7 +26,7 @@ powEpoch = 4*4 OCTET    ; Word32, minutes of server time
 
 The server sends its current epoch in the handshake, and the client counts minutes from it with a monotonic clock, so the clock of the device takes no part. A proof verifies while `serverEpoch - powEpoch` is within the advertised window, and one epoch ahead of the server is admitted for rounding.
 
-The window is the burst a client may prepare: a stock of `window * mint rate`. At 5 minutes and unit effort 16, one phone core holds about 900 queue proofs, and one desktop core about 2800.
+The window is the burst a client may prepare: a stock of `window * mint rate`. At 5 minutes and a price of 16, one phone core holds about 900 queue proofs, and one desktop core about 2800.
 
 A price increase cuts the stock a second way. A proof states the effort it was made for, so every proof below the new price is rejected, and the stock of an attacker survives an increase only at the effort it paid for in advance. The two bounds compose: the stock is worth the smaller of one window of minting and the time until the next increase.
 
@@ -49,15 +51,16 @@ Our problem is the price of a stored resource, so the auction is replaced by a p
 1. Threshold, not bidding. The server states the required effort; the client sends exactly that. The priority queue and its trimming are dropped. A faster device gains no priority, so the effort value describes the request rather than the device.
 2. Session binding, not seeds. The challenge includes the hash of the transport session id, which both sides already hold. This removes seed generation, seed rotation, seed publication, and the two-seed overlap.
 3. Single use by a counter, not by a replay cache. Each proof carries a session counter, and the server keeps the highest counter it accepted plus a 64-bit window of the counters below it. Per-session state is 16 bytes, against 16 bytes per accepted proof for a set of nonces. Tor needs the set because one seed spans many connections; a proof here is valid on one connection only.
-4. An expiry of minutes, against the seed window of two hours in Tor. A stock of proofs is worth one window of minting, so the price estimator answers a burst that was prepared under the old price.
-5. Price by resource, not by congestion alone. Effort is the resource cost in units multiplied by the current unit effort. Load moves the unit effort only.
-6. Entitlement as a discount, never an exemption. A verified entitlement divides the unit effort by a factor configured per entitlement name. A credential presents on any number of sessions without linking them, so an exemption would sell an attacker unlimited creation for the price of one badge.
+4. An expiry of minutes, against the seed window of two hours in Tor. A stock of proofs is worth one window of minting, so a price increase reaches a burst that was prepared under the old price.
+5. Prices set by the operator. Effort is the resource cost in units multiplied by the price per unit, and the operator sets the price. The estimator of Tor is deferred.
+6. One price per tier. The server knows the tier of every session, so a flood shows in its tier, and raising that price leaves the other tiers unchanged. An attacker without a badge leaves the price of badge holders where it was; an attacker with a supporter badge leaves the price of legend holders where it was.
+7. An entitlement lowers the price, and neither raises it nor removes it. A credential presents on any number of sessions without linking them, so a free tier would sell an attacker unlimited creation for the price of one badge; and a badge that could cost more than no badge would break the promise it was sold with, the promise the XFTP server keeps for storage time.
 
-Kept from Tor: the Equi-X function, the linear effort scale, the verification formula, and the shape of the adaptation loop.
+Kept from Tor: the Equi-X function, the linear effort scale, and the verification formula.
 
 ## Cost units
 
-Each protocol defines the unit of its own price list. The server advertises the effort per unit; the client computes the effort of its request.
+Each protocol defines the unit of its own price list. The server advertises the price per unit; the client computes the effort of its request.
 
 ```
 SMP:  1 unit per new queue
@@ -67,28 +70,25 @@ XFTP: 1 unit per megabyte-day of requested storage, rounded up
 NTF:  1 unit per token registration
 ```
 
-`effort = unitEffort * units`, capped at 2^32 - 1.
+`effort = price * units`, capped at 2^32 - 1.
 
 ## Handshake parameters
 
 Each protocol adds one optional field to the server handshake, encoded from the version that introduces proof of work.
 
 ```
-powParams = %s"0" / (%s"1" powScheme unitEffort entUnitEffort serverEpoch epochWindow)
-powScheme = 1*1 OCTET      ; 1 = Equi-X and Blake2b
-unitEffort = 4*4 OCTET     ; Word32, effort per unit, 0 = proof not required
-entUnitEffort = 4*4 OCTET  ; Word32, effort per unit for a session with a verified entitlement
-serverEpoch = 4*4 OCTET    ; Word32, current minute of server time
-epochWindow = 1*1 OCTET    ; minutes a proof stays valid
+powParams = %s"0" / (%s"1" powScheme defaultPrice entPrices serverEpoch epochWindow)
+powScheme = 1*1 OCTET        ; 1 = Equi-X and Blake2b
+defaultPrice = 4*4 OCTET     ; Word32, effort per unit without an entitlement, 0 = proof not required
+entPrices = count *entPrice
+entPrice = entName price
+entName = shortString        ; entitlement name, as in the entitlement proof
+price = 4*4 OCTET            ; Word32, effort per unit for a session of this entitlement
+serverEpoch = 4*4 OCTET      ; Word32, current minute of server time
+epochWindow = 1*1 OCTET      ; minutes a proof stays valid
 ```
 
-The server handshake precedes the client handshake that carries the entitlement proof, so both values are sent. The client applies `entUnitEffort` when it presented an entitlement, and `unitEffort` otherwise.
-
-```
-entUnitEffort = ceil(unitEffort / entDiscount)
-```
-
-`entDiscount` is configured per entitlement name. The handshake states the value for the smallest configured discount, so a first command may over-pay, and the response to a priced command states the value for the entitlement of the session. `entUnitEffort` is zero only when `unitEffort` is zero.
+The server handshake precedes the client handshake that carries the entitlement proof, so every price is sent. The client applies the price of its entitlement name, and the default price when it presented no entitlement or when its name is absent from the list.
 
 ## Algorithm
 
@@ -148,6 +148,14 @@ sessionHash = 32*32 OCTET      ; sha256 of the transport session id
 
 The client picks the next counter and a random search value, calls `equix_solve(challenge)`, computes `R = ntohl(blake2b_32(challenge || S))`, and accepts the solution when `R * E <= 2^32 - 1`, computed in 64 bits. Otherwise it increments the search value as a little-endian integer and repeats.
 
+```
+S = packed solution         ; 8 indices, each a little-endian uint16, 16 bytes
+blake2b_32 = BLAKE2b initialised with a 4-byte output length
+R = the 4 bytes of blake2b_32, read big-endian
+```
+
+BLAKE2b with a 4-byte output length differs from the first 4 bytes of BLAKE2b-512, because the length is a parameter of the initial state. Both definitions follow `validate_equix_challenge` and `pack_equix_solution` in `hs_pow.c`.
+
 Counters are assigned in order and spent in order. A client that solves on several cores gives each core its own counter.
 
 A proof verifies only under the protocol letter and the session hash it was made for, so it fails on another protocol, another server, and another connection.
@@ -169,7 +177,7 @@ A batch of transmissions carries one proof per command. Creation commands are se
 
 The server checks, in this order:
 
-1. `powEffort >= required effort for the request` - integer comparison.
+1. `powEffort >= price of the tier of the session * units of the request` - integer comparison.
 2. `powEpoch` within the epoch window of the server, and at most one epoch ahead.
 3. `powCounter` is above the window of the session, or inside it and unused.
 4. `R * powEffort <= 2^32 - 1` - one Blake2b of 88 bytes.
@@ -182,60 +190,97 @@ The window holds the last 64 counters, which admits the commands of one batch in
 
 Steps 1 to 4 cost about a microsecond, so a flood of malformed proofs is rejected before the Equi-X call. A session that fails verification repeatedly is closed, and the number of Equi-X verifications per session per second is capped.
 
+## Entitlement
+
+SMP and NTF servers verify the entitlement proof in the handshake, as the XFTP server does. A name the server prices is verified once per session; a name it does not price is ignored without verification, and the session pays the default price. A proof that fails to verify leaves the session at the default price too.
+
+The tier of the session is fixed at the handshake, so every command in it is priced without further work.
+
+An entitlement lowers the price, and neither raises it nor removes it:
+
+```
+min(1, price) <= price_for_<name> <= price
+```
+
+The server exits at startup when a configured price breaks this rule, and logs each name that breaks it, as the XFTP server does when an entitlement storage time is below the default. An entitlement price equal to the default is allowed, as an equal storage time is on XFTP.
+
+The control port sets the three prices in one command, and refuses a triple that breaks the rule. The triple is checked as a whole, so the order in which prices change plays no part.
+
+This gives the badge a function on SMP and NTF, where it grants nothing today: the holder pays less CPU time, and a flood outside its tier leaves its price where it was.
+
 ## Learning the price
 
 The price reaches the client three ways, and each of them is a message the protocol already sends.
 
-1. The server handshake, at the start of the session. It states both prices, because the entitlement proof arrives in the client handshake that follows.
-2. The response to a priced command. It states the price that applies to this session, so a client that presented an entitlement reads its own discount, and a client that paid the old price learns the new one while its command succeeds.
-3. The error below, when the proof was absent, stale, or below the price.
+1. The server handshake, at the start of the session. It states the price of every tier, because the entitlement proof arrives in the client handshake that follows.
+2. The response to a priced command. It states the price of the tier of the session, so a client that paid the old price learns the new one while its command succeeds.
+3. The error below, when the proof was absent, stale, or below the price. A client whose entitlement failed to verify learns here that it pays the default price.
 
 ```
-powPrice = unitEffort serverEpoch  ; 8 bytes, appended to the response of a priced command
+powPrice = price serverEpoch  ; 8 bytes, appended to the response of a priced command
 ```
 
 An increase costs one rejected command and the proof spent on it. A decrease costs nothing: the client over-pays until its next response, which states the lower price. A client that has been idle for longer than the epoch window solves at the last price it read, and pays one retry when the price moved meanwhile.
 
-The price is public, as it is in Tor, and reading it needs one command without a proof.
+The prices are public, as the suggested effort is in Tor, and the list of priced entitlement names is public with them.
 
 ## Errors and retry
 
 A new error carries the price and the time of the server.
 
 ```
-SMP:  ERR POW effort epoch
-XFTP: FRErr (POW effort epoch)
-NTF:  NRErr (POW effort epoch)
+SMP:  ERR POW price epoch
+XFTP: FRErr (POW price epoch)
+NTF:  NRErr (POW price epoch)
 ```
 
-The client resets its price and epoch from the error, solves at the stated effort, and retries. Two retries are allowed for one command, which covers a price that moves again while the client solves; past that it reports that the server is busy, as it does when the effort exceeds its own maximum. Clients of earlier versions receive `AUTH`, as they do today when the basic auth of the server does not match.
+The client resets its price and epoch from the error, solves at the stated price, and retries. Two retries are allowed for one command, which covers a price that moves again while the client solves; past that it reports that the server is busy, as it does when the effort exceeds its own maximum. Clients of earlier versions receive `AUTH`, as they do today when the basic auth of the server does not match.
 
-A proof made for a higher effort than required is accepted, so a proof that outlives an increase stays usable while its epoch holds.
+A proof made for a higher effort than required is accepted, so a proof that outlives a decrease stays usable while its epoch holds.
 
-## Adaptive effort
+## Setting prices
 
-Every 60 seconds the server updates `unitEffort` from its own pressure signals: resources created in the period against a configured budget, and storage used against the quota.
+The operator sets the prices: the configuration holds the values the server starts with, and the control port reads and changes them while it runs.
 
 ```
-overBudget = created > creationBudget or used > highWater * quota
-underBudget = created < creationBudget / 2 and used < lowWater * quota
-
-overBudget:  unitEffort' = min(maxUnitEffort, max(unitEffort + 1, unitEffort * 2))
-underBudget: unitEffort' = max(minUnitEffort, unitEffort * 2 / 3)
-otherwise:   unitEffort' = unitEffort
+[PROOF_OF_WORK]
+price = 16                  ; effort per unit without an entitlement, 0 = proof not required
+price_for_supporter = 4     ; effort per unit with the supporter entitlement, at least 1 and at most price
+price_for_legend = 2        ; effort per unit with the legend entitlement, at least 1 and at most price
+epoch_window_minutes = 5
 ```
 
-`minUnitEffort` is the configured price of an idle server, and may be zero. Doubling reaches a defensive price within a few periods, and the `2/3` step returns to the idle price slowly. New sessions read the value from the handshake; sessions in progress read it from the error.
+The keys follow `expire_files_hours_for_<name>` of the XFTP server, and on the XFTP server both keys name the same entitlements.
 
-## Entitlement
+Control port commands, on SMP, XFTP and NTF servers:
 
-The entitlement proof is verified once in the handshake and applies to the session, so the discount costs one verification per connection. The server configures the discount per entitlement name, alongside the storage time it already grants on XFTP.
+```
+pow             ; user role: the three prices, epoch window, counts of the current period per tier
+pow p0 p1 p2    ; admin role: set the prices - p0 without an entitlement, p1 supporter, p2 legend
+```
 
-The discount is a ratio, so the entitled price rises and falls with the load multiplier. A flood of creations under one badge raises the price for that badge as for everyone.
+A change reaches new sessions through the handshake, and sessions in progress through their next response or error. It lasts until the server stops; the configuration holds the value for the next start. The XFTP and NTF control ports gain the admin role check that the SMP control port already has; both check the user role today.
 
-The discount is bounded by how a badge can be used. Proofs of one credential are unlinkable, so one badge presents on every session of a botnet at once, and the discount is the factor that badge buys. A discount of 4 to 8 keeps the badge a convenience for a person and a bounded gain for an attacker; the numbers are in the attacker table below. A higher-priced entitlement name may carry a larger discount.
+The estimator of Tor is deferred. If prices set by hand prove too slow, it runs per tier on the creations of that tier, between bounds set on the control port.
 
-This gives the badge a function on SMP and NTF, where it grants nothing today: the holder pays less CPU time, and the price of resources stays above zero for everyone.
+## Statistics
+
+The server counts per tier, so a flood shows in its tier, and the use of each entitlement is accounted for. Sessions without an entitlement are counted under `default`.
+
+```
+sessions            ; sessions of the tier
+entFailed           ; entitlement proofs that failed to verify
+proofsAccepted
+effortAccepted      ; sum of the effort of accepted proofs
+proofsAbsent
+proofsBelowPrice
+proofsStale         ; epoch outside the window
+proofsReused        ; counter below the window or already marked
+proofsInvalid       ; Blake2b target or Equi-X check failed
+created             ; queues, chunks or tokens created
+```
+
+The counts appear in `pow` for the current period, in the stats log, and in the Prometheus metrics. They name a tier, never a session.
 
 ## Costs
 
@@ -249,7 +294,7 @@ effort   desktop core   phone core
   1024          6.8 s       20.5 s
 ```
 
-A queue at unit effort 16 costs a phone about 0.3 seconds. A 4 MB chunk stored for 48 hours is 8 units, so 128 effort, about 2.6 seconds on a phone, while the upload of the same chunk takes longer than that on most connections. A 100 MB file is 25 chunks, about 65 seconds of phone CPU spread across the upload, and about 8 seconds for a badge holder at a discount of 8.
+A queue at a price of 16 costs a phone about 0.3 seconds. A 4 MB chunk stored for 48 hours is 8 units, so 128 effort, about 2.6 seconds on a phone, while the upload of the same chunk takes longer than that on most connections. A 100 MB file is 25 chunks, about 65 seconds of phone CPU spread across the upload, and about 8 seconds for a badge holder at a price of 2.
 
 Verification at 100 microseconds allows about 10000 proofs per second per core, which exceeds the rate at which queues are created and written to the store.
 
@@ -258,25 +303,19 @@ Verification at 100 microseconds allows about 10000 proofs per second per core,
 The same table read from the other side, at 150 candidate solutions per second per core:
 
 ```
-unit effort   1 core      64 cores    1000 machines
-         16   9 queues/s  600/s       9000/s
-        256   0.6/s       38/s        600/s
-       1024   0.15/s      9/s         150/s
+price    1 core      64 cores    1000 machines
+   16    9 queues/s  600/s       9000/s
+  256    0.6/s       38/s        600/s
+ 1024    0.15/s      9/s         150/s
 ```
 
-The idle price is a speed bump. The defence is the increase: a flood raises `unitEffort` within a few periods, and the price that holds back a botnet also costs a phone 20 seconds per queue. Two things soften that price for ordinary users - it applies while the flood lasts, and a badge holder pays a fraction of it.
+The idle price is a speed bump. The defence is the increase in the tier the flood uses, and the statistics show which tier that is.
 
-The same table for an attacker who bought one badge, presented on every machine:
+An attacker without a badge floods the default tier. Its price rises, and badge holders keep their prices.
 
-```
-unit effort   discount 4, 1000 machines   discount 8, 1000 machines
-         16                 37000/s                    75000/s
-       1024                   600/s                     1200/s
-```
+An attacker who bought a badge presents it on every machine: at a price of 2, one badge on 1000 machines creates 75000 queues per second until the price of that tier is raised. The raise is paid by the holders of that badge while the flood lasts, and by no one else.
 
-A discount of `d` is a botnet `d` times larger, for the price of one badge, and a badge is cheaper than any machine. So `d` is set by the amplification the server tolerates, and the price of the badge sets no bound. What keeps the amplification bounded under attack is that the increase applies to the badge holder as to everyone.
-
-A client influences `unitEffort` only by consuming resources, which costs work, so the estimator is driven by paid-for demand.
+The price of a badge tier rises at most to the default price. A flood in a badge tier that the default price does not hold back needs the default raised too, so users without a badge pay that raise as well; the other badge tiers keep their prices.
 
 ## Client implementation
 
@@ -286,19 +325,26 @@ The agent solves in a worker thread. It holds few proofs ahead, sized by what th
 
 ## Deployment
 
-Proof of work is gated by a new version of each protocol: SMP, XFTP and NTF. Servers start with `unitEffort = 0`, which asks for nothing, and operators raise it. The existing controls - `allowNewQueues`, `allowNewFiles`, the basic auth of the server - stay as they are.
+Proof of work is gated by a new version of each protocol: SMP, XFTP and NTF. Servers start with every price at zero, which asks for nothing, and operators raise them. The existing controls - `allowNewQueues`, `allowNewFiles`, the basic auth of the server - stay as they are.
 
 ## Limits
 
 - Proof of work prices bulk creation; it stops no one who is willing to pay. Tor states the same conclusion: the defence covers a single machine and a small botnet, and a large botnet needs another mechanism.
+- Prices change by hand, so a flood runs at the old price until an operator raises it. The expiry bounds the stock prepared before the flood; the flood that follows is priced at the new value from the next response.
 - Equi-X aims to narrow the gap between a CPU and a GPU, and published GPU measurements are absent. A hash-based puzzle would give an attacker with one GPU a factor of about a thousand over a phone, which is why Equi-X is chosen.
 - Proofs are bound to a session, so a reconnection discards the unspent ones.
 - The cost falls on the device of the user: battery and heat, most visible when a group of many members is created at once.
-- Proof of work replaces no rate limit. A cap on creations per session per minute stays, and rejects the cheap part of a flood before any verification.
+- Proof of work replaces no rate limit, and the servers limit neither creations nor commands per session today. A cap on creations per session per minute would reject the cheap part of a flood before any verification.
 
 ## Open questions
 
-1. The price of an SMP queue against the price of stored bytes. A queue holds up to 128 messages of 16 KB for up to 21 days, and most queues stay near empty.
-2. Whether `LSET` and `NKEY` are priced in the first version, or the queue alone.
-3. Whether a proof is required for the first message to an unknown queue, which prices contact spam rather than storage.
-4. The size of the proof stock the agent keeps, and whether it solves while the device is on battery.
+1. Clients of earlier versions. A price above zero refuses their creation commands with `AUTH`, and admitting them without a proof admits any attacker who speaks the earlier version. When operators may raise prices, against the spread of the client release.
+2. XFTP units without a stated storage time. The client learns the granted time only from `SIDS`, and the agent usually sends no storage time, which asks for the maximum. The client needs the maximum of its tier to compute megabyte-days: in `powParams`, or the price by size alone.
+3. Service sessions. A service signs `NEW` with its service key, and a chat relay creates queues in volume. A service certificate is self-issued, so it cannot exempt a session: the default price, or a price of its own.
+4. The commands priced in the first version. `NEW` and `FNEW` and `TNEW` are; `LSET`, `NKEY`, `FADD` and `SNEW` are open, and so is the first message to an unknown queue.
+5. The version plan. Pricing by entitlement needs the entitlement proof in the SMP and NTF handshakes: one version for both changes, or the handshake first.
+6. The numbers the implementation needs: the client maximum effort before it reports a busy server, the cap on Equi-X verifications per session per second, the failed proofs that close a session, the size of the verifier pool.
+7. The licence: the LGPL code of tevador vendored under `cbits`, or a reimplementation.
+8. A cap on creations per session, in this work or apart from it.
+9. Client behaviour: solving on demand alone or with a small stock, the number of solver threads on a phone, solving on battery, and an agent event for the interface when solving takes longer than a second.
+10. Whether a price set on the control port is written back to the configuration.

src/Simplex/Messaging/Agent.hs

@@ -3051,8 +3051,8 @@ setProtocolServers c userId srvs = do
   checkUserServers "setProtocolServers" srvs
   atomically $ TM.insert userId (mkUserServers srvs) (userServers c)
 
--- | Change the entitlement credential presented to XFTP servers for the user.
--- The credential is presented in the handshake, so the user's XFTP clients are closed to present the new one.
+-- | Change the entitlement credential presented to the servers of the user.
+-- The credential is presented in the handshake, so the user's clients are closed to present the new one.
 setUserEntitlement :: AgentClient -> UserId -> Maybe EntitlementCredential -> IO ()
 setUserEntitlement c userId cred_ = do
   changed <- atomically $ do
@@ -3060,7 +3060,7 @@ setUserEntitlement c userId cred_ = do
     if prev_ == cred_
       then pure False
       else True <$ maybe (TM.delete userId) (TM.insert userId) cred_ (userEntitlements c)
-  when changed $ closeUserXFTPClients c userId
+  when changed $ closeUserClients c userId
 
 checkUserServers :: Text -> NonEmpty (ServerCfg p) -> IO ()
 checkUserServers name srvs =

src/Simplex/Messaging/Agent/Client.hs

@@ -41,7 +41,7 @@ module Simplex.Messaging.Agent.Client
     reconnectServerClients,
     reconnectSMPServer,
     closeXFTPServerClient,
-    closeUserXFTPClients,
+    closeUserClients,
     runSMPServerTest,
     runXFTPServerTest,
     runNTFServerTest,
@@ -760,9 +760,10 @@ smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs, presetDomains} nm
     connectClient :: SMPClientVar -> AM SMPConnectedClient
     connectClient v' = do
       cfg <- lift $ getClientConfig c smpCfg
+      keys <- asks $ entitlementKeys . config
       g <- asks random
       service <- getServiceCredentials c userId srv
-      let cfg' = cfg {serviceCredentials = fst <$> service}
+      let cfg' = cfg {serviceCredentials = fst <$> service, mkEntitlementProof = userEntitlementProof c keys userId $ knownUserServer (smpServers c) userId srv}
       env <- ask
       smp <- liftError (protocolClientError SMP $ B.unpack $ strEncode srv) $ do
         ts <- readTVarIO proxySessTs
@@ -863,7 +864,7 @@ notifySub c = notifySub' c ""
 {-# INLINE notifySub #-}
 
 getNtfServerClient :: AgentClient -> NetworkRequestMode -> NtfTransportSession -> AM NtfClient
-getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, presetDomains} nm tSess@(_, srv, _) = do
+getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, presetDomains} nm tSess@(userId, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   withGetSessVar workerSeq tSess ntfClients ts (newProtocolClient c tSess ntfClients connectClient) (waitForProtocolClient c nm tSess ntfClients)
@@ -871,10 +872,12 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, pr
     connectClient :: NtfClientVar -> AM NtfClient
     connectClient v = do
       cfg <- lift $ getClientConfig c ntfCfg
+      keys <- asks $ entitlementKeys . config
       g <- asks random
       ts <- readTVarIO proxySessTs
+      let cfg' = cfg {mkEntitlementProof = userEntitlementProof c keys userId $ knownNtfServer c srv}
       liftError' (protocolClientError NTF $ B.unpack $ strEncode srv) $
-        getProtocolClient g nm tSess cfg presetDomains Nothing ts $
+        getProtocolClient g nm tSess cfg' presetDomains Nothing ts $
           clientDisconnected v
 
     clientDisconnected :: NtfClientVar -> NtfClient -> IO ()
@@ -884,7 +887,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, pr
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
-getXFTPServerClient c@AgentClient {active, xftpClients, userEntitlements, workerSeq, proxySessTs, presetDomains} tSess@(userId, srv, _) = do
+getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs, presetDomains} tSess@(userId, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   withGetSessVar workerSeq tSess xftpClients ts (newProtocolClient c tSess xftpClients connectClient) (waitForProtocolClient c NRMBackground tSess xftpClients)
@@ -896,30 +899,38 @@ getXFTPServerClient c@AgentClient {active, xftpClients, userEntitlements, worker
       xftpNetworkConfig <- getNetworkConfig c
       ts <- readTVarIO proxySessTs
       liftError' (protocolClientError XFTP $ B.unpack $ strEncode srv) $
-        X.getXFTPClient tSess cfg {xftpNetworkConfig} presetDomains ts (mkEntitlementProof keys) $
+        X.getXFTPClient tSess cfg {xftpNetworkConfig} presetDomains ts (userEntitlementProof c keys userId $ knownUserServer (xftpServers c) userId srv) $
           clientDisconnected v
 
-    mkEntitlementProof :: Map Word16 BBSPublicKey -> SessionId -> IO (Maybe EntitlementProof)
-    mkEntitlementProof keys sessId =
-      ifM knownServer proof (pure Nothing)
-      where
-        -- the entitlement is presented only to the servers of this user, matched by key hash that TLS pins,
-        -- so a file description of the sender cannot direct it to another server
-        knownServer = maybe False (any (sameKeyHash . snd) . storageSrvs) <$> TM.lookupIO userId (xftpServers c)
-        sameKeyHash (ProtoServerWithAuth srv' _) = srvKeyHash srv' == srvKeyHash srv
-        srvKeyHash (ProtocolServer _ _ _ kh) = kh
-        proof =
-          TM.lookupIO userId userEntitlements $>>= \cred ->
-            generateEntitlementProof keys cred (BBSPresHeader sessId) >>= \case
-              Right p -> pure $ Just p
-              Left e -> Nothing <$ logError ("entitlement proof error: " <> tshow e)
-
     clientDisconnected :: XFTPClientVar -> XFTPClient -> IO ()
     clientDisconnected v client = do
       atomically $ removeSessVar v tSess xftpClients
       atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent DISCONNECT client)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
+userEntitlementProof :: AgentClient -> Map Word16 BBSPublicKey -> UserId -> IO Bool -> SessionId -> IO (Maybe EntitlementProof)
+userEntitlementProof AgentClient {userEntitlements} keys userId knownServer sessId =
+  ifM knownServer proof (pure Nothing)
+  where
+    proof =
+      TM.lookupIO userId userEntitlements $>>= \cred ->
+        generateEntitlementProof keys cred (BBSPresHeader sessId) >>= \case
+          Right p -> pure $ Just p
+          Left e -> Nothing <$ logError ("entitlement proof error: " <> tshow e)
+
+-- the entitlement is presented only to the servers of this user, matched by key hash that TLS pins,
+-- so a server address received from another party cannot direct it to another server
+knownUserServer :: TMap UserId (UserServers p) -> UserId -> ProtocolServer p -> IO Bool
+knownUserServer servers userId srv = maybe False (any sameSrvKeyHash . storageSrvs) <$> TM.lookupIO userId servers
+  where
+    sameSrvKeyHash (_, ProtoServerWithAuth srv' _) = sameKeyHash srv srv'
+
+knownNtfServer :: AgentClient -> NtfServer -> IO Bool
+knownNtfServer c srv = any (sameKeyHash srv) <$> readTVarIO (ntfServers c)
+
+sameKeyHash :: ProtocolServer p -> ProtocolServer p -> Bool
+sameKeyHash ProtocolServer {keyHash} ProtocolServer {keyHash = kh} = keyHash == kh
+
 waitForProtocolClient ::
   (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) =>
   AgentClient ->
@@ -1059,9 +1070,15 @@ reconnectSMPServer c userId srv = do
       | userId == userId' && srv == srv' = (v :)
       | otherwise = id
 
-closeUserXFTPClients :: AgentClient -> UserId -> IO ()
-closeUserXFTPClients c userId = do
-  vs <- atomically $ stateTVar (xftpClients c) $ \cs ->
+closeUserClients :: AgentClient -> UserId -> IO ()
+closeUserClients c userId = do
+  closeUserSessions c userId smpClients
+  closeUserSessions c userId ntfClients
+  closeUserSessions c userId xftpClients
+
+closeUserSessions :: ProtocolServerClient v err msg => AgentClient -> UserId -> (AgentClient -> TMap (TransportSession msg) (ClientVar msg)) -> IO ()
+closeUserSessions c userId clientsSel = do
+  vs <- atomically $ stateTVar (clientsSel c) $ \cs ->
     let (userCs, cs') = M.partitionWithKey (\(userId', _, _) _ -> userId == userId') cs
      in (M.elems userCs, cs')
   mapM_ (forkIO . closeClient_ c) vs

src/Simplex/Messaging/Client.hs

@@ -160,6 +160,7 @@ import Network.Socket (HostName, ServiceName)
 import Network.Socks5 (SocksCredentials (..))
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
@@ -482,7 +483,9 @@ data ProtocolClientConfig v = ProtocolClientConfig
     -- | Whether connecting client is a proxy server. See comment in ClientHandshake
     proxyServer :: Bool,
     -- | send SNI to server, False for SMP
-    useSNI :: Bool
+    useSNI :: Bool,
+    -- | proof of the user entitlement to send in the handshake, bound to the session
+    mkEntitlementProof :: SessionId -> IO (Maybe EntitlementProof)
   }
 
 -- | Default protocol client configuration.
@@ -497,7 +500,8 @@ defaultClientConfig clientALPN useSNI serverVRange =
       serverVRange,
       agreeSecret = False,
       proxyServer = False,
-      useSNI
+      useSNI,
+      mkEntitlementProof = \_ -> pure Nothing
     }
 {-# INLINE defaultClientConfig #-}
 
@@ -568,7 +572,7 @@ type SMPTransportSession = TransportSession BrokerMsg
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> NetworkRequestMode -> TransportSession msg -> ProtocolClientConfig v -> [HostName] -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
-getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serviceCredentials, serverVRange, agreeSecret, proxyServer, useSNI} presetDomains msgQ proxySessTs disconnected = do
+getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serviceCredentials, serverVRange, agreeSecret, proxyServer, useSNI, mkEntitlementProof} presetDomains msgQ proxySessTs disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
       (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
@@ -635,7 +639,7 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
     client _ c cVar h = do
       ks <- if agreeSecret then Just <$> atomically (C.generateKeyPair g) else pure Nothing
       serviceKeys_ <- mapM (\creds -> (creds,) <$> atomically (C.generateKeyPair g)) serviceCredentials
-      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange proxyServer serviceKeys_) >>= \case
+      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange proxyServer serviceKeys_ mkEntitlementProof) >>= \case
         Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
         Right th@THandle {params} -> do
           sessionTs <- getCurrentTime

src/Simplex/Messaging/Notifications/Transport.hs

@@ -14,16 +14,19 @@ module Simplex.Messaging.Notifications.Transport
     THandleNTF,
     supportedClientNTFVRange,
     supportedServerNTFVRange,
+    entitlementNTFVersion,
     alpnSupportedNTFHandshakes,
     ntfServerHandshake,
     ntfClientHandshake,
   ) where
 
 import Control.Monad.Except
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
 import Data.Word (Word16)
 import qualified Data.X509 as X
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (liftEitherWith)
@@ -50,11 +53,14 @@ initialNTFVersion = VersionNTF 3
 _invalidReasonNTFVersion :: VersionNTF
 _invalidReasonNTFVersion = VersionNTF 3
 
+entitlementNTFVersion :: VersionNTF
+entitlementNTFVersion = VersionNTF 4
+
 currentClientNTFVersion :: VersionNTF
-currentClientNTFVersion = VersionNTF 3
+currentClientNTFVersion = VersionNTF 4
 
 currentServerNTFVersion :: VersionNTF
-currentServerNTFVersion = VersionNTF 3
+currentServerNTFVersion = VersionNTF 4
 
 supportedClientNTFVRange :: VersionRangeNTF
 supportedClientNTFVRange = mkVersionRange initialNTFVersion currentClientNTFVersion
@@ -78,7 +84,9 @@ data NtfClientHandshake = NtfClientHandshake
   { -- | agreed SMP notifications server protocol version
     ntfVersion :: VersionNTF,
     -- | server identity - CA certificate fingerprint
-    keyHash :: C.KeyHash
+    keyHash :: C.KeyHash,
+    -- | proof of the user entitlement bound to the session
+    entitlementProof :: Maybe EntitlementProof
   }
 
 instance Encoding NtfServerHandshake where
@@ -91,11 +99,15 @@ instance Encoding NtfServerHandshake where
     pure NtfServerHandshake {ntfVersionRange, sessionId, authPubKey}
 
 instance Encoding NtfClientHandshake where
-  smpEncode NtfClientHandshake {ntfVersion, keyHash} =
-    smpEncode (ntfVersion, keyHash)
+  smpEncode NtfClientHandshake {ntfVersion = v, keyHash, entitlementProof} =
+    smpEncode (v, keyHash) <> ifHasEntitlement v (smpEncode entitlementProof) ""
   smpP = do
-    (ntfVersion, keyHash) <- smpP
-    pure NtfClientHandshake {ntfVersion, keyHash}
+    (v, keyHash) <- smpP
+    entitlementProof <- ifHasEntitlement v smpP (pure Nothing)
+    pure NtfClientHandshake {ntfVersion = v, keyHash, entitlementProof}
+
+ifHasEntitlement :: VersionNTF -> a -> a -> a
+ifHasEntitlement v a b = if v >= entitlementNTFVersion then a else b
 
 -- | Notifcations server transport handshake.
 ntfServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c 'TServer -> C.KeyPairX25519 -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TServer)
@@ -113,8 +125,8 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVersionRange = do
             Nothing -> throwE TEVersion
 
 -- | Notifcations server client transport handshake.
-ntfClientHandshake :: forall c. Transport c => c 'TClient -> C.KeyHash -> VersionRangeNTF -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleNTF c 'TClient)
-ntfClientHandshake c keyHash ntfVRange _proxyServer _serviceKeys = do
+ntfClientHandshake :: forall c. Transport c => c 'TClient -> C.KeyHash -> VersionRangeNTF -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> ExceptT TransportError IO (THandleNTF c 'TClient)
+ntfClientHandshake c keyHash ntfVRange _proxyServer _serviceKeys mkEntitlementProof = do
   let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
   NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey} <- getHandshake th
   if sessionId /= sessId
@@ -126,7 +138,8 @@ ntfClientHandshake c keyHash ntfVRange _proxyServer _serviceKeys = do
           pubKey <- C.verifyX509 serverKey authPubKey
           (,CertChainPubKey (getPeerCertChain c) authPubKey) <$> C.x509ToPublic' pubKey
         let v = maxVersion vr
-        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash}
+        ep <- if v >= entitlementNTFVersion then liftIO (mkEntitlementProof sessionId) else pure Nothing
+        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash, entitlementProof = ep}
         pure $ ntfThHandleClient th v vr ck
       Nothing -> throwE TEVersion
 

src/Simplex/Messaging/Protocol.hs

@@ -263,6 +263,7 @@ import Network.Socket (ServiceName)
 import qualified Network.TLS as TLS
 import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Names.Record (NameRecord (..))
@@ -1754,7 +1755,7 @@ transmissionP THandleParams {sessionId, implySessId, serviceAuth} = do
 class (ProtocolTypeI (ProtoType msg), ProtocolEncoding v err msg, ProtocolEncoding v err (ProtoCommand msg), Show err, Show msg) => Protocol v err msg | msg -> v, msg -> err where
   type ProtoCommand msg = cmd | cmd -> msg
   type ProtoType msg = (sch :: ProtocolType) | sch -> msg
-  protocolClientHandshake :: Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandle v c 'TClient)
+  protocolClientHandshake :: Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> ExceptT TransportError IO (THandle v c 'TClient)
   useServiceAuth :: ProtoCommand msg -> Bool
   protocolPing :: ProtoCommand msg
   protocolError :: msg -> Maybe err

src/Simplex/Messaging/Transport.hs

@@ -53,6 +53,7 @@ module Simplex.Messaging.Transport
     rcvServiceSMPVersion,
     namesSMPVersion,
     serverInfoSMPVersion,
+    entitlementSMPVersion,
     simplexMQVersion,
     smpBlockSize,
     TransportConfig (..),
@@ -135,6 +136,7 @@ import qualified Network.TLS as T
 import qualified Network.TLS.Extra as TE
 import qualified Paths_simplexmq as SMQ
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, parseRead1, sumTypeJSON)
@@ -175,6 +177,7 @@ smpBlockSize = 16384
 -- 19 - service subscriptions to messages (10/20/2025)
 -- 20 - public namespaces resolver, RSLV command (6/20/2026)
 -- 21 - server public information in handshake (7/5/2026)
+-- 22 - entitlement proof in client handshake (9/11/2026)
 
 data SMPVersion
 
@@ -211,6 +214,9 @@ namesSMPVersion = VersionSMP 20
 serverInfoSMPVersion :: VersionSMP
 serverInfoSMPVersion = VersionSMP 21
 
+entitlementSMPVersion :: VersionSMP
+entitlementSMPVersion = VersionSMP 22
+
 minClientSMPRelayVersion :: VersionSMP
 minClientSMPRelayVersion = VersionSMP 14
 
@@ -218,10 +224,10 @@ minServerSMPRelayVersion :: VersionSMP
 minServerSMPRelayVersion = VersionSMP 14
 
 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 21
+currentClientSMPRelayVersion = VersionSMP 22
 
 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 21
+currentServerSMPRelayVersion = VersionSMP 22
 
 -- Max SMP protocol version to be used in e2e encrypted connection between
 -- client and server, as defined by SMP proxy. Normally set below the current
@@ -566,7 +572,9 @@ data SMPClientHandshake = SMPClientHandshake
     -- - notification servers,
     -- - high traffic chat bots,
     -- - high traffic business support clients.
-    clientService :: Maybe SMPClientHandshakeService
+    clientService :: Maybe SMPClientHandshakeService,
+    -- | proof of the user entitlement bound to the session
+    entitlementProof :: Maybe EntitlementProof
   }
 
 data SMPClientHandshakeService = SMPClientHandshakeService
@@ -584,17 +592,19 @@ data ServiceCredentials = ServiceCredentials
 data SMPServiceRole = SRMessaging | SRNotifier | SRProxy deriving (Eq, Show)
 
 instance Encoding SMPClientHandshake where
-  smpEncode SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService} =
+  smpEncode SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService, entitlementProof} =
     smpEncode (v, keyHash)
       <> maybe "" smpEncode authPubKey
       <> smpEncode proxyServer
       <> ifHasService v (smpEncode clientService) ""
+      <> ifHasEntitlement v (smpEncode entitlementProof) ""
   smpP = do
     (v, keyHash) <- smpP
     authPubKey <- optional smpP
     proxyServer <- smpP
     clientService <- ifHasService v smpP (pure Nothing)
-    pure SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService}
+    entitlementProof <- ifHasEntitlement v smpP (pure Nothing)
+    pure SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService, entitlementProof}
 
 instance Encoding SMPClientHandshakeService where
   smpEncode SMPClientHandshakeService {serviceRole, serviceCertKey} =
@@ -618,6 +628,9 @@ instance Encoding SMPServiceRole where
 ifHasService :: VersionSMP -> a -> a -> a
 ifHasService v a b = if v >= serviceCertsSMPVersion then a else b
 
+ifHasEntitlement :: VersionSMP -> a -> a -> a
+ifHasEntitlement v a b = if v >= entitlementSMPVersion then a else b
+
 ifHasServerInfo :: VersionSMP -> a -> a -> a
 ifHasServerInfo v a b = if v >= serverInfoSMPVersion then a else b
 
@@ -773,8 +786,8 @@ smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVersionRange serverInfoByt
 -- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-smpClientHandshake :: forall c. Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleSMP c 'TClient)
-smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange proxyServer serviceKeys_ = do
+smpClientHandshake :: forall c. Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> ExceptT TransportError IO (THandleSMP c 'TClient)
+smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange proxyServer serviceKeys_ mkEntitlementProof = do
   SMPServerHandshake {sessionId = sessId, smpVersionRange, authPubKey = certKey@(CertChainPubKey chain exact), serverInfoBytes} <- getHandshake th
   when (sessionId /= sessId) $ throwE TEBadSession
   case smpVersionRange `compatibleVRange` smpVRange of
@@ -791,8 +804,8 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange proxyServer serviceKey
             Just sks | v >= serviceVersion (fst sks) && certificateSent c -> Just sks
             _ -> Nothing
           clientService = mkClientService <$> serviceKeys
-          hs = SMPClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer, clientService}
-      sendHandshake th hs
+      ep <- if v >= entitlementSMPVersion then liftIO (mkEntitlementProof sessionId) else pure Nothing
+      sendHandshake th SMPClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer, clientService, entitlementProof = ep}
       service <- mapM getClientService serviceKeys
       liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck proxyServer service serverInfoBytes
     Nothing -> throwE TEVersion

tests/AgentTests/FunctionalAPITests.hs

@@ -332,6 +332,8 @@ functionalAPITests ps = do
       withSmpServer ps testServerMultipleIdentities
     it "should connect with two peers" $
       withSmpServer ps testAgentClient3
+    it "should connect with entitlement credential" $
+      withSmpServer ps testAgentEntitlement
     it "should establish connection without PQ encryption and enable it" $
       withSmpServer ps testEnablePQEncryption
   describe "Duplex connection - delivery stress test" $ do
@@ -976,6 +978,15 @@ testAgentClient3 =
     get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
     ackMessage c aIdForC 3 Nothing
 
+testAgentEntitlement :: HasCallStack => IO ()
+testAgentEntitlement = do
+  (keys, credential) <- mkTestEntitlement
+  let aCfg = agentCfg {entitlementKeys = keys}
+      servers = initAgentServers {entitlements = M.fromList [(1, credential)]}
+  withAgentClientsCfgServers2 aCfg aCfg servers $ \a b -> runRight_ $ do
+    (aId, bId) <- makeConnection a b
+    exchangeGreetings a bId b aId
+
 runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
   runAgentClientContactTestPQ sqSecured viaProxy (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId

tests/CLITests.hs

@@ -193,7 +193,7 @@ smpServerTestStatic = do
         X.Certificate {X.certPubKey = X.PubKeyEd25519 _k} : _ca -> print _ca -- pure ()
         leaf : _ -> error $ "Unexpected leaf cert: " <> show leaf
         [] -> error "Empty chain"
-      runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange False Nothing
+      runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange False Nothing (\_ -> pure Nothing)
     logDebug "Combined SMP works"
   where
     getCerts :: TLS 'TClient -> [X.Certificate]

tests/NtfClient.hs

@@ -40,6 +40,7 @@ import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost, defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
@@ -117,10 +118,13 @@ ntfTestDBCfg2 :: PostgresStoreCfg
 ntfTestDBCfg2 = ntfTestDBCfg {dbOpts = ntfTestStoreDBOpts2, dbStoreLogPath = Just ntfTestStoreLogFile2}
 
 testNtfClient :: Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
-testNtfClient client = do
+testNtfClient = testNtfClientProof (\_ -> pure Nothing)
+
+testNtfClientProof :: Transport c => (SessionId -> IO (Maybe EntitlementProof)) -> (THandleNTF c 'TClient -> IO a) -> IO a
+testNtfClientProof mkEntitlementProof client = do
   Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
   runTransportClient defaultTransportClientConfig Nothing host ntfTestPort (Just testKeyHash) $ \h ->
-    runExceptT (ntfClientHandshake h testKeyHash supportedClientNTFVRange False Nothing) >>= \case
+    runExceptT (ntfClientHandshake h testKeyHash supportedClientNTFVRange False Nothing mkEntitlementProof) >>= \case
       Right th -> client th
       Left e -> error $ show e
 

tests/NtfServerTests.hs

@@ -39,9 +39,10 @@ import qualified Simplex.Messaging.Agent.Protocol as AP
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
+import qualified Simplex.Messaging.Notifications.Protocol as NP
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS
-import Simplex.Messaging.Notifications.Transport (THandleNTF)
+import Simplex.Messaging.Notifications.Transport (THandleNTF, entitlementNTFVersion)
 import Simplex.Messaging.Parsers (parse, parseAll)
 import Simplex.Messaging.Protocol hiding (notification)
 import Simplex.Messaging.Server.Env.STM (AStoreType)
@@ -55,6 +56,8 @@ ntfServerTests ps@(t, _) = do
   describe "Notifications server protocol syntax" $ ntfSyntaxTests t
   describe "Push provider policy" $ do
     it "rejects APNS test provider unless enabled" $ testApnsTestProviderRejected t
+  describe "Entitlement proof" $ do
+    it "responds in the session with entitlement proof" $ testNtfEntitlementProof t
   describe "Notification subscriptions (NKEY)" $ testNotificationSubscription ps createNtfQueueNKEY
   describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription ps createNtfQueueNEW
   describe "Retried notification subscription" $ testRetriedNtfSubscription ps
@@ -88,6 +91,16 @@ testApnsTestProviderRejected (ATransport (t :: TProxy c 'TServer)) = do
         signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
       pure ()
 
+testNtfEntitlementProof :: ASrvTransport -> Expectation
+testNtfEntitlementProof (ATransport (t :: TProxy c 'TServer)) = do
+  mkProof <- mkTestEntitlementProof
+  withNtfServer (ATransport t) $
+    testNtfClientProof mkProof $ \(nh :: THandleNTF c 'TClient) -> do
+      let THandle {params = THandleParams {thVersion}} = nh
+      thVersion `shouldSatisfy` (>= entitlementNTFVersion)
+      RespNtf "1" NoEntity NRPong <- sendRecvNtf nh (Nothing, "1", NoEntity, NP.PING)
+      pure ()
+
 pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> Transmission (Either ErrorType NtfResponse)
 pattern RespNtf corrId queueId command <- (corrId, queueId, Right command)
 

tests/SMPClient.hs

@@ -19,6 +19,10 @@ import Control.Monad
 import Control.Monad.Except (runExceptT)
 import Data.ByteString.Char8 (ByteString)
 import Data.List.NonEmpty (NonEmpty)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Time.Clock (addUTCTime, getCurrentTime, nominalDay)
+import Data.Word (Word16)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import Network.Socket
@@ -28,6 +32,8 @@ import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (NetworkConfig (..), NetworkTimeout (..), ProtocolClientConfig (..), chooseTransportHost, defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.BBS (BBSPresHeader (..), BBSPublicKey, bbsKeyGen)
+import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementCredential, EntitlementProof, MasterKey (..), generateEntitlementProof, signEntitlement)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (runSMPServerBlocking)
@@ -163,8 +169,16 @@ testSMPServiceClient serviceCreds client = do
   Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
   testSMPClient_ useHost testPort supportedClientSMPRelayVRange (Just serviceCreds) client
 
+testSMPClientProof :: Transport c => (SessionId -> IO (Maybe EntitlementProof)) -> (THandleSMP c 'TClient -> IO a) -> IO a
+testSMPClientProof mkEntitlementProof client = do
+  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
+  testSMPClientProof_ useHost testPort supportedClientSMPRelayVRange Nothing mkEntitlementProof client
+
 testSMPClient_ :: Transport c => TransportHost -> ServiceName -> VersionRangeSMP -> Maybe (TLS.Credential, C.KeyPairEd25519) -> (THandleSMP c 'TClient -> IO a) -> IO a
-testSMPClient_ host port vr serviceCreds_ client = do
+testSMPClient_ host port vr serviceCreds_ = testSMPClientProof_ host port vr serviceCreds_ (\_ -> pure Nothing)
+
+testSMPClientProof_ :: Transport c => TransportHost -> ServiceName -> VersionRangeSMP -> Maybe (TLS.Credential, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> (THandleSMP c 'TClient -> IO a) -> IO a
+testSMPClientProof_ host port vr serviceCreds_ mkEntitlementProof client = do
   serviceAndKeys_ <- forM serviceCreds_ $ \(serviceCreds@(cc, pk), keys) -> do
     Right serviceSignKey <- pure $ C.x509ToPrivate' pk
     let idCert' = case chainIdCaCerts cc of
@@ -175,12 +189,25 @@ testSMPClient_ host port vr serviceCreds_ client = do
     pure (ServiceCredentials {serviceRole = SRMessaging, serviceCreds, serviceCertHash, serviceSignKey}, keys)
   let tcConfig = defaultTransportClientConfig {clientALPN, clientCredentials = fst <$> serviceCreds_} :: TransportClientConfig
   runTransportClient tcConfig Nothing host port (Just testKeyHash) $ \h ->
-    runExceptT (smpClientHandshake h Nothing testKeyHash vr False serviceAndKeys_) >>= \case
+    runExceptT (smpClientHandshake h Nothing testKeyHash vr False serviceAndKeys_ mkEntitlementProof) >>= \case
       Right th -> client th
       Left e -> error $ show e
   where
     clientALPN = Just alpnSupportedSMPHandshakes
 
+mkTestEntitlement :: IO (Map Word16 BBSPublicKey, EntitlementCredential)
+mkTestEntitlement = do
+  Right (issuerKey, issuerSecret) <- bbsKeyGen
+  expiresAt <- addUTCTime (30 * nominalDay) <$> getCurrentTime
+  let entitlement = Entitlement {entitlementName = "supporter", expiresAt, extraInfo = ""}
+  Right credential <- signEntitlement issuerSecret 1 (MasterKey "0123456789abcdef0123456789abcdef") entitlement
+  pure (M.singleton 1 issuerKey, credential)
+
+mkTestEntitlementProof :: IO (SessionId -> IO (Maybe EntitlementProof))
+mkTestEntitlementProof = do
+  (keys, credential) <- mkTestEntitlement
+  pure $ \sessId -> either error Just <$> generateEntitlementProof keys credential (BBSPresHeader sessId)
+
 runSMPClient :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO a) -> IO a
 runSMPClient _ test' = testSMPClient test'
 
@@ -199,7 +226,7 @@ testNtfServiceClient _ keys client = do
             clientALPN = Just alpnSupportedSMPHandshakes
           }
   runTransportClient tcConfig Nothing "localhost" testPort (Just testKeyHash) $ \h ->
-    runExceptT (smpClientHandshake h Nothing testKeyHash supportedClientSMPRelayVRange False $ Just (service, keys)) >>= \case
+    runExceptT (smpClientHandshake h Nothing testKeyHash supportedClientSMPRelayVRange False (Just (service, keys)) (\_ -> pure Nothing)) >>= \case
       Right th -> client th
       Left e -> error $ show e
 

tests/ServerTests.hs

@@ -81,6 +81,7 @@ serverTests = do
     describe "NEW, OFF and DEL commands, SEND messages" testCreateDelete
     describe "Stress test" stressTest
     describe "allowNewQueues setting" testAllowNewQueues
+    describe "entitlement proof in handshake" testEntitlementProofHandshake
   describe "SMP messages" $ do
     describe "duplex communication over 2 SMP connections" testDuplex
     describe "switch subscription to another TCP connection" testSwitchSub
@@ -464,6 +465,19 @@ testAllowNewQueues =
         Resp "abcd" NoEntity (ERR AUTH) <- signSendRecv h rKey ("abcd", NoEntity, New rPub dhPub)
         pure ()
 
+testEntitlementProofHandshake :: SpecWith (ASrvTransport, AStoreType)
+testEntitlementProofHandshake =
+  it "should create queue in the session with entitlement proof" $ \(ATransport (t :: TProxy c 'TServer), msType) -> do
+    mkProof <- mkTestEntitlementProof
+    withSmpServerConfigOn (ATransport t) (cfgMS msType) testPort $ \_ ->
+      testSMPClientProof @c mkProof $ \h@THandle {params = THandleParams {thVersion}} -> do
+        thVersion `shouldSatisfy` (>= entitlementSMPVersion)
+        g <- C.newRandom
+        (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+        (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+        Resp "abcd" NoEntity (Ids _ _ _) <- signSendRecv h rKey ("abcd", NoEntity, New rPub dhPub)
+        pure ()
+
 testDuplex :: SpecWith (ASrvTransport, AStoreType)
 testDuplex =
   it "should create 2 simplex connections and exchange messages" $ \(ATransport t, msType) ->