From df7cf40fe64b2e548ca619075d210ac411748ec1 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Wed, 26 Aug 2026 15:27:06 +0000
Subject: [PATCH] core: correct badge comments and one query style

---
 src/Simplex/Chat/Badges/Types.hs     |  7 +++++++
 src/Simplex/Chat/Library/Commands.hs | 14 ++++++++++++--
 src/Simplex/Chat/Store/Badges.hs     |  7 ++++++-
 3 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/src/Simplex/Chat/Badges/Types.hs b/src/Simplex/Chat/Badges/Types.hs
index 985d0acb56..d719209d4d 100644
--- a/src/Simplex/Chat/Badges/Types.hs
+++ b/src/Simplex/Chat/Badges/Types.hs
@@ -218,6 +218,13 @@ data BadgeAlert = BadgeAlert
 -- 'Maybe' because every other reader wants a number, and the one distinction it would carry is
 -- already carried next to it.
 --
+-- __@monthsLeft@ excludes the month currently issued.__ It is the balance AFTER the running
+-- period was debited, and 'Simplex.Chat.Library.Commands.badgePaidThrough' adds that balance to
+-- a 'balanceStartTs' a successful issue moved to the END of that period — so a freshly redeemed
+-- 3-month code reads as @monthsLeft = 2@ with @paidThrough@ three months out. The pair is
+-- consistent and both figures are right; it is @monthsLeft@ ALONE that reads as if a month had
+-- been lost. A surface showing one number should show @paidThrough@ (G4, G5).
+--
 -- @paidThrough@ is deliberately not the credential's expiry (UX §2.11 forbids presenting one as
 -- the other).
 data UserBadge = UserBadge
diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs
index c6862fa36d..9ebb9187ee 100644
--- a/src/Simplex/Chat/Library/Commands.hs
+++ b/src/Simplex/Chat/Library/Commands.hs
@@ -5300,6 +5300,11 @@ startBadgeWorkers = mapM_ $ \User {userId} -> void $ getBadgeWorker True userId
 --
 -- The timer is this loop's own wait rather than a shared scheduler, and it is 'threadDelay''
 -- rather than 'timeout' because a day in microseconds does not fit an 'Int' on 32-bit builds.
+--
+-- Every iteration gates on 'waitChatStartedAndActivated' first, as 'cleanupManager',
+-- 'runRelayGroupLinkChecks' and 'expireChatItems' do: after @APISuspendChat@ the timer keeps
+-- firing, and without the gate a pass would read the store and send a signed request through a
+-- suspended agent.
 runBadgeWorker :: UserId -> Worker -> CM ()
 runBadgeWorker userId Worker {doWork} = do
   interval <- asks $ badgePassInterval . config
@@ -5336,8 +5341,13 @@ issueDueBadgePeriod user@User {userId} = do
           resp <- sendBadgeRequest NRMBackground user (Just purchasePrivKey) (badgeIssueRequest purchase balance)
           storeBadgeIssueResponse now user purchase (Just lastEntry) resp
       | 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
+    -- unreachable, but NOT because a purchase is created with an opening credit — nothing in this
+    -- milestone writes one (plan §9), and 'createPurchase' inserts the purchase row alone.
+    -- 'redeemBadgeCode' is the only writer of a purchase row and of @shown_badge_id@, it refuses a
+    -- statement carrying no issued period BEFORE it writes anything, and it inserts that
+    -- statement's entries in the same transaction as the purchase row — so a shown purchase always
+    -- has ledger rows. A shown purchase stuck with none 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
diff --git a/src/Simplex/Chat/Store/Badges.hs b/src/Simplex/Chat/Store/Badges.hs
index eebce0ce57..e4325e1f41 100644
--- a/src/Simplex/Chat/Store/Badges.hs
+++ b/src/Simplex/Chat/Store/Badges.hs
@@ -384,7 +384,12 @@ createIssuance db NewBadgeIssuance {badgePurchaseId, badgeType, periodStart, per
 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)
+    <$> DB.query
+      db
+      [sql|
+        SELECT EXISTS (SELECT 1 FROM badge_issuances WHERE badge_purchase_id = ? AND period_start = ?)
+      |]
+      (badgePurchaseId, periodStart)
 
 -- Ledger ----------------------------------------------------------------------