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

@@ -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.

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} ->