core: let a dev build ask the badge service on an interval

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

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,

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