core, plan: correct badge purchase type references

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,

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:
 

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 <userId> <json>
   ```
 
-- 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 <json>` 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.

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,

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}

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

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,

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
     }