mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-11-12 02:57:56 +00:00
spaced4ndyandspacedandy-agents-simplex
9696a71b91
* core, badge-service: name Apple claims by reference
Rename appleTransactionId to appleTransactionRef, matching googlePurchaseRef
and StoreTransactionRef. No behaviour change: the next change makes it
return a subscription's original transaction id, which the old name would
misstate.
Run: 001-badge-subscriptions, slice 1
* core, badge-service: store subscription charges and carry the subscription state
Add the service migration 20261012_badge_subscriptions: the subscription
charges table, the ledger's charge_id, and the payment's subscription state,
check time and Play token, replacing three subscription columns nothing
wrote. The ledger now stores and reads back charge credits, and the badge
credential response gains an optional subscription state that older clients
ignore and that reads an unknown state without failing. Nothing writes a
charge or a state yet, so no behaviour changes.
Run: 001-badge-subscriptions, slice 2
* core, badge-service: plan subscription charges and claim Apple subscriptions by original id
Add chargeEntries, the one planner for a store charge's ledger rows: a
lapse to the billing period start, the grant dated to that start, and a
lapse to now, so coverage follows the store's periods and every row
verifies by re-running it at its createdAt. A test runs its rows through
the client's own balanceChecked for first charges, monthly and annual
renewals, billing-retry recovery and grace.
An Apple auto-renewable transaction is now claimed by its original
transaction id, which every renewal keeps, so renewals resolve to one
purchase. One function names the ref for both the claim and the real
verifier, so they cannot disagree.
Run: 001-badge-subscriptions, slice 3a
* badge-service: credit a store subscription purchase
The catalog now tells subscription products from one-time ones and maps a
store plan to its tier and months. A subscription receipt is checked with
the store once: with a grantable charge, the service plans the charge's
rows from the store's period start, signs the first month, and writes the
payment, purchase, charge, ledger rows, issuance, state and Play token in
one transaction, answering with the subscription state. Without one, it
answers payment_pending (300 s while the period has not started or the
store is pending, a day otherwise), receipt_invalid for an ended Play
subscription, or test_purchase, and writes nothing. Replays carry the
state. The store verifier interface gains the subscription check, which no
real store implements yet; the fake store does.
Run: 001-badge-subscriptions, slice 3b
* badge-service: renew a subscription once its paid coverage ends
While a subscription purchase's coverage runs, issueBadge is unchanged
and makes no store call. Once it has ended, the service asks the store at
most once an hour per subscription, stamping every attempt, and answers
from the stored state in between; a failed check is retried after the
whole interval. A grantable charge is planned from the tip at the store's
period start, signed, and written with its issuance and state in one
transaction that re-reads the tip, answering internal if it moved. Any
other charge and the state are recorded without a ledger row. Every answer
for a subscription purchase carries its state.
Run: 001-badge-subscriptions, slice 4
* core: keep a subscription badge until the service says it ended
A purchase is a subscription exactly when its ledger replica holds a
charge credit, so the kind is derived with no column or migration. A
subscription is still asked about at zero months, at the shared weekly
moment, and keeps its badge past paidThrough until an answer says the
subscription ended, so a renewed month is presented at the old
credential's expiry with no gap, and a charge the store recovers later
still re-activates it. While it waits, the client records no failure and
raises no support-ended alert; "issued no credential" now fires only while
the ledger still owes a month. Prepaid purchases are unchanged.
Run: 001-badge-subscriptions, slice 5
* badge-service: check Apple subscriptions with the App Store Server API
With an in-app purchase key configured in [apple], the service reads a
subscription's status by its original transaction id from Get All
Subscription Statuses, authenticated by an ES256 token reused until near
expiry. Each signed transaction and renewal info is verified against the
pinned Apple root through the same chain check as one-time purchases, now a
separate function, and a body that fails it is a verifier failure, never a
refusal. Statuses map to renewing, cancelled, billing retry and ended;
family-shared transactions are refused; 401 and 403 are this service's
failure, other errors and timeouts unreachable. A verifier failure thrown
by a store check is answered internal, and a test subscription is refused
in one place for first purchases and renewals. Without the key, Apple
one-time purchases verify as before and subscriptions are not configured.
Run: 001-badge-subscriptions, slice 6
* badge-service: check and acknowledge Google Play subscriptions
The Play subscription check reads purchases.subscriptionsv2 by token
through the existing service-account client, with the same HTTP classes as
product reads, and maps Play's state, base plan, period, order id and
offer phase; the period start is its end minus the plan's length, and a
pending subscription stays pending. A subscription is acknowledged with
purchases.subscriptions.acknowledge before it is credited, skipped when
Play reports it acknowledged, so it never reaches the one-time endpoint.
Each store's subscriptions answer provider_not_configured when that store
is not configured. A charge on a plan the catalog does not sell is pending
rather than a malformed period.
Run: 001-badge-subscriptions, slice 7
* review: round 1 fixes
R1-1: test an App Store subscription renewal through issueBadge, including
a charge recorded before its period starts and granted later under the
same charge id.
R1-2: make the ledger's charge_id index unique, so the schema itself grants
each store charge at most once.
R1-3: pin that a charge on a plan the catalog does not sell, with an empty
period, is pending at purchase and recorded at renewal, never internal.
Run: 001-badge-subscriptions, review round 1
* core: update query plans
getBadgePurchase derives the purchase kind from the ledger replica, and a
subscription test makes a held store receipt due.
Run: 001-badge-subscriptions, final verification
* fixes
* core: move SubscriptionState to Badges.Types (structural)
BadgeState, which lives in Badges.Types, is about to carry a subscription's
state, and Badges.Service imports Badges.Types. Service re-exports it, as it
does BadgeServiceErrorCode. No behaviour change.
Run: 003-badge-subscriptions-ui, slice 1
* core: keep a store subscription's state on the client
The screens and alerts need to know whether a subscription renews, was
cancelled, waits for a charge, or ended, and the client dropped every state
the service sent but ended. It is now stored on the purchase: from the
answer to the first credit, and from a renewal answer only when the
asserted tip's coverage had ended, since while coverage runs the service
repeats what it read at the last renewal (a year old for an annual plan).
BadgeState gains `subscription` (the plan's months, from the latest charge
credit, and the state), and fills renewsAt/willRenew from it. A changed
state is announced with CEvtBadgeChanged. The column goes into the
unreleased M20260925 migration.
Run: 003-badge-subscriptions-ui, slice 2
* core: record the device store's view of a subscription
The service reads the store only once a subscription's paid coverage has
ended, so it never sees a cancellation while the period runs. The apps read
the device's store (StoreKit's renewal state, Play's isAutoRenewing) and
report it with /_badge subscription <state> <payment>, which records it on
the credited subscription purchase the payment resolves to and announces the
change to its owner.
A renewing report does not replace billingRetry or ended: Play lists a
subscription in its grace period with auto-renew on, and the service's next
answer clears billing retry once the charge lands.
Run: 003-badge-subscriptions-ui, slice 3
* core: claim a store-listed transaction only on the device that bought it
A store account's purchases are listed on every device signed into it:
Play's purchase query lists active subscriptions for their whole life, and
Apple's Transaction.updates delivers auto-renewables made on other devices.
A hand-over with no record and an unknown echoed invoice made a new record
under the presenting profile, so another device could claim a buyer's
subscription for its own active profile, or repeat a refused request every
30 days after cleanup.
/_badge purchase now takes a `listed` mark, which the apps' sweeps and
purchase listeners send: it joins only a record this core already has for
the transaction or its echoed invoice, and otherwise records and sends
nothing (CRStoreReceiptNotRecorded). The purchase call and Restore hand over
unmarked, as before.
Run: 003-badge-subscriptions-ui, slice 4
* core: let a held App Store subscription adopt its later transactions
A held Apple subscription record is keyed by its original transaction id,
so every renewal resolves to it. It kept the payment's back-off when a new
transaction arrived, and adopted any payment handed over, including a
revoked renewal, which the service refuses as receipt_invalid and so would
refuse the whole subscription.
A held Apple record now adopts a JWS only for another transaction with a
later purchaseDate and no revocationDate, read from the unverified payload,
and is then due at once with its retry delay and credit error cleared. A
re-delivered or re-signed copy changes nothing. A failed attempt writes its
back-off only if the record still holds the payment it sent.
Run: 003-badge-subscriptions-ui, slice 5
* core: refuse a badge code or invoice while a store receipt is pending
A code redeemed while a store receipt is held put the code's badge on the
profile, and the held receipt then waited behind it; for a subscription the
store kept charging every period meanwhile. Code redemption and invoice
creation now answer "store purchase open" while the profile holds an App
Store subscription receipt, or another receipt whose last failure can clear
on its own. A receipt that failed for good does not block, except an Apple
subscription, which Apple keeps charging; an uncredited Play subscription is
refunded by Play.
Run: 003-badge-subscriptions-ui, slice 6
* core: alert a subscriber that a payment failed, a renewal nears, or it was cancelled or ended
A subscription's alerts were the prepaid ones: a retired subscription said
"support ended", and nothing told the user a payment failed, an annual
renewal was near, or a cancelled subscription still runs. The derived alert
for a subscription is now, in order: subscription_ended once retired,
payment_issue while the store retries, issue_failed as before,
subscription_cancelled before paidThrough, and renewal_approaching from
three days before an annual plan renews, with a wake at that moment. Monthly
plans get no reminder, as there is no opt-out yet.
The unreleased migration's down step clears an acked subscription_cancelled,
which an older core cannot read.
Run: 003-badge-subscriptions-ui, slice 7
* badge-service: let the dev mock vouch for store subscriptions
With [dev] accept_unverified_store_receipts on, every subscription was
answered provider_not_configured, so the apps' subscription screens could
not be tried against a dev service. The mock now credits an App Store
subscription for the plan its product names, and a Play subscription for
the base plan a test token test.<basePlanId>.<uuid> names, or else its
product's monthly plan, from a minute ago; it remembers the plan in memory
and grants each renewal a new charge, answering a subscription it does not
know (after a restart) as ended.
The subscription check is given the product the presented receipt names,
which only the mock reads; it reads the service's badge clock at check time.
Run: 003-badge-subscriptions-ui, slice 8
* ios: hand App Store subscriptions to the core and report their renewal state
A subscription transaction was finished uncredited, so a buyer would pay and
get nothing. Every badge product now goes through a core invoice and is
handed over, and finished only once the core answers it credited or refused.
Transactions the store lists (the launch sweep, Transaction.updates) are
handed over as listed, so another device's purchase is not claimed here;
Restore purchases syncs with the App Store and claims them for this profile.
A revoked renewal is finished without hand-over, as the service would refuse
it and so the whole subscription.
The app reports StoreKit's renewal state to the core at each sweep, after the
manage-subscriptions sheet and after a restore. Monthly and annual are offered
only to an Apple ID with no earlier subscription in the group, which Apple
would fold a new one into.
Run: 003-badge-subscriptions-ui, slice 9
* ios: sell badge subscriptions and show their state on Your badge
Monthly and annual subscriptions are offered on How long and Check your
order, with the App Store's subscription disclosure, Terms of use and
Privacy policy links, and Restore purchases. Your badge shows a
subscription's state - Renews {date} · {price}, Ends {date}, Payment
problem, Renewing or Ended - with why another badge cannot be bought or
redeemed while it waits for its charge, Manage subscription and Restore
purchases. The chat list shows one banner for the current badge alert of
any kind: renewal soon, payment problem, cancelled, ended, as well as the
expired and renewal-failed ones it had.
Run: 003-badge-subscriptions-ui, slice 10
* android: hand Play subscriptions to the core and report their renewal state
The Kotlin port of the iOS store change. A Play subscription was
acknowledged uncredited; every badge product now goes through a core
invoice and is handed over. The sweep queries subscriptions as well as
one-time products, and the sweep and purchases listener hand over as listed,
so another device on the Google account does not claim them; Restore claims
them for this profile. A subscription is bought on its base plan's own
offer, and the app never acknowledges one itself: the service does when it
credits it, so Play still refunds one the service never credits.
The app reports Play's isAutoRenewing to the core as renewing or cancelled.
Run: 003-badge-subscriptions-ui, slice 11
* android, desktop: sell badge subscriptions and show their state on Your badge
The Kotlin port of the iOS screens. How long and Check your order offer
monthly and annual with Google Play's subscription disclosure, the privacy
policy link and Restore purchases. Your badge shows the subscription's state
with the same texts as iOS, the store named Google Play with a store lane and
"the store" without one, and Manage subscription and Restore purchases only
with a store lane on the local host. The chat list shows one banner for the
current badge alert of any kind. Desktop shows the state, footers and banners
without store rows or a price.
Run: 003-badge-subscriptions-ui, slice 12
* docs: describe the one badge alert banner in the apps' chat-list specs
Both chat-list specs described two hand-written badge banners (expired,
renewal failed); the chat list now has one banner for the current badge
alert of any kind. Also moves the line links this run shifted.
Run: 003-badge-subscriptions-ui, slice 13
* review: round 1 fixes
ios: stop selling a subscription once this device has seen one, so a
second profile is not charged for a subscription Apple folds into the
first (R1-12). Continue pins the chosen period on both apps (R1-13).
Only a device with a subscription asks its store for products and status
when reporting, and the purchases are marked checked before the report
(R1-14, R1-5: Kotlin now loads the products, so the price shows after a
restart). Restore says "Nothing to restore" after a cancelled purchase
(R1-7). Android keeps sweeping one-time purchases when the subscriptions
query fails (R1-6). The freshness comment in requestBadgeIssue states the
service's one-hour repeat of its last check (R1-1).
Run: 003-badge-subscriptions-ui, review round 1
* badge-service: answer a long-expired Play subscription as ended, and hash Play order ids
Play answers HTTP 410 for a subscription that expired too long ago to be
queried; it was read as unreachable, so the service never answered ended,
the badge was never retired and the profile stayed blocked from buying or
redeeming (R1-2). Play order ids appear on the buyer's receipt email, so
charges now store a hash of the order id, as purchase tokens already are
(R1-10).
Run: 004-badge-subscriptions-review, review round 1
* review: run 003 round 2 and run 004 round 1 app fixes
ios: buy a subscription only while it is still for sale, after re-reading
the Apple ID's transactions, and disable Pay once it is not, so a Check
your order screen opened before another profile or device subscribed
cannot buy one Apple folds into the earlier subscription (run 003 R2-1,
run 004 R1-4). android: skip the subscriptions query only on a device
whose Play does not support subscriptions, so Restore no longer says
"Nothing to restore" when the query failed (run 003 R2-2).
Run: 003-badge-subscriptions-ui round 2; 004-badge-subscriptions-review round 1
* review: round 3 fixes
ios: a subscription refused because this Apple ID subscribed before has
its own error, and Check your order says why Pay is disabled (R3-2).
android: skip the subscriptions query only when Play does not support
subscriptions, so a disconnected client fails the sweep or Restore
rather than reading as no subscriptions (R3-1).
Run: 003-badge-subscriptions-ui, review round 3
* core: update query plans
Regenerated by the full suite for the purchase, subscription status and adoption queries. Run: 003-badge-subscriptions-ui, final step
* badge-service: say what hashing the Play order id protects
The hash is unkeyed, so a holder of the buyer's receipt can still find the row (R2-1). Run: 004-badge-subscriptions-review, review round 2
* badge-service: name the rule for when a subscription is due a store check
The issue path's purchase read becomes getIssuePurchase and its "ask the
store now" test becomes subscriptionCheckDue, so the request router can
read the same rows by the same rule. No behaviour change.
Run: 005-subscriptions-load-timing, slice 1
* badge-service: answer every request that may ask a store on the store lane
App Store subscription purchases and subscription renewal checks called
their store from the main lane, so one slow or repeated store call held up
code redemptions and every other renewal. The router now reads the
purchase the way the issue path does and sends to the store lane every
request that may ask a store: Play purchases, App Store auto-renewable
purchases, and issue requests for a subscription due its store check,
judged a minute ahead so the handler never finds one due on the main lane.
Run: 005-subscriptions-load-timing, slice 2
* core: send no badge request before the wake a request that issued nothing set
While a subscription waited for its store charge, or a prepaid renewal
kept failing, every launch, foreground, profile switch and badge-state
read sent the issue request again, so the badge service saw the user's
app-open times for weeks. A due request now waits for the wake the last
pass stored, as long as that wake is no more than a stall interval away,
so it is asked again a day later as the renewal design says.
Run: 005-subscriptions-load-timing, slice 3
* fixup! core: send no badge request before the wake a request that issued nothing set
* fixup! badge-service: answer every request that may ask a store on the store lane
* badge-service: ask the App Store about a subscription purchase at most once an hour per claim
Anyone holding a real but uncreditable App Store subscription JWS, such as
their own lapsed subscription, could present it again and again, each time
spending an App Store Server API call from the quota every subscriber's
renewal check needs. The purchase path now remembers, in memory, which
subscription claims it asked about within the hour and answers a repeat
payment_pending with the time left. Keys are original transaction ids from
JWS that verified offline, entries expire after the hour, and a full table
asks rather than refuses, so memory stays bounded and no buyer waits on
another's claim.
Run: 005-subscriptions-load-timing, slice 4
* fixup! badge-service: ask the App Store about a subscription purchase at most once an hour per claim
* review: round 1 fixes
badge-service: a Play charge whose clipped period start leaves its month
already spent is answered as period over, not internal (R1-A1).
docs: the per-store answer classes list Play's 410 and the App Store
subscription check (R1-A2).
tests: a held receipt with no attempt yet blocks an invoice (R1-B2); a
renewing report keeps an ended status (R1-B3); a test comment names
[google] (run 005 C2-R2-1).
ios: a subscription refused because this Apple ID subscribed before
shows its sentence, not the error's name (R1-C2); ios, android, desktop:
the Check your order footnotes share one helper (R1-C3).
Run: 006-subscriptions-branch-review, review round 1
* fixup! review: round 1 fixes
* core: wait a day after a badge request that issued nothing, whatever the service or a snooze says
The hold on the stored wake let two moments the client does not schedule end it early. A renewal whose store check failed was answered with an hour's retryAfter, so the next activation after each hour sent it again, sampling when the app is opened. A snooze set before a request ended its wait at the snooze's end, timing the next request by the user's tap. Now a request that issued nothing waits the stall or a ledger moment: retryAfter only marks the failure transient, and a snooze is not a wake while a request waits; the request's own wake raises the alert again.
Run: 005-subscriptions-load-timing, slice 5
* fixup! review: round 1 fixes
* fixup! core: wait a day after a badge request that issued nothing, whatever the service or a snooze says
* badge-service: ask Play about a subscription purchase at most once an hour per token
The purchase path's hourly bound covered only App Store claims, so a re-presented Play subscription token, uncredited or credited to another key, spent a subscriptionsv2.get call each time, from the quota bucket Play renewal checks use. The bound now lives in purchaseSubscription, which both stores' purchase paths call, with one map per store: Play's keyed by the token's hash, so made-up Play tokens cannot fill the App Store's. Distinct made-up tokens are still one call each.
Run: 005-subscriptions-load-timing, slice 6
* badge-service: read Play's paused subscription as waiting to renew
An unmapped SUBSCRIPTION_STATE_PAUSED was answered internal, so a paused subscriber's renewal failed for the whole pause. Play reports a pause with auto-renewal on and charges again when it ends, so it now maps as an active subscription does: renewing, or cancelled with auto-renewal off. Pause is being turned off on the base plan; this is defence in depth. A pause grants nothing: Play names no new order, and the last one is already granted.
Run: 005-subscriptions-load-timing, slice 9
* core: retire a subscription badge once no store could still charge it, whatever the service answers
A subscription badge retired only on an ended answer, so a service that never sent one (a final error such as unknown_purchase_key, a rollback, a service that never answers) left the badge shown, one request a day forever, and the profile unable to redeem, buy or have a held receipt credited. Now it also retires once paidThrough is older than the longest store recovery window: Apple retries a failed renewal for up to 60 days, the longest with Play's pause off, plus a week. paidThrough counts every month the ledger holds, so banked months are never retired by it.
Run: 005-subscriptions-load-timing, slice 8
* ios, android: no Restore purchases on Your badge, where a restored purchase could not be credited
Your badge shows only while a badge is shown, so a purchase Restore found there with no record on this device was held under a profile whose held receipts are not processed while it shows a badge: not credited, nothing said, and on Android acknowledged, ending Play's three-day refund. Restore stays on Check your order, the one screen where a restored purchase can be processed.
Run: 005-subscriptions-load-timing, slice 7
* review: round 4 fixes
R4-1: a subscription badge is asked about first and retired only after the service answers, judged on the ledger after that answer. Retiring before asking used the client's paidThrough, which moves only when the client asks, so a subscriber who had not opened the app for longer than the recovery window while the store kept charging lost the badge at the next launch and was never asked again. A request that is not answered retires nothing. Tests: testSubscriptionRetiredAfterRecoveryWindow changed, testIdleSubscriptionKeptPastWindow and testSubscriptionNotRetiredWithoutAnswer added.
R4-2: one snooze comment where two contradicted each other.
R4-3: the recovery window's comment names Play's clipped period start.
R4-4: the retirement tests use subscriptionRecoveryWindow.
* badge-service: name the lane each request waits on
The router answered "may this request ask a store" as a Bool; renewal checks are to get a lane of their own, which a Bool cannot say. requestLane now names the lane: main, purchase or renewal. Both store lanes still share one queue, so no request changes lane.
Run: 007-subscriptions-retirement-lane, slice 1
* badge-service: check renewals on a lane no purchase waits on
Renewal checks shared the store lane with every purchase, so made-up Play tokens, which anyone can send, and the weekly burst of genuine purchases delayed them. Renewal checks now wait on a lane of their own, which only a request signed by the purchase key it names, and due its hourly store check, can reach.
Run: 007-subscriptions-retirement-lane, slice 2
* badge-service: name the web limiter's fixed-window step
takeToken counted a request against a minute's limit inline. The step becomes takeFrom, a pure function, so the purchase path's Play read allowance can use the same rule. No behaviour change.
Run: 007-subscriptions-retirement-lane, slice 3a
* 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
* core: count the subscription retirement window from the first answer that renewed nothing
The window was counted from the client's paidThrough, which moves only when the client asks, so after months away the first answer that granted nothing for any reason, a transient error, Play's clipped last days or a billing retry, retired a subscriber whose store may still have been charging. The purchase now stores its unrenewed run: the first answered request after which the ledger covered nothing, and the latest one. The badge retires once the window has passed since the run started, still only after an answer; a renewal ends the run, and an answer that comes a window or more after the latest one starts a new run, since an absence or an outage that long may hide a renewal. The window stays 67 days, written as Apple's 60-day billing retry plus the week contacts give an expired credential.
Run: 007-subscriptions-retirement-lane, slice 4
* review: round 1 fixes
R1-A1: the docs and the PlayReads comment said the purchase path reads Play's subscriptions at most 300 times a minute; it asks about at most 300 subscriptions, and a credited one is read once more to acknowledge it, so made-up tokens can spend at most a tenth of the quota renewal checks share.
R1-A2: a comment on RequestLane repeated the one above the queues.
R1-B1: a test that a held pass, which sends no request, leaves the unrenewed run unchanged.
R1-B2: the outage test's last wait for the run is 30 s instead of 5 s.
Run: 007-subscriptions-retirement-lane, review round 1
* core: add the badge subscription columns in their own migration
M20261016_badge_store_receipts shipped to master in #7587, so it must
stay as released. Restore it in both dialects and move the
subscription_status, unrenewed_since and last_unrenewed_at columns,
with the down step that clears subscription_cancelled acknowledgements
master cannot read, into M20261016_badge_subscriptions.
Run: 008-subs-migration-split, slice 1
* tests: drop the FilePath import a merge duplicated
The branch and master each added import System.FilePath ((</>)) to
Direct.hs on 2026-10-14 at different positions, and an earlier merge
kept both, so GHC warned that one was redundant. Keep master's.
Run: 008-subs-migration-split, slice 2
* fixup! core: add the badge subscription columns in their own migration
* ios, android, desktop: choose a badge in the app
* ios, android, desktop: use the dev badge page for testing (don't merge)
* update postgres schema
* update ios lib
* ios, android: hide Restore purchases on the order screen
* docs: summarize the badge subscriptions PR for reviewers, with diagrams
A summary of PR #7716 as built: buying, renewing and retiring on each
store, the retirement window, lanes and store limits, RPC, API and
database changes, alerts, tests, open items, and a review map. Seven
SVG diagrams, an HTML page with them inline, and a link from the plan.
* ios, android, desktop: restore purchases on the Support SimpleX screen
* ios, android, desktop: show the badge privacy policy in the app
* docs: keep only the badge subscription diagrams, with a README
The reviewer summary leaves the repo; the folder keeps the seven
diagrams with a README that captions each, and the plan links the
README.
* ios, android, desktop: smaller Restore purchases label
* ios: no alert when a badge purchase is cancelled
* docs: replace the badge subscriptions diagrams README with a short summary
A plain-English summary for anyone on the team, with the seven
diagrams and a self-contained HTML page; the plan links it again.
Diagrams follow the branch: Restore purchases is on Support SimpleX,
"Renewing" shows past paidThrough, and only a present retryAfter is
raised to an hour.
* ui
* ui wip
* core: retire a subscription badge as soon as its store says it ended
A subscription badge retired only on an ended answer to a request that was due, and only once the ledger's paidThrough had passed, so an ended answer while the ledger still covered, or the iOS app's report of StoreKit's expired or revoked state, left the badge shown, Support SimpleX unreachable and every purchase refused until a later request. Now an answered ended state is stored even while coverage runs (the service writes it only from a store check, after which it grants nothing), and every pass retires a subscription whose state, from this pass's answer or else as stored, is ended, whatever the ledger covers. The paidThrough guard stays at the prepaid call site, its only remaining user.
Run: 010-subscription-lifecycle, slice S1
* docs: record that a badge subscription cannot be restored or bought again
Restoring a subscription on a new device or under another profile fails for two independent reasons, the client's restore reading only unfinished transactions on iOS and the service answering any key but the one it credited receipt_used, and a lapsed iOS subscriber cannot subscribe again on the same install either. Both gaps files record it in their own format, and both restorePurchases() say why reading the store's entitlements alone would not help.
Run: 010-subscription-lifecycle, slice S2c
* fixup! core: retire a subscription badge as soon as its store says it ended
* transfer plan
* shorter plan
* update plan
* badge-service: let a dev deployment ask its mock store while coverage runs
[dev] check_store_during_coverage = on makes every issueBadge for a
subscription ask the dev mock, during paid coverage too, and bank the
month of a charge it can grant, issued once coverage reaches it. So a
renewal can be watched by hand without waiting a month, and a mock that
forgot the plan after a restart answers ended at once.
Off by default, and refused unless accept_unverified_store_receipts is
on, which is itself refused beside a real store: a real store has not
started its next charge while coverage runs, and asking spends the
quota every subscriber shares.
Run: 011-subscription-tools, slice S3a
* core: send a badge request at once from a build for the dev badge service
/_badge request <userId> sends the profile's badge request now, while
its badge is shown, and runs the badge pass on the answer, so a renewal
or an ended subscription can be watched by hand against the dev
service.
It is allowed only when ChatConfig's badgeDevRequests is set, which no
shipped build does and nothing sets at runtime: the dev-service branch
sets it beside its own badge service overrides. A request off the shared
expiry would tell requests apart, so every other build refuses it, and
it is refused from a paired remote controller.
Run: 011-subscription-tools, slice S3b
* fixup! badge-service: let a dev deployment ask its mock store while coverage runs
* fixup! badge-service: let a dev deployment ask its mock store while coverage runs
* fixup! core: send a badge request at once from a build for the dev badge service
* core: split the badge request's lock from its body
The receipt worker's attempt already holds the owner's badge lock, which is not reentrant, so it cannot call requestBadgeIssue. The body becomes sendBadgeIssue, and both answer a service error as Left (code, retryAfter) instead of Nothing, so that caller can classify it as it does today. No behaviour change.
Run: 011-subscription-resume, slice S2-0
* core: retire on a device's ended report only once the paid period is over
StoreKit can report a subscription expired during Apple's billing retry, and Apple may then recover the charge, so retiring at once on that report left a paying user without the badge. The service's answered ended still retires at once, also while the ledger covers. A stored ended, which is how the device's report arrives, retires once paidThrough has passed.
Run: 011-subscription-resume, slice S1c
* core: resume a retired Apple subscription when its store charges it again
A same-install resubscription keeps Apple's original transaction id, so its hand-over found the old credited record and was answered from it with the old credential: the subscriber paid and got nothing. A credited record is now held again when a later charge of its subscription is handed over, the charge is not revoked, its paid period runs and it is dated less than a day ahead of this device's clock, and the record's purchase is its owner's newest, a subscription and not shown, with no other receipt held. The receipt worker then sends the purchase's issueBadge, and the service grants the charge as a renewal. A covered answer shows the purchase again with the newest credential and clears an ended state. A charge the service answers without crediting is deferred an hour and refused a day after its purchase date, so it holds the profile for about a day. A refused resume is remembered on the record (every credit, re-hold and resume clears credit_error), so the app's sweep does not hold the same charge again after its day.
Run: 011-subscription-resume, slice S2a
* fixup! core: resume a retired Apple subscription when its store charges it again
Review round 1 fixes:
- R1-1: a resumable charge waiting behind another held receipt of the owner is answered held and left unfinished, rather than answered from the record and finished uncredited.
- R1-3: a resume shows the purchase again only with a credential that has not expired.
- R1-2, R1-8: tests of the resumable-charge rule and the hold's edge, of a held charge whose paid period ends before it is sent, and that a resumed profile shows the newest credential. The resume test is split in two, one environment each.
- R2-V1: a test comment that the reordered steps made false.
Run: 011-subscription-resume, review rounds 1 and 2
* core, ios, android, desktop: let a lapsed iOS subscriber subscribe again to the badge the profile retired
The iOS app refused any subscription to an Apple ID that ever subscribed, so a lapsed subscriber could never subscribe again in the app. Core now tells the apps each subscription's store reference (BadgeSubscription.transactionRef, optional in JSON), and the iOS gate opens a subscription card only when every earlier subscription of the Apple ID is the active profile's newest purchase, retired, of the card's badge: the one charge core resumes. Kotlin gets the model field only, as Play gives a resubscription a new token and needs no gate.
Run: 011-subscription-resume, slice S2b
* docs: bound a badge move by the previous credential's expiry
* badge-service: credit test purchases and check the store during coverage in a dev deployment
* core: let a dev build ask the badge service on an interval
* badge-service: log each request's command and each store check's outcome
* fix compilation
* badge-service: name the purchase each request came from in the log
* badge-service: name the purchase each request came from in the log
* core, ios, android: explain a failed badge renewal and stop retrying a subscription the store forgot; tests (#7788)
* core, badge-service, ios, android: change badge tier in the store, and restore a subscription on another device (#7795)
* core: tell the apps when a badge request banks a month without issuing it
A pass announced the badge state only when the balance start moved, so a charge granted onto running coverage, or a debit the service wrote, changed months left and paid-through without an event, and the apps kept showing the old renewal date until the screen was reopened. The pass now announces whenever the ledger's last entry is not the one it started from, which a moved balance start implies.
Run: 015-badge-fixes, slice 1
* core: test that every Play charge of a month-end subscription funds its month
Play reports only a period's end, and the service dates the charge a plan length before it, so month-end clipping could leave a charge funding less than its month. Walk a monthly and an annual Play plan anchored on 31 January through their renewals at the device's request moments, through the deployed Play verifier: each charge funds exactly its months, paid-through stays at most the grace behind Play's period end (three days at most in this walk), and no charge is left without a grant.
Run: 015-badge-fixes, slice 2
* core: test that the newest issued badge credential is taken by its ledger row
After a tier change the newer issuance can end before the older one, so ordering issuances by period end would answer the superseded credential to the worker and to the resume and tier-change paths. Pin the row order: the test fails if the query goes back to period_end order.
Run: 015-badge-fixes, slice 3
* review: round 1 fixes
The App Store tier-change hold, reviewed for the first time:
- R1-B2: a tier change's credit now shows its purchase again (shown_badge_id) in the same transaction, as a resume's does, so a retire that ran while the change was with the service cannot leave a paid purchase unshown and never renewed.
- R1-B5: a tier change of a shown purchase is held whatever other receipt is held, as the worker serves it while the badge is shown; only a resume waits for other held receipts.
- R1-B3: test a tier change the store does not vouch for: refused in silence, the badge kept, and answered from the record after.
- R1-B8: the changeTier comment names when the record settles.
Run: 015-badge-fixes, review round 1
* review: round 2 fixes
- R2-1: a granted tier change clears an ended state the device reported before it. A renewing report never replaces ended, and a charge of the new tier granted proves the subscription has not ended, so without this the worker retired the new tier's badge at its paid-through while the subscription renewed.
- R1-B3: test a tier change whose credential does not verify: the failure stays on the receipt record, not the purchase, and Supporter stays shown.
- R2-3: the refused tier change's test buys Supporter through an invoice, so it shows the refusal announces nothing.
- R2-2: the changeTier comment says what follows each way the record settles.
Run: 015-badge-fixes, review round 2
* review: round 3 fixes
- R3-1: a tier change whose answer says the subscription ended is not credited, as a resume is not, so the credit's clearing of a stored ended never drops the one this answer carries.
- R3-2: the changeTier comment in two lines.
Run: 015-badge-fixes, review round 3
* core: apply an App Store tier change at once only when it raises the tier
Apple keeps charging the old plan to the end of the period, so applying a downgrade at once took away a badge the subscriber had already paid for. A charge of another tier is now held and sent at once only from supporter to legend; a lower tier, or one that is not ranked (investor, unknown), is answered from the record and the renewal check grants it, as badges-rpc.md says. A record already held for such a change settles silently.
Run: 016-tier-change-direction
* 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
* badge-service: let a restore ask the store without waiting for the purchase's own check
* docs: describe badge tier changes and restore as the service handles them
The RPC document splits a store tier change by store and direction: the
app never starts one, an App Store raise seen within a day of its charge
is sent as upgradeBadgeSubscription, every other change waits for the
renewal check, and a Play plan change is a new token, a new purchase.
transferBadge and its limits are checked against the handlers, and the
upgrades that are not built are marked so.
The overview admits what Restore discloses: the service links the two
purchase keys, a store receipt moves its subscription to whoever presents
it within the move limit, and a new badge or tier is shown as soon as it
is issued. The Android gap names what remains of Restore.
* docs: tell the badge subscriptions story with tier changes and restore
The summary now covers the whole lifecycle: buying, renewing, changing
tier, moving to another device or profile, and ending. The badge retires
as soon as the store says the subscription ended, a lapsed iOS subscriber
can resume the retired badge, an App Store raise is granted at once and
a lower tier at the renewal, and a Play plan change is a new purchase.
The known limits and the before-sale list follow the code.
The seven diagrams are updated, with stale file and line references
dropped, and two are added: a tier change and a restore. The page now
points at the diagram files instead of carrying copies of them.
* fixup! docs: describe badge tier changes and restore as the service handles them
* fixup! docs: tell the badge subscriptions story with tier changes and restore
* fixup! docs: describe badge tier changes and restore as the service handles them
* fixup! docs: tell the badge subscriptions story with tier changes and restore
* core: make the badge subscription tests fail on the defects they name (#7798)
* fix compilation
* fix api
* ios, android, desktop: open the badge page on the site again
* ios: choose a badge on the site, not in the app
* tests: hold the move with no charge to grant, not with the purchase's store check
* unfocus test
* update postgres schema
* badge-service: break a tie between issuances by their period, so both databases agree
* badge subscription review fixes (#7799)
* update badge subscriptions docs (#7802)
* core: show a changed badge tier to contacts as soon as it is granted
* update plans
* core: show a raised badge tier to contacts at once, hold back a lower one
* update sqlite schema
* badge subscriptions review fixes (#7903)
* update ios lib
* update query plans
* ios: one property wrapper on the chat view's chat (#7910)
* android: a shorter note under Restore purchases
* Revert "ios: one property wrapper on the chat view's chat (#7910)"
This reverts commit d5a24bb342.
* ci: larger RAM disk so tests do not run out of space
* update sqlite schema
* ios: preview references for the badge screens
---------
Co-authored-by: spacedandy-agents-simplex <342056592+spacedandy-agents-simplex@users.noreply.github.com>
1094 lines
60 KiB
Haskell
1094 lines
60 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Bots.BadgeService.StoreVerifierTests
|
|
( badgeStoreVerifierTests,
|
|
TestChain (..),
|
|
trustedChain,
|
|
signedBy,
|
|
subscriptionPayload,
|
|
transactionPayload,
|
|
ourBundleId,
|
|
purchaseRecord,
|
|
subscriptionRecord,
|
|
lineItem,
|
|
basePlan,
|
|
)
|
|
where
|
|
|
|
import BadgeService.Config (AppleServerApi (..), AppleStoreConfig (..), PlayStoreConfig (..), ServiceConfig (..), readServiceConfig)
|
|
import BadgeService.Service (ServiceState (..), configureStoreVerifier, newServiceState)
|
|
import BadgeService.StoreReceipts
|
|
import BadgeService.StoreReceipts.Apple (appleSubscriptionChecker, readAppleRoot, verifyAppleTransaction)
|
|
import BadgeService.StoreReceipts.Google (PlayVerifier (..), playStoreVerifier)
|
|
import Bots.BadgeService.FakeAppStore
|
|
import Bots.BadgeService.FakePlay
|
|
import Control.Concurrent.STM (readTVarIO)
|
|
import Control.Exception (throwIO)
|
|
import Control.Monad (forM_)
|
|
import Crypto.Hash.Algorithms (SHA256 (..))
|
|
import Crypto.Number.Serialize (i2osp, i2ospOf_)
|
|
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
|
|
import qualified Crypto.PubKey.ECC.Generate as ECC
|
|
import qualified Crypto.PubKey.ECC.Types as ECC
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.KeyMap as KM
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Base64 as B64
|
|
import qualified Data.ByteString.Base64.URL as B64U
|
|
import qualified Data.ByteString.Lazy as LB
|
|
import Data.Either (isRight)
|
|
import Data.Hourglass (Date (..), DateTime (..), Month (..), TimeOfDay (..))
|
|
import Data.List (isInfixOf, nub)
|
|
import Data.List.NonEmpty (NonEmpty (..))
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Data.Text.Encoding (decodeUtf8)
|
|
import Data.Time.Calendar (fromGregorian)
|
|
import Data.Time.Clock (UTCTime (..))
|
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
|
import Data.X509
|
|
import Simplex.Chat.Badges.Service (SubscriptionState (..))
|
|
import Simplex.Chat.PaymentService (ServicePayment (..), appleTransactionRef, googlePurchaseRef)
|
|
import Simplex.Chat.PaymentService.Types (CurrencyAmount (..))
|
|
import System.Directory (createDirectoryIfMissing)
|
|
import System.FilePath (takeDirectory, (</>))
|
|
import Test.Hspec
|
|
import UnliftIO.Temporary (withTempDirectory)
|
|
|
|
badgeStoreVerifierTests :: Spec
|
|
badgeStoreVerifierTests = describe "badge store verifiers" $ do
|
|
describe "App Store signed transactions" $ do
|
|
it "vouches for a transaction a chain to the trusted root signed, naming the transaction it was claimed by" testAppleVerdict
|
|
it "vouches for a subscription renewal by its original transaction id, the ref it is claimed by" testAppleRenewalVerdict
|
|
it "verifies a transaction under any of the trusted roots" testAppleAnyTrustedRoot
|
|
it "fails, rather than refuses, an intermediate the trusted root did not sign, since the root may be misconfigured" testAppleRootNotTrusted
|
|
it "refuses a leaf the intermediate did not sign, though the intermediate is genuine" testAppleForgedLeaf
|
|
it "fails, rather than refuses, a leaf signature the library cannot check" testAppleLeafUncheckable
|
|
it "refuses a tampered payload" testAppleTamperedPayload
|
|
it "fails, rather than refuses, a chain that is not exactly leaf, intermediate and root, a shape Apple may yet adopt" testAppleChainLength
|
|
it "fails, rather than refuses, a header that names another algorithm, a shape Apple may yet adopt" testAppleOtherAlgorithm
|
|
it "fails, rather than refuses, another app's bundle id, since ours may be misconfigured" testAppleOtherBundle
|
|
it "refuses a refunded transaction" testAppleRevoked
|
|
it "reports a Sandbox transaction as a test purchase" testAppleSandbox
|
|
it "fails, rather than refuses, a chain Apple did not mark for signing receipts" testAppleUnmarkedChain
|
|
it "fails, rather than refuses, a payload Apple signed in a shape it does not know" testAppleUnknownShape
|
|
it "fails, rather than refuses, a leaf holding a key it cannot read" testAppleLeafKey
|
|
it "records the price in the currency's minor units, or not at all" testApplePrice
|
|
it "reads the trusted root from a DER file, and reports one it cannot read or that is not a root" testReadAppleRoot
|
|
it "has nothing to acknowledge" testAppleNoAcknowledgement
|
|
describe "App Store subscriptions" $ do
|
|
it "maps each status, renewing or cancelled by autoRenewStatus, and the charge to the latest transaction, with one token reused" testAppleSubscriptionStatuses
|
|
it "reads the subscription asked about from an answer that lists another one first" testAppleSubscriptionAmongOthers
|
|
it "reports a revoked charge and one in an offer, refuses a family-shared one, and names a Sandbox one a test purchase" testAppleSubscriptionCharges
|
|
it "fails, rather than refuses, a status Apple did not sign or that was changed after signing" testAppleSubscriptionUnsigned
|
|
it "fails on a verifier that cannot place what the store signed, and is unreachable on any other throw" testSubscriptionCheckThrows
|
|
it "refuses a check the store marks as a test, and passes it through only with credit_test_purchases on" testSubscriptionCheckCreditsTest
|
|
it "fails on 401 and 403, and is unreachable on 404, 429, 5xx, no answer and an answer naming no such subscription" testAppleSubscriptionHttp
|
|
it "fails on a key Apple refuses, and at boot on a key file it cannot read" testAppleSubscriptionKey
|
|
it "checks subscriptions only where [apple] sets the API key, and one-time purchases either way" testAppleConfiguredSubscriptions
|
|
describe "Google Play purchases" $ do
|
|
it "vouches for a purchased token, asking Play about that token in this app" testPlayPurchased
|
|
it "reports a license tester's purchase as a test purchase, and a promo code's as paid" testPlayTestAndPromo
|
|
it "refuses a canceled purchase" testPlayCanceled
|
|
it "answers a pending purchase as pending" testPlayPending
|
|
it "answers 404, 5xx and every other error but 401 and 403 as unreachable" testPlayErrorStatuses
|
|
it "fails on 401 and 403, and asks for a new access token after a 401" testPlayCredentialsRefused
|
|
it "fails when the token endpoint refuses the assertion, and is unreachable when it is down" testPlayTokenEndpoint
|
|
it "fails on a body it cannot read, another product, or an unknown state" testPlayUnreadable
|
|
it "answers a Play that does not answer, or cannot be reached, as unreachable" testPlayHangsOrIsGone
|
|
it "reuses its access token while it is valid" testPlayTokenCached
|
|
it "asks for a new access token once the one it holds is about to expire" testPlayTokenExpires
|
|
it "sends no token that is only dots, and describes a token outside the grammar without quoting it" testPlayTokensNotSent
|
|
it "acknowledges a purchase, unless it is acknowledged or consumed already" testPlayAcknowledges
|
|
it "reads a purchase once to verify and acknowledge it, and acknowledges only what that read found unacknowledged" testPlayReadsPurchaseOnce
|
|
it "reports an acknowledgement Play refuses or does not answer" testPlayAcknowledgementFails
|
|
it "acknowledges through the verifier a [google] section configures" testPlayConfiguredAcknowledges
|
|
describe "Google Play subscriptions" $ do
|
|
it "maps each state, renewing or cancelled by autoRenewEnabled, asking Play by the token alone" testPlaySubscriptionStates
|
|
it "answers a pending subscription as pending, and a license tester's as a test purchase" testPlaySubscriptionPendingOrTest
|
|
it "reads the charge from the line item, its period starting the plan's length before it ends" testPlaySubscriptionCharge
|
|
it "flags a charge in a free trial or an introductory price, and not one bought on an offer now at its base price" testPlaySubscriptionOffer
|
|
it "fails on a record it cannot read, an unknown state, or a charge without its period or plan" testPlaySubscriptionUnreadable
|
|
it "fails on 401 and 403, is unreachable on 404, 429, 5xx and no answer, and ended on 410" testPlaySubscriptionHttp
|
|
it "acknowledges a subscription once, through the subscriptions endpoint, unless Play reports it acknowledged" testPlaySubscriptionAcknowledges
|
|
it "reports a subscription acknowledgement Play refuses or does not answer" testPlaySubscriptionAcknowledgementFails
|
|
it "checks Play subscriptions only where [google] is configured, beside the App Store's" testPlayConfiguredSubscriptions
|
|
|
|
-- * App Store
|
|
|
|
-- TestPurchase is the service's own refusal after a verifier vouched, so no verifier returns it here
|
|
data Outcome = Invalid | TestPurchase | Pending | Unreachable | Failed | NotConfigured | Verdict
|
|
deriving (Eq, Show)
|
|
|
|
outcome :: Either StoreRefusal a -> Outcome
|
|
outcome = \case
|
|
Left (SRInvalid _) -> Invalid
|
|
Left SRTestPurchase -> TestPurchase
|
|
Left SRPending -> Pending
|
|
Left (SRUnreachable _) -> Unreachable
|
|
Left (SRVerifierFailed _) -> Failed
|
|
Left SRNotConfigured -> NotConfigured
|
|
Right _ -> Verdict
|
|
|
|
reason :: Either StoreRefusal a -> Text
|
|
reason = \case
|
|
Left (SRInvalid r) -> r
|
|
Left (SRUnreachable r) -> r
|
|
Left (SRVerifierFailed r) -> r
|
|
_ -> ""
|
|
|
|
seamVerdict :: StoreVerifier -> ServicePayment -> IO (Either StoreRefusal VerifiedStoreTransaction)
|
|
seamVerdict verifier payment = case toStoreReceipt verifier payment of
|
|
Just (Right StoreReceipt {verifyReceipt}) -> verifyReceipt
|
|
Just (Left refusal) -> pure $ Left refusal
|
|
Nothing -> expectationFailure "not a store payment" >> undefined
|
|
|
|
ourBundleId :: Text
|
|
ourBundleId = "chat.simplex.app"
|
|
|
|
appleVerdict :: SignedCertificate -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction)
|
|
appleVerdict root = appleVerdictUnder (root :| [])
|
|
|
|
appleVerdictUnder :: NonEmpty SignedCertificate -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction)
|
|
appleVerdictUnder roots jws = seamVerdict noStoreVerifier {verifyApple = Just (verifyAppleTransaction roots ourBundleId)} SPApple {jws}
|
|
|
|
data TestChain = TestChain
|
|
{ rootCert :: SignedCertificate,
|
|
intermediateCert :: SignedCertificate,
|
|
leafCert :: SignedCertificate,
|
|
intermediateKey :: ECDSA.PrivateKey,
|
|
leafKey :: ECDSA.PrivateKey
|
|
}
|
|
|
|
appleRootName, otherRootName, intermediateName, leafName :: DistinguishedName
|
|
appleRootName = DistinguishedName [([2, 5, 4, 3], "Apple Root CA - G3")]
|
|
otherRootName = DistinguishedName [([2, 5, 4, 3], "Some Other Root")]
|
|
intermediateName = DistinguishedName [([2, 5, 4, 3], "Apple Worldwide Developer Relations Certification Authority")]
|
|
leafName = DistinguishedName [([2, 5, 4, 3], "Prod ECC Mac App Store and iTunes Store Receipt Signing")]
|
|
|
|
receiptLeafMarker, intermediateMarker :: [Integer]
|
|
receiptLeafMarker = [1, 2, 840, 113635, 100, 6, 11, 1]
|
|
intermediateMarker = [1, 2, 840, 113635, 100, 6, 2, 1]
|
|
|
|
-- | Shaped as Apple's chain, under a root of the given name; the intermediate and the leaf carry the given markers.
|
|
newChain :: DistinguishedName -> [[Integer]] -> [[Integer]] -> IO TestChain
|
|
newChain rootName intermediateMarkers leafMarkers = do
|
|
(rootKey, rootPub) <- newKeyPair
|
|
(intermediateKey, intermediatePub) <- newKeyPair
|
|
(leafKey, leafPub) <- newKeyPair
|
|
rootCert <- certify rootKey rootName rootName rootPub []
|
|
intermediateCert <- certify rootKey rootName intermediateName intermediatePub intermediateMarkers
|
|
leafCert <- certify intermediateKey intermediateName leafName leafPub leafMarkers
|
|
pure TestChain {rootCert, intermediateCert, leafCert, intermediateKey, leafKey}
|
|
|
|
trustedChain :: IO TestChain
|
|
trustedChain = newChain appleRootName [intermediateMarker] [receiptLeafMarker]
|
|
|
|
newKeyPair :: IO (ECDSA.PrivateKey, PubKey)
|
|
newKeyPair = do
|
|
(ECDSA.PublicKey _ q, k) <- ECC.generate p256
|
|
case q of
|
|
ECC.Point x y -> pure (k, PubKeyEC $ PubKeyEC_Named ECC.SEC_p256r1 $ SerializedPoint $ B.cons 4 $ i2ospOf_ 32 x <> i2ospOf_ 32 y)
|
|
ECC.PointO -> newKeyPair
|
|
|
|
p256 :: ECC.Curve
|
|
p256 = ECC.getCurveByName ECC.SEC_p256r1
|
|
|
|
certify :: ECDSA.PrivateKey -> DistinguishedName -> DistinguishedName -> PubKey -> [[Integer]] -> IO SignedCertificate
|
|
certify = certifyWith $ SignatureALG HashSHA256 PubKeyALG_EC
|
|
|
|
certifyWith :: SignatureALG -> ECDSA.PrivateKey -> DistinguishedName -> DistinguishedName -> PubKey -> [[Integer]] -> IO SignedCertificate
|
|
certifyWith alg issuerKey issuerName subjectName subjectKey markers =
|
|
objectToSignedExactF sign certificate
|
|
where
|
|
certificate =
|
|
Certificate
|
|
{ certVersion = 2,
|
|
certSerial = 1,
|
|
certSignatureAlg = alg,
|
|
certIssuerDN = issuerName,
|
|
certValidity = (DateTime (Date 2020 January 1) (TimeOfDay 0 0 0 0), DateTime (Date 2040 January 1) (TimeOfDay 0 0 0 0)),
|
|
certSubjectDN = subjectName,
|
|
certPubKey = subjectKey,
|
|
certExtensions = Extensions $ Just [ExtensionRaw oid False "\x05\x00" | oid <- markers]
|
|
}
|
|
sign tbs = (\(ECDSA.Signature r s) -> (derSignature r s, alg)) <$> ECDSA.sign issuerKey SHA256 tbs
|
|
derSignature r s = der 0x30 (der 0x02 (unsigned r) <> der 0x02 (unsigned s))
|
|
unsigned n = let bs = i2osp n in if B.head bs >= 0x80 then B.cons 0 bs else bs
|
|
|
|
transactionPayload :: [(J.Key, J.Value)] -> [J.Key] -> J.Value
|
|
transactionPayload overrides removed =
|
|
J.Object $ foldr KM.delete (KM.fromList overrides `KM.union` base) removed
|
|
where
|
|
base =
|
|
KM.fromList
|
|
[ ("transactionId", "2000000900000001"),
|
|
("originalTransactionId", "2000000900000001"),
|
|
("bundleId", J.String ourBundleId),
|
|
("productId", "BADGE_SUPPORTER_01"),
|
|
("purchaseDate", J.toJSON (1790000000000 :: Int)),
|
|
("quantity", J.toJSON (1 :: Int)),
|
|
("type", "Consumable"),
|
|
("inAppOwnershipType", "PURCHASED"),
|
|
("signedDate", J.toJSON (1790000001000 :: Int)),
|
|
("environment", "Production"),
|
|
("transactionReason", "PURCHASE"),
|
|
("storefront", "USA"),
|
|
("price", J.toJSON (7000 :: Int)),
|
|
("currency", "USD")
|
|
]
|
|
|
|
signedTransaction :: TestChain -> [SignedCertificate] -> J.Value -> J.Value -> IO Text
|
|
signedTransaction TestChain {leafKey} x5c header payload = do
|
|
let signingInput = segment header' <> "." <> segment payload
|
|
header' = case header of
|
|
J.Object h -> J.Object $ KM.insert "x5c" (J.toJSON $ map (decodeUtf8 . B64.encode . encodeSignedObject) x5c) h
|
|
v -> v
|
|
ECDSA.Signature r s <- ECDSA.sign leafKey SHA256 signingInput
|
|
pure $ decodeUtf8 $ signingInput <> "." <> B64U.encodeUnpadded (i2ospOf_ 32 r <> i2ospOf_ 32 s)
|
|
|
|
segment :: J.Value -> ByteString
|
|
segment = B64U.encodeUnpadded . LB.toStrict . J.encode
|
|
|
|
es256 :: J.Value
|
|
es256 = J.object ["alg" J..= ("ES256" :: Text)]
|
|
|
|
signedBy :: TestChain -> J.Value -> IO Text
|
|
signedBy chain@TestChain {rootCert, intermediateCert, leafCert} = signedTransaction chain [leafCert, intermediateCert, rootCert] es256
|
|
|
|
testAppleVerdict :: IO ()
|
|
testAppleVerdict = do
|
|
chain <- trustedChain
|
|
jws <- signedBy chain $ transactionPayload [] []
|
|
appleVerdict (rootCert chain) jws
|
|
`shouldReturn` Right VerifiedStoreTransaction {transactionRef = "2000000900000001", productId = "BADGE_SUPPORTER_01", quantity = 1, testPurchase = False, paid = Just (CurrencyAmount 700, "USD"), alreadyAcknowledged = False}
|
|
appleTransactionRef jws `shouldBe` Just "2000000900000001"
|
|
|
|
-- the service answers internal when the verified ref is not the claimed one, so a renewal must be vouched for by the claim's own ref
|
|
testAppleRenewalVerdict :: IO ()
|
|
testAppleRenewalVerdict = do
|
|
chain <- trustedChain
|
|
jws <- signedBy chain $ transactionPayload [("transactionId", "2000000900000002"), ("type", "Auto-Renewable Subscription"), ("productId", "SUBSCR_BADGE_SUPPORTER_MONTH_01")] []
|
|
r <- appleVerdict (rootCert chain) jws
|
|
fmap transactionRef r `shouldBe` Right "2000000900000001"
|
|
appleTransactionRef jws `shouldBe` Just "2000000900000001"
|
|
-- an auto-renewable transaction without its original id names no subscription
|
|
noOriginal <- signedBy chain $ transactionPayload [("type", "Auto-Renewable Subscription")] ["originalTransactionId"]
|
|
outcome <$> appleVerdict (rootCert chain) noOriginal `shouldReturn` Invalid
|
|
|
|
testAppleAnyTrustedRoot :: IO ()
|
|
testAppleAnyTrustedRoot = do
|
|
old <- trustedChain
|
|
new <- newChain otherRootName [intermediateMarker] [receiptLeafMarker]
|
|
forM_ [old, new] $ \chain -> do
|
|
jws <- signedBy chain $ transactionPayload [] []
|
|
fmap transactionRef <$> appleVerdictUnder (rootCert old :| [rootCert new]) jws `shouldReturn` Right "2000000900000001"
|
|
|
|
testAppleRootNotTrusted :: IO ()
|
|
testAppleRootNotTrusted = do
|
|
trusted <- trustedChain
|
|
forM_ [appleRootName, otherRootName] $ \rootName -> do
|
|
untrusted <- newChain rootName [intermediateMarker] [receiptLeafMarker]
|
|
jws <- signedBy untrusted $ transactionPayload [] []
|
|
r <- appleVerdict (rootCert trusted) jws
|
|
outcome r `shouldBe` Failed
|
|
reason r `shouldSatisfy` ("configured root" `T.isInfixOf`)
|
|
|
|
testAppleForgedLeaf :: IO ()
|
|
testAppleForgedLeaf = do
|
|
chain@TestChain {rootCert, intermediateCert} <- trustedChain
|
|
(forgedKey, forgedPub) <- newKeyPair
|
|
forgedLeaf <- certify forgedKey intermediateName leafName forgedPub [receiptLeafMarker]
|
|
jws <- signedTransaction chain {leafKey = forgedKey} [forgedLeaf, intermediateCert, rootCert] es256 $ transactionPayload [] []
|
|
outcome <$> appleVerdict rootCert jws `shouldReturn` Invalid
|
|
|
|
testAppleLeafUncheckable :: IO ()
|
|
testAppleLeafUncheckable = do
|
|
chain@TestChain {rootCert, intermediateCert} <- trustedChain
|
|
(otherKey, otherPub) <- newKeyPair
|
|
rsaLabelled <- certifyWith (SignatureALG HashSHA256 PubKeyALG_RSA) otherKey intermediateName leafName otherPub [receiptLeafMarker]
|
|
jws <- signedTransaction chain {leafKey = otherKey} [rsaLabelled, intermediateCert, rootCert] es256 $ transactionPayload [] []
|
|
r <- appleVerdict rootCert jws
|
|
outcome r `shouldBe` Failed
|
|
reason r `shouldSatisfy` ("cannot check" `T.isInfixOf`)
|
|
|
|
testAppleTamperedPayload :: IO ()
|
|
testAppleTamperedPayload = do
|
|
chain <- trustedChain
|
|
jws <- signedBy chain $ transactionPayload [] []
|
|
case T.splitOn "." jws of
|
|
[header, _, signature] -> do
|
|
let tampered = T.intercalate "." [header, decodeUtf8 $ segment $ transactionPayload [("productId", "BADGE_LEGEND_01")] [], signature]
|
|
outcome <$> appleVerdict (rootCert chain) tampered `shouldReturn` Invalid
|
|
_ -> expectationFailure "not a JWS"
|
|
|
|
testAppleChainLength :: IO ()
|
|
testAppleChainLength = do
|
|
chain@TestChain {rootCert, intermediateCert, leafCert} <- trustedChain
|
|
forM_ [[leafCert, rootCert], [leafCert, intermediateCert], [leafCert, intermediateCert, rootCert, rootCert]] $ \x5c -> do
|
|
jws <- signedTransaction chain x5c es256 $ transactionPayload [] []
|
|
outcome <$> appleVerdict rootCert jws `shouldReturn` Failed
|
|
|
|
testAppleOtherAlgorithm :: IO ()
|
|
testAppleOtherAlgorithm = do
|
|
chain@TestChain {rootCert, intermediateCert, leafCert} <- trustedChain
|
|
let x5c = [leafCert, intermediateCert, rootCert]
|
|
forM_ ["none", "HS256", "ES384"] $ \alg -> do
|
|
jws <- signedTransaction chain x5c (J.object ["alg" J..= (alg :: Text)]) $ transactionPayload [] []
|
|
outcome <$> appleVerdict rootCert jws `shouldReturn` Failed
|
|
|
|
testAppleOtherBundle :: IO ()
|
|
testAppleOtherBundle = do
|
|
chain <- trustedChain
|
|
jws <- signedBy chain $ transactionPayload [("bundleId", "com.example.other")] []
|
|
r <- appleVerdict (rootCert chain) jws
|
|
outcome r `shouldBe` Failed
|
|
reason r `shouldSatisfy` ("bundle id" `T.isInfixOf`)
|
|
|
|
testAppleRevoked :: IO ()
|
|
testAppleRevoked = do
|
|
chain <- trustedChain
|
|
jws <- signedBy chain $ transactionPayload [("revocationDate", J.toJSON (1790000500000 :: Int)), ("revocationReason", J.toJSON (0 :: Int))] []
|
|
outcome <$> appleVerdict (rootCert chain) jws `shouldReturn` Invalid
|
|
|
|
testAppleSandbox :: IO ()
|
|
testAppleSandbox = do
|
|
chain <- trustedChain
|
|
jws <- signedBy chain $ transactionPayload [("environment", "Sandbox")] []
|
|
fmap testPurchase <$> appleVerdict (rootCert chain) jws `shouldReturn` Right True
|
|
|
|
testAppleUnmarkedChain :: IO ()
|
|
testAppleUnmarkedChain =
|
|
forM_ [([intermediateMarker], []), ([], [receiptLeafMarker])] $ \(intermediateMarkers, leafMarkers) -> do
|
|
unmarked <- newChain appleRootName intermediateMarkers leafMarkers
|
|
jws <- signedBy unmarked $ transactionPayload [] []
|
|
outcome <$> appleVerdict (rootCert unmarked) jws `shouldReturn` Failed
|
|
|
|
testAppleUnknownShape :: IO ()
|
|
testAppleUnknownShape = do
|
|
chain <- trustedChain
|
|
let failsOn payload = do
|
|
jws <- signedBy chain payload
|
|
outcome <$> appleVerdict (rootCert chain) jws `shouldReturn` Failed
|
|
failsOn $ transactionPayload [("environment", "Staging")] []
|
|
failsOn $ transactionPayload [("environment", "Xcode")] []
|
|
failsOn $ transactionPayload [("environment", "LocalTesting")] []
|
|
failsOn $ transactionPayload [] ["productId"]
|
|
failsOn $ transactionPayload [("quantity", "1")] []
|
|
|
|
-- | The key is read before the signature it would check, so the chain and the payload are genuine.
|
|
testAppleLeafKey :: IO ()
|
|
testAppleLeafKey = do
|
|
chain@TestChain {rootCert, intermediateCert, intermediateKey} <- trustedChain
|
|
let failsOnLeafKey pub = do
|
|
leaf <- certify intermediateKey intermediateName leafName pub [receiptLeafMarker]
|
|
jws <- signedTransaction chain [leaf, intermediateCert, rootCert] es256 $ transactionPayload [] []
|
|
outcome <$> appleVerdict rootCert jws `shouldReturn` Failed
|
|
failsOnLeafKey $ PubKeyEC $ PubKeyEC_Named ECC.SEC_p384r1 $ SerializedPoint $ B.cons 4 $ B.replicate 64 1
|
|
failsOnLeafKey $ PubKeyEC $ PubKeyEC_Named ECC.SEC_p256r1 $ SerializedPoint "\x04"
|
|
|
|
testApplePrice :: IO ()
|
|
testApplePrice = do
|
|
chain <- trustedChain
|
|
let paidFor fields removed = do
|
|
jws <- signedBy chain $ transactionPayload fields removed
|
|
fmap paid <$> appleVerdict (rootCert chain) jws
|
|
priced price currency = paidFor [("price", J.toJSON (price :: Int)), ("currency", currency)] []
|
|
-- Apple's own examples: $1.99, JPY 300 and KRW 3300
|
|
priced 1990 "USD" `shouldReturn` Right (Just (CurrencyAmount 199, "USD"))
|
|
priced 300000 "JPY" `shouldReturn` Right (Just (CurrencyAmount 300, "JPY"))
|
|
priced 3300000 "KRW" `shouldReturn` Right (Just (CurrencyAmount 3300, "KRW"))
|
|
priced 1234 "KWD" `shouldReturn` Right (Just (CurrencyAmount 1234, "KWD"))
|
|
priced 1995 "USD" `shouldReturn` Right Nothing
|
|
priced 1000 "CLF" `shouldReturn` Right Nothing
|
|
priced 1000 "usd" `shouldReturn` Right Nothing
|
|
paidFor [] ["price", "currency"] `shouldReturn` Right Nothing
|
|
|
|
testReadAppleRoot :: IO ()
|
|
testReadAppleRoot = do
|
|
TestChain {rootCert, intermediateCert} <- trustedChain
|
|
readAppleRoot ("apps" </> "simplex-badge-service" </> "test-fixtures" </> "apple" </> "AppleRootCA-G3.cer") >>= (`shouldSatisfy` isRight)
|
|
createDirectoryIfMissing True "tests/tmp"
|
|
withTempDirectory "tests/tmp" "apple-root" $ \d -> do
|
|
B.writeFile (d </> "root.cer") (encodeSignedObject rootCert)
|
|
readAppleRoot (d </> "root.cer") `shouldReturn` Right rootCert
|
|
B.writeFile (d </> "root.pem") "-----BEGIN CERTIFICATE-----\n"
|
|
readAppleRoot (d </> "root.pem") >>= (`shouldSatisfy` either ("not a DER certificate" `isInfixOf`) (const False))
|
|
readAppleRoot (d </> "absent.cer") >>= (`shouldSatisfy` either ("could not be read" `isInfixOf`) (const False))
|
|
B.writeFile (d </> "intermediate.cer") (encodeSignedObject intermediateCert)
|
|
readAppleRoot (d </> "intermediate.cer") >>= (`shouldSatisfy` either ("not a self-signed root certificate" `isInfixOf`) (const False))
|
|
|
|
testAppleNoAcknowledgement :: IO ()
|
|
testAppleNoAcknowledgement = do
|
|
chain <- trustedChain
|
|
jws <- signedBy chain $ transactionPayload [] []
|
|
withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
acknowledgement verifier {verifyApple = Just (verifyAppleTransaction (rootCert chain :| []) ourBundleId)} SPApple {jws} `shouldReturn` Nothing
|
|
|
|
-- * App Store subscriptions
|
|
|
|
subscriptionId :: Text
|
|
subscriptionId = "2000000900000001"
|
|
|
|
periodStartMs, periodEndMs :: Int
|
|
periodStartMs = 1790000000000
|
|
periodEndMs = periodStartMs + 30 * 86400000
|
|
|
|
-- | A renewal of the subscription subscriptionId names: a transaction of its own, under the original one.
|
|
subscriptionPayload :: [(J.Key, J.Value)] -> [J.Key] -> J.Value
|
|
subscriptionPayload overrides =
|
|
transactionPayload $
|
|
[ ("transactionId", "2000000900000002"),
|
|
("type", "Auto-Renewable Subscription"),
|
|
("productId", "SUBSCR_BADGE_SUPPORTER_MONTH_01"),
|
|
("purchaseDate", J.toJSON periodStartMs),
|
|
("expiresDate", J.toJSON periodEndMs),
|
|
("transactionReason", "RENEWAL")
|
|
]
|
|
<> overrides
|
|
|
|
renewalPayload :: [(J.Key, J.Value)] -> J.Value
|
|
renewalPayload overrides =
|
|
J.Object $
|
|
KM.fromList $
|
|
[ ("originalTransactionId", J.String subscriptionId),
|
|
("autoRenewStatus", J.toJSON (1 :: Int)),
|
|
("autoRenewProductId", "SUBSCR_BADGE_SUPPORTER_MONTH_01"),
|
|
("productId", "SUBSCR_BADGE_SUPPORTER_MONTH_01"),
|
|
("environment", "Production"),
|
|
("signedDate", J.toJSON (1790000001000 :: Int))
|
|
]
|
|
<> overrides
|
|
|
|
-- | Get All Subscription Statuses as Apple answers it, with the subscription's latest transaction.
|
|
statusBody :: Int -> Text -> Text -> J.Value
|
|
statusBody status signedTx signedRenewal = statusListing [lastTransaction subscriptionId status signedTx signedRenewal]
|
|
|
|
-- | Get All Subscription Statuses listing these subscriptions, all in one subscription group.
|
|
statusListing :: [J.Value] -> J.Value
|
|
statusListing lastTransactions =
|
|
J.object
|
|
[ "environment" J..= ("Production" :: Text),
|
|
"bundleId" J..= ourBundleId,
|
|
"data"
|
|
J..= [ J.object
|
|
[ "subscriptionGroupIdentifier" J..= ("21000000" :: Text),
|
|
"lastTransactions" J..= lastTransactions
|
|
]
|
|
]
|
|
]
|
|
|
|
lastTransaction :: Text -> Int -> Text -> Text -> J.Value
|
|
lastTransaction originalId status signedTx signedRenewal =
|
|
J.object ["originalTransactionId" J..= originalId, "status" J..= status, "signedTransactionInfo" J..= signedTx, "signedRenewalInfo" J..= signedRenewal]
|
|
|
|
-- | The check the service runs, through the same runner as a purchase and a renewal.
|
|
withAppleChecker :: TestChain -> (FakeAppStore -> (Text -> IO (Either StoreRefusal SubscriptionCheck)) -> IO a) -> IO a
|
|
withAppleChecker chain action = withFakeAppStore ourBundleId $ \fake -> do
|
|
check <- appleChecker chain (fasApi fake)
|
|
action fake $ \originalId -> checkStoreSubscription noStoreVerifier {checkSubscription = Just (\ref _ -> check ref), verifyTimeout = 2000000} (SubscriptionApple originalId) Nothing
|
|
|
|
appleChecker :: TestChain -> AppleServerApi -> IO (SubscriptionRef -> IO (Either StoreRefusal SubscriptionCheck))
|
|
appleChecker chain serverApi =
|
|
appleSubscriptionChecker (rootCert chain :| []) ourBundleId serverApi >>= \case
|
|
Right check -> pure $ \case
|
|
SubscriptionApple originalId -> check originalId
|
|
SubscriptionGoogle _ -> pure $ Left SRNotConfigured
|
|
Left e -> expectationFailure e >> undefined
|
|
|
|
-- | Signs the transaction and the renewal info with the given chain, and serves them as the subscription's status.
|
|
serveStatus :: FakeAppStore -> TestChain -> Int -> J.Value -> J.Value -> IO ()
|
|
serveStatus fake chain status transaction renewal = do
|
|
signedTx <- signedBy chain transaction
|
|
signedRenewal <- signedBy chain renewal
|
|
answerStatus fake subscriptionId $ AppStoreBody $ statusBody status signedTx signedRenewal
|
|
|
|
stateOf :: Either StoreRefusal SubscriptionCheck -> Either StoreRefusal SubscriptionState
|
|
stateOf = fmap $ \SubscriptionCheck {subscriptionState} -> subscriptionState
|
|
|
|
chargeOf :: Either StoreRefusal SubscriptionCheck -> Either StoreRefusal (Maybe (Text, Text, UTCTime, UTCTime, Maybe (CurrencyAmount, Text), Bool, Bool))
|
|
chargeOf = fmap $ \SubscriptionCheck {latestCharge} ->
|
|
(\StoreCharge {chargeRef, planId, periodStart, periodEnd, chargePaid, revoked, offer} -> (chargeRef, planId, periodStart, periodEnd, chargePaid, revoked, offer)) <$> latestCharge
|
|
|
|
testAppleSubscriptionStatuses :: IO ()
|
|
testAppleSubscriptionStatuses = do
|
|
chain <- trustedChain
|
|
withAppleChecker chain $ \fake check -> do
|
|
let stateFor status autoRenew = do
|
|
serveStatus fake chain status (subscriptionPayload [] []) (renewalPayload [("autoRenewStatus", J.toJSON (autoRenew :: Int))])
|
|
stateOf <$> check subscriptionId
|
|
stateFor 1 1 `shouldReturn` Right SSRenewing
|
|
stateFor 1 0 `shouldReturn` Right SSCancelled
|
|
stateFor 3 1 `shouldReturn` Right SSBillingRetry
|
|
stateFor 4 1 `shouldReturn` Right SSBillingRetry
|
|
stateFor 2 0 `shouldReturn` Right SSEnded
|
|
stateFor 5 0 `shouldReturn` Right SSEnded
|
|
outcome <$> stateFor 6 1 `shouldReturn` Failed
|
|
-- the charge is the latest transaction: its own id, its product as the plan, and its period
|
|
serveStatus fake chain 1 (subscriptionPayload [] []) (renewalPayload [])
|
|
chargeOf <$> check subscriptionId
|
|
`shouldReturn` Right (Just ("2000000900000002", "SUBSCR_BADGE_SUPPORTER_MONTH_01", millis periodStartMs, millis periodEndMs, Just (CurrencyAmount 700, "USD"), False, False))
|
|
-- each call carried a token the fake accepted, signed once and reused
|
|
tokens <- readTVarIO (fasTokens fake)
|
|
length tokens `shouldBe` 8
|
|
length (nub tokens) `shouldBe` 1
|
|
where
|
|
millis ms = posixSecondsToUTCTime $ fromIntegral ms / 1000
|
|
|
|
-- | Apple lists every subscription the customer holds in the app, a family member's shared one included.
|
|
testAppleSubscriptionAmongOthers :: IO ()
|
|
testAppleSubscriptionAmongOthers = do
|
|
chain <- trustedChain
|
|
withAppleChecker chain $ \fake check -> do
|
|
let sharedId = "2000000900000011"
|
|
sharedTx <- signedBy chain $ subscriptionPayload [("originalTransactionId", J.String sharedId), ("transactionId", "2000000900000012"), ("inAppOwnershipType", "FAMILY_SHARED")] []
|
|
sharedRenewal <- signedBy chain $ renewalPayload [("originalTransactionId", J.String sharedId)]
|
|
ownTx <- signedBy chain $ subscriptionPayload [] []
|
|
ownRenewal <- signedBy chain $ renewalPayload []
|
|
answerStatus fake subscriptionId $ AppStoreBody $ statusListing [lastTransaction sharedId 1 sharedTx sharedRenewal, lastTransaction subscriptionId 1 ownTx ownRenewal]
|
|
stateOf <$> check subscriptionId `shouldReturn` Right SSRenewing
|
|
|
|
testAppleSubscriptionCharges :: IO ()
|
|
testAppleSubscriptionCharges = do
|
|
chain <- trustedChain
|
|
withAppleChecker chain $ \fake check -> do
|
|
let answerFor transaction = serveStatus fake chain 1 transaction (renewalPayload []) >> check subscriptionId
|
|
flags = fmap (fmap (\(_, _, _, _, _, revoked, offer) -> (revoked, offer))) . chargeOf
|
|
flags <$> answerFor (subscriptionPayload [("revocationDate", J.toJSON (1790000500000 :: Int))] []) `shouldReturn` Right (Just (True, False))
|
|
flags <$> answerFor (subscriptionPayload [("offerType", J.toJSON (1 :: Int))] []) `shouldReturn` Right (Just (False, True))
|
|
-- family sharing is off, so a family-shared transaction is no purchase of this badge
|
|
outcome <$> answerFor (subscriptionPayload [("inAppOwnershipType", "FAMILY_SHARED")] []) `shouldReturn` Invalid
|
|
-- a defence: the production host never answers about a Sandbox transaction
|
|
outcome <$> answerFor (subscriptionPayload [("environment", "Sandbox")] []) `shouldReturn` TestPurchase
|
|
outcome <$> answerFor (subscriptionPayload [("bundleId", "com.example.other")] []) `shouldReturn` Failed
|
|
outcome <$> answerFor (subscriptionPayload [("originalTransactionId", "2000000900000009")] []) `shouldReturn` Failed
|
|
outcome <$> answerFor (subscriptionPayload [] ["expiresDate"]) `shouldReturn` Failed
|
|
|
|
-- | Apple answered, and no client presented any of it, so a status that fails the chain check is this
|
|
-- service's failure: never a refusal, which would drop a buyer's keys.
|
|
testAppleSubscriptionUnsigned :: IO ()
|
|
testAppleSubscriptionUnsigned = do
|
|
chain@TestChain {rootCert, intermediateCert} <- trustedChain
|
|
withAppleChecker chain $ \fake check -> do
|
|
let failsOn transaction renewal = do
|
|
answerStatus fake subscriptionId $ AppStoreBody $ statusBody 1 transaction renewal
|
|
outcome <$> check subscriptionId `shouldReturn` Failed
|
|
signedRenewal <- signedBy chain $ renewalPayload []
|
|
signedTx <- signedBy chain $ subscriptionPayload [] []
|
|
untrusted <- newChain otherRootName [intermediateMarker] [receiptLeafMarker]
|
|
signedBy untrusted (subscriptionPayload [] []) >>= \tx -> failsOn tx signedRenewal
|
|
(forgedKey, forgedPub) <- newKeyPair
|
|
forgedLeaf <- certify forgedKey intermediateName leafName forgedPub [receiptLeafMarker]
|
|
signedTransaction chain {leafKey = forgedKey} [forgedLeaf, intermediateCert, rootCert] es256 (subscriptionPayload [] []) >>= \tx -> failsOn tx signedRenewal
|
|
failsOn (tampered signedTx $ subscriptionPayload [("productId", "SUBSCR_BADGE_LEGEND_YEAR_01")] []) signedRenewal
|
|
failsOn signedTx (tampered signedRenewal $ renewalPayload [("autoRenewStatus", J.toJSON (0 :: Int))])
|
|
where
|
|
tampered jws payload = case T.splitOn "." jws of
|
|
[header, _, signature] -> T.intercalate "." [header, decodeUtf8 $ segment payload, signature]
|
|
_ -> jws
|
|
|
|
-- | A verifier that cannot place what the store signed throws StoreVerifierFailure, which is its own
|
|
-- failure; any other throw is the network's, as for Play.
|
|
testSubscriptionCheckThrows :: IO ()
|
|
testSubscriptionCheckThrows = do
|
|
let throwing act = checkStoreSubscription noStoreVerifier {checkSubscription = Just (\_ _ -> act), verifyTimeout = 2000000} (SubscriptionApple subscriptionId) Nothing
|
|
outcome <$> throwing (throwIO $ StoreVerifierFailure "apple verifier: a chain it cannot place") `shouldReturn` Failed
|
|
outcome <$> throwing (ioError $ userError "connection reset") `shouldReturn` Unreachable
|
|
|
|
testSubscriptionCheckCreditsTest :: IO ()
|
|
testSubscriptionCheckCreditsTest = do
|
|
let testCheck = SubscriptionCheck {subscriptionState = SSRenewing, testSubscription = True, latestCharge = Nothing}
|
|
checkCrediting credit = checkStoreSubscription noStoreVerifier {checkSubscription = Just (\_ _ -> pure (Right testCheck)), creditTestPurchases = credit} (SubscriptionApple subscriptionId) Nothing
|
|
outcome <$> checkCrediting False `shouldReturn` TestPurchase
|
|
fmap (\SubscriptionCheck {subscriptionState, testSubscription} -> (subscriptionState, testSubscription)) <$> checkCrediting True `shouldReturn` Right (SSRenewing, True)
|
|
|
|
testAppleSubscriptionHttp :: IO ()
|
|
testAppleSubscriptionHttp = do
|
|
chain <- trustedChain
|
|
withAppleChecker chain $ \fake check -> do
|
|
let answeredWith answer = answerStatus fake subscriptionId answer >> (outcome <$> check subscriptionId)
|
|
answeredWith (AppStoreStatus 401) `shouldReturn` Failed
|
|
answeredWith (AppStoreStatus 403) `shouldReturn` Failed
|
|
forM_ [404, 429, 500, 503] $ \code -> answeredWith (AppStoreStatus code) `shouldReturn` Unreachable
|
|
answeredWith AppStoreHang `shouldReturn` Unreachable
|
|
answeredWith (AppStoreBody $ J.object ["data" J..= ([] :: [J.Value])]) `shouldReturn` Unreachable
|
|
-- an id that is not one names no App Store transaction, and is not sent
|
|
tokens <- length <$> readTVarIO (fasTokens fake)
|
|
outcome <$> check "2000000900000001/../x" `shouldReturn` Failed
|
|
length <$> readTVarIO (fasTokens fake) `shouldReturn` tokens
|
|
|
|
testAppleSubscriptionKey :: IO ()
|
|
testAppleSubscriptionKey = do
|
|
chain <- trustedChain
|
|
withFakeAppStore ourBundleId $ \fake@FakeAppStore {fasApi = api@AppleServerApi {aPrivateKeyFile}} -> do
|
|
serveStatus fake chain 1 (subscriptionPayload [] []) (renewalPayload [])
|
|
-- a key App Store Connect did not issue for this account is refused, and is this service's failure
|
|
let otherKeyFile = takeDirectory aPrivateKeyFile </> "OtherKey.p8"
|
|
_ <- writeApiKey otherKeyFile
|
|
otherKey <- appleChecker chain api {aPrivateKeyFile = otherKeyFile}
|
|
outcome <$> otherKey (SubscriptionApple subscriptionId) `shouldReturn` Failed
|
|
readTVarIO (fasTokens fake) `shouldReturn` []
|
|
appleSubscriptionChecker (rootCert chain :| []) ourBundleId api {aPrivateKeyFile = takeDirectory aPrivateKeyFile </> "absent.p8"}
|
|
>>= either (`shouldContain` "could not be read") (const $ expectationFailure "an absent key file must fail at boot")
|
|
B.writeFile otherKeyFile "-----BEGIN PRIVATE KEY-----\n-----END PRIVATE KEY-----\n"
|
|
appleSubscriptionChecker (rootCert chain :| []) ourBundleId api {aPrivateKeyFile = otherKeyFile}
|
|
>>= either (`shouldContain` "P-256") (const $ expectationFailure "a file holding no key must fail at boot")
|
|
|
|
-- | Without the API key [apple] verifies one-time purchases as before, and no subscription.
|
|
testAppleConfiguredSubscriptions :: IO ()
|
|
testAppleConfiguredSubscriptions = do
|
|
chain <- trustedChain
|
|
withFakeAppStore ourBundleId $ \fake@FakeAppStore {fasApi} -> do
|
|
let dir = takeDirectory (aPrivateKeyFile fasApi)
|
|
rootFile = dir </> "root.cer"
|
|
ini = dir </> "badge_service.ini"
|
|
apple serverApi = Just AppleStoreConfig {aBundleId = ourBundleId, aRootCertificates = rootFile :| [], aServerApi = serverApi}
|
|
B.writeFile rootFile (encodeSignedObject $ rootCert chain)
|
|
writeFile ini "[listener]\nstatic_dir = /srv/badges\n"
|
|
Right cfg <- readServiceConfig ini
|
|
ServiceState {storeVerifier = withKey} <- newServiceState >>= configureStoreVerifier (Just cfg {appleStore = apple (Just fasApi)})
|
|
ServiceState {storeVerifier = withoutKey} <- newServiceState >>= configureStoreVerifier (Just cfg {appleStore = apple Nothing})
|
|
serveStatus fake chain 1 (subscriptionPayload [] []) (renewalPayload [])
|
|
stateOf <$> checkStoreSubscription withKey (SubscriptionApple subscriptionId) Nothing `shouldReturn` Right SSRenewing
|
|
outcome <$> checkStoreSubscription withoutKey (SubscriptionApple subscriptionId) Nothing `shouldReturn` NotConfigured
|
|
jws <- signedBy chain $ transactionPayload [] []
|
|
outcome <$> seamVerdict withoutKey SPApple {jws} `shouldReturn` Verdict
|
|
|
|
-- * Google Play
|
|
|
|
playVerifier :: FakePlay -> IO StoreVerifier
|
|
playVerifier fake =
|
|
playStoreVerifier (fpConfig fake) >>= \case
|
|
Right PlayVerifier {verifyPlayPurchase, acknowledgePlayPurchase, checkPlaySubscription, acknowledgePlaySubscription} ->
|
|
pure
|
|
noStoreVerifier
|
|
{ verifyGoogle = Just verifyPlayPurchase,
|
|
acknowledgeGoogle = Just acknowledgePlayPurchase,
|
|
acknowledgeGoogleSubscription = Just acknowledgePlaySubscription,
|
|
checkSubscription = Just $ \ref _ -> case ref of
|
|
SubscriptionGoogle token -> checkPlaySubscription token
|
|
SubscriptionApple _ -> pure $ Left SRNotConfigured,
|
|
verifyTimeout = 2000000
|
|
}
|
|
Left e -> expectationFailure e >> undefined
|
|
|
|
acknowledgement :: StoreVerifier -> ServicePayment -> IO (Maybe (Either StoreRefusal ()))
|
|
acknowledgement = acknowledgementBy $ \StoreReceipt {verifyReceipt, acknowledgeReceipt} ->
|
|
verifyReceipt >>= \case
|
|
Right tx -> traverse ($ tx) acknowledgeReceipt
|
|
Left refusal -> expectationFailure ("not verified: " <> show refusal) >> undefined
|
|
|
|
subscriptionAcknowledgement :: StoreVerifier -> ServicePayment -> IO (Maybe (Either StoreRefusal ()))
|
|
subscriptionAcknowledgement = acknowledgementBy $ \StoreReceipt {acknowledgeSubscription} -> sequence acknowledgeSubscription
|
|
|
|
acknowledgementBy :: (StoreReceipt -> IO (Maybe (Either StoreRefusal ()))) -> StoreVerifier -> ServicePayment -> IO (Maybe (Either StoreRefusal ()))
|
|
acknowledgementBy acknowledge verifier payment = case toStoreReceipt verifier payment of
|
|
Just (Right receipt) -> acknowledge receipt
|
|
_ -> expectationFailure "not a store receipt" >> undefined
|
|
|
|
playVerdict :: StoreVerifier -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction)
|
|
playVerdict verifier token = seamVerdict verifier SPGoogle {productId = "badge_supporter_01", token}
|
|
|
|
purchaseRecord :: Int -> [(J.Key, J.Value)] -> J.Value
|
|
purchaseRecord state fields =
|
|
J.Object $
|
|
KM.fromList fields
|
|
`KM.union` KM.fromList
|
|
[ ("kind", "androidpublisher#productPurchase"),
|
|
("purchaseTimeMillis", "1790000000000"),
|
|
("purchaseState", J.toJSON state),
|
|
("consumptionState", J.toJSON (0 :: Int)),
|
|
("orderId", "GPA.3312-4521-8899-01234"),
|
|
("acknowledgementState", J.toJSON (0 :: Int)),
|
|
("regionCode", "US")
|
|
]
|
|
|
|
testToken :: Text
|
|
testToken = "fake-play-token.AO-J1Oz9x2kqE7wYt3"
|
|
|
|
-- | Every reason reaches the service's log, which must never hold the token.
|
|
answeredAs :: StoreVerifier -> Text -> Outcome -> IO ()
|
|
answeredAs verifier token expected = do
|
|
r <- playVerdict verifier token
|
|
outcome r `shouldBe` expected
|
|
reason r `shouldNotSatisfy` (token `T.isInfixOf`)
|
|
|
|
testPlayPurchased :: IO ()
|
|
testPlayPurchased = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
playVerdict verifier testToken
|
|
`shouldReturn` Right VerifiedStoreTransaction {transactionRef = googlePurchaseRef testToken, productId = "badge_supporter_01", quantity = 1, testPurchase = False, paid = Nothing, alreadyAcknowledged = False}
|
|
readTVarIO (fpPurchasePaths fake)
|
|
`shouldReturn` [["androidpublisher", "v3", "applications", fakePackageName, "purchases", "products", "badge_supporter_01", "tokens", testToken]]
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 [("quantity", J.toJSON (2 :: Int)), ("productId", "badge_supporter_01")]
|
|
fmap quantity <$> playVerdict verifier testToken `shouldReturn` Right 2
|
|
|
|
testPlayTestAndPromo :: IO ()
|
|
testPlayTestAndPromo = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 [("purchaseType", J.toJSON (0 :: Int))]
|
|
fmap testPurchase <$> playVerdict verifier testToken `shouldReturn` Right True
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 [("purchaseType", J.toJSON (1 :: Int))]
|
|
fmap testPurchase <$> playVerdict verifier testToken `shouldReturn` Right False
|
|
|
|
testPlayCanceled :: IO ()
|
|
testPlayCanceled = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 1 []
|
|
answeredAs verifier testToken Invalid
|
|
|
|
testPlayPending :: IO ()
|
|
testPlayPending = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 2 []
|
|
answeredAs verifier testToken Pending
|
|
|
|
testPlayErrorStatuses :: IO ()
|
|
testPlayErrorStatuses = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answeredAs verifier testToken Unreachable
|
|
forM_ [400, 404, 410, 429, 500, 503] $ \code -> do
|
|
answerPurchase fake testToken $ PlayStatus code
|
|
answeredAs verifier testToken Unreachable
|
|
|
|
testPlayCredentialsRefused :: IO ()
|
|
testPlayCredentialsRefused = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayStatus 403
|
|
answeredAs verifier testToken Failed
|
|
answerPurchase fake testToken $ PlayStatus 401
|
|
answeredAs verifier testToken Failed
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
answeredAs verifier testToken Verdict
|
|
length <$> readTVarIO (fpGrantedTokens fake) `shouldReturn` 2
|
|
|
|
testPlayTokenEndpoint :: IO ()
|
|
testPlayTokenEndpoint = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
forM_ [400, 401] $ \code -> do
|
|
answerTokenRequests fake $ Just code
|
|
answeredAs verifier testToken Failed
|
|
forM_ [429, 503] $ \code -> do
|
|
answerTokenRequests fake $ Just code
|
|
answeredAs verifier testToken Unreachable
|
|
answerTokenRequests fake Nothing
|
|
answeredAs verifier testToken Verdict
|
|
readTVarIO (fpPurchasePaths fake) >>= (`shouldSatisfy` ((== 1) . length))
|
|
|
|
testPlayUnreadable :: IO ()
|
|
testPlayUnreadable = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
forM_
|
|
[ PlayBody "<html>not json</html>",
|
|
PlayBody "{\"purchaseState\":\"0\"}",
|
|
PlayRecord $ J.object ["kind" J..= ("androidpublisher#productPurchase" :: Text)],
|
|
PlayRecord $ purchaseRecord 0 [("productId", "badge_legend_01")],
|
|
PlayRecord $ purchaseRecord 3 [],
|
|
PlayRecord $ purchaseRecord 0 [("purchaseType", J.toJSON (2 :: Int))],
|
|
PlayBody $ J.encode (purchaseRecord 0 []) <> LB.replicate (1024 * 1024) 32
|
|
]
|
|
$ \answer -> do
|
|
answerPurchase fake testToken answer
|
|
answeredAs verifier testToken Failed
|
|
|
|
testPlayHangsOrIsGone :: IO ()
|
|
testPlayHangsOrIsGone = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken PlayHang
|
|
r <- playVerdict verifier testToken
|
|
(outcome r, reason r) `shouldBe` (Unreachable, "google verifier timed out")
|
|
-- not a stopped stub's port, which a test running alongside may already have been given
|
|
gone <- playVerifier fake {fpConfig = (fpConfig fake) {gApiHost = "http://127.0.0.1:1"}}
|
|
answeredAs gone testToken Unreachable
|
|
|
|
testPlayTokenCached :: IO ()
|
|
testPlayTokenCached = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
answeredAs verifier testToken Verdict
|
|
answeredAs verifier testToken Verdict
|
|
length <$> readTVarIO (fpGrantedTokens fake) `shouldReturn` 1
|
|
|
|
testPlayTokenExpires :: IO ()
|
|
testPlayTokenExpires = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
grantTokensFor fake 300
|
|
answeredAs verifier testToken Verdict
|
|
answeredAs verifier testToken Verdict
|
|
length <$> readTVarIO (fpGrantedTokens fake) `shouldReturn` 2
|
|
|
|
testPlayTokensNotSent :: IO ()
|
|
testPlayTokensNotSent = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answeredAs verifier ".." Unreachable
|
|
let outside = "fake/play+token=AO-J1Oz9x2kqE7wYt3"
|
|
r <- playVerdict verifier outside
|
|
outcome r `shouldBe` Unreachable
|
|
reason r `shouldBe` "a Play token this service will not send: 34 characters: lowercase, uppercase, digits, '-', other printable ASCII"
|
|
readTVarIO (fpPurchasePaths fake) `shouldReturn` []
|
|
|
|
testPlayAcknowledges :: IO ()
|
|
testPlayAcknowledges = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let acknowledging = acknowledgement verifier SPGoogle {productId = "badge_supporter_01", token = testToken}
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
acknowledging `shouldReturn` Just (Right ())
|
|
readTVarIO (fpAcknowledged fake) `shouldReturn` [testToken]
|
|
forM_ ["acknowledgementState", "consumptionState"] $ \state -> do
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 [(state, J.toJSON (1 :: Int))]
|
|
acknowledging `shouldReturn` Just (Right ())
|
|
readTVarIO (fpAcknowledged fake) `shouldReturn` [testToken]
|
|
|
|
testPlayReadsPurchaseOnce :: IO ()
|
|
testPlayReadsPurchaseOnce = do
|
|
requestsFor [] `shouldReturn` (1, [testToken])
|
|
forM_ ["acknowledgementState", "consumptionState"] $ \state ->
|
|
requestsFor [(state, J.toJSON (1 :: Int))] `shouldReturn` (1, [])
|
|
where
|
|
requestsFor fields = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 fields
|
|
acknowledgement verifier SPGoogle {productId = "badge_supporter_01", token = testToken} `shouldReturn` Just (Right ())
|
|
(,) <$> (length <$> readTVarIO (fpPurchasePaths fake)) <*> readTVarIO (fpAcknowledged fake)
|
|
|
|
testPlayAcknowledgementFails :: IO ()
|
|
testPlayAcknowledgementFails = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let acknowledgedAs expected = do
|
|
r <- acknowledgement verifier SPGoogle {productId = "badge_supporter_01", token = testToken}
|
|
outcome <$> r `shouldBe` Just expected
|
|
maybe "" reason r `shouldSatisfy` ("acknowledging: " `T.isPrefixOf`)
|
|
maybe "" reason r `shouldNotSatisfy` (testToken `T.isInfixOf`)
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
answerAcknowledgements fake $ Just $ PlayStatus 403
|
|
acknowledgedAs Failed
|
|
answerAcknowledgements fake $ Just $ PlayStatus 503
|
|
acknowledgedAs Unreachable
|
|
answerAcknowledgements fake $ Just PlayHang
|
|
acknowledgedAs Unreachable
|
|
readTVarIO (fpAcknowledged fake) `shouldReturn` []
|
|
|
|
testPlayConfiguredAcknowledges :: IO ()
|
|
testPlayConfiguredAcknowledges = withFakePlay $ \fake@FakePlay {fpConfig} -> do
|
|
let ini = takeDirectory (gServiceAccountFile fpConfig) </> "badge_service.ini"
|
|
writeFile ini "[listener]\nstatic_dir = /srv/badges\n"
|
|
Right cfg <- readServiceConfig ini
|
|
ServiceState {storeVerifier} <- newServiceState >>= configureStoreVerifier (Just cfg {playStore = Just fpConfig})
|
|
answerPurchase fake testToken $ PlayRecord $ purchaseRecord 0 []
|
|
acknowledgement storeVerifier SPGoogle {productId = "badge_supporter_01", token = testToken} `shouldReturn` Just (Right ())
|
|
readTVarIO (fpAcknowledged fake) `shouldReturn` [testToken]
|
|
|
|
-- * Google Play subscriptions
|
|
|
|
subscriptionToken :: Text
|
|
subscriptionToken = "fake-play-subscription-token.AO-J1Oz9x2kqE7wYt4"
|
|
|
|
subscriptionProductId :: Text
|
|
subscriptionProductId = "subscr_badge_supporter_01"
|
|
|
|
-- | purchases.subscriptionsv2 as Play answers it, unacknowledged.
|
|
subscriptionRecord :: Text -> [(J.Key, J.Value)] -> [J.Value] -> J.Value
|
|
subscriptionRecord state overrides items =
|
|
J.Object $
|
|
KM.fromList overrides
|
|
`KM.union` KM.fromList
|
|
[ ("kind", "androidpublisher#subscriptionPurchaseV2"),
|
|
("regionCode", "US"),
|
|
("startTime", "2026-09-14T10:00:00.123456789Z"),
|
|
("subscriptionState", J.String state),
|
|
("latestOrderId", "GPA.3312-4521-8899-01234..1"),
|
|
("acknowledgementState", "ACKNOWLEDGEMENT_STATE_PENDING"),
|
|
("lineItems", J.toJSON items)
|
|
]
|
|
|
|
-- | A monthly supporter plan's line item, renewing at the base price.
|
|
lineItem :: [(J.Key, J.Value)] -> [J.Key] -> J.Value
|
|
lineItem overrides removed =
|
|
J.Object $ foldr KM.delete (KM.fromList overrides `KM.union` base) removed
|
|
where
|
|
base =
|
|
KM.fromList
|
|
[ ("productId", J.String subscriptionProductId),
|
|
("expiryTime", "2026-11-14T10:00:00.123456789Z"),
|
|
("autoRenewingPlan", J.object ["autoRenewEnabled" J..= True]),
|
|
("offerDetails", J.object ["basePlanId" J..= ("subscr-badge-supporter-month-02" :: Text)]),
|
|
("latestSuccessfulOrderId", "GPA.3312-4521-8899-01234..1"),
|
|
("offerPhase", J.object ["basePrice" J..= J.object []])
|
|
]
|
|
|
|
basePlan :: Text -> (J.Key, J.Value)
|
|
basePlan planId = ("offerDetails", J.object ["basePlanId" J..= planId])
|
|
|
|
answerSubscription :: FakePlay -> J.Value -> IO ()
|
|
answerSubscription fake = answerPurchase fake subscriptionToken . PlayRecord
|
|
|
|
-- | Through the same runner as a purchase and a renewal; every reason reaches the service's log, which must never hold the token.
|
|
playCheck :: StoreVerifier -> IO (Either StoreRefusal SubscriptionCheck)
|
|
playCheck verifier = do
|
|
r <- checkStoreSubscription verifier (SubscriptionGoogle subscriptionToken) Nothing
|
|
reason r `shouldNotSatisfy` (subscriptionToken `T.isInfixOf`)
|
|
pure r
|
|
|
|
testPlaySubscriptionStates :: IO ()
|
|
testPlaySubscriptionStates = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let stateFor state autoRenew = do
|
|
answerSubscription fake $ subscriptionRecord state [] [lineItem [("autoRenewingPlan", J.object ["autoRenewEnabled" J..= autoRenew])] []]
|
|
stateOf <$> playCheck verifier
|
|
stateFor "SUBSCRIPTION_STATE_ACTIVE" True `shouldReturn` Right SSRenewing
|
|
stateFor "SUBSCRIPTION_STATE_ACTIVE" False `shouldReturn` Right SSCancelled
|
|
stateFor "SUBSCRIPTION_STATE_PAUSED" True `shouldReturn` Right SSRenewing
|
|
stateFor "SUBSCRIPTION_STATE_PAUSED" False `shouldReturn` Right SSCancelled
|
|
stateFor "SUBSCRIPTION_STATE_IN_GRACE_PERIOD" True `shouldReturn` Right SSBillingRetry
|
|
stateFor "SUBSCRIPTION_STATE_ON_HOLD" True `shouldReturn` Right SSBillingRetry
|
|
stateFor "SUBSCRIPTION_STATE_CANCELED" False `shouldReturn` Right SSCancelled
|
|
stateFor "SUBSCRIPTION_STATE_EXPIRED" False `shouldReturn` Right SSEnded
|
|
stateFor "SUBSCRIPTION_STATE_PENDING_PURCHASE_CANCELED" False `shouldReturn` Right SSEnded
|
|
-- a plan that does not renew itself, as a prepaid one
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] ["autoRenewingPlan"]]
|
|
stateOf <$> playCheck verifier `shouldReturn` Right SSCancelled
|
|
paths <- readTVarIO (fpPurchasePaths fake)
|
|
length paths `shouldBe` 10
|
|
nub paths `shouldBe` [["androidpublisher", "v3", "applications", fakePackageName, "purchases", "subscriptionsv2", "tokens", subscriptionToken]]
|
|
|
|
testPlaySubscriptionPendingOrTest :: IO ()
|
|
testPlaySubscriptionPendingOrTest = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_PENDING" [] [lineItem [] []]
|
|
outcome <$> playCheck verifier `shouldReturn` Pending
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [("testPurchase", J.object [])] [lineItem [] []]
|
|
outcome <$> playCheck verifier `shouldReturn` TestPurchase
|
|
|
|
testPlaySubscriptionCharge :: IO ()
|
|
testPlaySubscriptionCharge = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let chargeFor item = answerSubscription fake (subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [item]) >> (chargeOf <$> playCheck verifier)
|
|
at y m d = UTCTime (fromGregorian y m d)
|
|
orderRef = googlePurchaseRef "GPA.3312-4521-8899-01234..1"
|
|
chargeFor (lineItem [] [])
|
|
`shouldReturn` Right (Just (orderRef, "subscr-badge-supporter-month-02", at 2026 10 14 36000.123456789, at 2026 11 14 36000.123456789, Nothing, False, False))
|
|
chargeFor (lineItem [("productId", "subscr_badge_legend_01"), basePlan "subscr-badge-legend-year-01", ("expiryTime", "2027-10-14T10:00:00Z")] [])
|
|
`shouldReturn` Right (Just (orderRef, "subscr-badge-legend-year-01", at 2026 10 14 36000, at 2027 10 14 36000, Nothing, False, False))
|
|
-- a plan this service does not sell has no length, so its charge is given no period, and is never granted
|
|
chargeFor (lineItem [basePlan "subscr-badge-supporter-month-99"] [])
|
|
`shouldReturn` Right (Just (orderRef, "subscr-badge-supporter-month-99", at 2026 11 14 36000.123456789, at 2026 11 14 36000.123456789, Nothing, False, False))
|
|
chargeFor (lineItem [] ["latestSuccessfulOrderId"]) `shouldReturn` Right Nothing
|
|
|
|
testPlaySubscriptionOffer :: IO ()
|
|
testPlaySubscriptionOffer = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let offerFor item = do
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [item]
|
|
fmap (fmap (\(_, _, _, _, _, _, offer) -> offer)) . chargeOf <$> playCheck verifier
|
|
offerIn phase = offerFor $ lineItem [offerDetails, ("offerPhase", J.object [phase J..= J.object []])] []
|
|
offerDetails = ("offerDetails", J.object ["basePlanId" J..= ("subscr-badge-supporter-month-02" :: Text), "offerId" J..= ("intro-3-months" :: Text)])
|
|
offerIn "freeTrial" `shouldReturn` Right (Just True)
|
|
offerIn "introductoryPrice" `shouldReturn` Right (Just True)
|
|
-- offerDetails names the offer it was bought with for its whole life, so a full-price renewal still carries it
|
|
offerIn "basePrice" `shouldReturn` Right (Just False)
|
|
offerIn "prorationPeriod" `shouldReturn` Right (Just False)
|
|
offerFor (lineItem [] ["offerPhase"]) `shouldReturn` Right (Just False)
|
|
|
|
testPlaySubscriptionUnreadable :: IO ()
|
|
testPlaySubscriptionUnreadable = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
forM_
|
|
[ PlayBody "<html>not json</html>",
|
|
PlayRecord $ J.object ["lineItems" J..= [lineItem [] []]],
|
|
PlayRecord $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [],
|
|
PlayRecord $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] [], lineItem [] []],
|
|
PlayRecord $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] ["expiryTime"]],
|
|
PlayRecord $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] ["offerDetails"]],
|
|
PlayRecord $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [("expiryTime", "next month")] []],
|
|
PlayBody $ J.encode (subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] []]) <> LB.replicate (1024 * 1024) 32
|
|
]
|
|
$ \answer -> do
|
|
answerPurchase fake subscriptionToken answer
|
|
outcome <$> playCheck verifier `shouldReturn` Failed
|
|
-- a state Play may yet add is this service's to learn, and its name is not logged
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_PAUSED_FOREVER" [] [lineItem [] []]
|
|
r <- playCheck verifier
|
|
outcome r `shouldBe` Failed
|
|
reason r `shouldNotSatisfy` ("PAUSED_FOREVER" `T.isInfixOf`)
|
|
|
|
testPlaySubscriptionHttp :: IO ()
|
|
testPlaySubscriptionHttp = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let answeredWith answer = answerPurchase fake subscriptionToken answer >> (outcome <$> playCheck verifier)
|
|
answeredWith (PlayStatus 401) `shouldReturn` Failed
|
|
answeredWith (PlayStatus 403) `shouldReturn` Failed
|
|
forM_ [400, 404, 429, 500, 503] $ \code -> answeredWith (PlayStatus code) `shouldReturn` Unreachable
|
|
-- Play no longer answers about a subscription that expired long ago
|
|
answerPurchase fake subscriptionToken (PlayStatus 410)
|
|
ended <- playCheck verifier
|
|
(stateOf ended, chargeOf ended) `shouldBe` (Right SSEnded, Right Nothing)
|
|
answerPurchase fake subscriptionToken PlayHang
|
|
r <- playCheck verifier
|
|
(outcome r, reason r) `shouldBe` (Unreachable, "subscription check timed out")
|
|
|
|
testPlaySubscriptionAcknowledges :: IO ()
|
|
testPlaySubscriptionAcknowledges = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let acknowledging = subscriptionAcknowledgement verifier SPGoogle {productId = subscriptionProductId, token = subscriptionToken}
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] []]
|
|
acknowledging `shouldReturn` Just (Right ())
|
|
readTVarIO (fpSubscriptionAcknowledged fake) `shouldReturn` [(subscriptionProductId, subscriptionToken)]
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [("acknowledgementState", "ACKNOWLEDGEMENT_STATE_ACKNOWLEDGED")] [lineItem [] []]
|
|
acknowledging `shouldReturn` Just (Right ())
|
|
readTVarIO (fpSubscriptionAcknowledged fake) `shouldReturn` [(subscriptionProductId, subscriptionToken)]
|
|
readTVarIO (fpAcknowledged fake) `shouldReturn` []
|
|
|
|
testPlaySubscriptionAcknowledgementFails :: IO ()
|
|
testPlaySubscriptionAcknowledgementFails = withFakePlay $ \fake -> do
|
|
verifier <- playVerifier fake
|
|
let acknowledgedAs expected = do
|
|
r <- subscriptionAcknowledgement verifier SPGoogle {productId = subscriptionProductId, token = subscriptionToken}
|
|
outcome <$> r `shouldBe` Just expected
|
|
maybe "" reason r `shouldSatisfy` ("acknowledging: " `T.isPrefixOf`)
|
|
maybe "" reason r `shouldNotSatisfy` (subscriptionToken `T.isInfixOf`)
|
|
answerSubscription fake $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] []]
|
|
answerAcknowledgements fake $ Just $ PlayStatus 403
|
|
acknowledgedAs Failed
|
|
answerAcknowledgements fake $ Just $ PlayStatus 503
|
|
acknowledgedAs Unreachable
|
|
answerAcknowledgements fake Nothing
|
|
answerPurchase fake subscriptionToken PlayHang
|
|
acknowledgedAs Unreachable
|
|
readTVarIO (fpSubscriptionAcknowledged fake) `shouldReturn` []
|
|
|
|
-- | Without [google] a Play subscription is not configured, whether or not [apple] checks the App Store's.
|
|
testPlayConfiguredSubscriptions :: IO ()
|
|
testPlayConfiguredSubscriptions = do
|
|
chain <- trustedChain
|
|
withFakePlay $ \play@FakePlay {fpConfig} -> withFakeAppStore ourBundleId $ \appStore@FakeAppStore {fasApi} -> do
|
|
let dir = takeDirectory (gServiceAccountFile fpConfig)
|
|
rootFile = dir </> "root.cer"
|
|
ini = dir </> "badge_service.ini"
|
|
apple = Just AppleStoreConfig {aBundleId = ourBundleId, aRootCertificates = rootFile :| [], aServerApi = Just fasApi}
|
|
configured c = (\ServiceState {storeVerifier} -> storeVerifier) <$> (newServiceState >>= configureStoreVerifier (Just c))
|
|
outcomes v = (,) <$> (outcome <$> checkStoreSubscription v (SubscriptionGoogle subscriptionToken) Nothing) <*> (outcome <$> checkStoreSubscription v (SubscriptionApple subscriptionId) Nothing)
|
|
acknowledging v = subscriptionAcknowledgement v SPGoogle {productId = subscriptionProductId, token = subscriptionToken}
|
|
B.writeFile rootFile (encodeSignedObject $ rootCert chain)
|
|
writeFile ini "[listener]\nstatic_dir = /srv/badges\n"
|
|
Right cfg <- readServiceConfig ini
|
|
both <- configured cfg {appleStore = apple, playStore = Just fpConfig}
|
|
playOnly <- configured cfg {playStore = Just fpConfig}
|
|
appleOnly <- configured cfg {appleStore = apple}
|
|
answerSubscription play $ subscriptionRecord "SUBSCRIPTION_STATE_ACTIVE" [] [lineItem [] []]
|
|
serveStatus appStore chain 1 (subscriptionPayload [] []) (renewalPayload [])
|
|
outcomes both `shouldReturn` (Verdict, Verdict)
|
|
outcomes playOnly `shouldReturn` (Verdict, NotConfigured)
|
|
outcomes appleOnly `shouldReturn` (NotConfigured, Verdict)
|
|
acknowledging appleOnly `shouldReturn` Nothing
|
|
acknowledging playOnly `shouldReturn` Just (Right ())
|
|
readTVarIO (fpSubscriptionAcknowledged play) `shouldReturn` [(subscriptionProductId, subscriptionToken)]
|
|
|