core: fix cached badge issue in last funded month

apps/simplex-badge-service/src/BadgeService/Service.hs

@@ -660,12 +660,14 @@ data IssuePlan
   = -- | A period to issue: it is signed, then recorded as one @debit(badge)@ entry and one
     -- issuance row. Carries the state @issue@ left, the period start and the period end.
     IssuePeriod LedgerState UTCTime UTCTime
-  | -- | The current month is already issued -- a positive balance whose @balanceStartTs@ a
-    -- previous @issue@ moved past @now@. Its credential is fetched, not signed, and neither a
-    -- @debit(badge)@ entry nor an issuance row is written: that month's pair already exists and
-    -- B2's property 3 keeps them 1:1.
+  | -- | The current month is already issued -- a @balanceStartTs@ a previous @issue@ moved past
+    -- @now@. Its credential is fetched, not signed, and neither a @debit(badge)@ entry nor an
+    -- issuance row is written: that month's pair already exists and B2's property 3 keeps them
+    -- 1:1. This holds whatever the balance is: the month after the LAST funded one is issued is
+    -- both already issued and unfunded, and it is the already-issued half that decides the answer.
     IssueCached
-  | -- | Nothing to issue: the balance is exhausted. Not an error -- the statement shows why.
+  | -- | Nothing to issue: the balance is exhausted AND the month it would cover has not been
+    -- issued. Not an error -- the statement shows why.
     IssueExhausted
 
 -- | An 'IssuePlan' with its credential resolved.
@@ -716,9 +718,23 @@ planLedger now' creditWith wasPaused st0 =
     st2 = maybe st1 (\(_, _, st) -> st) credited
     issuePlan = case issue now' st2 of
       Just (st3, periodStart, periodEnd) -> IssuePeriod st3 periodStart periodEnd
