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 d0d97d0630..24f0fe1f09 100644 --- a/plans/badges-codes/2026-08-21-badges-web-checkout.md +++ b/plans/badges-codes/2026-08-21-badges-web-checkout.md @@ -697,7 +697,7 @@ badgeWorkers :: TMap UserId Worker -- a ChatController field: agent Worker, d - Add a `CLBadge UserId` constructor to `ChatLockEntity` (`Store/Shared.hs:68`), whose derived `Eq` and `Ord` still hold, and give it a branch in `enityLockString` (`Library/Commands.hs:3639-3646`): `CLBadge userId -> "Badge " <> tshow userId`. That case is exhaustive with no wildcard and the build uses `-Werror=incomplete-patterns` (`simplex-chat.cabal:338`), so the new constructor breaks the build until the branch exists. - Define `withBadgeLock :: Text -> UserId -> CM a -> CM a`, `withEntityLock name . CLBadge`, with an `INLINE` pragma, beside the existing wrappers at `Library/Internal.hs:133-139`, and lock every signed badge operation with it. There is no separate lock map: the badge lock is an ordinary entity lock over the shared `entityLocks` map (`Controller.hs:295`), so the `chatLock`-first order is inherited rather than reimplemented, and no new lock order is introduced. - The worker calls `sendBadgeRequest :: Maybe C.PrivateKeyEd25519 -> BadgeServiceRequest -> CM BadgeServiceResponse`, the single send path C4 implements in `Library/Commands.hs`. At this step it is a stub with that signature returning `BSPError` with code `internal` and the message `not implemented`, so the worker compiles and its mechanics are testable; C4 gives it the lazy connection and the signing. -- Per pass, for the shown purchase: re-issue when the balance is positive and the month is unissued — the last ledger entry's `balanceMonths > 0` and `balanceStartTs <= now`, which is `issue`'s own guard and never the balance alone (B2) — by calling `issueBadge`, signed with the purchase's own key and carrying the purchase row's master key unchanged (§9). Apply the response with C1's writers, in one transaction: `insertLedgerEntries` for the statement verbatim, then `createIssuance` for the period the statement's last `debit(badge)` entry implies, with `ledgerEntryId = Nothing` (§9). The purchase row itself does not change on a re-issue, since it is already `issued`; only a new issuance row is written. Verify it with C2's `verifyUserBadge` before the transaction and call `setUserBadge` inside it, writing the `User` it returns to the `currentUser` TVar; a credential that fails verification is discarded and nothing is written. Release the badge lock, then call C2's `presentUserBadgeToContacts` with that `User`, which takes `chatLock`, so the monthly pass never broadcasts while holding a lock. Emit `CEvtBadgeChanged` on change. +- Per pass, for the shown purchase: re-issue when the balance is positive and the month is unissued — the last ledger entry's `balanceMonths > 0` and `balanceStartTs <= now`, which is `issue`'s own guard and never the balance alone (B2) — by calling `issueBadge`, signed with the purchase's own key and carrying the purchase row's master key unchanged (§9). Apply the response with C1's writers, in one transaction: `insertLedgerEntries` for the statement verbatim, then `createIssuance` for the period the statement's last `debit(badge)` entry implies, with `ledgerEntryId = Nothing` (§9). The purchase row itself does not change on a re-issue, since it is already `issued`; only a new issuance row is written. Verify it with C2's `verifyUserBadge` before the transaction and call `setUserBadge` inside it; a credential that fails verification is discarded and nothing is written. **Every user gets a worker (below), so the profile a pass just wrote need not be the active one** — write the `User` it returns to the `currentUser` TVar only when that profile IS the active one, on the read-then-compare-then-write idiom already used at `Commands.hs:576,1647,4373` (§9). Release the badge lock, then call C2's `presentUserBadgeToContacts` with that `User`, which takes `chatLock`, so the monthly pass never broadcasts while holding a lock. Emit `CEvtBadgeChanged` on change. - A response with `credential = Nothing` is not an error: it is the exhausted balance B7 defines. Store the statement's ledger rows, write no issuance, leave the profile's badge as it is, and emit `CEvtBadgeChanged` only if the stored state changed. The pass is not suppressed afterwards: a pass on a zero balance reads the last ledger entry and stops, which is cheap, and suppressing it would need a re-arming signal that nothing sends. - Three things trigger a pass, and nothing else does: - the chat controller start signals every user's worker, beside the other worker starts in `startChatController`'s `start` block (`Library/Commands.hs:250-252`, `startDeliveryWorkers`, `startRelayRequestWorker_`, `startCleanupManager`), which has `users` in hand and so suits a per-user worker. `src/Simplex/Chat.hs:196-198,242-244` is `newChatController` and only initialises the maps; @@ -1407,6 +1407,12 @@ Append here when a step contradicts this plan: the step id, what was wrong, and - **C3 — a badge request that fails is reported to the app.** Neither the step nor core §6 says what to do with a `BSPError` from a pass. It is surfaced with `eToView` as `CEBadgeServiceError`, as the delivery worker surfaces its failures, which is also what makes a pass observable to a test while `sendBadgeRequest` is a stub. - **C3 — `badgeCurrentTime` is proved by C3, not by C5.** C2's entry above says C5 is the first place the override is proved to work. It is proved here: `Bots.BadgeManagerTests` injects a clock that counts and gates the passes, which is what lets the worker tests be deterministic without waiting on `badgePassInterval` or on wall-clock time at all. - **C3 — the Postgres cross-check was not run for this step.** SQLite-only: `cabal test --test-options='-m "Supporter badges" -m "Badge service"'`, `CI` unset. The `--flags=client_postgres` cross-check B10 established is optional per-step and was skipped here rather than run; nothing in this step is guarded `#if !defined(dbPostgres)`, so there is no reason to expect a backend-specific gap, but it has not been exercised against Postgres and that remains open until it is. +- **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 — 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. ## 10. End-to-end verification diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index cfe66771a1..3a192d08d0 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -92,7 +92,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 (..), createIssuance, getLastBadgeLedgerEntry, getShownPurchase, insertLedgerEntries) +import Simplex.Chat.Store.Badges (NewBadgeIssuance (..), UserBadgePurchase (..), createIssuance, getLastBadgeLedgerEntry, getShownPurchase, hasIssuanceForPeriod, insertLedgerEntries) import Simplex.Chat.Store.ContactRequest import Simplex.Chat.Store.Connections import Simplex.Chat.Store.Delivery @@ -5291,6 +5291,7 @@ runBadgeWorker :: UserId -> Worker -> CM () runBadgeWorker userId Worker {doWork} = do interval <- asks $ badgePassInterval . config forever $ do + lift waitChatStartedAndActivated liftIO $ race_ (atomically $ takeTMVar doWork) (threadDelay' $ diffToMicroseconds interval) badgeManagerPass userId `catchAllErrors` eToView @@ -5320,7 +5321,13 @@ issueDueBadgePeriod user@User {userId} = do balance <- assertedBadgeBalance lastEntry resp <- sendBadgeRequest (Just purchasePrivKey) (badgeIssueRequest purchase balance) storeBadgeIssueResponse now user purchase (Just lastEntry) resp - _ -> pure BadgeUnchanged + | otherwise -> pure BadgeUnchanged + -- unreachable via C1's createPurchase, which always inserts an opening credit, but a shown + -- purchase stuck with no ledger row would otherwise stall forever with no signal at all + Just (UserBadgePurchase {badgePurchaseId}, Nothing) -> do + logWarn $ "badge worker: shown purchase " <> tshow badgePurchaseId <> " (user " <> tshow userId <> ") has no ledger entries; nothing to issue" + pure BadgeUnchanged + Nothing -> pure BadgeUnchanged -- | Whether the month the balance would fund is unissued: a positive balance whose coverage -- window has already started. @@ -5432,7 +5439,7 @@ data BadgeChange -- absent credential is the opposite — the exhausted balance the service defines, whose statement -- is stored like any other. storeBadgeIssueResponse :: UTCTime -> User -> UserBadgePurchase -> Maybe BadgeLedgerEntry -> BadgeServiceResponse -> CM BadgeChange -storeBadgeIssueResponse now user UserBadgePurchase {badgePurchaseId = pId} heldEntry_ = \case +storeBadgeIssueResponse now user@User {userId} UserBadgePurchase {badgePurchaseId = pId} heldEntry_ = \case BSPBadgeCredential {credential = Nothing, statement} -> do withStore $ \db -> insertLedgerEntries db pId statement now ledgerChange @@ -5444,12 +5451,20 @@ storeBadgeIssueResponse now user UserBadgePurchase {badgePurchaseId = pId} heldE user' <- withStore $ \db -> do insertLedgerEntries db pId statement now -- the issuance is written only for a statement that carries the period it issued; - -- ledgerEntryId stays absent (see 'issuedBadgePeriod' and plan §9) + -- ledgerEntryId stays absent (see 'issuedBadgePeriod' and plan §9). A healed ledger's + -- complete history can re-present a debit(badge) this purchase already has an + -- issuance for, and nothing dedupes badge_issuances on (purchase, period) the way + -- insertLedgerEntries dedupes the ledger itself, so check before writing a second one. forM_ (issuedBadgePeriod heldEntry_ statement) $ \(periodStart, periodEnd) -> - liftIO . void $ - createIssuance db NewBadgeIssuance {badgePurchaseId = pId, badgeType, periodStart, periodEnd, expiry, ledgerEntryId = Nothing, credential = cred} now + liftIO (hasIssuanceForPeriod db pId periodStart) >>= \exists -> + unless exists . liftIO . void $ + createIssuance db NewBadgeIssuance {badgePurchaseId = pId, badgeType, periodStart, periodEnd, expiry, ledgerEntryId = Nothing, credential = cred} now liftIO $ setUserBadge db user (Just (OwnBadge cred (mkBadgeStatus now (Just True) info))) - asks currentUser >>= atomically . (`writeTVar` Just user') + -- a pass runs for whichever user its worker was started for, which need not be the + -- ACTIVE one (every user gets a worker, C3 §9) — only overwrite currentUser when the + -- profile this pass just updated is the one currently active + activeUserId <- fmap (\User {userId = uId} -> uId) <$> chatReadVar currentUser + when (activeUserId == Just userId) $ chatWriteVar currentUser $ Just user' pure $ BadgeIssued user' -- 'issueSignedBadge' always sets the expiry, so this is a malformed response rather than -- a lifetime credential, and a lifetime badge has no issuance row to write anyway diff --git a/src/Simplex/Chat/Store/Badges.hs b/src/Simplex/Chat/Store/Badges.hs index 41b63dd41c..b1e7d99925 100644 --- a/src/Simplex/Chat/Store/Badges.hs +++ b/src/Simplex/Chat/Store/Badges.hs @@ -43,6 +43,7 @@ module Simplex.Chat.Store.Badges -- * Issuances NewBadgeIssuance (..), createIssuance, + hasIssuanceForPeriod, -- * Ledger getLastBadgeLedgerEntry, @@ -373,6 +374,17 @@ createIssuance db NewBadgeIssuance {badgePurchaseId, badgeType, periodStart, per createdAt = now } +-- | Whether an issuance already exists for this purchase and period start. +-- +-- Nothing in the schema dedupes @badge_issuances@ on @(badge_purchase_id, period_start)@ the way +-- 'insertLedgerEntries' dedupes the ledger on @entry_uuid@: a fresh @issuance_id@ is minted on +-- every 'createIssuance' call. A healed ledger's complete history can re-present the same +-- @debit(badge)@ the client already holds an issuance for, so the caller must check this first. +hasIssuanceForPeriod :: DB.Connection -> Int64 -> UTCTime -> IO Bool +hasIssuanceForPeriod db badgePurchaseId periodStart = + fromOnly . head + <$> DB.query db "SELECT EXISTS (SELECT 1 FROM badge_issuances WHERE badge_purchase_id = ? AND period_start = ?)" (badgePurchaseId, periodStart) + -- Ledger ---------------------------------------------------------------------- -- | @entry_type, entry_credit_type, entry_debit_type, payment_id, charge_id, from_purchase_id, diff --git a/tests/Bots/BadgeManagerTests.hs b/tests/Bots/BadgeManagerTests.hs index 7919d5bf54..16051004f4 100644 --- a/tests/Bots/BadgeManagerTests.hs +++ b/tests/Bots/BadgeManagerTests.hs @@ -17,8 +17,9 @@ -- 'issueDueBadgePeriod' and 'badgeManagerPass' compose them. -- -- __No test waits on 'badgePassInterval'.__ A pass is driven by @\/_badge state@ (which signals --- the worker) and paced by the injected 'badgeCurrentTime', which every pass reads exactly once --- before it reads any state — so the test can count passes and hold one open without sleeping. +-- the worker) and paced by the injected 'badgeCurrentTime', which every pass reads exactly once, +-- before it reads the purchase or ledger it would act on (though 'badgeManagerPass' has already +-- read the user row by then) — so the test can count passes and hold one open without sleeping. module Bots.BadgeManagerTests (badgeManagerTests) where import ChatClient @@ -70,8 +71,9 @@ badgeManagerTests = do it "stores the statement, writes the issuance, sets the profile badge and reports the change" testIssuedCredentialApplied it "discards a credential signed by another key and writes nothing at all" testForeignCredentialRejected it "an exhausted balance stores the statement, writes no issuance and keeps the badge" testExhaustedBalanceApplied - describe "the badge worker" $ + describe "the badge worker" $ do it "collapses the signals that arrive during a pass into one more pass, never a concurrent one" testSignalsDuringPassRunOnePass + it "applies a pass for an inactive profile without switching which profile is active" testInactiveProfilePassDoesNotSwitchActiveUser -- Fixtures -------------------------------------------------------------------- @@ -116,11 +118,13 @@ fixtureEntry entryId changeMonths balanceMonths balanceStartTs entryType = } -- | Counts and paces the badge passes of a controller. Every pass reads 'badgeCurrentTime' --- exactly once, before it reads any state, so 'passes' is the number of passes that have STARTED --- and a pass gets no further until the test grants a permit. +-- exactly once, before it reads the purchase or ledger, so 'passes' is the number of passes that +-- have STARTED and a pass gets no further until the test grants a permit. (One store read — +-- 'badgeManagerPass'\'s own @getUser@ — does happen before the gate; it is not one of the rows +-- these tests seed or assert on, so it cannot race them.) -- -- Tests that apply a response themselves grant none: that parks the pass chat start signals --- before it can read the store, so it can never race their fixtures. +-- before it can read the purchase or ledger, so it can never race their fixtures. data BadgeGate = BadgeGate {passes :: TVar Int, permits :: TVar Int} gatedClock :: BadgeGate -> IO UTCTime @@ -182,10 +186,17 @@ runCM TestCC {chatController} action = runReaderT (runExceptT action) chatContro -- | The pass's second half, composed exactly as 'badgeManagerPass' composes it: the response is -- stored (in production under the per-user badge lock) and the change it made is then presented --- and reported (in production with that lock released). +-- and reported (in production with that lock released). Runs for the currently ACTIVE user. applyIssueResponse :: TestCC -> UserBadgePurchase -> Maybe BadgeLedgerEntry -> BadgeServiceResponse -> IO () -applyIssueResponse cc purchase heldEntry_ resp = do - user <- testUser cc +applyIssueResponse cc purchase heldEntry_ resp = testUser cc >>= \user -> applyIssueResponseFor cc user purchase heldEntry_ resp + +-- | As 'applyIssueResponse', but for an explicit user rather than whichever one happens to be +-- active. Production's 'badgeManagerPass' always fetches the WORKER's own user by id +-- (@withFastStore (\`getUser\` userId)@) rather than reading 'currentUser', so a pass can run for +-- a profile that is not the active one — this is what 'testInactiveProfilePassDoesNotSwitchActiveUser' +-- exercises (plan §9, review round). +applyIssueResponseFor :: TestCC -> User -> UserBadgePurchase -> Maybe BadgeLedgerEntry -> BadgeServiceResponse -> IO () +applyIssueResponseFor cc user purchase heldEntry_ resp = runCM cc $ storeBadgeIssueResponse passNow user purchase heldEntry_ resp >>= presentBadgeChange -- | A credential for the fixture's period, signed by the given issuer key. The master key is the @@ -322,3 +333,34 @@ testSignalsDuringPassRunOnePass ps = do -- and that is the only pass the three signals bought, however many they were reportsNothing alice readTVarIO (passes gate) `shouldReturn` 2 + +-- | Every user gets a badge worker (plan §9 review round), so a pass need not run for the +-- ACTIVE profile. Proves the guard that keeps such a pass from switching which profile is +-- active: without it, applying a credential response for alice's purchase below would leave +-- 'currentUser' pointing at alice even though \"secret\" was made active in between — because +-- production's 'badgeManagerPass' fetches its own user by id rather than through 'currentUser', +-- exactly like 'applyIssueResponseFor' does here. +testInactiveProfilePassDoesNotSwitchActiveUser :: HasCallStack => TestParams -> IO () +testInactiveProfilePassDoesNotSwitchActiveUser ps = do + Right (pk, sk) <- bbsKeyGen + withBadgeChat ps pk $ \_gate alice -> do + -- alice is active when her purchase is created, so it is created under HER userId + aliceUser@User {userId = aliceUserId} <- testUser alice + (purchase, heldEntry) <- setupShownPurchase alice + -- a second profile becomes active; alice's is now the inactive one + alice ##> "/create user secret" + alice <## "user profile: secret" + alice <## "use /p [] to change it" + User {userId = secretUserId} <- testUser alice + cred <- issuedCredential sk purchase + let statement = BadgeStatement {entries = [issuedDebitEntry], previousEntryId = Just heldEntryUuid} + -- the pass runs for ALICE (explicit, as her worker's would), while "secret" stays active + applyIssueResponseFor alice aliceUser purchase (Just heldEntry) (badgeCredentialResponse (Just cred) statement) + -- the event still reports alice's own change, prefixed since she is not the active profile + alice <## "[user: alice] supporter badge 1 (shown): issued, 1 month(s) left, paid through 2026-05-01" + -- alice's own row was written despite her being inactive + storedCredential alice `shouldReturn` cred + -- but the active profile did not move: still "secret", never back to alice + User {userId = activeAfter} <- testUser alice + activeAfter `shouldBe` secretUserId + activeAfter `shouldNotBe` aliceUserId