From ccf136ca13ead27117c811e6397290799f0cfbbf Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 20 Oct 2026 19:03:53 +0400
Subject: [PATCH] core: let a dev build ask the badge service on an interval

---
 src/Simplex/Chat.hs                  |  1 +
 src/Simplex/Chat/Controller.hs       |  3 +++
 src/Simplex/Chat/Library/Commands.hs | 12 ++++++++----
 3 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index d8b3f08b4e..033bf31837 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -76,6 +76,7 @@ defaultChatConfig =
       badgeRetryInterval = RetryInterval {initialInterval = 30_000000, increaseAfter = 0, maxInterval = 3600_000000},
       badgeConsecutiveRetries = 3,
       badgeDevRequests = False,
+      badgeDevRequestInterval = Nothing,
       confirmMigrations = MCConsole,
       -- this property should NOT use operator = Nothing
       -- non-operator servers can be passed via options
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index a782586a4a..459a476abd 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -158,6 +158,9 @@ data ChatConfig = ChatConfig
     badgeConsecutiveRetries :: Int,
     -- set only by builds for a dev badge service: allows /_badge request, sent off the shared schedule
     badgeDevRequests :: Bool,
+    -- Local testing only: the badge worker treats a request as due this often, instead of near the
+    -- credential's expiry, so a renewal can be watched without waiting weeks.
+    badgeDevRequestInterval :: Maybe NominalDiffTime,
     confirmMigrations :: MigrationConfirmation,
     presetServers :: PresetServers,
     shortLinkPresetServers :: NonEmpty SMPServer,
diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs
index 2eac4b473f..2a9fa7fed8 100644
--- a/src/Simplex/Chat/Library/Commands.hs
+++ b/src/Simplex/Chat/Library/Commands.hs
@@ -5773,10 +5773,13 @@ updateUserBadge userId emitted now = do
             PKPrepaid | L.paidThrough balance <= now -> retireBadge user p
             _ -> pure False
           latest <- withStore' (`getLatestIssuedCredential` badgePurchaseId)
-          let due = not retiredBefore && badgeRequestDue now purchaseKind (shownBadgeCredential user p) latest balance
+          devRequestInterval <- asks $ badgeDevRequestInterval . config
+          let due = not retiredBefore && (isJust devRequestInterval || badgeRequestDue now purchaseKind (shownBadgeCredential user p) latest balance)
               -- a due month waits for the wake the last pass set, so a request that issued nothing is not repeated at every activation;
-              -- a wake further than a stall away was not set by such a request, but by a device clock set back since
-              heldUntil = if due then find (\w -> w > now && w <= addUTCTime badgeStalledInterval now) nextWakeAt else Nothing
+              -- a wake further than this was not set by such a request, but by a device clock set back since.
+              -- A dev interval reuses the same guard, as it needs the same thing: no second request within it.
+              askNoSoonerThan = fromMaybe badgeStalledInterval devRequestInterval
+              heldUntil = if due then find (\w -> w > now && w <= addUTCTime askNoSoonerThan now) nextWakeAt else Nothing
               requestDue = due && isNothing heldUntil
           (balance', subscription_) <-
             if requestDue
@@ -5822,7 +5825,8 @@ updateUserBadge userId emitted now = do
               reminderAt = case kindAfter of
                 PKSubscription s -> find (> now) $ renewalReminderAt s balance'
                 PKPrepaid -> Nothing
-              wakeAt = earliestTime [snoozeAt, stalledAt, heldUntil, reminderAt, badgeBoundary now (shownBadgeCredential user'' p') balance']
+              devWakeAt = (`addUTCTime` now) <$> devRequestInterval
+              wakeAt = earliestTime [devWakeAt, snoozeAt, stalledAt, heldUntil, reminderAt, badgeBoundary now (shownBadgeCredential user'' p') balance']
               failed = failureAfter /= failureBefore
               subscriptionChanged = kindAfter /= purchaseKind
           -- written before the event, so the state it reports carries the attempt it leads to