diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 0e04ea7a4f..90dfed8206 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -6251,10 +6251,10 @@ presentIssuedBadge user p@UserBadgePurchase {badgePurchaseId, shown} now shownType = (\(BadgeCredential _ _ _ BadgeInfo {badgeType}) -> badgeType) <$> shownCred -- Held back until the shown credential lapses, so the broadcast does not correlate with the -- request that produced it. Nothing shown at all is the state a lost profile write leaves. - -- A changed tier is presented at once, whichever request granted it: the store knows of the - -- change already, and showing the tier the subscriber now pays for is the point of it. + -- A raised tier is presented at once, whichever request granted it: the subscriber raised it in + -- the store, so the broadcast tells it nothing new; a lower tier keeps the hold-back. presentDue cred@(BadgeCredential _ _ _ BadgeInfo {badgeType}) = - Just cred /= shownCred && (Just badgeType /= shownType || maybe True ((<= now) . credentialExpiry) shownCred) + Just cred /= shownCred && (maybe False (`raisesTier` badgeType) shownType || maybe True ((<= now) . credentialExpiry) shownCred) -- | The visible half of "the badge ended". retireBadge :: User -> UserBadgePurchase -> CM Bool diff --git a/tests/Bots/BadgeService/BotTests.hs b/tests/Bots/BadgeService/BotTests.hs index 33ac486708..a3602cbc03 100644 --- a/tests/Bots/BadgeService/BotTests.hs +++ b/tests/Bots/BadgeService/BotTests.hs @@ -2561,19 +2561,19 @@ testSubscriptionTierChangeAtRenewal ps = tiersOf = map (\(_, ch, m, start, tier, t) -> (ch, m, start, tier, t)) renewAs plan n = do rows <- ledgerRows (chatController alice) "badge_ledger" - let (requestAt, presentAt) = renewalMoments rows + let (requestAt, _) = renewalMoments rows appleStoreReports store $ subscriptionCheck SSRenewing $ Just $ monthly plan n setClockAt bsClock requestAt alice ##> "/_app activate" alice <## "ok" renewed <- waitLedgerRows (chatController alice) (length rows + 2) - pure (drop (length rows) renewed, presentAt) + pure $ drop (length rows) renewed appleStoreReports store $ subscriptionCheck SSRenewing $ Just $ storeCharge "SUBSCR_BADGE_SUPPORTER_MONTH_01" firstStart 1 alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = appleSubscriptionJWS}) inAnyOrder alice [[openPurchase ""], ["1: supporter"]] waitWakeArmed (chatController alice) -- the store charges Legend at the renewal: a new run from its period start, on both sides - (upgraded, presentAt) <- renewAs "SUBSCR_BADGE_LEGEND_MONTH_01" 1 + upgraded <- renewAs "SUBSCR_BADGE_LEGEND_MONTH_01" 1 alice <##. "1: legend" let legendStart = addMonths 1 firstStart tiersOf upgraded `shouldBe` [(1, 1, legendStart, "legend", Just "charge"), (-1, 0, addMonths 1 legendStart, "legend", Just "badge")] @@ -2581,12 +2581,10 @@ testSubscriptionTierChangeAtRenewal ps = purchaseBadgeTypes (chatController alice) "badge_purchases" `shouldReturn` ["legend"] purchaseBadgeTypes cc "sx_badge_service_badge_purchases" `shouldReturn` ["legend"] issuedBadgeTypes (chatController alice) `shouldReturn` ["supporter", "legend"] - setClockAt bsClock presentAt - alice ##> "/_app activate" - alice <## "ok" + -- the raised tier is shown without waiting for the Supporter credential to expire waitShownIssued (chatController alice) -- and back to Supporter at the next renewal - (downgraded, _) <- renewAs "SUBSCR_BADGE_SUPPORTER_MONTH_01" 2 + downgraded <- renewAs "SUBSCR_BADGE_SUPPORTER_MONTH_01" 2 alice <##. "1: supporter" tiersOf downgraded `shouldBe` [(1, 1, addMonths 2 firstStart, "supporter", Just "charge"), (-1, 0, addMonths 3 firstStart, "supporter", Just "badge")] balanceChecks (chatController alice) `shouldReturn` replicate 6 (Just True)