badge-service: read Play's subscriptions at most 300 times a minute for purchases

A Play subscription purchase is asked about without any offline check, so any token in the accepted grammar spends a read from the Subscriptions quota renewal checks share. The purchase path now takes one of a minute's 300 reads for each Play subscription it asks about, a tenth of Play's default quota; with none left, the claim is answered rate_limited with the seconds left in the minute and is not held, as Play was not asked. A claim already held takes no read, and App Store claims, verified offline first, take none.

Run: 007-subscriptions-retirement-lane, slice 3

apps/simplex-badge-service/README.md

@@ -264,7 +264,8 @@ service_account_file = /etc/simplex-badge-service/play-service-account.json
   subscription purchases on one, and issue requests for a subscription due its hourly store check
   on another. A slow or unreachable store therefore delays only those, not code redemptions,
   App Store one-time purchases or other renewals; and no purchase, genuine or made up, delays a
-  renewal check.
+  renewal check. The purchase path reads Play's subscriptions at most 300 times a minute, so
+  made-up tokens cannot spend the quota renewal checks share.
 
 Which answers are terminal for a purchase and which leave it to be presented again is listed per
 store in [`docs/protocol/badges-rpc.md`](../../docs/protocol/badges-rpc.md#commands).

apps/simplex-badge-service/src/BadgeService/Service.hs

@@ -20,6 +20,9 @@ module BadgeService.Service
     newPurchaseChecks,
     purchaseCheckWait,
     maxPurchaseChecks,
+    PlayReads,
+    playReadWait,
+    maxPlayPurchaseReads,
     badgeErrorRetryAfter,
     shownServiceRequest,
     survive,
@@ -46,7 +49,7 @@ import BadgeService.StoreReceipts.Apple (appleSubscriptionChecker, readAppleRoot
 import BadgeService.StoreReceipts.Google (PlayVerifier (..), playStoreVerifier)
 import BadgeService.StoreReceipts.Mock (newMockStoreVerifier)
 import BadgeService.Waiters (Waiters, newWaiters)
-import BadgeService.Web.Server (exportWebapp, newWebEnv, runWebListener)
+import BadgeService.Web.Server (Bucket, exportWebapp, newWebEnv, runWebListener, takeFrom)
 import Control.Applicative (optional)
 import Control.Concurrent.STM
 import Control.Monad
@@ -540,9 +543,12 @@ purchaseWithReceipt key cc verifier checks purchaseKey masterKey StoreReceipt {t
     -- the store is asked about a claim at most once an interval on this path, whoever presents it
     purchaseSubscription product_ credit = do
       now <- badgeNow cc
-      atomically (purchaseCheckWait claimChecks now providerRef) >>= \case
-        Just remaining -> pure BSPError {code = BSEPaymentPending, message = Nothing, retryAfter = Just (ceiling remaining)}
-        Nothing ->
+      atomically (subscriptionAsk now) >>= \case
+        ClaimHeld remaining -> pure BSPError {code = BSEPaymentPending, message = Nothing, retryAfter = Just (ceiling remaining)}
+        NoPlayRead wait -> do
+          logWarn "Play subscription read refused: the purchase path's reads for this minute are used"
+          pure BSPError {code = BSERateLimited, message = Nothing, retryAfter = Just (ceiling wait)}
+        AskStore ->
           checkStoreSubscription verifier subscriptionRef product_ >>= \case
             -- no store was asked, so the claim is not held off
             Left SRNotConfigured -> atomically (modifyTVar' claimChecks $ M.delete providerRef) >> storeRefusalResponse SRNotConfigured
@@ -550,9 +556,17 @@ purchaseWithReceipt key cc verifier checks purchaseKey masterKey StoreReceipt {t
             Right checked -> atLeastCheckInterval <$> case credit of
               Uncredited -> newSubscription checked
               _ -> answerCredit credit
-    claimChecks = case subscriptionRef of
-      SubscriptionApple _ -> appleChecks checks
-      SubscriptionGoogle _ -> googleChecks checks
+    subscriptionAsk now =
+      purchaseCheckWait claimChecks now providerRef >>= \case
+        Just remaining -> pure $ ClaimHeld remaining
+        Nothing ->
+          maybe (pure Nothing) (`playReadWait` now) playReads_ >>= \case
+            Nothing -> pure AskStore
+            -- a claim refused a read is not held, as Play was not asked
+            Just wait -> modifyTVar' claimChecks (M.delete providerRef) $> NoPlayRead wait
+    (claimChecks, playReads_) = case subscriptionRef of
+      SubscriptionApple _ -> (appleChecks checks, Nothing)
+      SubscriptionGoogle _ -> (googleChecks checks, Just $ playReads checks)
     newSubscription checked@SubscriptionCheck {subscriptionState} = do
       now <- badgeNow cc
       case grantableCharge provider Nothing now checked >>= fundsMonthNow now Nothing of
@@ -797,13 +811,17 @@ atLeastCheckInterval = \case
   resp -> resp
 
 -- | The subscription claims the purchase path asked a store about, one map per store: the App Store's by original
--- transaction id, Play's by the token's hash, so Play tokens, which cost nothing to make up, cannot fill the App Store's.
-data PurchaseChecks = PurchaseChecks {appleChecks :: ClaimChecks, googleChecks :: ClaimChecks}
+-- transaction id, Play's by the token's hash, so Play tokens, which cost nothing to make up, cannot fill the App Store's;
+-- and the minute's allowance of Play reads.
+data PurchaseChecks = PurchaseChecks {appleChecks :: ClaimChecks, googleChecks :: ClaimChecks, playReads :: PlayReads}
 
 type ClaimChecks = TVar (M.Map T.Text UTCTime)
 
+-- | The Play subscription reads the purchase path took in the current minute, counted as the web listener counts requests.
+type PlayReads = TVar (Maybe Bucket)
+
 newPurchaseChecks :: IO PurchaseChecks
-newPurchaseChecks = PurchaseChecks <$> newTVarIO M.empty <*> newTVarIO M.empty
+newPurchaseChecks = PurchaseChecks <$> newTVarIO M.empty <*> newTVarIO M.empty <*> newTVarIO Nothing
 
 -- | How long a claim waits before its store is asked again; Nothing records a check at now. A claim that finds
 -- the table full of checks inside the interval is asked without being recorded, so a full table refuses no one.
@@ -820,3 +838,14 @@ purchaseCheckWait checks now ref = stateTVar checks $ \m ->
 -- while Play keys cost nothing to make up, so a full Play map only stops recording Play claims.
 maxPurchaseChecks :: Int
 maxPurchaseChecks = 10000
+
+data SubscriptionAsk = AskStore | ClaimHeld NominalDiffTime | NoPlayRead NominalDiffTime
+
+-- | How long until the purchase path may read Play again; Nothing takes one of this minute's reads.
+playReadWait :: PlayReads -> UTCTime -> STM (Maybe NominalDiffTime)
+playReadWait taken now = stateTVar taken $ \b_ -> either (\wait -> (Just wait, b_)) (\b -> (Nothing, Just b)) (takeFrom maxPlayPurchaseReads now b_)
+
+-- | A tenth of Play's default Subscriptions quota of 3,000 reads a minute, which renewal checks share: any token in the
+-- accepted grammar costs a read, so this caps what made-up tokens can spend; far above a minute of genuine purchases.
+maxPlayPurchaseReads :: Int
+maxPlayPurchaseReads = 300

docs/protocol/badges-rpc.md

@@ -34,8 +34,8 @@ The client never states what is signed. The tier is that of whatever funded the
 - `redeemBadgeCode` → `badgeCredential` — redeems a code, records the credit, and issues the first credential, in one round trip. It carries `masterKey` and `code` and no `badgeRequest`: a code states no tier and no expiry, so the credential is what reports them. Errors: `code_invalid` for an unknown or malformed code, `code_used` when other keys have taken all its uses (a code has one use unless issued with more), `code_expired` past a redemption deadline.
 - `purchaseBadge` → `badgeCredential` — verifies the funding (`apple` JWS offline; `google` product id and token via the Publisher API; `invoice` against webhook-confirmed settlement, `payment_pending` until it lands; `receipt`), records the credit, and issues the first credential, in one round trip. It carries `masterKey` and no `badgeRequest`. The response `receipt` is the recovery bearer secret (model § recovery); the service stores its hash; lifetime badges receive none.
   - A store transaction is claimed by its own id, read from the evidence before verification, and credited only when the verified transaction carries that same id. An App Store auto-renewable subscription is claimed by its `originalTransactionId`, which every renewal keeps, so all its charges fund one purchase; a Play subscription keeps its token across renewals already. A receipt already credited to the signing key is answered from the record, without asking the store.
-  - **Subscriptions.** A Play subscription is verified by reading the subscription itself, not by the one-time purchase read; an App Store one by its JWS offline, as any transaction, and then by reading the subscription's status. The latest charge the store reports is credited as a `charge` credit for the months of the plan it was for, dated to the store's billing period start, and the response carries `subscription`. A charge is credited only while its period runs, if it is not revoked, not in a free trial or introductory price, for a plan this service sells, while the subscription has not ended, and while the months its plan grants from its period start still run (Play derives that start by clipping at month ends, so a period's last days can fund nothing). Otherwise nothing is written. No record yet bounds how often the store is asked, so a subscription is asked about at most once an hour on this path, an App Store one per original transaction id and a Play one per token: presented again inside that hour, by any key (and an App Store one as any of its transactions), it is answered `payment_pending` with the time left, and an answer whose `retryAfter` would be shorter carries the hour. The answers: `payment_pending` with an hour for a period that has not started yet or a store that reports the payment pending; `receipt_invalid` for a Play subscription that has ended, since Play issues a new token when it is bought again; `payment_pending` with a day for everything a later charge on the same receipt could still change — a revoked charge, one in an offer, no charge yet, a period over while the store still retries, a charge whose months from its period start have already run out, a plan this service does not sell, and an App Store subscription that has ended, which a resubscription under the same original id would continue. A charge whose period does not end after it starts is answered `internal`, and a deployment that cannot read a store's subscriptions answers `provider_not_configured`.
-  - Errors: `receipt_invalid`, `test_purchase`, `payment_pending`, `provider_unavailable` — see the classes below; `receipt_used` when another key was credited with it; `product_unavailable` for a product this service does not price; `provider_not_configured` when this deployment has no verifier for the store. `receipt_invalid`, `test_purchase` and `receipt_used` are the only answers on which the client drops the keys it signed with and finishes the store transaction. Every other answer records nothing and leaves the purchase with its keys, to be presented again at the next trigger.
+  - **Subscriptions.** A Play subscription is verified by reading the subscription itself, not by the one-time purchase read; an App Store one by its JWS offline, as any transaction, and then by reading the subscription's status. The latest charge the store reports is credited as a `charge` credit for the months of the plan it was for, dated to the store's billing period start, and the response carries `subscription`. A charge is credited only while its period runs, if it is not revoked, not in a free trial or introductory price, for a plan this service sells, while the subscription has not ended, and while the months its plan grants from its period start still run (Play derives that start by clipping at month ends, so a period's last days can fund nothing). Otherwise nothing is written. No record yet bounds how often the store is asked, so a subscription is asked about at most once an hour on this path, an App Store one per original transaction id and a Play one per token: presented again inside that hour, by any key (and an App Store one as any of its transactions), it is answered `payment_pending` with the time left, and an answer whose `retryAfter` would be shorter carries the hour. Across all requests, this path reads Play's subscriptions at most 300 times a minute: a Play subscription that would need a read when none is left is answered `rate_limited` with the seconds left in the minute, and is not held off. The answers: `payment_pending` with an hour for a period that has not started yet or a store that reports the payment pending; `receipt_invalid` for a Play subscription that has ended, since Play issues a new token when it is bought again; `payment_pending` with a day for everything a later charge on the same receipt could still change — a revoked charge, one in an offer, no charge yet, a period over while the store still retries, a charge whose months from its period start have already run out, a plan this service does not sell, and an App Store subscription that has ended, which a resubscription under the same original id would continue. A charge whose period does not end after it starts is answered `internal`, and a deployment that cannot read a store's subscriptions answers `provider_not_configured`.
+  - Errors: `receipt_invalid`, `test_purchase`, `payment_pending`, `provider_unavailable` — see the classes below; `rate_limited` for a Play subscription when this path's Play reads for the minute are used; `receipt_used` when another key was credited with it; `product_unavailable` for a product this service does not price; `provider_not_configured` when this deployment has no verifier for the store. `receipt_invalid`, `test_purchase` and `receipt_used` are the only answers on which the client drops the keys it signed with and finishes the store transaction. Every other answer records nothing and leaves the purchase with its keys, to be presented again at the next trigger.
   - **Which class an answer belongs to.** The two mistakes do not cost the same, so when it is not certain, answer unreachable. `receipt_invalid` tells the client the purchase is dead: it drops the keys it signed with and finishes the store transaction — consumed on Play, finished on StoreKit — and nothing can present it again, so a buyer answered this by mistake has paid for a badge they can never receive. Answering unreachable by mistake costs one more verification request each time the app presents the purchase again, and a Play purchase left unacknowledged for three days is refunded to the buyer. It also locks the buyer out: the app offers no Buy while a purchase is open, so until that receipt settles the profile holding it cannot buy any badge, and an answer that never changes leaves it that way for good.
     - **Terminal**, `receipt_invalid` — only a verdict no later attempt could change: the store answered about this purchase and cannot change its mind, or the evidence can never verify. Anything that might answer differently later — the store's lag, an outage, this service's own misconfiguration or bug, a shape of evidence this service does not know yet — is one of the other classes.
     - **Terminal and named**, `test_purchase` — the store vouched for a purchase that cost nothing: Apple's `Sandbox`, or Play's `purchaseType` test. It is separated from `receipt_invalid` for one reason: the device that made the purchase already knows it was a test one, so naming it reveals nothing a forger could iterate on, and it lets the app say why instead of reporting a generic failure. Every other refusal stays lumped together for exactly that reason.

tests/Bots/BadgeService/BotTests.hs

@@ -226,6 +226,8 @@ badgeServiceTests = do
     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
     it "should keep at most the maximum of purchase checks, asking without recording once full, and drop expired ones" testPurchaseChecksBounded
+    it "should allow the purchase path at most the maximum of Play reads in a minute, counted from its first read" testPlayReadsBounded
+    it "should answer a Play subscription rate_limited without asking Play once the minute's reads are used, and not hold it off" testPlayPurchaseReadsLimited
     it "should refuse an App Store Sandbox subscription as a test purchase without asking Apple" testAppleSandboxSubscriptionNotAsked
     it "should answer an App Store subscription provider_not_configured without an API key, and credit a one-time purchase" testAppleSubscriptionWithoutApiKey
     it "should answer an App Store subscription provider_not_configured every time when only Play's subscriptions are checked" testAppleSubscriptionWithPlayChecker
@@ -3001,6 +3003,50 @@ testPurchaseChecksBounded _ = do
   waitAt (addUTCTime 3600 now) "new" `shouldReturn` Nothing
   size `shouldReturn` 1
 
+testPlayReadsBounded :: HasCallStack => TestParams -> IO ()
+testPlayReadsBounded _ = do
+  PurchaseChecks {playReads = taken} <- newPurchaseChecks
+  now <- getCurrentTime
+  let readAt t = atomically $ playReadWait taken t
+      nextMinute = addUTCTime 60 now
+  forM_ [1 .. maxPlayPurchaseReads] $ \_ -> readAt now `shouldReturn` Nothing
+  readAt now `shouldReturn` Just 60
+  readAt (addUTCTime 30 now) `shouldReturn` Just 30
+  readAt nextMinute `shouldReturn` Nothing
+  forM_ [2 .. maxPlayPurchaseReads] $ \_ -> readAt nextMinute `shouldReturn` Nothing
+  readAt nextMinute `shouldReturn` Just 60
+
+testPlayPurchaseReadsLimited :: HasCallStack => TestParams -> IO ()
+testPlayPurchaseReadsLimited ps =
+  withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsClock, bsController = cc, bsPurchaseChecks = PurchaseChecks {playReads = taken}, bsStore = store@FakeStore {appleSubscriptionJWS}} -> do
+    let token n = "fake-play-token-reads-" <> n <> ".AO-J1Om8l3biV8pPk4"
+        play = googlePayment "subscr_badge_supporter_01" . token
+        present (purchaseKey, masterKey) payment = refusalOf <$> serviceCmd env purchaseKey (purchaseCmd masterKey payment)
+        heldOff (code, retryAfter) = code == BSEPaymentPending && maybe False (\s -> s > 3540 && s <= 3600) retryAfter
+        readRefused (code, retryAfter) = code == BSERateLimited && maybe False (\s -> s >= 1 && s <= 60) retryAfter
+        useUpReads = do
+          wait_ <- testClockTime bsClock >>= atomically . playReadWait taken
+          when (isNothing wait_) useUpReads
+    now <- serviceNow env
+    setSubscription store (SubscriptionGoogle $ token "A") $ subscriptionCheck SSBillingRetry Nothing
+    setSubscription store (SubscriptionGoogle $ token "B") $ subscriptionCheck SSBillingRetry Nothing
+    setSubscription store (SubscriptionApple appleSubscriptionOriginalId) $ subscriptionCheck SSEnded $ Just $ storeCharge "SUBSCR_BADGE_SUPPORTER_MONTH_01" (addUTCTime (-3600) now) 1
+    keys <- newPurchaseKeys
+    checks <- subscriptionChecks store
+    present keys (play "A") `shouldReturn` (BSEPaymentPending, Just 86400)
+    firstReadAfter <- testClockTime bsClock
+    subscriptionChecks store `shouldReturn` checks + 1
+    useUpReads
+    present keys (play "A") >>= (`shouldSatisfy` heldOff)
+    present keys (play "B") >>= (`shouldSatisfy` readRefused)
+    subscriptionChecks store `shouldReturn` checks + 1
+    present keys SPApple {jws = appleSubscriptionJWS} `shouldReturn` (BSEPaymentPending, Just 86400)
+    subscriptionChecks store `shouldReturn` checks + 2
+    setClockAt bsClock $ addUTCTime 61 firstReadAfter
+    present keys (play "B") `shouldReturn` (BSEPaymentPending, Just 86400)
+    subscriptionChecks store `shouldReturn` checks + 3
+    nothingPurchased cc
+
 -- | Apple's production host answers 404 for a Sandbox transaction, so the offline check refuses it first.
 testAppleSandboxSubscriptionNotAsked :: HasCallStack => TestParams -> IO ()
 testAppleSandboxSubscriptionNotAsked ps = do