From f6cbf15963969c008eb35d25751934cde1b8372c Mon Sep 17 00:00:00 2001 From: shum Date: Wed, 26 Aug 2026 06:46:33 +0000 Subject: [PATCH] core, plan: correct badge purchase type references --- .../src/BadgeService/Store.hs | 10 ++++++---- plans/2026-07-31-badges-core-implementation.md | 13 +++++++++++-- .../2026-08-21-badges-web-checkout.md | 4 ++-- src/Simplex/Chat/Badges/Types.hs | 14 +++++++++++--- src/Simplex/Chat/Controller.hs | 6 +++--- src/Simplex/Chat/Library/Commands.hs | 2 +- src/Simplex/Chat/Store/Badges.hs | 15 +++++++++------ src/Simplex/Chat/Terminal/Main.hs | 3 ++- 8 files changed, 45 insertions(+), 22 deletions(-) diff --git a/apps/simplex-badge-service/src/BadgeService/Store.hs b/apps/simplex-badge-service/src/BadgeService/Store.hs index cfd15558c6..3f56342a9a 100644 --- a/apps/simplex-badge-service/src/BadgeService/Store.hs +++ b/apps/simplex-badge-service/src/BadgeService/Store.hs @@ -143,10 +143,12 @@ withServiceTransaction st action = -- Purchases and payments ----------------------------------------------------- --- | The service's own projection of a @badge_purchases@ row. The shared 'Types.BadgePurchase' --- carries client-only columns (@user_id@, @purchase_priv_key@, alert bookkeeping) that only --- exist on the client's own table (added by the client-only @20260731_user_badges@ --- migration); the service's table has just the columns 'badgeSchema' creates. +-- | The service's own projection of a @badge_purchases@ row. The single shared purchase record +-- core §3 drafted as @Badges.Types.BadgePurchase@ carried client-only columns (@user_id@, +-- @purchase_priv_key@, alert bookkeeping) that only exist on the client's own table (added by +-- the client-only @20260731_user_badges@ migration); the service's table has just the columns +-- 'badgeSchema' creates. That draft is gone: the client's half is +-- 'Simplex.Chat.Store.Badges.UserBadgePurchase' and this is the service's. data BadgePurchaseRow = BadgePurchaseRow { badgePurchaseId :: Int64, purchaseKey :: C.PublicKeyEd25519, diff --git a/plans/2026-07-31-badges-core-implementation.md b/plans/2026-07-31-badges-core-implementation.md index c8f45deb2d..fa0a29337c 100644 --- a/plans/2026-07-31-badges-core-implementation.md +++ b/plans/2026-07-31-badges-core-implementation.md @@ -81,13 +81,22 @@ The protocol entry (`StatementEntry`, §4): `entryId`, `changeMonths`, `balanceM Domain types — `src/Simplex/Chat/Badges/Types.hs`. Records: -- `BadgePurchase` +- `BadgePurchase` — **superseded, and the type no longer exists.** One record could not describe + both sides: the client's table has `user_id`/`purchase_priv_key` that the service's has not, + and the draft's `priceId`/`offerId`/`credential` are columns of neither. It became three types — + `Simplex.Chat.Store.Badges.UserBadgePurchase` (the client row, secrets included), + `BadgeService.Store.BadgePurchaseRow` (the service row) and `UserBadge` below (the API + projection, no secrets, the one that crosses the FFI). See §9 of + `plans/badges-codes/2026-08-21-badges-web-checkout.md`, entries C1 and C2. - `BadgePayment` - `BadgeLedgerEntry` - `BadgeCharge` - `BadgeIssuance` - `BadgeAlert` -- `UserBadgeState` +- `UserBadge` — one badge as the badge surfaces render it; added by C2 in place of the deleted + `BadgePurchase` +- `UserBadgeState` — C2 trimmed it to `badges`/`shownBadgeId`; `payments`, `renewsAt`, `willRenew` + and `alert` are unimplemented and were removed rather than shipped permanently empty Id newtypes: 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 3bb964b96c..7d2ae42648 100644 --- a/plans/badges-codes/2026-08-21-badges-web-checkout.md +++ b/plans/badges-codes/2026-08-21-badges-web-checkout.md @@ -664,7 +664,7 @@ Phase C ends with a chat client that can redeem a code minted by B8 and show the | APIPurchaseBadge {userId :: UserId, payment :: BadgePurchasePayment} -- /_badge purchase ``` -- Responses `CRBadgeState` and `CRBadgeCatalog`; event `CEvtBadgeChanged`; error `CEBadgeServiceError {badgeError, badgeErrorMessage, retryAfter}` for the inline redeem errors (UX §2.8). `retryAfter` is `Maybe Word32`, populated by B5's `rate_limited`. The message field is NOT `message`: a record field has one type across a whole data type and `ChatErrorType.message` is already `String` in six constructors (§9). +- Responses `CRBadgeState` and `CRBadgeCatalog`; event `CEvtBadgeChanged`; error `CEBadgeServiceError {badgeError, badgeErrorMessage, retryAfter}` for the inline redeem errors (UX §2.8). `retryAfter` is `Maybe Word32`, populated by B5's `rate_limited`. The message field is NOT `message`: a record field has one type across a whole data type and `ChatErrorType.message` is already `String` in 15 constructors (§9). - `CRBadgeState` carries the shown badge's paid-through date, `addMonths balanceMonths balanceStartTs` over the last ledger entry, using B2's `Simplex.Chat.Badges.Months`; the clamping rule has one implementation and the client does not restate it. G6 renders it in place of `stubBillingDate()` and its Swift equivalent. UX §2.11 requires the paid-through date and forbids the phrase "badge valid until", so the credential expiry is never shown. - `CRBadgeState` also carries `badgeWebBaseUrl`, filled by this step's `APIGetBadgeState` handler from `ChatConfig`. `ChatConfig` is not readable from Kotlin or Swift, so the site URL travels in a response rather than through the FFI, and it rides on the badge-state response, which is a local read, so the browser hand-off does not depend on the service being reachable. - Parsers in `chatCommandP`, rendering in `View.hs`. @@ -1395,7 +1395,7 @@ Append here when a step contradicts this plan: the step id, what was wrong, and - **C1 — deleting a stale ledger row could in principle violate `badge_issuances.entry_id`'s foreign key.** The REPLACE path deletes `badge_ledger` rows the service no longer holds, and `badge_issuances.entry_id REFERENCES badge_ledger` has no `ON DELETE` clause. Unreachable today, because nothing in this plan writes a non-NULL `entry_id` on the client (`NewBadgeIssuance.ledgerEntryId` exists to mirror the service's record and C3 passes `Nothing`), and it can only arise if the service both drops an already-issued entry and the client had linked an issuance to it. **For C3**, which decides whether to link issuances to local ledger rows at all: if it does, the REPLACE path must null those references before deleting. - **C1 — `payments.provider` is still written as a bare `'code'` literal on both sides.** `PaymentProvider` (`PaymentService/Types.hs:36`) has no `TextEncoding`, so `Store/Badges.hs` repeats `BadgeService/Store.hs`'s `codePaymentProviderText`. Two literals, one spelling, in two different databases that are never compared. **For D0/E2/F1**, as that entry already says: the instance should be added when a second provider needs writing. - **C2 — `UserBadgeState` is reshaped and the draft `BadgePurchase` is deleted.** C1's entry above left this to C2. `Badges/Types.BadgePurchase` could not be the API shape: it carries `purchasePrivKey` and `masterKey`, and neither may cross the FFI (the private key signs `issueBadge`; the master key is the unlinkability secret), quite apart from the three fields C1 named. `UserBadgeState.badges` is now `[UserBadge]`, a new record holding only what the client can read and the app may see — `badgePurchaseId`, `badgeType`, `status`, `monthsLeft`, `paidThrough`, `createdAt`. `UserBadgeState` keeps `badges` and `shownBadgeId` and loses `payments`, `renewsAt`, `willRenew` and `alert`: nothing in this plan can fill them (alerts, subscriptions and renewals are §6), and a field that is permanently `Nothing`/`[]`/`False` documents a feature that does not exist. `paidThrough` is per badge rather than also at the top level, so the shown badge's paid-through date has ONE source; the app resolves it through `shownBadgeId`. The draft `BadgePurchase` is deleted rather than left unused — its row half is C1's `UserBadgePurchase` and its API half is `UserBadge` — which also removes the `import Simplex.Chat.Badges hiding (BadgePurchase (..))` clash with the unrelated `Simplex.Chat.Badges.BadgePurchase` (the payment-proof sum, which is in use). `badges` holds at most one entry today: `Store/Badges.hs` (unchanged, per the step) exposes only `getShownPurchase`, and with the paid slot the only slot in use the shown purchase IS the profile's badge. -- **C2 — the error's message field is `badgeErrorMessage :: Maybe Text`, and `retryAfter` is `Maybe Word32`.** The step and core §5 both write `CEBadgeServiceError {badgeError, message, retryAfter}`. `message` is not expressible: a Haskell record field has one type across a whole data type, and `ChatErrorType.message` is already `String` in `CECommandError`, `CEGroupInternal`, `CEFileNotFound`, `CEFileAlreadyReceiving`, `CEInternalError` and others. Reusing it as `String` would have meant mapping the wire's absent message to `""`; the field is named apart instead and keeps the wire's `Maybe`. `retryAfter` is `Word32` rather than core §5's `Int` to match `BSPError.retryAfter`, which is its only source, so C4 needs no conversion. Both appear in the regenerated `TYPES.md`, `types.ts` and `_types.py`. +- **C2 — the error's message field is `badgeErrorMessage :: Maybe Text`, and `retryAfter` is `Maybe Word32`.** The step and core §5 both write `CEBadgeServiceError {badgeError, message, retryAfter}`. `message` is not expressible: a Haskell record field has one type across a whole data type, and `ChatErrorType.message` is already `String` in **15** of that type's constructors (`CEInvalidChatMessage`, `CEGroupInternal`, `CEFileNotFound`, `CEFileAlreadyReceiving`, `CEFileCancelled`, `CEFileCancel`, `CEFileWrite`, `CEFileRcvChunk`, `CEFileInternal`, `CECommandError`, `CEAgentCommandError`, `CEInvalidFileDescription`, `CERelayTestError`, `CEInternalError`, `CEException`). Reusing it as `String` would have meant mapping the wire's absent message to `""`; the field is named apart instead and keeps the wire's `Maybe`. `retryAfter` is `Word32` rather than core §5's `Int` to match `BSPError.retryAfter`, which is its only source, so C4 needs no conversion. Both appear in the regenerated `TYPES.md`, `types.ts` and `_types.py`. - **C2 — the new commands go in `undocumentedCommands`, not `cliCommands`, and neither list documents anything.** The step said to add them to `cliCommands` "so they reach `bots/api/COMMANDS.md` and both generated clients". Both lists are exemptions from `tests/APIDocs.hs:76`'s completeness check; a command reaches `COMMANDS.md` and the clients only through `chatCommandsDocs`. `cliCommands` holds the terminal-syntax commands and `undocumentedCommands` the `API*` ones, so the three `API*` commands go in the latter. The only regenerated files are therefore `bots/api/TYPES.md`, `types.ts` and `_types.py`, all three changed by `CEBadgeServiceError`/`BadgeServiceErrorCode` alone; `COMMANDS.md` and `EVENTS.md` are unchanged, and the step's Files line is corrected accordingly. Documenting the three commands properly belongs with C4, when they do something. - **C2 — the step's last manual check contradicts the step.** "`/_badge catalog 1` reaching the service at the overridden address" cannot hold while the same step stubs `APIGetBadgeCatalog` with `not implemented`. What was checked instead: `--badge-service-address` parses a contact link and is rejected when it is not one, `/_badge catalog 1` and `/_badge purchase 1 ` both return the stub `CEBadgeServiceError`, and the issuer-key override is exercised end to end through `/badge add` — a credential signed by a locally generated key at index 1 verifies with `--badge-issuer-key 1:KEY` and fails without it ("does not verify against configured key"), while a credential at index 2 fails with "unknown badge key index" when only index 1 is overridden, which is what proves REPLACE rather than merge. Verify corrected above. **C4 owns the reaching-the-service check.** - **C2 — `addUserBadge` reads `badgeCurrentTime`, not `getCurrentTime`.** The step introduces the field for C3 and C4 only. Wiring the one existing client-side badge clock read through it too costs nothing (the default is `getCurrentTime`, so `AddBadge` is unchanged) and means the field is load-bearing from the step that adds it rather than from the step that first needs to override it. **It has no behavioural test yet** — nothing in this step can observe a different clock — so C5 is the first place the override is proved to work. diff --git a/src/Simplex/Chat/Badges/Types.hs b/src/Simplex/Chat/Badges/Types.hs index 8842f50864..985d0acb56 100644 --- a/src/Simplex/Chat/Badges/Types.hs +++ b/src/Simplex/Chat/Badges/Types.hs @@ -209,9 +209,17 @@ data BadgeAlert = BadgeAlert -- network. -- -- @monthsLeft@ and @paidThrough@ come from the purchase's LAST ledger entry: the balance the --- client believes it holds, and 'Simplex.Chat.Badges.Months.addMonths' applied to it. Both are --- absent from a purchase with no ledger entry yet. @paidThrough@ is deliberately not the --- credential's expiry (UX §2.11 forbids presenting one as the other). +-- client believes it holds, and 'Simplex.Chat.Badges.Months.addMonths' applied to it. +-- +-- __They differ on a purchase with no ledger entry.__ @paidThrough@ is 'Nothing' — no entry, no +-- date — while @monthsLeft@ is @0@, which is indistinguishable from a balance that has run out. +-- Only @paidThrough@ separates "nothing is known yet" from "nothing is left", so a caller +-- rendering both must branch on @paidThrough@, not on @monthsLeft == 0@. @monthsLeft@ is not a +-- 'Maybe' because every other reader wants a number, and the one distinction it would carry is +-- already carried next to it. +-- +-- @paidThrough@ is deliberately not the credential's expiry (UX §2.11 forbids presenting one as +-- the other). data UserBadge = UserBadge { badgePurchaseId :: Int64, badgeType :: BadgeType, diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 427ab7bf0d..8f54a99515 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -1562,9 +1562,9 @@ data ChatErrorType -- @retryAfter@ is seconds, populated by the service's @rate_limited@. A failure with no -- service involved (a credential that does not verify) uses 'BSEInternal'. -- - -- The message field is named apart from the @message :: String@ that the rest of this union - -- carries: a record field has one type across a whole data type, and this one is the wire's - -- optional 'Text'. + -- The message field is named apart from the @message :: String@ that 15 other constructors + -- of this union carry: a record field has one type across a whole data type, and this one is + -- the wire's optional 'Text'. CEBadgeServiceError {badgeError :: BadgeServiceErrorCode, badgeErrorMessage :: Maybe Text, retryAfter :: Maybe Word32} | CEInternalError {message :: String} | CEException {message :: String} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 1c6593c506..cd63de70b2 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -5205,7 +5205,7 @@ presentUserBadgeToContacts :: User -> CM () presentUserBadgeToContacts user' = do cxt <- asks $ mkStoreCxt . config contacts <- withFastStore' $ \db -> getUserContacts db cxt user' - withChatLock "addUserBadge" $ forM_ contacts $ \ct -> + withChatLock "presentUserBadgeToContacts" $ forM_ contacts $ \ct -> case contactSendConn_ ct of Right conn | not (connIncognito conn) -> do diff --git a/src/Simplex/Chat/Store/Badges.hs b/src/Simplex/Chat/Store/Badges.hs index c467b0c2a7..41b63dd41c 100644 --- a/src/Simplex/Chat/Store/Badges.hs +++ b/src/Simplex/Chat/Store/Badges.hs @@ -100,12 +100,15 @@ import Database.SQLite.Simple.QQ (sql) -- | The client's own projection of a @badge_purchases@ row: exactly its columns, with the -- client-only @user_id@ and @purchase_priv_key@ that the service's table does not have. -- --- This is deliberately NOT 'Simplex.Chat.Badges.Types.BadgePurchase'. That record declares --- @priceId@, @offerId@ and @credential@, none of which is a column of this table: the price and --- offer of a purchase live on its @badge_invoices@ rows (one per invoice, so not a function of --- the purchase), and the credential lives on its @badge_issuances@ rows (one per period). A row --- type that had to invent three fields to be constructed would report a purchase the database --- does not hold. 'BadgeService.Store.BadgePurchaseRow' is the same decision on the service side. +-- This is deliberately NOT the single shared purchase record core §3 drafted as +-- @Badges.Types.BadgePurchase@. That draft declared @priceId@, @offerId@ and @credential@, none +-- of which is a column of this table: the price and offer of a purchase live on its +-- @badge_invoices@ rows (one per invoice, so not a function of the purchase), and the credential +-- lives on its @badge_issuances@ rows (one per period). A row type that had to invent three +-- fields to be constructed would report a purchase the database does not hold. +-- 'BadgeService.Store.BadgePurchaseRow' is the same decision on the service side. C2 deleted the +-- draft once both row types existed and split its API half off as +-- 'Simplex.Chat.Badges.Types.UserBadge', which carries no secrets and so may cross the FFI. data UserBadgePurchase = UserBadgePurchase { badgePurchaseId :: Int64, userId :: UserId, diff --git a/src/Simplex/Chat/Terminal/Main.hs b/src/Simplex/Chat/Terminal/Main.hs index a8be8d0d49..f544d4fd60 100644 --- a/src/Simplex/Chat/Terminal/Main.hs +++ b/src/Simplex/Chat/Terminal/Main.hs @@ -4,6 +4,7 @@ module Simplex.Chat.Terminal.Main where +import Control.Applicative ((<|>)) import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.STM import Control.Monad @@ -37,7 +38,7 @@ simplexChatCLI cfg server_ = do badgeOptsOverride :: ChatConfig -> ChatOpts -> ChatConfig badgeOptsOverride cfg ChatOpts {optBadgeServiceAddress, optBadgeWebUrl, optBadgeIssuerKeys} = cfg - { badgeServiceAddress = maybe (badgeServiceAddress cfg) Just optBadgeServiceAddress, + { badgeServiceAddress = optBadgeServiceAddress <|> badgeServiceAddress cfg, badgeWebBaseUrl = fromMaybe (badgeWebBaseUrl cfg) optBadgeWebUrl, badgePublicKeys = if null optBadgeIssuerKeys then badgePublicKeys cfg else M.fromList optBadgeIssuerKeys }