+      -- @issue@ refuses for two independent reasons -- an exhausted balance, and a current month
+      -- that is already issued -- and the two need opposite answers. Ask which one directly
+      -- (@balanceStartTs > now@ is @issue@'s own already-issued guard) rather than inferring it
+      -- from the balance: after the LAST funded month is issued BOTH hold at once, and reading
+      -- the balance alone reports that as exhausted, refusing to hand back a credential the
+      -- service has already signed, stored and delivered. That is the one case RPC §Idempotency
+      -- is about -- C3's worker retrying after a timeout -- and it would lose the user a month
+      -- they paid for (B7 defect, found and fixed by B10; plan §9).
+      --
+      -- @balanceStartTs > now@ can only have been set by a previous @issue@: 'initialLedgerState'
+      -- sets it to @now@, 'credit' to @max balanceStartTs now@, and 'advance' steps it only to
+      -- boundaries at or before @now@. So an issuance covering @now@ always exists here, which is
+      -- what 'resolveIssue' then fetches.
       Nothing -> case st2 of
-        LedgerState {balanceMonths = 0} -> IssueExhausted
-        _ -> IssueCached
+        LedgerState {balanceStartTs = startTs}
+          | startTs > now' -> IssueCached
+          | otherwise -> IssueExhausted
 
 -- | Step 5: the only IO between the pure plan and the write, and the only place a credential is
 -- produced. A fresh period is SIGNED (B4); an already-issued month has its credential FETCHED;

plans/badges-codes/2026-08-21-badges-web-checkout.md

@@ -560,7 +560,7 @@ Keep the existing `sendChatCmd cc (APISendServiceResponse …)` reply path.
 3. Resolve the purchase with `getPurchaseByKey`. If it is absent, which is the normal case since C4 mints a fresh key per redemption, plan its creation for step 6 rather than writing it here; nothing is written before the signature. A repeated key is only produced by a non-standard client: credit the months to that purchase's existing ledger, write no second purchase row, and return `bad_request` if the code's `badge_type` differs from that purchase's, until tier upgrades land (§6).
 4. Compute the prospective ledger state in memory with B2's pure functions: `advance now`, then `credit now months (SCPayment Nothing)`, then `issue now`. A purchase absent in step 3 has no ledger entry to read, so its state is B2's `initialLedgerState now` seeded with the code's `badge_type`. `invoiceId` is absent for code payments (`Badges/Service.hs:162`). `advance` may yield one `debit(lapse)` entry; it belongs to the write set, not to a computation that is discarded.
 
-   `issue` returns `Nothing` in two cases, and the answer also depends on the command. With a zero balance, which only `issueBadge` reaches since every code credits at least one month (B8), go to step 6 if `advance` produced a `debit(lapse)`, writing that entry alone, and otherwise straight to step 7. When step 6 runs, the `statement` is read back inside its transaction; when nothing is written, it is read in a single read transaction. Either way it never shows a balance the database does not hold. With a positive balance the current month is already issued. Fetch its credential with B1's `getIssuanceForPeriod` probed **at `now`**, not at `addMonths (-1) balanceStartTs` (§9): `now` is inside that period because the previous `issue` moved `balanceStartTs` to the start of the next unissued month, which is past `now`, while its own period start is at or before the instant that issue ran; `advance` therefore returns `Nothing` here. For `issueBadge` there is nothing to record, so return it and write nothing (RPC §Idempotency). For `purchaseBadge{code}` the credit must still be recorded, so go to step 6 with the fetched credential in place of a fresh signature and with neither a `debit(badge)` entry nor an issuance row to write, since that month's issuance and its debit already exist and B2 property 3 keeps them 1:1; only the code redemption, the payment row, any `debit(lapse)` and the `credit(payment)` entry are recorded. Neither case reaches step 5.
+   `issue` returns `Nothing` in two cases, and the answer also depends on the command. The two are told apart by **`balanceStartTs > now`** — `issue`'s own already-issued guard — and NOT by the balance (§9, B10): after the last funded month is issued both hold at once, and reading the balance there would refuse a credential the service has already signed and stored. When the month it would cover is NOT already issued the balance is exhausted: go to step 6 if `advance` produced a `debit(lapse)`, writing that entry alone, and otherwise straight to step 7. When step 6 runs, the `statement` is read back inside its transaction; when nothing is written, it is read in a single read transaction. Either way it never shows a balance the database does not hold. Otherwise the current month is already issued, whatever the balance is. Fetch its credential with B1's `getIssuanceForPeriod` probed **at `now`**, not at `addMonths (-1) balanceStartTs` (§9): `now` is inside that period because the previous `issue` moved `balanceStartTs` to the start of the next unissued month, which is past `now`, while its own period start is at or before the instant that issue ran; `advance` therefore returns `Nothing` here. For `issueBadge` there is nothing to record, so return it and write nothing (RPC §Idempotency). For `purchaseBadge{code}` the credit must still be recorded, so go to step 6 with the fetched credential in place of a fresh signature and with neither a `debit(badge)` entry nor an issuance row to write, since that month's issuance and its debit already exist and B2 property 3 keeps them 1:1; only the code redemption, the payment row, any `debit(lapse)` and the `credit(payment)` entry are recorded. Neither case reaches step 5.
 5. Sign the resulting period with B4. **A signing failure returns `internal` and writes nothing**; the code stays unredeemed and the client may retry it.
 6. No write happens before a signature succeeds or step 4 proves one unnecessary. Then open one transaction and write, in order: the `badge_purchases` row if absent, through `createPurchase`; the `payments` row through `createCodePayment`, pointed at by the purchase through `attachPurchasePayment` only when the purchase has no payment yet (§9); the `debit(lapse)` entry `advance` produced in step 4, if any; the `credit(payment)` entry; the `debit(badge)` entry; the issuance row carrying the signed credential; and `redeemed_purchase_id` with `redeemed_at` on the code. A conflict on the code's redemption columns aborts the transaction and re-classifies from step 1.
 
@@ -1373,9 +1373,10 @@ Append here when a step contradicts this plan: the step id, what was wrong, and
 - **B10 — the harness's `now` override did not exist, and B10 built it.** A6's step says `withBadgeService` "also accepts a `now` override, used by B10 and C5", but A6 shipped `newBadgeServiceEnv` with `now = getCurrentTime` hardcoded and no way to reach it from a test — the live service builds its own env in `badgePreStartHook`. B10 adds `BadgeServiceOpts.serviceClock :: IO UTCTime` (the CLI parser has no option for it and always sets `getCurrentTime`, so production is unchanged) and makes `newBadgeServiceEnv` take the clock as a parameter, which also fixes a smaller inconsistency: the two service-wide token buckets were initialised from `getCurrentTime` while every handler read `BadgeServiceEnv.now`, so under an overridden clock their refill origin would have come from a different timeline. The test harness gains `withBadgeServiceClock`, of which the existing `withBadgeServiceConfig` is now the real-clock case. **C5 needs the client-side twin (`badgeCurrentTime`) and should not assume it exists either.**
 - **B10 — the single `unsupported_version` test was NOT replaced, only added to.** The step's "Replace the single `unsupported_version` test with …" was written when that was the file's only test; B5, B6, B7 and B9 have since put 46 more examples in it, and B7's own note above says "B10 replaces the surrounding suite". Nothing was removed or weakened: the 18 new examples were added alongside, and `testBadgeServiceUnsupportedVersion` still asserts the version gate.
 - **B10 — `balance_start_ts` is backdated by moving the injected clock, not by seeding a row through B1.** The step says "with the purchase's `balance_start_ts` backdated one month through B1". A hand-seeded backdated ledger row has no matching `badge_issuances` row, so the second half of the same bullet — "a third call inside the same month returns the cached credential" — would reach `IssueCached` with nothing to fetch and answer `internal`. Advancing `BadgeServiceEnv.now` past a real redemption exercises the same boundary against a self-consistent database, and is what the "No test sleeps" rule points at anyway.
-- **B10 — DEFECT FOUND, NOT FIXED: a zero balance hides an already-issued month.** `planLedger` tells `IssueCached` from `IssueExhausted` by the balance alone (`Service.hs`), but `issue` returns `Nothing` for two different reasons — an exhausted balance, and a month that is already issued. Once the LAST funded month has been issued, both hold, and a repeat `issueBadge` inside that same month answers `credential = Nothing` instead of the credential the service already signed and stored for it. RPC §Idempotency requires the cached credential; C3's worker retrying after a timeout in the final funded month is the reachable case. The fix is to classify by `balanceStartTs > now'` (which is what `issue`'s own guard tests) rather than by `balanceMonths == 0`. B10 is a test step and does not change B7's handler; `testBadgeServiceIssueBadgeSecondPeriod` funds four months so it keeps the *specified* behaviour under test instead of pinning the wrong one. **Whoever owns C3 or the next service step must settle this.**
+- **B10 — a B7 defect found and FIXED here: a zero balance hid an already-issued month.** `planLedger` told `IssueCached` from `IssueExhausted` by the balance alone, but `issue` returns `Nothing` for two independent reasons — an exhausted balance, and a month that is already issued. Once the LAST funded month had been issued both held at once, so a repeat `issueBadge` inside that same month answered `credential = Nothing` instead of the credential the service had already signed, stored and delivered. **Failure mode: C3's worker retries `issueBadge` after a timeout in the final funded month, is told there is no credential, and the user loses a month they paid for** — the exact case RPC §Idempotency exists for. Fixed by classifying on `balanceStartTs > now` (`issue`'s own already-issued guard) instead of `balanceMonths == 0`, which is total over both reasons on every path: `initialLedgerState` sets `balanceStartTs` to `now`, `credit` to `max balanceStartTs now` and `advance` only to boundaries at or before `now`, so a `balanceStartTs` past `now` can only have been set by a previous `issue` and an issuance covering `now` always exists there. B7's step 4 above is corrected in place. This is B7 code changed inside B10's commit range, deliberately: B10 held the reproduction. Pinned by `testBadgeServiceIssueBadgeCachedInLastFundedMonth` (one funded month, issued, then `issueBadge` again at the same instant and ten days later — both must return the cached credential), proved able to fail by reverting the classification; `testBadgeServiceIssueBadgeExhaustedBalance` holds the genuinely-exhausted month after it, and `testBadgeServiceIssueBadgeSecondPeriod` funds four months so the two cases stay separate.
 - **B10 — `SECodeConflict`'s retry path is left untested, deliberately.** B7's own concern: driving it needs two redemptions of one code interleaved between classification and write, and the request loop handles one request at a time. Nothing in B10 pretends to cover it; the one mutation that reached it (a same-key replay reclassified as `RedeemOk`) proved only that the code-row guard fires, not that the retry resolves correctly.
 - **B10 — the Postgres cross-check deferred since A3 was run, and passes.** `--flags=client_postgres` with `-m "Badge service"`: 64 examples, 0 failures (65 minus the one `#if !defined(dbPostgres)` example). Four environment obstacles, none of them code: the flag build reuses `dist-newstyle` and so invalidates the SQLite build in both directions; the socket directory must be short (`/tmp/pgs`, not a long scratchpad path — `sun_path` is 107 bytes); the suite needs **two** roles, `test_chat_user` (owner of `test_chat_db`) and a superuser **`postgres`**, which `Test.hs`'s `createdDropDb` bracket connects as; and `max_connections` must be raised well above the default 100 (30 of 64 examples failed on connection slots until it was 500). The two file-reading assertions are guarded, so the §3 Linkage privacy guard and the no-plaintext-at-rest check run on SQLite only — a Postgres twin over `information_schema` is a worthwhile follow-up.
+- **B10 — the two `#if !defined(dbPostgres)` assertions are a SQLite-only guard, and want a Postgres twin.** The §3 Linkage schema assertion (no table references both `@web_orders` and `@badge_purchases`) and B8's no-plaintext-at-rest check both read a database *file*, so both are guarded — as this step's brief requires, since the Postgres run would otherwise break. The consequence is that the privacy regression guard does not run on the backend a real deployment uses. A twin reading `information_schema.table_constraints`/`key_column_usage` for the first, and `pg_dump`ing the schema-qualified tables for the second, is a small follow-up worth doing before the web-order tables acquire any new column.
 - **B10 — B8's `codes` assertions run through `runAdminCmd` with stdout captured, and inspect the database only through `codes status`.** `runAdminCmd` opens its own store and creates a chat database with no user profile, which the test harness's `withTestChat` reopen cannot read (it requires an active user) — so the row-level checks are made by asking the tool itself: each of the ten printed codes resolves to an unredeemed row, and `codes revoke` reports exactly ten in the batch. The plaintext-at-rest check reads the SQLite file directly and is `#if !defined(dbPostgres)`-guarded, as is the §3 Linkage schema assertion.
 
 ## 10. End-to-end verification

tests/Bots/BadgeServiceTests.hs

@@ -182,6 +182,7 @@ badgeServiceTests = do
   it "should debit the per-signer bucket once per failed redemption and not at all for a success, replay, badgeExtra or tier mismatch" testBadgeServiceFailureDebitsBucketOncePerFailure
   it "should rate_limit a fresh signer once the global failure budget is drained, and let the same code succeed after it refills" testBadgeServiceGlobalFailureBudgetRefills
   it "should issue the second period with debit(lapse) before debit(badge), then serve the cached credential" testBadgeServiceIssueBadgeSecondPeriod
+  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
@@ -1628,6 +1629,38 @@ testBadgeServiceIssueBadgeSecondPeriod ps = do
 badgeCredentialExpiry :: BadgeCredential -> Maybe UTCTime
 badgeCredentialExpiry BadgeCredential {badgeInfo = BadgeInfo {badgeExpiry}} = badgeExpiry
 
+-- The regression guard for the B7 defect B10 found and fixed (plan §9): inside the month that the
+-- LAST funded month paid for, the balance is zero AND the month is already issued, and 'issue'
+-- refuses for both reasons at once. Classifying that by the balance answered @credential = null@
+-- and lost the client a credential the service had already signed, stored and delivered --
+-- exactly the retry-after-a-timeout case RPC §Idempotency exists for, which is C3's worker's
+-- normal failure mode. The right answer is the cached credential, both at the instant of issue
+-- and later in the same month; the month AFTER it is the genuinely exhausted case, which
+-- 'testBadgeServiceIssueBadgeExhaustedBalance' holds.
+testBadgeServiceIssueBadgeCachedInLastFundedMonth :: HasCallStack => TestParams -> IO ()
+testBadgeServiceIssueBadgeCachedInLastFundedMonth ps = do
+  clock <- newTestClock testClockStart
+  signer <- newTestSigner
+  codeRef <- newIORef ""
+  let seedCode = seedTestCodes ps [(BTSupporter, 1, testCodeExpiry)] >>= writeIORef codeRef . head
+  withBadgeServiceClock ps (readIORef clock) (writeTestBadgeServiceConfig ps) seedCode $ \client bsLink -> do
+    code <- readIORef codeRef
+    sendRequest client bsLink signer (purchaseCodeRequest signer BTSupporter code)
+    (cred1, statement1) <- expectCredential "redeem the only funded month" client
+    statementShape statement1 `shouldBe` [(1, 1, "credit payment (no invoiceId)"), (-1, 0, "debit badge")]
+    let req = issueRequest signer BTSupporter "" unknownEntryUuid
+    sendRequest client bsLink signer req
+    (cached, statement2) <- expectCredential "issueBadge in the month just issued" client
+    cached `shouldBe` cred1
+    statementShape statement2 `shouldBe` statementShape statement1
+    -- and ten days later, still inside the same period (which ends 2026-04-10)
+    advanceTestClockSeconds clock (10 * nominalDay)
+    sendRequest client bsLink signer req
+    (cachedLater, statement3) <- expectCredential "issueBadge ten days into the issued month" client
+    cachedLater `shouldBe` cred1
+    statementShape statement3 `shouldBe` statementShape statement1
+  withServiceDB ps $ \db -> serviceRowCounts db `shouldReturn` (1, 1, 2, 1, 1)
+
 -- Brief 7 / B10 item 10: an exhausted balance is not an error -- no credential, and a statement
 -- ending at zero months that says why.
 testBadgeServiceIssueBadgeExhaustedBalance :: HasCallStack => TestParams -> IO ()