diff --git a/apps/simplex-badge-service/src/BadgeService/Service.hs b/apps/simplex-badge-service/src/BadgeService/Service.hs index b1321a99cf..8016964719 100644 --- a/apps/simplex-badge-service/src/BadgeService/Service.hs +++ b/apps/simplex-badge-service/src/BadgeService/Service.hs @@ -872,6 +872,28 @@ issuanceCredential BadgeIssuance {credential} = credential requestedBadgeType :: BadgeRequest -> BadgeType requestedBadgeType BadgeRequest {badgeInfo = BadgeInfo {badgeType}} = badgeType +-- | The request with its tier replaced by the one the FUNDING states, which is what +-- 'handlePurchaseCode' signs. +-- +-- A redemption code carries no tier (B3) and no command reports one without redeeming, so a +-- client cannot name the tier of a code it is about to present -- and the response is what +-- states it (core §5, UX 2.8). Refusing a mismatch, which this path did until C4, made code +-- redemption unimplementable for any client that had not been told the tier out of band. The +-- security property that refusal defended is kept in full by overriding instead: a credential +-- can never exceed what its funding bought, because the tier is read from the code's row and +-- never from the request. +-- +-- __Only this path overrides.__ 'handleIssueBadge' keeps its own check against the purchase's +-- @current_badge_type@, which the client HOLDS and can state, and it shares 'resolveIssue' with +-- this one -- so the override lives here, at the one call site whose tier the client cannot +-- know, and not in 'issueSignedBadge', where it would silence that check too. +-- +-- Everything else the client sent is untouched, the master key above all: 'requestMasterKey' +-- reads the original request, so the credential is bound to the key the client generated. +withFundedBadgeType :: BadgeType -> BadgeRequest -> BadgeRequest +withFundedBadgeType badgeType BadgeRequest {masterKey, badgeInfo = BadgeInfo {badgeExpiry, badgeExtra}} = + BadgeRequest {masterKey, badgeInfo = BadgeInfo {badgeType, badgeExpiry, badgeExtra}} + -- | @badgeExtra@ is reserved and must be empty (RPC "Commands"). 'issueSignedBadge' rejects a -- non-empty one itself, but by the time that comes back it is indistinguishable from a signing -- failure, and the two need opposite answers: a non-empty @badgeExtra@ is a client fault @@ -941,46 +963,40 @@ handlePurchaseCode bsEnv@BadgeServiceEnv {store, now} signerKey badgeRequest pre replay now' pid = withServiceTransaction store (replayTxn now' pid) >>= \case Left e -> storeFailed "purchaseBadge{code} replay" e - Right (Left code) -> pure $ errorResponse code Nothing Nothing - Right (Right (credential, statement)) -> do + Right (credential, statement) -> do when (isNothing credential) $ logWarn $ "no badge issuance found for the redemption being replayed by purchase " <> tshow pid pure BSPBadgeCredential {credential, receipt = Nothing, statement} - replayTxn now' pid db = - getIssuanceForRedeemedCode db hash >>= \case - -- the tier check every other path applies, here against the credential actually being - -- handed back: replaying a supporter redemption under a legend badgeRequest must answer - -- like any other tier mismatch rather than return a credential of the other tier. When - -- there is no issuance there is nothing to return and so nothing to mismatch. - Just BadgeIssuance {badgeType} | badgeType /= requestedBadgeType badgeRequest -> pure $ Left BSEBadRequest - issuance -> do - statement <- purchaseStatement now' db Nothing pid - pure $ Right (issuanceCredential <$> issuance, statement) - redeem attemptsLeft now' badgeType months - -- The service signs exactly the content the client sent (RPC "Commands"), so a request - -- naming a tier the code does not fund is refused rather than silently signed as the - -- code's tier or, worse, as the tier asked for. - | requestedBadgeType badgeRequest /= badgeType = pure badRequest - | otherwise = do - -- minted before the plan, so the credit entry can name the payment row it references, - -- and before the transaction, so nothing but writes happens inside it - paymentUuid <- UUID.toText <$> UUID.nextRandom - withServiceTransaction store (planTxn now' badgeType months paymentUuid) >>= \case - Left e -> storeFailed "purchaseBadge{code} planning" e - Right (Left code) -> pure $ errorResponse code Nothing Nothing - Right (Right (row_, plan)) -> - resolveIssue bsEnv now' (rowPurchaseId <$> row_) badgeRequest (lpIssue plan) >>= \case - Left code -> pure $ errorResponse code Nothing Nothing - Right result -> - withServiceTransaction store (writeTxn now' badgeType paymentUuid row_ plan {lpIssue = result}) >>= \case - -- the code was claimed between the classification and this write; nothing of - -- ours committed, so re-classify and answer what the code now is (a replay - -- for this key, code_used for any other). Unreachable while the request loop - -- is single-threaded -- see 'redemptionRetries' for why that matters. - Left SECodeConflict | attemptsLeft > 0 -> attempt (attemptsLeft - 1) - Left e -> storeFailed "purchaseBadge{code} write" e - Right statement -> - pure BSPBadgeCredential {credential = issuedCredential result, receipt = Nothing, statement} + -- The replay applies no tier check of its own: the credential it hands back was signed with + -- the tier of the code that bought it, and 'withFundedBadgeType' means a request naming + -- another tier could not have produced a credential of that tier to begin with. A check here + -- would only refuse the honest client that repeats a request after a timeout without knowing + -- the tier -- the very case the idempotency rule exists for. + replayTxn now' pid db = do + issuance <- getIssuanceForRedeemedCode db hash + statement <- purchaseStatement now' db Nothing pid + pure (issuanceCredential <$> issuance, statement) + redeem attemptsLeft now' badgeType months = do + -- minted before the plan, so the credit entry can name the payment row it references, + -- and before the transaction, so nothing but writes happens inside it + paymentUuid <- UUID.toText <$> UUID.nextRandom + withServiceTransaction store (planTxn now' badgeType months paymentUuid) >>= \case + Left e -> storeFailed "purchaseBadge{code} planning" e + Right (Left code) -> pure $ errorResponse code Nothing Nothing + Right (Right (row_, plan)) -> + -- the tier signed is the CODE's, never the request's (see 'withFundedBadgeType') + resolveIssue bsEnv now' (rowPurchaseId <$> row_) (withFundedBadgeType badgeType badgeRequest) (lpIssue plan) >>= \case + Left code -> pure $ errorResponse code Nothing Nothing + Right result -> + withServiceTransaction store (writeTxn now' badgeType paymentUuid row_ plan {lpIssue = result}) >>= \case + -- the code was claimed between the classification and this write; nothing of + -- ours committed, so re-classify and answer what the code now is (a replay + -- for this key, code_used for any other). Unreachable while the request loop + -- is single-threaded -- see 'redemptionRetries' for why that matters. + Left SECodeConflict | attemptsLeft > 0 -> attempt (attemptsLeft - 1) + Left e -> storeFailed "purchaseBadge{code} write" e + Right statement -> + pure BSPBadgeCredential {credential = issuedCredential result, receipt = Nothing, statement} planTxn now' badgeType months paymentUuid db = getPurchaseByKey db signerKey >>= \case -- the normal case: C4 mints a fresh key per redemption, so there is no purchase row and diff --git a/docs/protocol/badges-rpc.md b/docs/protocol/badges-rpc.md index 7ce3b78b34..d7e2841842 100644 --- a/docs/protocol/badges-rpc.md +++ b/docs/protocol/badges-rpc.md @@ -26,11 +26,11 @@ A timeout hides the outcome, so the client repeats the identical signed request ## Commands -`purchaseBadge`, `upgradeBadgeSubscription`, and `issueBadge` carry `badgeRequest`, the signer's input (`BadgeRequest`, `Simplex.Chat.Badges`): the service signs exactly this content or rejects the command. The proposed `badgeExpiry` is capped by the funded coverage (`sundayAfter`, model §3); its absence requests a lifetime credential; `badgeExtra` is reserved and must be empty. +`purchaseBadge`, `upgradeBadgeSubscription`, and `issueBadge` carry `badgeRequest`, the signer's input (`BadgeRequest`, `Simplex.Chat.Badges`): the service signs exactly this content or rejects the command — with one exception, `purchaseBadge` funded by a `code`, where the service signs the badge type the CODE funds and ignores the one the request names. A code carries no badge type and no command reports one without redeeming it, so a client cannot state it; the response is what states it. Every other command keeps the rule, `issueBadge` in particular, where the badge type is the purchase's own and the client holds it: naming another one there is `bad_request`. The proposed `badgeExpiry` is capped by the funded coverage (`sundayAfter`, model §3); its absence requests a lifetime credential; `badgeExtra` is reserved and must be empty. - `getBadgeCatalog` → `badgeCatalog` — the prices and offers; signed, also the purchase's `badgeStatement`. Store builds never send it: prices come from the store and SKUs from app config. - `getBadgeInvoice` → `badgeInvoice` — prices the purchase for `badgeInfo` and `paymentVia` (`card` — Stripe; `crypto` — btc, xmr). The response holds the generic `invoice` — `invoiceId`, `price`, `discount`, the upgrade `credit`, `amount` = price − discount − credit, `currency`, `expiresAt`, and `paymentTo` (`url` for card; `address` and `cryptoAmount` for crypto) — beside the badge part, `badgeType` and `months`. `priceId` pins the price the client displayed; `offerId` selects a discounted duration, and its absence buys one month at that price. Price and offer status is checked here only: `deprecated` is still accepted, `disabled` is rejected; a badge type with no active price yields `product_unavailable`. -- `purchaseBadge` → `badgeCredential` — verifies the funding (`apple` JWS offline; `google` token via the Publisher API; `invoice` against webhook-confirmed settlement, `payment_pending` until it lands; `code`; `receipt`), records the credit, and issues the first credential, in one round trip. The response `receipt` is the recovery bearer secret (model § recovery); the service stores its hash; lifetime badges receive none. +- `purchaseBadge` → `badgeCredential` — verifies the funding (`apple` JWS offline; `google` token via the Publisher API; `invoice` against webhook-confirmed settlement, `payment_pending` until it lands; `code`; `receipt`), records the credit, and issues the first credential, in one round trip. A `code` names the badge type and the months it funds, and the credential is issued for that badge type whatever `badgeRequest.badgeInfo.badgeType` says, so a credential can never exceed its funding. The response `receipt` is the recovery bearer secret (model § recovery); the service stores its hash; lifetime badges receive none. - Funding by `receipt` is a transfer (post-MVP): the unissued months of the purchase that receipt belongs to move to the signing key, recorded as `debit(transferOut)` on the source and `credit(transferIn)` on the new purchase, and the presented receipt is retired for a fresh one. The transferred period's issuance debits a month like any other. Lifetime badges hold no receipt, so support handles them. - `upgradeBadgeSubscription` → `badgeCredential` — the app-led store subscription change, on the same key: verifies the store evidence of the replaced subscription and records the new plan; an immediate upgrade returns the new credential, a deferred change returns none. - `issueBadge` → `badgeCredential` — issues the next period from the balance, the only source of issuance. The ledger is advanced first; the credential is signed before the `debit(badge)` and issuance rows are written, in one transaction. An exhausted balance yields no `credential`; the `statement` shows why. Issuing on a paused badge resumes it (model 2.13). diff --git a/plans/badges-codes/2026-08-21-badges-web-checkout.md b/plans/badges-codes/2026-08-21-badges-web-checkout.md index 25ab5ccc00..1c1dd054cf 100644 --- a/plans/badges-codes/2026-08-21-badges-web-checkout.md +++ b/plans/badges-codes/2026-08-21-badges-web-checkout.md @@ -710,13 +710,13 @@ badgeWorkers :: TMap UserId Worker -- a ChatController field: agent Worker, d #### C4 — Redeem path wired end to end -**Files:** `src/Simplex/Chat/Library/Commands.hs` +**Files:** `src/Simplex/Chat/Library/Commands.hs`, `src/Simplex/Chat/Store/Badges.hs` (`checkStatementEntries`, §9), `apps/simplex-badge-service/src/BadgeService/Service.hs` and `tests/Bots/BadgeServiceTests.hs` (the funded-tier ruling, §9), `docs/protocol/badges-rpc.md`, `tests/Bots/BadgeManagerTests.hs` (two stub expectations) **Do:** `sendBadgeRequest`, the single send path C3's worker also calls, plus `APIPurchaseBadge` with a code, under the per-user badge lock, and `APIGetBadgeCatalog`: - Generate the purchase keypair (Ed25519, per core §5) and the badge master key in memory, and hold them for the duration of the call. Nothing is written before the response, because the purchase row's two badge-type columns are `NOT NULL` and the badge type is not known until the service states it (C1). A fresh key per redemption is the rule (§3). - `sendBadgeRequest :: NetworkRequestMode -> User -> Maybe C.PrivateKeyEd25519 -> BadgeServiceRequest -> CM BadgeServiceResponse` sends one RPC to `ChatConfig.badgeServiceAddress`, signed with the given key or unsigned when it is `Nothing` (B5's identity rules). The agent's service request is its own connection — it joins the address, takes the one reply and deletes the connection again — so nothing is contacted until a badge command sends something and a profile that never buys a badge never reaches the service. It takes the profile's `User` and the request mode rather than reading the active user (§9), and returns its transport failures as `BSPError internal` rather than throwing them (§9). It replaces C3's stub. -- Send `purchaseBadge`, once per tier a code can fund: the client cannot know a code's tier and B7 refuses a `badgeRequest` naming another one, so the code is presented under `supporter` then `legend` until the service stops answering `bad_request` (§9). +- Send `purchaseBadge`, once. The request's `badgeInfo.badgeType` is not the client's to choose — a code carries no tier, so the service signs the tier the CODE funds and ignores the field on this command (the B7 change C4 makes, §9); the response states the tier the purchase row is written with. - On success, call C2's `verifyUserBadge` first: a credential that fails verification surfaces as `CEBadgeServiceError` and writes nothing. Its `Left` becomes `CEBadgeServiceError` with `badgeError = BSEInternal` and the `Left` text as `message`: the failure is local, and no `BadgeServiceErrorCode` denotes one. Then, in one transaction, call C1's `createCodePayment`, `createPurchase` with the response's badge type and the held keys, `insertLedgerEntries` for the statement verbatim, `createIssuance` for the credential, `supersedePurchases` for that slot, `setShownPurchase` and `setUserBadge`. Write the `User` `setUserBadge` returns to the `currentUser` TVar when that profile is the active one, on the read-then-compare-then-write idiom C3's pass uses (§9), or the in-memory user keeps the old badge. Release the per-user badge lock, then call C2's `presentUserBadgeToContacts` with that `User`, which takes `chatLock` and broadcasts the updated profile. The badge type, and with it the slot, is stated in the response (core §5). These are the **client's** tables; B7 writes the service's own `badge_purchases` row independently, and the two databases share only the ledger rows. - Do not signal the worker: C4 has already presented the badge, and the current month is issued, so a pass would find nothing to do. The next pass comes from C3's timer or the next `APIGetBadgeState`. - On timeout, surface the error to the user. A code consumed by a lost response is recovered with H2's `codes unredeem`. @@ -1356,7 +1356,7 @@ Append here when a step contradicts this plan: the step id, what was wrong, and - **B7 — the already-issued month's credential is fetched by probing `getIssuanceForPeriod` at `now`, not at `addMonths (-1) balanceStartTs` as step 4 said.** `addMonths` is deliberately not additive under clamping (`Badges/Months.hs`: 31 Jan + 1 month = 28 Feb, and 28 Feb − 1 month = 28 **Jan**), so stepping a month back from a clamped period boundary can land *before* the period it came from and match the issuance for the month before — returning the wrong credential, not merely none. `now` is inside the period by construction (`balanceStartTs > now` is why `issue` returned `Nothing`, and the period's start is at or before the instant that issue ran, hence at or before `now`), so it names exactly one issuance with no arithmetic at all. Step 4 corrected in place. - **B7 — B1's `createCodePayment` is split into `createCodePayment` (the `@payments` row) and `attachPurchasePayment` (the purchase's pointer).** Step 3 requires a second code redeemed under a key that already has a purchase to credit that purchase's existing ledger, and step 6 requires the `payments` row for the `credit(payment)` entry to reference — but `@badge_purchases.payment_id` is `UNIQUE` and holds at most one payment (`M20260731_user_badges.hs:99,104`), so the combined function could only answer `SEPaymentConflict` there. The second code now gets its own `payments` row while the purchase's pointer stays on the first. `createCodePayment` had no caller before B7, so nothing else changed. Step 6 corrected in place. - **B7 — `markCodeRedeemed` is now guarded and a new `SECodeConflict` exists.** Step 6's "a conflict on the code's redemption columns aborts the transaction and re-classifies from step 1" had nothing to detect a conflict with: B1's `UPDATE` was unguarded and would have silently overwritten another key's redemption. It is now `WHERE code_hash = ? AND redeemed_purchase_id IS NULL`, with an existence check separating `SECodeNotFound` from `SECodeConflict`. The handler retries the whole redemption exactly once on `SECodeConflict` (`redemptionAttempts = 1`); the second pass is terminal, because a redeemed code cannot become unredeemed by itself. -- **B7 — a `badgeRequest` naming a different tier than the funding is refused with `bad_request`. Not in the step, and it is a security boundary.** RPC "Commands": "the service signs exactly this content or rejects the command". Without the check, a client could present a `supporter` code (or hold a `supporter` balance) and be handed a signed **`legend`** credential, since `issueSignedBadge` overrides only `badgeExpiry` and signs the `badgeInfo` it is given. `purchaseBadge{code}` now requires `badgeRequest.badgeInfo.badgeType` to equal the code's `badge_type`, `issueBadge` requires it to equal the purchase's `current_badge_type`, and the same-key **replay** path requires it to equal the `badge_type` of the issuance being handed back — the replay returns a cached credential and signs nothing, but a mismatch there must answer like every other path rather than return a credential of the other tier. +- **B7 — a `badgeRequest` naming a different tier than the funding is refused with `bad_request`. Not in the step, and it is a security boundary.** RPC "Commands": "the service signs exactly this content or rejects the command". Without the check, a client could present a `supporter` code (or hold a `supporter` balance) and be handed a signed **`legend`** credential, since `issueSignedBadge` overrides only `badgeExpiry` and signs the `badgeInfo` it is given. `purchaseBadge{code}` now requires `badgeRequest.badgeInfo.badgeType` to equal the code's `badge_type`, `issueBadge` requires it to equal the purchase's `current_badge_type`, and the same-key **replay** path requires it to equal the `badge_type` of the issuance being handed back — the replay returns a cached credential and signs nothing, but a mismatch there must answer like every other path rather than return a credential of the other tier. **Two of those three checks were replaced in C4 (§9 below): `purchaseBadge{code}` now signs the code's tier instead of refusing a mismatch, and the replay check went with it. `issueBadge`'s check is untouched, and so is `planTxn`'s guard against crediting a code of one tier to a purchase of another.** The property this entry exists for is unchanged and is now asserted directly rather than through a refusal. - **B7 fix round 1 — a signing failure returns `internal`, not `bad_request`; and a non-empty `badgeExtra` is refused before anything is classified.** The first pass propagated `issueSignedBadge`'s code verbatim, and B4 collapses *every* failure to `BSEBadRequest` (`Credentials.hs:61-62`) — a BBS signing failure included, which is a service fault. `bad_request` is **terminal for the attempted command** (`docs/protocol/badges-rpc.md:64`), so that told the client never to retry a purchase whose code was still valid and still unredeemed, the exact opposite of step 5's stated reason for choosing `internal`. The one genuinely client-caused failure B4 folds into that code — a non-empty `badgeExtra`, which the RPC reserves — is now refused by both handlers up front (`badgeExtraEmpty`), before classification, planning or signing, and before any bucket is debited; everything reaching `resolveIssue`'s signer is therefore the service's own fault and maps to `internal`. B4 itself is untouched: it still discards the underlying error, so the log names only the operation. - **B7 fix round 1 — the plan-then-sign-then-write split is safe because the request loop is single-threaded, and that is now stated as a precondition rather than implied to be handled.** `markCodeRedeemed`'s `redeemed_purchase_id IS NULL` guard and the one-retry `SECodeConflict` path read as if a concurrent redemption were a live scenario. It is not: `processServiceEvents`/`processQueuedRequests` handle one request at a time in a single `forever` thread. The guard is kept — it costs nothing and the code row is also written out of band by B8's operator tooling — but the **ledger has no equivalent**, and that is the real constraint: two overlapping commands on one purchase key would both plan from the same `getLastLedgerEntry` and both append, producing two entries whose `balance_months` derive from the same base (a silently wrong balance) and, for two `issueBadge` calls, two issuances for one period. **Anyone making dispatch concurrent must serialise per purchase key, or add a compare-and-append to the ledger, first.** Deliberately not guarded now: a compare-and-append for a race that cannot occur would be untested defensive code in B1's layer. - **B7 — `purchaseBadge` carrying an `upgrade` is `bad_request`, before the payment is looked at.** `BSCPurchaseBadge.upgrade` is the store one-time upgrade (RPC "Upgrades"), which needs store evidence, and tier upgrades are out of scope (§6). Ignoring the field would consume the code while silently dropping what the client asked for. @@ -1411,16 +1411,19 @@ Append here when a step contradicts this plan: the step id, what was wrong, and - **C3 review round — a pass for a non-active profile silently switched the active user. Fixed.** `startBadgeWorkers` starts a worker for every user from `getUsers`, not just the active one, and the daily timer re-fires each — so once `sendBadgeRequest` is live (C4), a background profile crossing a month boundary would overwrite `currentUser` with itself, changing the app's active profile with nothing having asked. Latent under C3 alone because the stub never issues. Fixed with the same read-then-compare-then-write idiom already used at `Commands.hs:576,1647,4373`: `storeBadgeIssueResponse` now reads `currentUser` and only writes the pass's `User` back when its `userId` is the one already active. The Do bullet above is corrected to state this rather than "writing the `User` it returns to the `currentUser` TVar" unconditionally, which is what produced the bug — that phrasing was written from a single-profile viewpoint. - **C3 review round — the worker loop did not gate on `waitChatStartedAndActivated`. Fixed.** Every other periodic loop in this module gates each iteration on it (`cleanupManager`, `runRelayGroupLinkChecks`, `expireChatItems`); `runBadgeWorker` did not, so after `APISuspendChat` the timer still fired passes that read the store and, once C4 lands, would attempt a signed send through a suspended agent. `lift waitChatStartedAndActivated` now sits at the top of the `forever` body, before the `race_`. - **C3 review round — a shown purchase with no ledger rows stalled silently. Fixed with a log line.** Unreachable via C1's `createPurchase`, which always inserts an opening credit, but nothing signalled the stall if it ever happened. `issueDueBadgePeriod` now `logWarn`s the purchase and user id in that case rather than falling through to `BadgeUnchanged` with no trace. -- **C3 review round — a healed ledger's complete history could write a duplicate issuance row. Fixed.** `badge_issuances` has no uniqueness on `(badge_purchase_id, period_start)`, and `createIssuance` mints a fresh id per call; the "no duplicate issuance from a re-delivered history" argument above covers the append case but not REPLACE-after-heal, where the service returns a complete history whose last entry is a `debit(badge)` the client already holds an issuance for. `Store/Badges.hs` adds `hasIssuanceForPeriod`, checked before every `createIssuance` call. +- **C3 review round — a healed ledger's complete history could write a duplicate issuance row. Fixed.** `badge_issuances` has no uniqueness on `(badge_purchase_id, period_start)`, and `createIssuance` mints a fresh id per call; the "no duplicate issuance from a re-delivered history" argument above covers the append case but not REPLACE-after-heal, where the service returns a complete history whose last entry is a `debit(badge)` the client already holds an issuance for. `Store/Badges.hs` adds `hasIssuanceForPeriod`, checked before the worker's `createIssuance`. **C4's redeem path calls `createIssuance` without it** (`Commands.hs`), and correctly so: it writes the issuance of a purchase row created two statements earlier in the same transaction, which can hold no issuance yet — the check applies where a statement can re-present a period the purchase already has an issuance for, which is the healed-ledger case only. - **C3 review round — the lock ordering that is this step's central risk has no regression test.** `badgeManagerPass` reads the user row, then takes the badge lock and runs `issueDueBadgePeriod`, then releases it before `presentBadgeChange`. This is guaranteed by source shape alone — nothing tests that a concurrent operation on the same profile cannot interleave between the lock's release and `presentUserBadgeToContacts`. `BadgeGate`'s doc comment in `BadgeManagerTests.hs` was also corrected: the gated clock parks a pass after `badgeManagerPass`'s own `getUser` but before `issueDueBadgePeriod` reads the purchase or ledger, not "before it reads any state". - **C3 review round — `APIGetBadgeState` racing `stopChatController`'s worker-map swap can re-insert an uncancelled worker. Recorded, not fixed.** `getAgentWorker` can create and insert a fresh entry into `badgeWorkers` between the map being swapped to empty and the old workers being cancelled; that entry is then never cancelled. Same shape as a pattern already present in the agent's own worker bookkeeping elsewhere in the codebase, not introduced by this step. Left as a known gap: `stopChatController` runs once per process shutdown, and the window is one `getAgentWorker` call wide. - **C4 — `sendBadgeRequest` also takes the `NetworkRequestMode` and the `User`.** The step's signature is `Maybe C.PrivateKeyEd25519 -> BadgeServiceRequest -> CM BadgeServiceResponse`, but the agent's service request is created under an agent user (`aUserId`) and resolves a short link or a SimpleX name under a request mode. Reading the ACTIVE user inside the send would put C3's per-profile pass on whichever profile happens to be active — the same defect class as the `currentUser` write the C3 review round fixed — so the caller states the profile instead: the two commands pass `withUserId`'s user and `processChatCommand`'s `nm`, the worker passes its own pass's user and `NRMBackground`. It is still one send path with three call sites, not a second one. -- **C4 — a redemption code is presented once per tier, because the client cannot know which tier it funds.** The step, core §5 and UX 2.8 all have the RESPONSE state the badge type — and the client does need it stated, since `badge_purchases.initial_badge_type`/`current_badge_type` are `NOT NULL` and a code carries no tier (B3: 20 opaque characters). But B7 added, beyond its own step and for good reason (§9 above), a check that refuses a `purchaseBadge` whose `badgeRequest` names a tier other than the code's with `bad_request`, because `issueSignedBadge` signs the badge info it is handed. The two cannot both hold for a client that does not already know the tier, and no client does: G2's and G3's redeem views are a code field and a paste button, and a code may also come from `codes issue` (B8) or an order the app never opened. C4 therefore presents the code under `supporter`, then under `legend` — `codeBadgeTypes`, the two tiers `codes.badge_type` admits. The probe is bounded and costs nothing but a second round trip on a legend code: the tier check runs before anything is planned, so a refusal writes nothing, leaves the code unredeemed and debits neither throttle bucket (B10 [7.4]), and the service can only ever issue the tier the code funds, so no wrong-tier credential is reachable. **The clean fix is a service one and was not taken here:** `handlePurchaseCode` could sign the CODE's tier, overriding what the request named exactly as it already overrides `badgeExpiry`, which keeps B7's security property (a credential can never exceed its funding) and makes the redemption one request again. That is a change to another step's code and to a mutation-proved security assertion (B10 item 6), so it is recorded for the plan owner rather than made by C4. +- **C4 — the service signs the tier the CODE funds, and the client states nothing.** The step, core §5 and UX 2.8 all have the RESPONSE state the badge type, and the client needs it stated: `badge_purchases.initial_badge_type`/`current_badge_type` are `NOT NULL` and a code carries no tier (B3: 20 opaque characters, with none of the tier in them). B7 had added, beyond its own step, a check refusing a `purchaseBadge` whose `badgeRequest` names a tier other than the code's — which makes code redemption unimplementable for any client that was not told the tier out of band, and no client is: G2's and G3's redeem views are a code field and a paste button, and a code may come from `codes issue` (B8) or from an order the app never opened. The two could not both hold. **Resolved on the service side, in C4's own range**, after an independent review confirmed it: `handlePurchaseCode.redeem` applies `withFundedBadgeType` to the request immediately before `resolveIssue`, so the credential carries the code's tier whatever the request named. The security property B7's check defended is kept in full — a credential can never exceed its funding, because the tier is read from the code's row and never from the request — and it is now asserted directly instead of through a proxy: B10's `testBadgeServiceSignsFundedTier` (renamed from `testBadgeServiceTierMismatchIsBadRequest`) presents a **legend** request over a **supporter** code and pins the credential, the wire ledger and the purchase row as supporter. Proved able to fail: with the override dropped, it reports `expected ("credential tier", BTSupporter) but got ("credential tier", BTLegend)` — the service handing out a signed legend credential for a supporter code, which is exactly the defect the assertion exists to catch. Three things deliberately did NOT change: the override is at this ONE call site and not in `issueSignedBadge`, which `handleIssueBadge` shares; `requestMasterKey` still reads the original request, so the credential stays bound to the client's own master key; and `planTxn`'s `currentBadgeType /= badgeType` guard is untouched, because it compares the existing purchase row's tier to the CODE's and is what stops a legend code crediting a supporter purchase (B10's per-signer bucket test still trips exactly that guard, verified, not assumed). The replay path's tier check was deleted with the refusal it belonged to: it could only ever have refused an honest client repeating a request after a timeout without knowing the tier, which is the case the idempotency rule exists for. `codeBadgeTypes` and the tier probe C4 first shipped are gone; `APIPurchaseBadge` sends exactly one request, whose `badgeInfo.badgeType` is `BTSupporter` because the field is not optional on the wire and nothing reads it. + - **C4 — `sendBadgeRequest` returns its failures as `BSPError internal` and never throws.** An unconfigured `badgeServiceAddress`, a timeout, an agent failure and a response that does not decode are all answers to the request. Both callers already handle a service error — the worker reports it and keeps its state, the commands raise it as `CEBadgeServiceError` — and raising here would hand the worker's pass a chat error of a different shape for the transport half of the same operation. This is also what C3's report asked for ("a timeout must surface as a `BSPError`, not an exception"). -- **C4 — nothing is written when the response cannot be recorded in full.** A credential that fails verification, one carrying no expiry, a statement with no issued period, and a `badgeCredential` with no credential at all each raise `CEBadgeServiceError` and write NOTHING — the payment, purchase, ledger, issuance and shown-badge rows are one transaction and none of them lands. This extends C3's rule for a failed verification to the redeem path's other three malformed shapes: a response we cannot record completely is not one to record partially. The code is consumed in those cases, and the recovery is the same one a lost response has, `codes unredeem` (H2). +- **C4 — nothing is written when the response cannot be recorded in full, and that needed a pre-flight check to be true.** A credential that fails verification, one carrying no expiry, a statement with no issued period, and a `badgeCredential` with no credential at all each raise `CEBadgeServiceError` and write nothing. The first three are checked before the transaction opens; the claim that the transaction itself is all-or-nothing is **not** true of a `Left` from an `ExceptT` store function, and this was a real hole: `withStore` runs `runExceptT` INSIDE `withImmediateTransaction`, so a `Left` returns normally and the transaction **commits** what preceded it. `insertLedgerEntries` can `Left` on an entry type this build cannot store, and in the redeem path it runs after the payment and purchase rows — an unstorable statement would have left an orphan `payments`/`badge_purchases` pair rather than nothing. `Store/Badges.hs` gains `checkStatementEntries`, the pure half of `insertLedgerEntries`' own row conversion, and both C4's `storeRedeemedBadge` and C3's `storeBadgeIssueResponse` call it before opening their transaction; C3's ordering made it unreachable there today, but the check also gives it the badge-error shape every other failure of a pass has, instead of a store error. The two `ExceptT` calls that remain inside C4's transaction, `supersedePurchases` and `setShownPurchase`, can only fail for a purchase that is not this user's — the row created two statements earlier in the same transaction — so the claim now holds for every reachable shape. The code is consumed in all these cases and is recovered with `codes unredeem` (H2), as a lost response is. + - **C4 — `APIPurchaseBadge` answers `CRBadgeState` and emits no event.** Nothing in the plan states its response. `CEvtBadgeChanged` is documented as the worker's ("emitted whenever the badge worker changes a profile's badge state"), and the redeeming client gets the new state in the response, so emitting both would report the same change twice to the one caller that asked for it. - **C4 — the store payment cases of `APIPurchaseBadge` are refused, not ignored.** `BPPApple` and `BPPGoogle` carry the `payments.payment_id` of a row the app's store purchase flow created, and neither that flow nor a writer for that row exists in this plan (§6). Both answer `CEBadgeServiceError internal "badge store payments are not supported"` rather than falling through to a code redemption they are not. +- **C4 — `APIGetBadgeCatalog` takes no lock and de-duplicates nothing, which the badge screens must not lean on.** Each call creates a connection to the service, takes one reply and deletes it, so N concurrent calls are N connections. The command is deliberately unlocked (it names no purchase and writes nothing, and a per-user lock would serialise it behind a redemption for no benefit), so the bound has to come from the callers: **G4 and G5 must not refetch the catalog on every focus event** — fetch on open, and on an explicit refresh, and keep the last result. Recorded here rather than fixed, because the fix belongs where the calls are made. - **C4 — `resolveServiceTarget` is now a top-level function.** It was a `where` clause of `APISendServiceRequest`, and `sendBadgeRequest` needs the same resolution, because a badge service address may be published as a full contact request, a short link or a SimpleX name (B9). One function, two callers, no second resolution. - **C4 — two `BadgeManagerTests` expectations changed.** They asserted C3's stub answer, `badge service error: internal, not implemented`; with the real send path a test controller, which configures no `badgeServiceAddress`, fails before contacting anything and reports `badge service error: internal, badge service address is not configured`. Same assertion, same shape, new message; no test was weakened or removed. - **C4 — the Postgres cross-check was not run for this step.** SQLite-only, `CI` unset: `cabal test --test-options='-m "Supporter badges" -m "Badge service"'`. Nothing in this step is guarded `#if !defined(dbPostgres)` and it adds no SQL of its own — every write goes through C1's store functions — so there is no reason to expect a backend-specific gap, but it has not been exercised against Postgres. diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index d0c83cb73e..bd3b6f2cbf 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -94,7 +94,7 @@ import Simplex.Chat.Library.Internal import Simplex.Chat.Stats import Simplex.Chat.Store import Simplex.Chat.Store.AppSettings -import Simplex.Chat.Store.Badges (NewBadgeIssuance (..), UserBadgePurchase (..), createCodePayment, createIssuance, createPurchase, getLastBadgeLedgerEntry, getShownPurchase, hasIssuanceForPeriod, insertLedgerEntries, setShownPurchase, supersedePurchases) +import Simplex.Chat.Store.Badges (NewBadgeIssuance (..), UserBadgePurchase (..), checkStatementEntries, createCodePayment, createIssuance, createPurchase, getLastBadgeLedgerEntry, getShownPurchase, hasIssuanceForPeriod, insertLedgerEntries, setShownPurchase, supersedePurchases) import Simplex.Chat.Store.ContactRequest import Simplex.Chat.Store.Connections import Simplex.Chat.Store.Delivery @@ -5211,6 +5211,11 @@ unexpectedBadgeResponse cmd r = localBadgeError $ "unexpected badge service resp storePaymentsUnsupported :: Text storePaymentsUnsupported = "badge store payments are not supported" +-- | A statement carrying an entry this build cannot store, reported before any row is written +-- (see 'checkStatementEntries'). +unstorableStatement :: StoreError -> Text +unstorableStatement e = "badge service statement cannot be stored: " <> tshow e + -- | Checks that a credential was signed by a configured issuer key. -- -- It RETURNS its failures instead of throwing, because its three callers need three different @@ -5456,32 +5461,18 @@ sendBadgeRequest :: NetworkRequestMode -> User -> Maybe C.PrivateKeyEd25519 -> B sendBadgeRequest nm user signKey req = asks (badgeServiceAddress . config) >>= \case Nothing -> pure $ badgeRequestFailed "badge service address is not configured" - Just target -> either (badgeRequestFailed . ("badge service request failed: " <>) . tshow) id <$> tryAllErrors (sendRequest target) + Just target -> either (badgeRequestFailed . requestFailed) id <$> tryAllErrors (sendRequest target) where sendRequest target = do cReq <- resolveServiceTarget nm user target respData <- withAgent $ \a -> sendServiceRequestAsync a (aUserId user) cReq Nothing signKey (LB.toStrict $ J.encode req) - pure $ either (badgeRequestFailed . ("invalid badge service response: " <>) . T.pack) id $ J.eitherDecodeStrict' respData + pure $ either (badgeRequestFailed . responseFailed) id $ J.eitherDecodeStrict' respData + -- a sentence first, then the error itself: the apps render an 'internal' code by showing this + -- message (G2), and a bare 'Show' of a 'ChatError' is not something to put in front of a user + requestFailed e = "The badge service could not be reached, and the request was not delivered. Details: " <> tshow e + responseFailed e = "The badge service answered with something this app version cannot read. Details: " <> T.pack e badgeRequestFailed e = BSPError {code = BSEInternal, message = Just e, retryAfter = Nothing} --- | The badge tiers a redemption code can fund, in the order a code is presented under. --- --- __The client cannot know which tier a code funds before it is redeemed.__ A code is 20 opaque --- characters (B3) and carries no tier, the response is what states it (core §5), and no command --- reports a code's tier without redeeming it — yet @purchaseBadge@ refuses a @badgeRequest@ --- naming a tier other than the code's with @bad_request@ (B7, plan §9), because the service --- signs the badge info it is sent. So the code is presented once per tier until the service --- stops refusing it. --- --- The probe is safe and cheap by construction: the tier check runs before anything is planned, --- so a refused presentation writes nothing, leaves the code unredeemed and debits neither --- throttle bucket (B10), and the service can only ever issue the tier the code funds. It costs --- one extra round trip for a legend code and none for a supporter one. These are the two tiers --- @badge_codes.badge_type@ admits (@CHECK (badge_type IN ('supporter','legend'))@); lifetime --- codes are out of scope (plan §6). -codeBadgeTypes :: NonEmpty BadgeType -codeBadgeTypes = BTSupporter :| [BTLegend] - -- | Redeems a code: the keys are minted in memory, the badge lock is held across the send and -- the writes, and the presentation happens after it is released. -- @@ -5510,23 +5501,25 @@ redeemBadgeCode nm user@User {userId} code = do ChatConfig {badgeWebBaseUrl} <- asks config pure CRBadgeState {user = user', badgeState, badgeWebBaseUrl} where - purchaseWithCode purchaseKey purchasePrivKey masterKey = presentCode codeBadgeTypes - where - presentCode (badgeType :| tiers) = - sendBadgeRequest nm user (Just purchasePrivKey) (badgeCodeRequest purchaseKey masterKey badgeType code) >>= \case - BSPBadgeCredential {credential = Just cred, statement} -> pure (cred, statement) - -- the exhausted balance of an issueBadge, which a redemption cannot be: a code - -- credits the months it funds in the same transaction that issues them (B7) - BSPBadgeCredential {credential = Nothing} -> - throwChatError $ localBadgeError "badge service redeemed the code without issuing a credential" - -- the one refusal that is a question about the code rather than an answer about it - BSPError {code = BSEBadRequest} | tier : tiers' <- tiers -> presentCode (tier :| tiers') - BSPError {code = errCode, message, retryAfter} -> - throwChatError CEBadgeServiceError {badgeError = errCode, badgeErrorMessage = message, retryAfter} - r -> throwChatError $ unexpectedBadgeResponse "purchaseBadge" r - -- one transaction: the payment row, the purchase row with the held keys, the statement's - -- ledger rows, the issuance, the slot's supersession, the shown-badge pointer and the - -- profile's own badge columns either all land or none of them do + -- the tier the request names is not the client's to choose: a code carries none, and the + -- service signs the tier the CODE funds whatever this says (B7, plan §9). 'BTSupporter' is + -- what it states, and a legend code still returns a legend credential. + purchaseWithCode purchaseKey purchasePrivKey masterKey = + sendBadgeRequest nm user (Just purchasePrivKey) (badgeCodeRequest purchaseKey masterKey code) >>= \case + BSPBadgeCredential {credential = Just cred, statement} -> pure (cred, statement) + -- the exhausted balance of an issueBadge, which a redemption cannot be: a code + -- credits the months it funds in the same transaction that issues them (B7) + BSPBadgeCredential {credential = Nothing} -> + throwChatError $ localBadgeError "badge service redeemed the code without issuing a credential" + BSPError {code = errCode, message, retryAfter} -> + throwChatError CEBadgeServiceError {badgeError = errCode, badgeErrorMessage = message, retryAfter} + r -> throwChatError $ unexpectedBadgeResponse "purchaseBadge" r + -- Everything the response can be rejected for is checked FIRST, and then one transaction + -- writes the payment row, the purchase row with the held keys, the statement's ledger rows, + -- the issuance, the slot's supersession, the shown-badge pointer and the profile's own badge + -- columns. The order is the contract: a store function's 'Left' does NOT roll the + -- transaction back (see 'checkStatementEntries'), so a rejection reachable from a response + -- must be raised before the first row is written, not from inside. storeRedeemedBadge now purchaseKey purchasePrivKey masterKey cred statement = do -- a credential that is not ours is discarded and nothing at all is written, the statement -- included: a response we cannot verify is not a response to trust the rest of. The @@ -5535,6 +5528,13 @@ redeemBadgeCode nm user@User {userId} code = do (periodStart, periodEnd) <- maybe (throwChatError $ localBadgeError "badge service issued no period for the redeemed code") pure $ issuedBadgePeriod Nothing statement + -- BEFORE the transaction, because a 'Left' inside one does not roll it back: @withStore@ + -- runs the 'ExceptT' inside 'withImmediateTransaction', so an unstorable entry type + -- reaching 'insertLedgerEntries' would COMMIT the payment and purchase rows written above + -- it and leave them orphaned. The two 'ExceptT' calls after it can only fail for a + -- purchase that is not this user's, which is the row created two statements earlier in + -- this very transaction. + either (throwChatError . localBadgeError . unstorableStatement) pure $ checkStatementEntries statement case cred of BadgeCredential {badgeInfo = info@BadgeInfo {badgeType, badgeExpiry = Just expiry}} -> do user' <- withStore $ \db -> do @@ -5560,16 +5560,22 @@ redeemBadgeCode nm user@User {userId} code = do -- | The @purchaseBadge@ request redeeming a code, signed by the purchase key it mints. -- +-- __The badge type is stated but not chosen.__ A code carries no tier (B3), and the client has +-- no way to learn one before redeeming, so the service signs the tier the CODE funds and +-- ignores this field on this command (B7, plan §9); the response is what states the tier, which +-- is what the purchase row is written with. The field is not optional on the wire, so it holds +-- 'BTSupporter'. +-- -- 'badgeExpiry' is absent and 'badgeExtra' empty on the same terms as 'badgeIssueRequest': the -- service sets the expiry itself and refuses a non-empty extra. -badgeCodeRequest :: C.PublicKeyEd25519 -> BadgeMasterKey -> BadgeType -> Text -> BadgeServiceRequest -badgeCodeRequest purchaseKey masterKey badgeType code = +badgeCodeRequest :: C.PublicKeyEd25519 -> BadgeMasterKey -> Text -> BadgeServiceRequest +badgeCodeRequest purchaseKey masterKey code = BadgeServiceRequest { version = currentBadgeVersion, purchaseKey = Just purchaseKey, request = BSCPurchaseBadge - { badgeRequest = BadgeRequest {masterKey, badgeInfo = BadgeInfo {badgeType, badgeExpiry = Nothing, badgeExtra = ""}}, + { badgeRequest = BadgeRequest {masterKey, badgeInfo = BadgeInfo {badgeType = BTSupporter, badgeExpiry = Nothing, badgeExtra = ""}}, payment = SPCode {code}, -- upgrades need store evidence or a receipt, both out of scope (plan §6), and a -- purchase carrying one is refused before its payment is looked at (B7) @@ -5604,10 +5610,10 @@ data BadgeChange -- is stored like any other. storeBadgeIssueResponse :: UTCTime -> User -> UserBadgePurchase -> Maybe BadgeLedgerEntry -> BadgeServiceResponse -> CM BadgeChange storeBadgeIssueResponse now user@User {userId} UserBadgePurchase {badgePurchaseId = pId} heldEntry_ = \case - BSPBadgeCredential {credential = Nothing, statement} -> do + BSPBadgeCredential {credential = Nothing, statement} -> storable statement $ do withStore $ \db -> insertLedgerEntries db pId statement now ledgerChange - BSPBadgeCredential {credential = Just cred, statement} -> + BSPBadgeCredential {credential = Just cred, statement} -> storable statement $ verifyUserBadge cred >>= \case Left e -> badgeFailed e Right () -> case cred of @@ -5638,6 +5644,11 @@ storeBadgeIssueResponse now user@User {userId} UserBadgePurchase {badgePurchaseI r -> BadgeUnchanged <$ eToView (ChatError $ unexpectedBadgeResponse "issueBadge" r) where badgeFailed e = BadgeUnchanged <$ eToView (ChatError $ localBadgeError e) + -- checked BEFORE the transaction opens, because a 'Left' inside one does not roll it back + -- (see 'checkStatementEntries'): every write this pass makes would otherwise commit around + -- an unstorable entry type, and the failure would arrive as a store error rather than as the + -- badge error every other failure of a pass is reported as + storable statement action = either (badgeFailed . unstorableStatement) (const action) $ checkStatementEntries statement -- the ledger the statement left, against the one that was held: nothing else the badge state -- reports comes from the ledger, so an unchanged last entry is an unchanged state ledgerChange = do diff --git a/src/Simplex/Chat/Store/Badges.hs b/src/Simplex/Chat/Store/Badges.hs index b1e7d99925..96d5ad24d9 100644 --- a/src/Simplex/Chat/Store/Badges.hs +++ b/src/Simplex/Chat/Store/Badges.hs @@ -47,6 +47,7 @@ module Simplex.Chat.Store.Badges -- * Ledger getLastBadgeLedgerEntry, + checkStatementEntries, insertLedgerEntries, ) where @@ -543,6 +544,21 @@ getLastBadgeLedgerEntry db badgePurchaseId = do -- complete history every time; only @issueBadge@ honours a cursor. Insertion is therefore -- @ON CONFLICT (entry_uuid) DO NOTHING@ against @idx_badge_ledger_uuid@ — a second delivery of -- the same statement writes nothing and changes nothing, rather than merely not crashing. +-- | Whether every entry of a statement can be stored, without opening a transaction or touching +-- the database. +-- +-- 'insertLedgerEntries' is the only fallible call its callers make with rows already written in +-- the same transaction, and a @Left@ from it does NOT roll them back: @withStore@ runs its +-- 'ExceptT' inside the transaction, so a @Left@ returns normally and the transaction COMMITS +-- what preceded it. A caller therefore asks this first, outside the transaction, and the only +-- failure that reaches 'insertLedgerEntries' proper is one that would also have failed here. +-- +-- It is exactly 'insertLedgerEntries'' own row conversion with the row discarded, so the two +-- cannot disagree about what is storable. +checkStatementEntries :: BadgeStatement -> Either StoreError () +checkStatementEntries BadgeStatement {entries} = + mapM_ (\StatementEntry {entryType} -> encodeLedgerEntryType =<< storedEntryType entryType) entries + insertLedgerEntries :: DB.Connection -> Int64 -> BadgeStatement -> UTCTime -> ExceptT StoreError IO () insertLedgerEntries db badgePurchaseId BadgeStatement {entries, previousEntryId} now = do rows <- liftEither $ mapM entryRow entries diff --git a/tests/Bots/BadgeServiceTests.hs b/tests/Bots/BadgeServiceTests.hs index bd41ff184f..ad8a7aa46a 100644 --- a/tests/Bots/BadgeServiceTests.hs +++ b/tests/Bots/BadgeServiceTests.hs @@ -192,7 +192,7 @@ badgeServiceTests = do it "should serve the cached credential when issueBadge repeats inside the last funded month" testBadgeServiceIssueBadgeCachedInLastFundedMonth it "should return no credential and a zero-balance statement when the balance is exhausted" testBadgeServiceIssueBadgeExhaustedBalance it "should credit a second code to the existing purchase with its own payment and no second issuance" testBadgeServiceSecondCodeSamePurchaseKey - it "should respond bad_request to a badgeRequest naming a tier the funding does not cover, on every path" testBadgeServiceTierMismatchIsBadRequest + it "should sign the tier the code funds whatever tier the request names, and still refuse a tier mismatch on issueBadge" testBadgeServiceSignsFundedTier it "should respond bad_request to a purchase carrying an upgrade, leaving the code unredeemed" testBadgeServiceUpgradeIsBadRequest it "should respond bad_request to a reserved badgeExtra, leaving the code unredeemed" testBadgeServiceBadgeExtraIsBadRequest it "should return only the entries after an asserted cursor, and the full history for an unknown or another purchase's one" testBadgeServiceIssueBadgeCursor @@ -1794,13 +1794,21 @@ testBadgeServiceSecondCodeSamePurchaseKey ps = do purchasePaymentId `shouldBe` Just firstPayment other -> expectationFailure $ "expected two credit entries with distinct payments, got: " <> show other --- B10 item 6, the security assertion of this step: the service signs exactly the content the --- client sent, so a badgeRequest naming a tier the funding does not cover is refused on ALL --- THREE paths -- a fresh redemption, a replay of one, and issueBadge. Without this a supporter --- code buys a signed legend credential, since 'issueSignedBadge' overrides only badgeExpiry. --- The refusal must also leave the code intact: it is redeemed successfully in between. -testBadgeServiceTierMismatchIsBadRequest :: HasCallStack => TestParams -> IO () -testBadgeServiceTierMismatchIsBadRequest ps = do +-- B10 item 6, the security assertion of this step, in the form C4 left it: the tier a credential +-- carries is the CODE's, never the request's. A client cannot know a code's tier before it +-- redeems it -- a code carries none (B3) and the response is what states it (core §5) -- so +-- 'purchaseBadge{code}' signs the tier the funding bought and ignores the one the request names +-- ('withFundedBadgeType', plan §9). The property that replaced the old refusal is asserted +-- directly: a LEGEND request over a SUPPORTER code yields a SUPPORTER credential, a supporter +-- ledger and a supporter purchase row, so nothing a request says can buy a tier its funding did +-- not. Drop the override and this reads back 'legend' on all three. +-- +-- 'issueBadge' is deliberately unchanged: there the tier is the purchase's own +-- 'current_badge_type', which the client HOLDS and must state, so a mismatch is still +-- bad_request -- and that is why the override lives at this one call site and not in +-- 'issueSignedBadge', which both paths share. +testBadgeServiceSignsFundedTier :: HasCallStack => TestParams -> IO () +testBadgeServiceSignsFundedTier ps = do clock <- newTestClock testClockStart signer <- newTestSigner codeRef <- newIORef "" @@ -1808,15 +1816,26 @@ testBadgeServiceTierMismatchIsBadRequest ps = do withBadgeServiceClock ps (readIORef clock) (writeTestBadgeServiceConfig ps) seedCode $ \client bsLink -> do code <- readIORef codeRef sendRequest client bsLink signer (purchaseCodeRequest signer BTLegend code) - expectErrorCode "legend request with a supporter code" client "bad_request" - sendRequest client bsLink signer (purchaseCodeRequest signer BTSupporter code) - _ <- expectCredential "the same code still redeems" client + (cred1, statement) <- expectCredential "legend request with a supporter code" client + let BadgeCredential {badgeInfo = BadgeInfo {badgeType = credentialType}} = cred1 + ("credential tier" :: String, credentialType) `shouldBe` ("credential tier", BTSupporter) + statementShape statement `shouldBe` [(3, 3, "credit payment (no invoiceId)"), (-1, 2, "debit badge")] + -- the ledger the same request wrote is supporter entry by entry (field 5 of StatementEntry, + -- constructed positionally as everywhere else in this file) + let BadgeStatement {entries} = statement + entryTypes = map (\(StatementEntry _ _ _ _ bt _ _ _) -> bt) entries + ("ledger tiers" :: String, entryTypes) `shouldBe` ("ledger tiers", [BTSupporter, BTSupporter]) + -- the replay under the same legend request hands back the very same supporter credential sendRequest client bsLink signer (purchaseCodeRequest signer BTLegend code) - expectErrorCode "legend request replaying a supporter redemption" client "bad_request" + (cred2, _) <- expectCredential "legend request replaying the same redemption" client + cred2 `shouldBe` cred1 sendRequest client bsLink signer (issueRequest signer BTLegend "" unknownEntryUuid) expectErrorCode "issueBadge naming another tier" client "bad_request" - -- exactly what the one successful redemption writes: the three refusals wrote nothing - withServiceDB ps $ \db -> serviceRowCounts db `shouldReturn` (1, 1, 2, 1, 1) + withServiceDB ps $ \db -> do + -- exactly what the one redemption writes: the replay and the issueBadge refusal wrote nothing + serviceRowCounts db `shouldReturn` (1, 1, 2, 1, 1) + [Only purchaseType] <- DB.query_ db "SELECT current_badge_type FROM sx_badge_service_badge_purchases" + ("purchase tier" :: String, purchaseType :: BadgeType) `shouldBe` ("purchase tier", BTSupporter) -- B10 item 7: a purchase carrying an upgrade is refused before the payment is even looked at, so -- the code is not consumed by a request whose upgrade would have been silently dropped.