From ca4c70c93ec5cd1300c3899816cd5238dd8a22ae Mon Sep 17 00:00:00 2001 From: spacedandy-agents-simplex <342056592+spacedandy-agents-simplex@users.noreply.github.com> Date: Thu, 22 Oct 2026 08:11:12 +0000 Subject: [PATCH] core: test that an App Store change to a lower tier waits for the renewal A Supporter charge handed over while Legend is shown is answered from the record and sends nothing, and the renewal check grants Supporter, shown once the Legend credential expires; a record an older build held for a lower tier settles with no request. Both fail if every change of tier is sent at once again. Run: 016-tier-change-direction --- tests/Bots/BadgeService/BotTests.hs | 69 ++++++++++++++++++++++++++++- 1 file changed, 68 insertions(+), 1 deletion(-) diff --git a/tests/Bots/BadgeService/BotTests.hs b/tests/Bots/BadgeService/BotTests.hs index a692fe0ae6..4b6e2431be 100644 --- a/tests/Bots/BadgeService/BotTests.hs +++ b/tests/Bots/BadgeService/BotTests.hs @@ -73,7 +73,7 @@ import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..)) import Simplex.Chat.Options.DB import Simplex.Chat.PaymentService (ServicePayment (..), googlePurchaseRef) import Simplex.Chat.PaymentService.Types (InvoiceId (..)) -import Simplex.Chat.Store.Badges (clearShownBadge, getLatestIssuedCredential, getNextHeldStoreReceipt) +import Simplex.Chat.Store.Badges (StoreHoldKind (..), clearShownBadge, getLatestIssuedCredential, getNextHeldStoreReceipt, reholdStoreReceipt) import Simplex.Chat.Store.Profiles (getUser, setUserBadge) import Simplex.Messaging.Agent (disposeAgentClient) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..)) @@ -279,6 +279,8 @@ badgeServiceTests = do it "should hold and credit an Apple tier change while another receipt of the owner is held" testAppleTierChangeBesideHeldReceipt it "should keep renewing a tier change's purchase that the device reported ended before the change" testAppleTierChangeClearsEnded it "should record on the receipt, not the purchase, a tier change whose credential does not verify" testAppleTierChangeCredentialUnverified + it "should send nothing for an Apple charge of a lower tier while its badge is shown, and grant it at renewal, shown when the old credential expires" testAppleTierChangeLowerWaitsForRenewal + it "should settle with no request a tier change held for a lower tier, as a build that held every change held it" testAppleTierChangeHeldLowerSettles it "should answer an Apple resubscription from the record when it cannot resume, refuse a held one that stops being resumable or that the service does not grant within its hold, and keep one behind another held receipt unfinished" testAppleResubscribeBounded it "should ask the App Store about a subscription claim at most once an hour, whoever presents it and as any of its transactions" testApplePurchaseChecksBounded it "should ask Play about a subscription token at most once an hour, whoever presents it, credited to another key or not" testPlayPurchaseChecksBounded @@ -4366,6 +4368,71 @@ testAppleTierChangeCredentialUnverified ps = issueErrorRow (chatController alice) `shouldReturn` (Nothing, Nothing) shownBadgeId (chatController alice) `shouldReturn` Just 1 +-- | A monthly Apple Legend subscription bought at legendBoughtAt, shown; the clock an hour into it. +appleLegendShown :: HasCallStack => BadgeServiceEnv -> TestCC -> IO () +appleLegendShown BadgeServiceEnv {bsClock, bsStore = store@FakeStore {appleLegendSubscriptionJWS}} alice = do + setClockAt bsClock $ addUTCTime 3600 legendBoughtAt + appleStoreReports store $ subscriptionCheck SSRenewing $ Just $ storeCharge "SUBSCR_BADGE_LEGEND_MONTH_01" legendBoughtAt 1 + alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = appleLegendSubscriptionJWS}) + inAnyOrder alice [[openPurchase ""], ["1: legend"]] + waitWakeArmed (chatController alice) + +testAppleTierChangeLowerWaitsForRenewal :: HasCallStack => TestParams -> IO () +testAppleTierChangeLowerWaitsForRenewal ps = + withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsClock, bsClientCfg, bsController = cc, bsStore = store@FakeStore {appleRenewalSubscriptionJWS}} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + appleLegendShown env alice + let a = chatController alice + checks <- subscriptionChecks store + -- a Supporter charge of the subscription within the window is answered from the record and sends nothing + alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = appleRenewalSubscriptionJWS}) + alice <## "badge already redeemed" + (alice "/_app activate" + alice <## "ok" + renewed <- waitLedgerRows a (length rows + 2) + alice <##. "1: supporter" + map (\(_, ch, m, start, tier, t) -> (ch, m, start, tier, t)) (drop (length rows) renewed) + `shouldBe` [(1, 1, supporterStart, "supporter", Just "charge"), (-1, 0, addMonths 1 supporterStart, "supporter", Just "badge")] + purchaseBadgeTypes a "badge_purchases" `shouldReturn` ["supporter"] + purchaseBadgeTypes cc "sx_badge_service_badge_purchases" `shouldReturn` ["supporter"] + issuedBadgeTypes a `shouldReturn` ["legend", "supporter"] + shownAndIssuedExpiry a >>= \(shown, issued) -> shown `shouldNotBe` issued + setClockAt bsClock presentAt + alice ##> "/_app activate" + alice <## "ok" + waitShownIssued a + +testAppleTierChangeHeldLowerSettles :: HasCallStack => TestParams -> IO () +testAppleTierChangeHeldLowerSettles ps = + withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsClientCfg, bsStore = store@FakeStore {appleRenewalSubscriptionJWS}} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + appleLegendShown env alice + let a = chatController alice + now <- serviceNow env + -- held directly, as the hand-over no longer holds a lower tier + withTransaction (chatStore a) $ \db -> do + Right user <- runExceptT $ getUser db 1 + [(receiptId, purchaseId)] <- DB.query_ db "SELECT badge_store_receipt_id, badge_purchase_id FROM badge_purchases" + reholdStoreReceipt db user receiptId purchaseId SHKTierChange SPApple {jws = appleRenewalSubscriptionJWS} now `shouldReturn` True + checks <- subscriptionChecks store + alice ##> "/_app activate" + alice <## "ok" + heldStoreReceipts a `shouldEventuallyReturn` 0 + (alice BadgeServiceEnv -> TestCC -> IO UTCTime