From 3d3b410d698daff40d462b71eb0e1bace4033b44 Mon Sep 17 00:00:00 2001 From: spacedandy-agents-simplex <342056592+spacedandy-agents-simplex@users.noreply.github.com> Date: Wed, 21 Oct 2026 18:53:41 +0000 Subject: [PATCH] core: tell the apps when a badge request banks a month without issuing it A pass announced the badge state only when the balance start moved, so a charge granted onto running coverage, or a debit the service wrote, changed months left and paid-through without an event, and the apps kept showing the old renewal date until the screen was reopened. The pass now announces whenever the ledger's last entry is not the one it started from, which a moved balance start implies. Run: 015-badge-fixes, slice 1 --- src/Simplex/Chat/Library/Commands.hs | 3 ++- tests/Bots/BadgeService/BotTests.hs | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index fc8619fa26..231b610b54 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -5903,9 +5903,10 @@ updateUserBadge userId emitted now = do wakeAt = earliestTime [devWakeAt, snoozeAt, stalledAt, heldUntil, reminderAt, badgeBoundary now (shownBadgeCredential user'' p') balance'] failed = failureAfter /= failureBefore subscriptionChanged = kindAfter /= purchaseKind + balanceMoved = entryId balance' /= entryId balance -- written before the event, so the state it reports carries the attempt it leads to withStore' $ \db -> setBadgeNextWake db badgePurchaseId wakeAt - when (retired || issued || failed || subscriptionChanged) $ toView . CEvtBadgeChanged user'' =<< getUserBadgeState user'' + when (retired || balanceMoved || failed || subscriptionChanged) $ toView . CEvtBadgeChanged user'' =<< getUserBadgeState user'' pure wakeAt -- | Warning before a prepaid badge ends is not actionable while topping up cannot credit months without issuing. diff --git a/tests/Bots/BadgeService/BotTests.hs b/tests/Bots/BadgeService/BotTests.hs index 0ad1cc20a9..1a5beab070 100644 --- a/tests/Bots/BadgeService/BotTests.hs +++ b/tests/Bots/BadgeService/BotTests.hs @@ -282,6 +282,7 @@ badgeServiceTests = do it "should have the dev mock credit and renew the plan a subscription names, end one it does not know, and still vouch for a one-time purchase" testMockSubscriptions it "should bank a charge the dev mock reports during coverage, issue it once coverage reaches it, and answer ended after the mock restarts" testStoreChecksDuringCoverage it "should not bank again during coverage a charge the ledger already granted" testStoreChecksDuringCoverageGrantedOnce + it "should announce a month a request banks during coverage, though it issues nothing" testBankedMonthAnnounced badgeBotName :: Text badgeBotName = "SimpleX Badges" @@ -1406,6 +1407,8 @@ testNoCredentialMonthsRanOut ps = alice ##> "/_app activate" alice <## "ok" alice <##. "badge alert: support_ended " + alice <##. "1: supporter, 0 months left" + alice <##. "badge alert: support_ended " issueErrorRow (chatController alice) `shouldReturn` (Nothing, Nothing) -- the debit is the client's now, and the next pass retires the badge on it rows' <- ledgerRows (chatController alice) "badge_ledger" @@ -4563,6 +4566,21 @@ testStoreChecksDuringCoverageGrantedOnce ps = ledgerRows cc "sx_badge_service_badge_ledger" `shouldReturn` ledger rowCount cc "sx_badge_service_subscription_charges" `shouldReturn` 1 +testBankedMonthAnnounced :: HasCallStack => TestParams -> IO () +testBankedMonthAnnounced ps = + withRequestCountingService ps $ \env@BadgeServiceEnv {bsClock, bsClientCfg, bsStore = store} -> + withNewTestChatCfg ps bsClientCfg {badgeDevRequestInterval = Just 600} "alice" aliceProfile $ \alice -> do + (firstStart, rows) <- clientSubscribedMonthly env alice + let t1 = devIntervalStart rows + paidThrough = addMonths 2 firstStart + storeReports store $ subscriptionCheck SSRenewing $ Just (storeCharge "subscr-badge-supporter-month-02" (addUTCTime (-60) t1) 1) {chargeRef = "GPA.banked"} + setClockAt bsClock t1 + alice `send` "/_app activate" + expectLinesWithin 30 alice ["/_app activate", "ok", "1: supporter, 1 months left, paid through " <> day paidThrough] ["subscribed "] + drop 2 . rowChanges <$> ledgerRows (chatController alice) "badge_ledger" `shouldReturn` [(1, 1, dueAtOf rows, Just "charge")] + where + day = formatTime defaultTimeLocale "%Y-%m-%d" + testPurchaseBadge :: HasCallStack => TestParams -> IO () testPurchaseBadge ps = withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClientCfg, bsController = cc} ->