core, plan: fix badge worker active-user leak and suspend gate

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
 

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

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,

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 <name> [<bio>] 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