From 59c588932ea6a253caa990d525a44a4a33ec37fb Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 13 Oct 2026 15:24:07 +0000 Subject: [PATCH] badge-service: verify App Store and Google Play purchases (#7654) --- apps/ios/Shared/Views/Badges/BadgeStore.swift | 4 +- apps/ios/SimpleXChat/APITypes.swift | 4 + apps/ios/SimpleXChat/ChatTypes.swift | 8 + .../chat/simplex/common/model/SimpleXAPI.kt | 4 + .../simplex/common/views/badges/BadgeStore.kt | 2 +- .../moko-resources/base/strings.xml | 1 + apps/simplex-badge-service/README.md | 43 +- .../badge_service.ini.example | 21 +- .../src/BadgeService/Config.hs | 48 +- .../src/BadgeService/Service.hs | 84 ++- .../src/BadgeService/StoreReceipts.hs | 63 +- .../src/BadgeService/StoreReceipts/Apple.hs | 181 ++++++ .../src/BadgeService/StoreReceipts/Google.hs | 233 ++++++++ .../src/BadgeService/StoreReceipts/Mock.hs | 12 +- bots/api/TYPES.md | 1 + docs/protocol/badges-rpc.md | 29 +- .../types/typescript/src/types.ts | 1 + .../src/simplex_chat/types/_types.py | 2 +- .../badge-service/badge_service.ini.example | 19 +- scripts/badge-service/compose.yml | 2 + simplex-chat.cabal | 13 + src/Simplex/Chat/Badges/Types.hs | 3 + src/Simplex/Chat/Library/Commands.hs | 1 + tests/BadgeTests.hs | 4 +- tests/Bots/BadgeService/BotTests.hs | 71 ++- tests/Bots/BadgeService/ConfigTests.hs | 50 ++ tests/Bots/BadgeService/FakePlay.hs | 181 ++++++ tests/Bots/BadgeService/FakeStore.hs | 4 +- tests/Bots/BadgeService/StoreVerifierTests.hs | 560 ++++++++++++++++++ tests/Bots/BadgeService/WebTests.hs | 2 + tests/Test.hs | 2 + 31 files changed, 1574 insertions(+), 79 deletions(-) create mode 100644 apps/simplex-badge-service/src/BadgeService/StoreReceipts/Apple.hs create mode 100644 apps/simplex-badge-service/src/BadgeService/StoreReceipts/Google.hs create mode 100644 tests/Bots/BadgeService/FakePlay.hs create mode 100644 tests/Bots/BadgeService/StoreVerifierTests.hs diff --git a/apps/ios/Shared/Views/Badges/BadgeStore.swift b/apps/ios/Shared/Views/Badges/BadgeStore.swift index 2b265b01ab..87485ec06d 100644 --- a/apps/ios/Shared/Views/Badges/BadgeStore.swift +++ b/apps/ios/Shared/Views/Badges/BadgeStore.swift @@ -272,7 +272,7 @@ final class BadgeStore: ObservableObject { func storePurchaseRefused(_ user: UserRef, _ invoiceId: String, _ refusal: BadgeIssueFailure) async { await MainActor.run { if active(user) && openStorePurchases(user.userId).contains(where: { $0.invoiceId == invoiceId }) { - showAlert(NSLocalizedString("Purchase error", comment: "alert title"), message: refusal.purchaseText) + showAlert(refusal.purchaseAlertTitle, message: refusal.purchaseText) } } await storePurchaseResolved(user, invoiceId) @@ -379,7 +379,7 @@ private func storeReceipt(_ verification: VerificationResult) -> Ba // a sweep that hands over a receipt refused while the app was not running learns it only from this answer private func badgeReceiptRefused(_ error: Error) -> Bool { if case let .error(.badgeRedeemError(.serviceError(code))) = error as? ChatError { - return code == .receiptInvalid || code == .receiptUsed + return code == .receiptInvalid || code == .receiptUsed || code == .testPurchase } return false } diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index 9b38dae9a9..6f5f62daf3 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -855,6 +855,7 @@ public enum BadgeServiceErrorCode: Decodable, Hashable { case codeExpired case receiptInvalid case receiptUsed + case testPurchase case internalError case unknown(String) @@ -876,6 +877,7 @@ public enum BadgeServiceErrorCode: Decodable, Hashable { case .codeUsed: "code_used" case .codeExpired: "code_expired" case .receiptInvalid: "receipt_invalid" + case .testPurchase: "test_purchase" case .receiptUsed: "receipt_used" case .internalError: "internal" case let .unknown(s): s @@ -900,6 +902,7 @@ public enum BadgeServiceErrorCode: Decodable, Hashable { case "code_used": self = .codeUsed case "code_expired": self = .codeExpired case "receipt_invalid": self = .receiptInvalid + case "test_purchase": self = .testPurchase case "receipt_used": self = .receiptUsed case "internal": self = .internalError case let s: self = .unknown(s) @@ -917,6 +920,7 @@ public func badgeServiceErrorText(_ code: BadgeServiceErrorCode) -> String? { case .unknownPurchaseKey: NSLocalizedString("The badge service does not recognize this badge.", comment: "alert message") case .internalError: NSLocalizedString("The badge service reported an internal error.", comment: "alert message") case .receiptInvalid: NSLocalizedString("The store did not confirm this purchase.", comment: "alert message") + case .testPurchase: NSLocalizedString("Sandbox purchases are not credited. Badges can only be bought in the App Store version of the app.", comment: "alert message") case .receiptUsed: NSLocalizedString("This purchase was already credited to a badge on another device or profile.", comment: "alert message") case .paymentPending: NSLocalizedString("The payment has not been confirmed yet.", comment: "alert message") case .providerUnavailable: NSLocalizedString("The store could not be reached.", comment: "alert message") diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index 252ffad974..bf4440a810 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -379,6 +379,14 @@ public enum BadgeIssueFailure: Decodable, Hashable { } } + public var purchaseAlertTitle: String { + switch self { + case .serviceError(.testPurchase, _): + NSLocalizedString("Sandbox purchase", comment: "alert title") + default: NSLocalizedString("Purchase error", comment: "alert title") + } + } + // the stored form, for support public var tag: String { switch self { diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index d6f605dc8b..7c4acafe0b 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -7475,6 +7475,7 @@ sealed class BadgeServiceErrorCode { object CodeExpired: BadgeServiceErrorCode() object ReceiptInvalid: BadgeServiceErrorCode() object ReceiptUsed: BadgeServiceErrorCode() + object TestPurchase: BadgeServiceErrorCode() object Internal: BadgeServiceErrorCode() data class Unknown(val code: String): BadgeServiceErrorCode() @@ -7497,6 +7498,7 @@ sealed class BadgeServiceErrorCode { is CodeExpired -> "code_expired" is ReceiptInvalid -> "receipt_invalid" is ReceiptUsed -> "receipt_used" + is TestPurchase -> "test_purchase" is Internal -> "internal" is Unknown -> code } @@ -7511,6 +7513,7 @@ fun badgeServiceErrorText(code: BadgeServiceErrorCode): String? = when (code) { is BadgeServiceErrorCode.UnknownPurchaseKey -> generalGetString(MR.strings.badges_error_unknown_purchase) is BadgeServiceErrorCode.Internal -> generalGetString(MR.strings.badges_error_service_internal) is BadgeServiceErrorCode.ReceiptInvalid -> generalGetString(MR.strings.badges_error_receipt_invalid) + is BadgeServiceErrorCode.TestPurchase -> generalGetString(MR.strings.badges_error_test_purchase) is BadgeServiceErrorCode.ReceiptUsed -> generalGetString(MR.strings.badges_error_receipt_used) is BadgeServiceErrorCode.PaymentPending -> generalGetString(MR.strings.badges_error_payment_pending) is BadgeServiceErrorCode.ProviderUnavailable -> generalGetString(MR.strings.badges_error_provider_unavailable) @@ -7540,6 +7543,7 @@ object BadgeServiceErrorCodeSerializer : KSerializer { "code_expired" -> BadgeServiceErrorCode.CodeExpired "receipt_invalid" -> BadgeServiceErrorCode.ReceiptInvalid "receipt_used" -> BadgeServiceErrorCode.ReceiptUsed + "test_purchase" -> BadgeServiceErrorCode.TestPurchase "internal" -> BadgeServiceErrorCode.Internal else -> BadgeServiceErrorCode.Unknown(v) } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgeStore.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgeStore.kt index c9b413221d..4b37c6c7ba 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgeStore.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/badges/BadgeStore.kt @@ -443,5 +443,5 @@ private fun compactPrice(product: BadgeProduct): String { private fun badgeReceiptRefused(err: ChatError?): Boolean { val redeemError = ((err as? ChatError.ChatErrorChat)?.errorType as? ChatErrorType.CEBadgeRedeemError)?.badgeRedeemError val code = (redeemError as? BadgeRedeemError.ServiceError)?.serviceError - return code is BadgeServiceErrorCode.ReceiptInvalid || code is BadgeServiceErrorCode.ReceiptUsed + return code is BadgeServiceErrorCode.ReceiptInvalid || code is BadgeServiceErrorCode.ReceiptUsed || code is BadgeServiceErrorCode.TestPurchase } diff --git a/apps/multiplatform/common/src/commonMain/moko-resources/base/strings.xml b/apps/multiplatform/common/src/commonMain/moko-resources/base/strings.xml index f7fc6e94b5..5b0227b3a4 100644 --- a/apps/multiplatform/common/src/commonMain/moko-resources/base/strings.xml +++ b/apps/multiplatform/common/src/commonMain/moko-resources/base/strings.xml @@ -3230,6 +3230,7 @@ The badge service reported an internal error. The store did not confirm this purchase. This purchase was already credited to a badge on another device or profile. + Test purchases are not credited. Badges can only be bought with a real purchase. The payment has not been confirmed yet. The store could not be reached. Badges cannot be bought in the app yet. diff --git a/apps/simplex-badge-service/README.md b/apps/simplex-badge-service/README.md index 6de3e53d2f..5340314da5 100644 --- a/apps/simplex-badge-service/README.md +++ b/apps/simplex-badge-service/README.md @@ -51,7 +51,7 @@ simplex-badge-service --help `simplex-directory-service --run-cli`). This mode is the chat/RPC side and the `//` commands below: it starts no web listener and no poller, and serves no group commands, whatever `--service-config` says. It still updates a code's group message when the code is redeemed or - revoked. `[dev] accept_unverified_store_receipts` applies to it. + revoked. `[apple]`, `[google]` and `[dev] accept_unverified_store_receipts` apply to it. - `--no-address`: skip address creation on start-up (for operators who provision the address themselves). The service cannot sign credentials without an issuer key and refuses to start without one: @@ -84,7 +84,7 @@ Other options: - `--service-config INI_FILE`: path to `badge_service.ini`. Omit it to run the chat/RPC side only; the process never starts a web listener without it, and never starts one under `--run-cli`, which parses and validates the whole file (`[listener] static_dir` included) but - uses only its `[issuer]` section and `[dev] accept_unverified_store_receipts`. An issuer key is + uses only its `[issuer]`, `[apple]` and `[google]` sections and `[dev] accept_unverified_store_receipts`. An issuer key is still required either way. - `--service-name NAME`: the bot's display name, without `*`s or spaces (default `SimpleX Badges`). - `--client-service`: use the client service certificate. @@ -209,6 +209,43 @@ the exception: each answers 200, 400 or 413 with an empty body, because its prov caller and nothing it could read would change what the route does. A wrong verb on any route, those two included, answers `method_not_allowed`. +### Store purchases (App Store and Google Play) + +Each store is verified only when its section is present; without one, every receipt from that store +is answered `provider_not_configured` and the app keeps the purchase to present again. A section +missing a key, an unreadable root certificate or service account key, or either section beside +`[dev] accept_unverified_store_receipts = on`, stops the service at startup. + +```ini +[apple] +bundle_id = chat.simplex.app +root_certificate = /etc/simplex-badge-service/AppleRootCA-G3.cer + +[google] +package_name = chat.simplex.app +service_account_file = /etc/simplex-badge-service/play-service-account.json +``` + +- `[apple]` verifies the signed transaction offline, against Apple Root CA - G3 in DER as Apple + publishes it at . A transaction + for another bundle id, or a chain this root does not verify, is answered `internal` and logged as + an error rather than refused, since `bundle_id` or `root_certificate` may be the wrong one; check + both when those errors appear, unless the purchase was made in Xcode's StoreKit testing, which + the App Store does not sign, so no root verifies it. +- `[google]` asks the Google Play Developer API about each purchase, and acknowledges it before + crediting it, as the service account whose JSON key `service_account_file` holds. The account + needs both Play Console permissions Google's + [getting started](https://developers.google.com/android-publisher/getting_started) lists for its + billing APIs: "View financial data, orders, and cancellation survey responses" to read a + purchase, and "Manage orders and subscriptions" to acknowledge it. Without the second, a Play + purchase the app has not already acknowledged itself is answered `internal` and logged as an + error naming the acknowledgement, and the app presents it again once the permission is granted, + which must be within three days, before Play refunds it. The key signs in + for an access token, so keep the file readable by this service alone. + +Which answers are terminal for a purchase and which leave it to be presented again is listed per +store in [`docs/protocol/badges-rpc.md`](../../docs/protocol/badges-rpc.md#commands). + ### Accepting store receipts unverified, for local testing ```ini @@ -221,7 +258,7 @@ the service accepts any well-formed receipt without asking or verifying anything the `transactionId` and `productId` its payload names, unsigned or not, and a Play product id and token as given. It applies to both run modes, since `--run-cli` answers service requests too, and the service logs a warning at every start while it is on. Off by default, and only `on`/`off` -parse. +parse. The service refuses to start with it on beside an `[apple]` or `[google]` section. With it on, anyone who can reach the service address can mint badges by sending a made-up receipt. That is harmless only while this deployment signs with an issuer key released apps do not carry, so diff --git a/apps/simplex-badge-service/badge_service.ini.example b/apps/simplex-badge-service/badge_service.ini.example index e9ca861806..20d4e8614b 100644 --- a/apps/simplex-badge-service/badge_service.ini.example +++ b/apps/simplex-badge-service/badge_service.ini.example @@ -40,6 +40,24 @@ session_minutes = 60 waiting_seconds = 3 idle_seconds = 60 +; verifies App Store purchases offline. Omit the whole section and the service answers every App Store +; receipt provider_not_configured, which the app retries later. +; root_certificate is Apple Root CA - G3 as Apple publishes it, in DER: +; https://www.apple.com/certificateauthority/AppleRootCA-G3.cer +;[apple] +;bundle_id = chat.simplex.app +;root_certificate = /etc/simplex-badge-service/AppleRootCA-G3.cer + +; verifies Play purchases with the Google Play Developer API. Omit the whole section and the service answers +; every Play receipt provider_not_configured, which the app retries later. +; service_account_file is the JSON key Google issues for a service account with the Play Console +; permissions "View financial data, orders, and cancellation survey responses" and "Manage orders and +; subscriptions", to read and acknowledge purchases. Without the second, a purchase the app has not +; already acknowledged itself is answered internal until the permission is granted. Keep the file readable by this service alone. +;[google] +;package_name = chat.simplex.app +;service_account_file = /etc/simplex-badge-service/play-service-account.json + ; the key this service signs credentials with. index is the index clients verify against, so ; private_key has to be one whose public half already ships in the apps at that index: a fresh ; `simplex-chat badge keygen` pair is refused until it does. @@ -62,6 +80,7 @@ idle_seconds = 60 ;description = Welcome to the badges group ; local testing only, in both run modes: accepts any well-formed App Store or Play receipt without -; verifying it, so anyone who can reach this service can mint badges +; verifying it, so anyone who can reach this service can mint badges. The service refuses to start +; with this on beside an [apple] or [google] section. [dev] accept_unverified_store_receipts = off diff --git a/apps/simplex-badge-service/src/BadgeService/Config.hs b/apps/simplex-badge-service/src/BadgeService/Config.hs index 8b24956a57..493c95c27e 100644 --- a/apps/simplex-badge-service/src/BadgeService/Config.hs +++ b/apps/simplex-badge-service/src/BadgeService/Config.hs @@ -10,6 +10,8 @@ module BadgeService.Config SpeedPolicy (..), speedPolicyName, PollConfig (..), + AppleStoreConfig (..), + PlayStoreConfig (..), BadgeIssuerKey (..), GroupConfig (..), ServiceConfig (..), @@ -22,11 +24,11 @@ where import qualified Control.Exception as E import BadgeService.Log (logWarn) -import Control.Monad (mfilter) +import Control.Monad (mfilter, when) import Data.Attoparsec.Text (Parser, endOfInput, isEndOfLine, parseOnly, satisfy, skipMany, skipSpace, skipWhile) import qualified Data.ByteString.Char8 as B import Data.Ini (Ini, iniGlobals, iniParser, keys, lookupValue, sections) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as TIO @@ -91,6 +93,20 @@ instance Show StripeConfig where data PollConfig = PollConfig {pWaitingSeconds :: Int, pIdleSeconds :: Int} deriving (Eq, Show) +data AppleStoreConfig = AppleStoreConfig + { aBundleId :: Text, + aRootCertificate :: FilePath + } + deriving (Eq, Show) + +data PlayStoreConfig = PlayStoreConfig + { gPackageName :: Text, + gServiceAccountFile :: FilePath, + gApiHost :: Text, + gTokenUrl :: Text + } + deriving (Eq, Show) + data BadgeIssuerKey = BadgeIssuerKey { keyIdx :: Int, secretKey :: BBSSecretKey @@ -112,6 +128,8 @@ data ServiceConfig = ServiceConfig btcpay :: Maybe BTCPayConfig, stripe :: Maybe StripeConfig, poll :: PollConfig, + appleStore :: Maybe AppleStoreConfig, + playStore :: Maybe PlayStoreConfig, issuer :: Maybe BadgeIssuerKey, group :: Maybe GroupConfig, -- Local testing only; anyone who can reach the service can mint badges with any well-formed receipt. @@ -128,6 +146,12 @@ defaultStripeHost = "https://api.stripe.com" defaultSessionMinutes :: Int defaultSessionMinutes = 60 +defaultPlayApiHost :: Text +defaultPlayApiHost = "https://androidpublisher.googleapis.com" + +defaultPlayTokenUrl :: Text +defaultPlayTokenUrl = "https://oauth2.googleapis.com/token" + -- | At most one day, so a card order expires long before the poller stops checking it at 72 hours. minSessionMinutes, maxSessionMinutes :: Int minSessionMinutes = 1 @@ -166,6 +190,8 @@ knownSettings = ("btcpay", ["host", "api_key", "store_id", "webhook_secret", "expiry_minutes", "speed_policy", "payment_tolerance"]), ("stripe", ["secret_key", "publishable_key", "webhook_secret", "session_minutes"]), ("poll", ["waiting_seconds", "idle_seconds"]), + ("apple", ["bundle_id", "root_certificate"]), + ("google", ["package_name", "service_account_file"]), ("group", ["display_name", "description"]), ("dev", ["accept_unverified_store_receipts"]), ("issuer", ["index", "private_key"]) @@ -199,13 +225,19 @@ parseConfig ini = do grp <- groupSection pWaitingSeconds <- cadence "waiting_seconds" 3 pIdleSeconds <- cadence "idle_seconds" 60 + apple <- appleSection + google <- googleSection devUnverifiedReceipts <- bool "dev" "accept_unverified_store_receipts" False + when (devUnverifiedReceipts && (isJust apple || isJust google)) $ + Left "[dev] accept_unverified_store_receipts must be off where [apple] or [google] verifies store receipts" pure ServiceConfig { listener = ListenerConfig {lHost, lPort, lStaticDir, lServeWebapp, lWebappExportDir, lTrustForwardedFor}, btcpay = btc, stripe = str, poll = PollConfig {pWaitingSeconds, pIdleSeconds}, + appleStore = apple, + playStore = google, issuer = iss, group = grp, devAcceptUnverifiedStoreReceipts = devUnverifiedReceipts @@ -300,6 +332,18 @@ parseConfig ini = do sSessionMinutes <- sessionMinutes let sHost = defaultStripeHost pure (Just StripeConfig {sSecretKey, sPublishableKey, sWebhookSecret, sSessionMinutes, sHost}) + appleSection + | not (hasSection "apple") = Right Nothing + | otherwise = do + aBundleId <- required "apple" "bundle_id" + aRootCertificate <- T.unpack <$> required "apple" "root_certificate" + pure (Just AppleStoreConfig {aBundleId, aRootCertificate}) + googleSection + | not (hasSection "google") = Right Nothing + | otherwise = do + gPackageName <- required "google" "package_name" + gServiceAccountFile <- T.unpack <$> required "google" "service_account_file" + pure (Just PlayStoreConfig {gPackageName, gServiceAccountFile, gApiHost = defaultPlayApiHost, gTokenUrl = defaultPlayTokenUrl}) sessionMinutes = do v <- num "stripe" "session_minutes" defaultSessionMinutes if v >= minSessionMinutes && v <= maxSessionMinutes diff --git a/apps/simplex-badge-service/src/BadgeService/Service.hs b/apps/simplex-badge-service/src/BadgeService/Service.hs index 8eafc16f2e..92eeeb195b 100644 --- a/apps/simplex-badge-service/src/BadgeService/Service.hs +++ b/apps/simplex-badge-service/src/BadgeService/Service.hs @@ -7,6 +7,7 @@ module BadgeService.Service ( ServiceState (..), newServiceState, + configureStoreVerifier, welcomeGetOpts, checkIssuerKey, badgeService, @@ -22,7 +23,7 @@ where import BadgeService.Catalog (StoreProduct (..), defaultCatalog, storeProduct) import BadgeService.Codes (issueFailedText, issueOneCode, singleUse) -import BadgeService.Config (BadgeIssuerKey (..), ServiceConfig (..), readServiceConfig) +import BadgeService.Config (AppleStoreConfig (..), BadgeIssuerKey (..), PlayStoreConfig (..), ServiceConfig (..), readServiceConfig) import BadgeService.Group (GroupEvent, ensureManagedGroup, groupEvent, hasTracker, refreshTracker, revokeWithTracker, runGroupLane) import BadgeService.Group.Command (badgeTypeP, codeP, maxMonths, textTokenP) import BadgeService.Log (logError, logInfo, logWarn) @@ -34,6 +35,8 @@ import BadgeService.Store import BadgeService.Store.Invoices (seedCatalog, truncateToSecond) import BadgeService.Store.Migrate (runBadgeServiceMigrations) import BadgeService.StoreReceipts +import BadgeService.StoreReceipts.Apple (readAppleRoot, verifyAppleTransaction) +import BadgeService.StoreReceipts.Google (playStoreVerifier) import BadgeService.StoreReceipts.Mock (mockStoreVerifier) import BadgeService.Waiters (Waiters, newWaiters) import BadgeService.Web.Server (exportWebapp, newWebEnv, runWebListener) @@ -84,8 +87,8 @@ data ServiceState = ServiceState storeVerifier :: StoreVerifier } --- | No store verifier exists yet, so every store receipt not already credited is answered --- provider_not_configured, terminal for the request: retrying cannot deploy one. +-- | With no store verifier, which badge_service.ini configures, every store receipt not already credited +-- is answered provider_not_configured. newServiceState :: IO ServiceState newServiceState = do serviceCC <- newEmptyTMVarIO @@ -130,19 +133,37 @@ readConfigOrExit path = Left e -> putStrLn (path <> ": " <> e) >> exitFailure Right sc -> pure sc -devStoreVerifier :: Maybe ServiceConfig -> ServiceState -> IO ServiceState -devStoreVerifier serviceCfg env - | maybe False devAcceptUnverifiedStoreReceipts serviceCfg = do - logWarn "[dev] accept_unverified_store_receipts is on: any store receipt is accepted without verification" - pure env {storeVerifier = mockStoreVerifier} - | otherwise = pure env +-- | The config refuses the dev flag beside a real verifier, so only one of them applies. +configureStoreVerifier :: Maybe ServiceConfig -> ServiceState -> IO ServiceState +configureStoreVerifier serviceCfg env@ServiceState {storeVerifier = v} = case serviceCfg of + Just ServiceConfig {devAcceptUnverifiedStoreReceipts = True} -> do + logWarn "[dev] accept_unverified_store_receipts is on: any store receipt is accepted without verification" + pure env {storeVerifier = mockStoreVerifier} + Just ServiceConfig {appleStore, playStore} -> do + apple <- forM appleStore $ \AppleStoreConfig {aBundleId, aRootCertificate} -> + (\root -> verifyAppleTransaction root aBundleId) <$> orExit (readAppleRoot aRootCertificate) + google <- forM playStore $ orExit . playStoreVerifier + forM_ appleStore $ \AppleStoreConfig {aBundleId} -> logInfo $ "verifying App Store receipts for " <> aBundleId + forM_ playStore $ \PlayStoreConfig {gPackageName} -> logInfo $ "verifying Play purchases for " <> gPackageName + pure + env + { storeVerifier = + v + { verifyApple = maybe (verifyApple v) Just apple, + verifyGoogle = maybe (verifyGoogle v) (Just . fst) google, + acknowledgeGoogle = maybe (acknowledgeGoogle v) (Just . snd) google + } + } + Nothing -> pure env + where + orExit = (>>= either (\e -> putStrLn ("Error: " <> e) >> exitFailure) pure) badgeService :: BadgeServiceOpts -> ChatConfig -> ServiceState -> IO () badgeService opts@BadgeServiceOpts {serviceConfigFile} cfg env = do serviceCfg <- traverse readConfigOrExit serviceConfigFile key <- requireIssuerKey opts serviceCfg cfg waiters <- newWaiters - requestEnv <- devStoreVerifier serviceCfg env + requestEnv <- configureStoreVerifier serviceCfg env let groupCfg = serviceCfg >>= \ServiceConfig {group} -> group trackerQ_ = groupEventQ env <$ groupCfg readEvents cc = @@ -193,7 +214,7 @@ badgeServiceCLI :: BadgeServiceOpts -> IO () badgeServiceCLI opts@BadgeServiceOpts {serviceConfigFile} = do serviceCfg <- traverse readConfigOrExit serviceConfigFile key <- requireIssuerKey opts serviceCfg terminalChatConfig - env <- newServiceState >>= devStoreVerifier serviceCfg + env <- newServiceState >>= configureStoreVerifier serviceCfg let eventHook _cc = \case Right (CEvtServiceRequest u reqId sigKey reqData) -> do atomically $ writeTQueue (serviceRequestQ env) (u, reqId, sigKey, reqData) @@ -416,7 +437,7 @@ redeemCode key cc trackerQ_ purchaseKey masterKey codeText = case parseBadgeCode -- | Every refusal is answered before anything is written, so it leaves the receipt unclaimed; and -- nothing is written until the credential is signed. purchaseWithReceipt :: BadgeIssuerKey -> ChatController -> C.PublicKeyEd25519 -> BadgeMasterKey -> StoreReceipt -> IO BadgeServiceResponse -purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTransactionRef {provider, transactionRef = providerRef}, verifyReceipt} = +purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTransactionRef {provider, transactionRef = providerRef}, verifyReceipt, acknowledgeReceipt} = withDB' "getStorePayment" cc (\db -> getStorePaymentCredit db provider providerRef) >>= \case Left _ -> pure $ errorResponse BSEInternal Right credit @@ -430,7 +451,7 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTran | transactionRef /= providerRef -> storeRefusalResponse $ SRVerifierFailed "verified a transaction other than the one claimed" Right VerifiedStoreTransaction {quantity} | quantity /= 1 -> storeRefusalResponse $ SRVerifierFailed $ "verified a quantity of " <> tshow quantity - Right VerifiedStoreTransaction {testPurchase = True} -> storeRefusalResponse $ SRInvalid "test purchase" + Right VerifiedStoreTransaction {testPurchase = True} -> storeRefusalResponse SRTestPurchase -- another key's credit is told only once the store vouched for the receipt, or it would reveal which transactions were credited Right tx -> case credit of Uncredited -> newPurchase tx @@ -446,26 +467,31 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTran -- the product is read only for a receipt not yet credited, so retiring it leaves its replays answered newPurchase VerifiedStoreTransaction {productId, paid} = case storeProduct provider productId of Nothing -> pure $ errorResponse BSEProductUnavailable - Just StoreProduct {badgeType, months} -> do - now <- badgeNow cc - signFirstMonth key cc masterKey badgeType months (SCPayment Nothing) now >>= \case - Left resp -> pure resp - Right firstMonth -> do - paymentId <- randomId cc - r <- withDB "writeStorePurchase" cc $ \db -> - liftIO (createStorePurchase db NewStorePurchase {paymentId, provider, providerRef, paid, purchaseKey, masterKey, badgeType} now) >>= \case - -- Credited to another key, or to this one by a request that ran alongside it, while signing. - Nothing -> - liftIO (getStorePaymentCredit db provider providerRef >>= creditedResponse db purchaseKey) >>= \case - Left resp -> pure resp - Right () -> logError ("badge service: a payment for " <> providerRef <> " exists but funds no purchase") $> errorResponse BSEInternal - Just purchaseId -> liftIO $ firstMonthResponse db purchaseId (Just paymentId) firstMonth - pure $ fromRight (errorResponse BSEInternal) r + Just StoreProduct {badgeType, months} -> + fromMaybe (pure $ Right ()) acknowledgeReceipt >>= \case + Left refusal -> storeRefusalResponse refusal + Right () -> do + now <- badgeNow cc + signFirstMonth key cc masterKey badgeType months (SCPayment Nothing) now >>= \case + Left resp -> pure resp + Right firstMonth -> do + paymentId <- randomId cc + r <- withDB "writeStorePurchase" cc $ \db -> + liftIO (createStorePurchase db NewStorePurchase {paymentId, provider, providerRef, paid, purchaseKey, masterKey, badgeType} now) >>= \case + -- Credited to another key, or to this one by a request that ran alongside it, while signing. + Nothing -> + liftIO (getStorePaymentCredit db provider providerRef >>= creditedResponse db purchaseKey) >>= \case + Left resp -> pure resp + Right () -> logError ("badge service: a payment for " <> providerRef <> " exists but funds no purchase") $> errorResponse BSEInternal + Just purchaseId -> liftIO $ firstMonthResponse db purchaseId (Just paymentId) firstMonth + pure $ fromRight (errorResponse BSEInternal) r --- | The client learns only the code: a forged receipt, a refunded purchase and a test one are all receipt_invalid. +-- | A forged receipt and a refunded one are both receipt_invalid, so the client learns nothing a +-- forger could iterate on. A test purchase is named, since the device that made it already knows. storeRefusalResponse :: StoreRefusal -> IO BadgeServiceResponse storeRefusalResponse = \case SRInvalid reason -> logInfo ("store receipt refused: " <> reason) $> errorResponse BSEReceiptInvalid + SRTestPurchase -> logInfo "store receipt refused: test purchase" $> errorResponse BSETestPurchase SRPending -> pure $ errorResponse BSEPaymentPending SRUnreachable reason -> logWarn ("store unreachable: " <> reason) $> errorResponse BSEProviderUnavailable SRVerifierFailed reason -> logError ("store receipt not verified: " <> reason) $> errorResponse BSEInternal diff --git a/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs b/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs index b623944c46..952a4d0152 100644 --- a/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs +++ b/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs @@ -14,14 +14,13 @@ module BadgeService.StoreReceipts where import Control.Exception (evaluate) -import Data.Bifunctor (first) -import Data.Char (isAsciiLower, isAsciiUpper, isDigit) +import Data.Char (isAlphaNum, isAscii, isAsciiLower, isAsciiUpper, isControl, isDigit, isPrint, isSpace) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Simplex.Chat.PaymentService (ServicePayment (..), appleTransactionId, googlePurchaseRef) import Simplex.Chat.PaymentService.Types (CurrencyAmount, PaymentProvider (..), StoreTransactionRef (..)) -import Simplex.Messaging.Util (catchOwn') +import Simplex.Messaging.Util (catchOwn', tshow) import System.Timeout (timeout) -- | What a store vouches for about one completed transaction. @@ -38,19 +37,24 @@ data VerifiedStoreTransaction = VerifiedStoreTransaction deriving (Eq, Show) -- | The reasons are for the service's log alone and must never quote the receipt. +-- SRInvalid and SRTestPurchase are terminal: the client drops the purchase's keys and nothing +-- presents it again. So only a verdict no later attempt could change is either; when in doubt, SRUnreachable. data StoreRefusal - = SRInvalid Text -- a verdict that cannot change, and the client consumes the purchase: forged, malformed, another app's, refunded + = SRInvalid Text -- a verdict that cannot change, and the client consumes the purchase: forged, malformed, refunded + | SRTestPurchase -- the store vouched for it, but it cost nothing; terminal, and named so the app can say why | SRPending -- a real purchase the store has not settled; it may yet | SRUnreachable Text -- no verdict: the store was not asked, did not answer, or does not know the token (a Play 404 may be lag) - | SRVerifierFailed Text -- a bug, not the store's answer + | SRVerifierFailed Text -- this service's own failure, its bug or misconfiguration, never the store's answer | SRNotConfigured -- no verifier for this store is deployed; the purchase may be real deriving (Eq, Show) -- | Apple signs its receipt and ships the certificate chain in it, so it is verified with no network --- call; a Play token is opaque and must be asked about, which is why only that field is in IO. +-- call; a Play token is opaque and must be asked about, which is why only the Play fields are in IO. data StoreVerifier = StoreVerifier - { verifyApple :: Maybe (Text -> Either Text VerifiedStoreTransaction), -- the JWS; Left is why Apple did not sign it + { -- the JWS + verifyApple :: Maybe (Text -> Either StoreRefusal VerifiedStoreTransaction), verifyGoogle :: Maybe (Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction)), -- the product id and the token + acknowledgeGoogle :: Maybe (Text -> Text -> IO (Either StoreRefusal ())), -- microseconds; requests are answered one at a time, so a verifier that does not finish holds up every other one verifyTimeout :: Int } @@ -58,37 +62,43 @@ data StoreVerifier = StoreVerifier -- | A store payment, named by the store's own reference before anything is verified. data StoreReceipt = StoreReceipt { txRef :: StoreTransactionRef, - verifyReceipt :: IO (Either StoreRefusal VerifiedStoreTransaction) + verifyReceipt :: IO (Either StoreRefusal VerifiedStoreTransaction), + acknowledgeReceipt :: Maybe (IO (Either StoreRefusal ())) } noStoreVerifier :: StoreVerifier -noStoreVerifier = StoreVerifier {verifyApple = Nothing, verifyGoogle = Nothing, verifyTimeout = 10000000} +noStoreVerifier = StoreVerifier {verifyApple = Nothing, verifyGoogle = Nothing, acknowledgeGoogle = Nothing, verifyTimeout = 10000000} -- | Nothing for a payment no store made. Exceptions are not logged, since they can quote the receipt -- or, from Google, a URL holding the token. toStoreReceipt :: StoreVerifier -> ServicePayment -> Maybe (Either StoreRefusal StoreReceipt) -toStoreReceipt StoreVerifier {verifyApple, verifyGoogle, verifyTimeout} = \case +toStoreReceipt StoreVerifier {verifyApple, verifyGoogle, acknowledgeGoogle, verifyTimeout} = \case SPApple {jws} -> Just $ case appleTransactionId jws of Nothing -> Left $ SRInvalid "names no transaction" - Just ref -> Right $ StoreReceipt (StoreTransactionRef PPApple ref) $ maybe unconfigured (\verify -> offline $ first SRInvalid $ verify jws) verifyApple + Just ref -> Right $ StoreReceipt (StoreTransactionRef PPApple ref) (maybe unconfigured (\verify -> offline $ verify jws) verifyApple) Nothing SPGoogle {productId, token} -- the claim is the token's hash, so neither string may name any purchase but the one it claims, -- whatever path a verifier builds from them | not (googleProductId productId) -> Just $ Left $ SRInvalid "not a Play product id" -- Play documents no token grammar, so this is our guess, and refusing to ask Play is not its verdict - | not (googleToken token) -> Just $ Left $ SRUnreachable "a Play token this service will not send" - | otherwise -> Just $ Right $ StoreReceipt (StoreTransactionRef PPGoogle (googlePurchaseRef token)) $ maybe unconfigured (\verify -> online $ verify productId token) verifyGoogle + | not (googleToken token) -> Just $ Left $ SRUnreachable $ "a Play token this service will not send: " <> tokenShape token + | otherwise -> + Just $ Right $ + StoreReceipt + (StoreTransactionRef PPGoogle (googlePurchaseRef token)) + (maybe unconfigured (\verify -> online "google verifier" $ verify productId token) verifyGoogle) + ((\acknowledge -> online "acknowledging: google" $ acknowledge productId token) <$> acknowledgeGoogle) SPInvoice {} -> Nothing SPReceipt {} -> Nothing where unconfigured = pure $ Left SRNotConfigured - -- nothing was fetched, so a throw or an overrun is a bug or a malformed receipt, never an outage + -- nothing was fetched, so a throw or an overrun is this service's failure or a shape it does not know, never an outage offline verdict = (fromMaybe (Left $ SRVerifierFailed "apple verifier timed out") <$> timeout verifyTimeout (forced verdict)) `catchOwn'` \_ -> pure $ Left $ SRVerifierFailed "apple verifier threw" - online verify = - (fromMaybe (Left $ SRUnreachable "google verifier timed out") <$> timeout verifyTimeout (verify >>= forced)) - `catchOwn'` \_ -> pure $ Left $ SRUnreachable "google verifier threw" + online what call = + (fromMaybe (Left $ SRUnreachable $ what <> " timed out") <$> timeout verifyTimeout (call >>= forced)) + `catchOwn'` \_ -> pure $ Left $ SRUnreachable $ what <> " threw" -- a verdict holding a thunk that throws would otherwise throw later, outside these handlers forced = either (fmap Left . evaluate) (fmap Right . evaluate) @@ -97,5 +107,22 @@ googleProductId pid = case T.uncons pid of Just (c, _) -> T.length pid <= 150 && (isAsciiLower c || isDigit c) && T.all (\x -> isAsciiLower x || isDigit x || x == '_' || x == '.') pid Nothing -> False +-- | Not empty or only dots, which a URL path resolves away. googleToken :: Text -> Bool -googleToken t = not (T.null t) && T.length t <= 4096 && T.all (\x -> isAsciiLower x || isAsciiUpper x || isDigit x || x == '.' || x == '_' || x == '-') t +googleToken t = not (T.all (== '.') t) && T.length t <= 4096 && T.all (\x -> isAsciiLower x || isAsciiUpper x || isDigit x || x == '.' || x == '_' || x == '-') t + +-- | What the log may say about a token: its length and the kinds of character in it, never any of them. +tokenShape :: Text -> Text +tokenShape t = tshow (T.length t) <> " characters: " <> T.intercalate ", " [kind | (kind, isKind) <- kinds, T.any isKind t] + where + kinds = + [ ("lowercase", isAsciiLower), + ("uppercase", isAsciiUpper), + ("digits", isDigit), + ("'.'", (== '.')), + ("'_'", (== '_')), + ("'-'", (== '-')), + ("other printable ASCII", \c -> isAscii c && isPrint c && not (isAlphaNum c) && c `notElem` ("._-" :: String)), + ("whitespace or control", \c -> isSpace c || isControl c), + ("non-ASCII", not . isAscii) + ] diff --git a/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Apple.hs b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Apple.hs new file mode 100644 index 0000000000..90cc69915c --- /dev/null +++ b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Apple.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module BadgeService.StoreReceipts.Apple + ( verifyAppleTransaction, + readAppleRoot, + ) +where + +import BadgeService.StoreReceipts (StoreRefusal (..), VerifiedStoreTransaction (..)) +import Control.Exception (IOException, try) +import Control.Monad (guard, unless) +import Crypto.Hash.Algorithms (SHA256 (..)) +import Crypto.Number.Serialize (os2ip) +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Data.Aeson as J +import qualified Data.Aeson.KeyMap as JM +import qualified Data.Aeson.Types as JT +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 Data.Foldable (toList) +import Data.Maybe (isJust) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Word (Word32) +import Data.X509 +import Data.X509.EC (unserializePoint) +import Data.X509.Validation (SignatureFailure (..), SignatureVerification (..), verifySignedSignature) +import Simplex.Chat.PaymentService.Types (CurrencyAmount (..)) +import Simplex.Messaging.Util (eitherToMaybe) + +verifyAppleTransaction :: SignedCertificate -> Text -> Text -> Either StoreRefusal VerifiedStoreTransaction +verifyAppleTransaction root ourBundleId jws = case T.splitOn "." jws of + [header, payload, signature] -> do + leaf <- signingChain root =<< certificateChain header + sig <- jwsSignature signature + key <- leafKey leaf + unless (ECDSA.verify SHA256 key sig (encodeUtf8 $ header <> "." <> payload)) $ + refused "the signature does not verify" + tx <- either (const $ failed "the payload Apple signed is not a transaction") Right $ do + o <- maybe (Left "not base64url JSON") Right $ jsonObject payload + JT.parseEither appleTransactionP o + transaction ourBundleId tx + _ -> refused "not three dot-separated parts" + +-- | A header or chain in a shape Apple may yet adopt proves no forgery, so it fails rather than refuses. +certificateChain :: Text -> Either StoreRefusal [ByteString] +certificateChain header = do + o <- maybe (refused "the header is not base64url JSON") Right $ jsonObject header + case JM.lookup "alg" o of + Just (J.String "ES256") -> Right () + _ -> failed "the header does not name ES256" + case JM.lookup "x5c" o of + Just (J.Array certs) -> traverse der $ toList certs + _ -> failed "the header carries no x5c chain" + where + der = \case + J.String c | Right bs <- B64.decode (encodeUtf8 c) -> Right bs + _ -> refused "an x5c certificate is not base64" + +-- | The root in the chain is ignored: trust comes from the configured one alone. +signingChain :: SignedCertificate -> [ByteString] -> Either StoreRefusal SignedCertificate +signingChain root = \case + [leafDer, intermediateDer, _] -> do + leaf <- certificate leafDer + intermediate <- certificate intermediateDer + -- the configured root may be stale or wrong as likely as the receipt forged, so this retries rather than refuses + unless (signedBy root intermediate) $ failed "the intermediate is not signed by the configured root" + case verifySignedSignature leaf (certPubKey $ getCertificate intermediate) of + SignaturePass -> Right () + SignatureFailed SignatureInvalid -> refused "the leaf is not signed by the intermediate" + SignatureFailed _ -> failed "the intermediate's key cannot check the leaf's signature algorithm" + -- Apple issues other certificates under this root, developers' among them; only these two mark the receipt-signing chain + unless (marked receiptSigningLeaf leaf && marked appleIntermediate intermediate) $ + failed "Apple issued this chain, but not to sign receipts" + pure leaf + _ -> failed "x5c is not leaf, intermediate and root" + where + certificate = either (const $ failed "an x5c certificate does not decode") Right . decodeSignedCertificate + signedBy issuer cert = verifySignedSignature cert (certPubKey $ getCertificate issuer) == SignaturePass + marked oid cert = case certExtensions (getCertificate cert) of + Extensions (Just exts) -> any ((== oid) . extRawOID) exts + Extensions Nothing -> False + receiptSigningLeaf = [1, 2, 840, 113635, 100, 6, 11, 1] + appleIntermediate = [1, 2, 840, 113635, 100, 6, 2, 1] + +leafKey :: SignedCertificate -> Either StoreRefusal ECDSA.PublicKey +leafKey leaf = case certPubKey (getCertificate leaf) of + PubKeyEC (PubKeyEC_Named ECC.SEC_p256r1 pt) | Just p <- unserializePoint p256 pt -> Right $ ECDSA.PublicKey p256 p + _ -> failed "the leaf Apple issued holds no P-256 key" + where + p256 = ECC.getCurveByName ECC.SEC_p256r1 + +-- | JWS carries ES256 as r and s, 32 bytes each, not the DER a certificate uses. +jwsSignature :: Text -> Either StoreRefusal ECDSA.Signature +jwsSignature s = case B64U.decodeUnpadded (encodeUtf8 s) of + Right bs | B.length bs == 64 -> let (r, s') = B.splitAt 32 bs in Right $ ECDSA.Signature (os2ip r) (os2ip s') + _ -> refused "the signature is not 64 base64url bytes" + +data AppleTransaction = AppleTransaction + { transactionId :: Text, + productId :: Text, + bundleId :: Text, + environment :: Text, + quantity :: Int, + revoked :: Bool, + price :: Maybe Integer, + currency :: Maybe Text + } + +appleTransactionP :: J.Object -> JT.Parser AppleTransaction +appleTransactionP o = do + transactionId <- o J..: "transactionId" + productId <- o J..: "productId" + bundleId <- o J..: "bundleId" + environment <- o J..: "environment" + quantity <- o J..: "quantity" + revoked <- isJust <$> (o J..:? "revocationDate" :: JT.Parser (Maybe J.Value)) + price <- o J..:? "price" + currency <- o J..:? "currency" + pure AppleTransaction {transactionId, productId, bundleId, environment, quantity, revoked, price, currency} + +transaction :: Text -> AppleTransaction -> Either StoreRefusal VerifiedStoreTransaction +transaction ourBundleId AppleTransaction {transactionId, productId, bundleId, environment, quantity, revoked, price, currency} + -- the configured bundle id may be the wrong one, and refusing for good would destroy every genuine purchase + | bundleId /= ourBundleId = failed "another app's bundle id, or ours misconfigured" + | revoked = refused "refunded or revoked" + | otherwise = do + testPurchase <- case environment of + "Production" -> Right False + "Sandbox" -> Right True + _ -> failed "an environment this verifier does not know" + Right + VerifiedStoreTransaction + { transactionRef = transactionId, + productId, + quantity, + testPurchase, + paid = paidOf price currency + } + +-- | Apple's price is in milliunits of the currency, whatever its minor unit. +paidOf :: Maybe Integer -> Maybe Text -> Maybe (CurrencyAmount, Text) +paidOf price_ currency_ = do + milliunits <- price_ + code <- currency_ + digits <- minorUnitDigits code + let (minor, rest) = (milliunits * 10 ^ digits) `divMod` 1000 + guard $ rest == 0 && minor >= 0 && minor <= toInteger (maxBound :: Word32) + pure (CurrencyAmount $ fromInteger minor, code) + +-- | ISO 4217 as of its 2026-09-17 list; four-digit and non-currency codes are not recorded. +minorUnitDigits :: Text -> Maybe Integer +minorUnitDigits c + | c `elem` ["BIF", "CLP", "DJF", "GNF", "ISK", "JPY", "KMF", "KRW", "PYG", "RWF", "UGX", "VND", "VUV", "XAF", "XOF", "XPF"] = Just 0 + | c `elem` ["BHD", "IQD", "JOD", "KWD", "LYD", "OMR", "TND"] = Just 3 + | c `elem` ["CLF", "UYW", "UYI", "XAG", "XAU", "XBA", "XBB", "XBC", "XBD", "XDR", "XPD", "XPT", "XSU", "XTS", "XUA", "XXX"] = Nothing + | T.length c == 3 && T.all (\x -> x >= 'A' && x <= 'Z') c = Just 2 + | otherwise = Nothing + +jsonObject :: Text -> Maybe J.Object +jsonObject part = J.decodeStrict' =<< eitherToMaybe (B64U.decodeUnpadded $ encodeUtf8 part) + +refused :: Text -> Either StoreRefusal a +refused = Left . SRInvalid + +failed :: Text -> Either StoreRefusal a +failed = Left . SRVerifierFailed . ("apple verifier: " <>) + +readAppleRoot :: FilePath -> IO (Either String SignedCertificate) +readAppleRoot path = + try (B.readFile path) >>= \case + Left (_ :: IOException) -> pure $ Left $ path <> ": could not be read" + Right der -> pure $ either (const $ Left $ path <> ": is not a DER certificate") Right $ decodeSignedCertificate der diff --git a/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Google.hs b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Google.hs new file mode 100644 index 0000000000..f70d8cba77 --- /dev/null +++ b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Google.hs @@ -0,0 +1,233 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} + +module BadgeService.StoreReceipts.Google (playStoreVerifier) where + +import BadgeService.Config (PlayStoreConfig (..)) +import BadgeService.StoreReceipts (StoreRefusal (..), VerifiedStoreTransaction (..)) +import Control.Concurrent.STM +import Control.Exception (IOException, try) +import Crypto.Hash.Algorithms (SHA256 (..)) +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Data.Aeson as J +import Data.Bifunctor (bimap) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64.URL as B64U +import qualified Data.ByteString.Lazy as LB +import Data.Functor (($>)) +import Data.Int (Int64) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) +import Data.X509 (PrivKey (..)) +import Data.X509.Memory (readKeyFileFromMemory) +import Network.HTTP.Client + ( HttpException (..), + Manager, + Request (..), + RequestBody (..), + Response (..), + brReadSome, + parseRequest, + withResponse, + ) +import Network.HTTP.Client.TLS (newTlsManager) +import Network.HTTP.Types (Status (..), hAuthorization, hContentType, methodPost, renderSimpleQuery) +import Simplex.Chat.PaymentService (googlePurchaseRef) +import Simplex.Messaging.Util (tshow) + +data ServiceAccount = ServiceAccount {clientEmail :: Text, privateKey :: RSA.PrivateKey} + +data PlayEnv = PlayEnv + { config :: PlayStoreConfig, + account :: ServiceAccount, + manager :: Manager, + accessToken :: TVar (Maybe (ByteString, UTCTime)) + } + +playStoreVerifier :: PlayStoreConfig -> IO (Either String (Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction), Text -> Text -> IO (Either StoreRefusal ()))) +playStoreVerifier config@PlayStoreConfig {gServiceAccountFile} = + readServiceAccount gServiceAccountFile >>= \case + Left e -> pure $ Left e + Right account -> do + manager <- newTlsManager + accessToken <- newTVarIO Nothing + let env = PlayEnv {config, account, manager, accessToken} + pure $ Right (verifyPurchase env, acknowledgePurchase env) + +readServiceAccount :: FilePath -> IO (Either String ServiceAccount) +readServiceAccount path = + try (B.readFile path) >>= \case + Left (_ :: IOException) -> pure $ Left $ path <> ": could not be read" + Right s -> pure $ case J.decodeStrict' s of + Just (ServiceAccountFile clientEmail pem) -> case readKeyFileFromMemory (encodeUtf8 pem) of + [PrivKeyRSA privateKey] -> Right ServiceAccount {clientEmail, privateKey} + _ -> Left $ path <> ": private_key is not one RSA key" + Nothing -> Left $ path <> ": is not a service account key with client_email and private_key" + +data ServiceAccountFile = ServiceAccountFile Text Text + +instance J.FromJSON ServiceAccountFile where + parseJSON = J.withObject "service account key" $ \o -> ServiceAccountFile <$> o J..: "client_email" <*> o J..: "private_key" + +verifyPurchase :: PlayEnv -> Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction) +verifyPurchase env productId token = (>>= purchaseVerdict productId token) <$> readPurchase env productId token + +-- | Acknowledged, never consumed: consuming drops the purchase from the app's purchase query, +-- which is how the app finds a purchase it has not yet settled. +acknowledgePurchase :: PlayEnv -> Text -> Text -> IO (Either StoreRefusal ()) +acknowledgePurchase env productId token = + readPurchase env productId token >>= \case + Left refusal -> pure $ Left $ acknowledging refusal + Right ProductPurchase {alreadyAcknowledged = True} -> pure $ Right () + Right _ -> bimap acknowledging (const ()) <$> playCall env (\req -> req {method = methodPost}) (purchaseUrl env productId token <> ":acknowledge") + where + acknowledging = \case + SRUnreachable reason -> SRUnreachable $ "acknowledging: " <> reason + SRVerifierFailed reason -> SRVerifierFailed $ "acknowledging: " <> reason + refusal -> refusal + +readPurchase :: PlayEnv -> Text -> Text -> IO (Either StoreRefusal ProductPurchase) +readPurchase env productId token = (>>= decoded) <$> playCall env id (purchaseUrl env productId token) + where + decoded = either (const $ Left $ SRVerifierFailed "could not read Play's purchase record") Right . J.eitherDecode' + +purchaseUrl :: PlayEnv -> Text -> Text -> Text +purchaseUrl PlayEnv {config = PlayStoreConfig {gApiHost, gPackageName}} productId token = + T.intercalate "/" [gApiHost, "androidpublisher/v3/applications", gPackageName, "purchases/products", productId, "tokens", token] + +playCall :: PlayEnv -> (Request -> Request) -> Text -> IO (Either StoreRefusal LB.ByteString) +playCall env@PlayEnv {accessToken} prepare url = + bearerToken env >>= \case + Left refusal -> pure $ Left refusal + Right bearer -> + playRequest env (\req -> (prepare req) {requestHeaders = [(hAuthorization, "Bearer " <> bearer)]}) url >>= \case + Left refusal -> pure $ Left refusal + Right (code, body) | code >= 200 && code < 300 -> pure $ Right body + Right (401, _) -> atomically (writeTVar accessToken Nothing) $> Left (SRVerifierFailed "Play refused this service's access token") + Right (403, _) -> pure $ Left $ SRVerifierFailed "the service account lacks the Play Console permission for this call" + -- a 404 among them, which Play may answer for a token it issued but has not yet recorded + Right (code, _) -> pure $ Left $ SRUnreachable $ "Play answered HTTP " <> tshow code + +purchaseVerdict :: Text -> Text -> ProductPurchase -> Either StoreRefusal VerifiedStoreTransaction +purchaseVerdict productId token ProductPurchase {purchaseState, purchaseType, purchaseQuantity, purchaseProductId} + | maybe False (/= productId) purchaseProductId = Left $ SRVerifierFailed "Play answered about another product" + | otherwise = case purchaseState of + 0 -> purchased <$> testPurchaseOf purchaseType + -- a canceled purchase stays canceled, and buying again issues a new token + 1 -> Left $ SRInvalid "canceled" + 2 -> Left SRPending + s -> Left $ SRVerifierFailed $ "an unknown purchaseState " <> tshow s + where + purchased testPurchase = + VerifiedStoreTransaction + { transactionRef = googlePurchaseRef token, + productId, + quantity = fromMaybe 1 purchaseQuantity, + testPurchase, + paid = Nothing + } + testPurchaseOf = \case + Nothing -> Right False + Just 0 -> Right True + -- a promo code, which only this app's developer can issue + Just 1 -> Right False + Just t -> Left $ SRVerifierFailed $ "a purchaseType this service does not credit: " <> tshow t + +data ProductPurchase = ProductPurchase + { purchaseState :: Int, + purchaseType :: Maybe Int, + purchaseQuantity :: Maybe Int, + purchaseProductId :: Maybe Text, + alreadyAcknowledged :: Bool + } + +instance J.FromJSON ProductPurchase where + parseJSON = J.withObject "ProductPurchase" $ \o -> do + purchaseState <- o J..: "purchaseState" + purchaseType <- o J..:? "purchaseType" + purchaseQuantity <- o J..:? "quantity" + purchaseProductId <- o J..:? "productId" + acknowledgementState <- o J..:? "acknowledgementState" + consumptionState <- o J..:? "consumptionState" + let alreadyAcknowledged = acknowledgementState == Just (1 :: Int) || consumptionState == Just (1 :: Int) + pure ProductPurchase {purchaseState, purchaseType, purchaseQuantity, purchaseProductId, alreadyAcknowledged} + +bearerToken :: PlayEnv -> IO (Either StoreRefusal ByteString) +bearerToken env@PlayEnv {accessToken} = do + now <- getCurrentTime + readTVarIO accessToken >>= \case + Just (bearer, validUntil) | now < validUntil -> pure $ Right bearer + _ -> requestAccessToken env now + +requestAccessToken :: PlayEnv -> UTCTime -> IO (Either StoreRefusal ByteString) +requestAccessToken env@PlayEnv {config = PlayStoreConfig {gTokenUrl}, account, accessToken} now = + signedAssertion account gTokenUrl now >>= \case + Nothing -> pure $ Left $ SRVerifierFailed "could not sign the service account assertion" + Just assertion -> + playRequest env (tokenForm assertion) gTokenUrl >>= \case + Left refusal -> pure $ Left refusal + Right (200, body) -> case J.eitherDecode' body of + Right (GrantedToken bearer expiresIn) -> do + atomically $ writeTVar accessToken $ Just (bearer, addUTCTime (fromIntegral expiresIn - refreshMargin) now) + pure $ Right bearer + Left _ -> pure $ Left $ SRVerifierFailed "could not read Google's access token" + Right (code, _) + | code >= 500 || code == 429 -> pure $ Left $ SRUnreachable $ "Google's token endpoint answered HTTP " <> tshow code + | otherwise -> pure $ Left $ SRVerifierFailed $ "Google refused the service account assertion: HTTP " <> tshow code + where + tokenForm assertion req = + req + { method = methodPost, + requestHeaders = [(hContentType, "application/x-www-form-urlencoded")], + requestBody = RequestBodyBS $ renderSimpleQuery False [("grant_type", "urn:ietf:params:oauth:grant-type:jwt-bearer"), ("assertion", assertion)] + } + +refreshMargin :: NominalDiffTime +refreshMargin = 300 + +data GrantedToken = GrantedToken ByteString Int + +instance J.FromJSON GrantedToken where + parseJSON = J.withObject "access token" $ \o -> GrantedToken . encodeUtf8 <$> o J..: "access_token" <*> o J..: "expires_in" + +signedAssertion :: ServiceAccount -> Text -> UTCTime -> IO (Maybe ByteString) +signedAssertion ServiceAccount {clientEmail, privateKey} audience now = + either (const Nothing) (\sig -> Just $ signingInput <> "." <> B64U.encodeUnpadded sig) <$> RSA.signSafer (Just SHA256) privateKey signingInput + where + issuedAt = floor (utcTimeToPOSIXSeconds now) :: Int64 + signingInput = segment (J.object ["alg" J..= ("RS256" :: Text), "typ" J..= ("JWT" :: Text)]) <> "." <> segment claims + claims = + J.object + [ "iss" J..= clientEmail, + "scope" J..= ("https://www.googleapis.com/auth/androidpublisher" :: Text), + "aud" J..= audience, + "iat" J..= issuedAt, + "exp" J..= (issuedAt + 3600) + ] + segment = B64U.encodeUnpadded . LB.toStrict . J.encode + +playRequest :: PlayEnv -> (Request -> Request) -> Text -> IO (Either StoreRefusal (Int, LB.ByteString)) +playRequest PlayEnv {manager} prepare url = + try (parseRequest (T.unpack url) >>= \req -> withResponse (prepare req) manager readBody) >>= \case + -- http-client's exceptions show the request, whose URL can hold the purchase token, so only the kind is kept + Left (e :: HttpException) -> pure $ Left $ SRUnreachable $ "request to Google failed: " <> failureKind e + Right (code, body) + | LB.length body > maxPlayBytes -> pure $ Left $ SRVerifierFailed $ "Google answered HTTP " <> tshow code <> " with over " <> tshow maxPlayBytes <> " bytes" + | otherwise -> pure $ Right (code, body) + where + readBody resp = (statusCode (responseStatus resp),) <$> brReadSome (responseBody resp) (fromIntegral maxPlayBytes + 1) + failureKind = \case + HttpExceptionRequest _ content -> T.pack $ takeWhile (/= ' ') $ show content + InvalidUrlException _ _ -> "InvalidUrlException" + +maxPlayBytes :: Int64 +maxPlayBytes = 1024 * 1024 diff --git a/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs index c2fd1ab63d..5de05fbf99 100644 --- a/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs +++ b/apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs @@ -18,24 +18,24 @@ import Simplex.Messaging.Util (eitherToMaybe) mockStoreVerifier :: StoreVerifier mockStoreVerifier = noStoreVerifier {verifyApple = Just mockApple, verifyGoogle = Just mockGoogle} -mockApple :: Text -> Either Text VerifiedStoreTransaction +mockApple :: Text -> Either StoreRefusal VerifiedStoreTransaction mockApple signed = case T.splitOn "." signed of [_, payload, _] -> do o <- case J.decodeStrict' =<< eitherToMaybe (B64U.decodeUnpadded $ encodeUtf8 payload) of Just (J.Object obj) -> Right obj - _ -> Left "payload is not base64url JSON" + _ -> Left $ SRInvalid "payload is not base64url JSON" productId <- case JM.lookup "productId" o of Just (J.String p) -> Right p - _ -> Left "no productId" - transactionRef <- maybe (Left "no transactionId") Right $ appleTransactionId signed + _ -> Left $ SRInvalid "no productId" + transactionRef <- maybe (Left $ SRInvalid "no transactionId") Right $ appleTransactionId signed Right $ vouched transactionRef productId - _ -> Left "not three dot-separated parts" + _ -> Left $ SRInvalid "not three dot-separated parts" mockGoogle :: Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction) mockGoogle productId token = pure $ Right $ vouched (googlePurchaseRef token) productId vouched :: Text -> Text -> VerifiedStoreTransaction vouched transactionRef productId = - -- not a test purchase, though nothing was paid: a test purchase is refused as receipt_invalid, which is + -- not a test purchase, though nothing was paid: a test purchase is refused as test_purchase, which is -- terminal and drops the client's keys, so every dev purchase would fail for good VerifiedStoreTransaction {transactionRef, productId, quantity = 1, testPurchase = False, paid = Nothing} diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index 338fa6c206..fe79d847e2 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -487,6 +487,7 @@ CredentialNotVerified: - "code_expired" - "receipt_invalid" - "receipt_used" +- "test_purchase" - "internal" diff --git a/docs/protocol/badges-rpc.md b/docs/protocol/badges-rpc.md index 42b602f4d2..80285fd383 100644 --- a/docs/protocol/badges-rpc.md +++ b/docs/protocol/badges-rpc.md @@ -34,12 +34,27 @@ The client never states what is signed. The tier is that of whatever funded the - `redeemBadgeCode` → `badgeCredential` — redeems a code, records the credit, and issues the first credential, in one round trip. It carries `masterKey` and `code` and no `badgeRequest`: a code states no tier and no expiry, so the credential is what reports them. Errors: `code_invalid` for an unknown or malformed code, `code_used` when other keys have taken all its uses (a code has one use unless issued with more), `code_expired` past a redemption deadline. - `purchaseBadge` → `badgeCredential` — verifies the funding (`apple` JWS offline; `google` product id and token via the Publisher API; `invoice` against webhook-confirmed settlement, `payment_pending` until it lands; `receipt`), records the credit, and issues the first credential, in one round trip. It carries `masterKey` and no `badgeRequest`. The response `receipt` is the recovery bearer secret (model § recovery); the service stores its hash; lifetime badges receive none. - A store transaction is claimed by its own id, read from the evidence before verification, and credited only when the verified transaction carries that same id. A receipt already credited to the signing key is answered from the record, without asking the store. - - Errors: `receipt_invalid`, `payment_pending`, `provider_unavailable` — see the classes below; `receipt_used` when another key was credited with it; `product_unavailable` for a product this service does not price; `provider_not_configured` when this deployment has no verifier for the store, terminal for the request since retrying cannot deploy one. `receipt_invalid` and `receipt_used` are the only answers on which the client drops the keys it signed with and finishes the store transaction. Every other answer records nothing and leaves the purchase with its keys, to be presented again at the next trigger. - - **Which class an answer belongs to.** The two mistakes do not cost the same, so when it is not certain, answer unreachable. `receipt_invalid` tells the client the purchase is dead: it drops the keys it signed with and finishes the store transaction — consumed on Play, finished on StoreKit — and nothing can present it again, so a buyer answered this by mistake has paid for a badge they can never receive. Answering unreachable by mistake costs one more verification request each time the app presents the purchase again, and a Play purchase left unacknowledged for three days is refunded to the buyer. - - **Terminal**, `receipt_invalid` — the store answered about this purchase and cannot change its mind: an Apple signature or certificate chain that does not verify, another app's bundle id, a test purchase (Apple Sandbox, Play `purchaseType` test), a refunded or revoked purchase, Play `purchaseState` canceled. - - **Pending**, `payment_pending` — Play `purchaseState` pending. - - **Unreachable**, `provider_unavailable` — the store was not asked or did not answer: network, timeout, 5xx, quota, this service's own auth or permission failures, and every Play error response, a 404 from `purchases.products.get` or `purchases.subscriptionsv2.get` and a 400 or 410 calling the token invalid included. A 404 decides nothing: Play answers it both for a token it has just issued and not yet recorded, and for one that was never a purchase. Only a purchase record is a verdict. A token whose characters this service will not send is never sent, so Play never answers about it — and Play documents no token grammar, so that check is our guess, not its verdict. A product id outside the characters Play does document is terminal, since no product of this app can have one. - - Apple is verified offline, so it has no "not yet" and a negative answer about the signed evidence is terminal. Two things are not the store's answer and leave the client holding the purchase: the verifier's own failure, such as a root certificate it could not load, which is `internal`; and a product this service does not price, which is `product_unavailable` — the verifier vouched for the transaction either way. + - Errors: `receipt_invalid`, `test_purchase`, `payment_pending`, `provider_unavailable` — see the classes below; `receipt_used` when another key was credited with it; `product_unavailable` for a product this service does not price; `provider_not_configured` when this deployment has no verifier for the store. `receipt_invalid`, `test_purchase` and `receipt_used` are the only answers on which the client drops the keys it signed with and finishes the store transaction. Every other answer records nothing and leaves the purchase with its keys, to be presented again at the next trigger. + - **Which class an answer belongs to.** The two mistakes do not cost the same, so when it is not certain, answer unreachable. `receipt_invalid` tells the client the purchase is dead: it drops the keys it signed with and finishes the store transaction — consumed on Play, finished on StoreKit — and nothing can present it again, so a buyer answered this by mistake has paid for a badge they can never receive. Answering unreachable by mistake costs one more verification request each time the app presents the purchase again, and a Play purchase left unacknowledged for three days is refunded to the buyer. It also locks the buyer out: the app offers no Buy while a purchase is open, so until that receipt settles the profile holding it cannot buy any badge, and an answer that never changes leaves it that way for good. + - **Terminal**, `receipt_invalid` — only a verdict no later attempt could change: the store answered about this purchase and cannot change its mind, or the evidence can never verify. Anything that might answer differently later — the store's lag, an outage, this service's own misconfiguration or bug, a shape of evidence this service does not know yet — is one of the other classes. + - **Terminal and named**, `test_purchase` — the store vouched for a purchase that cost nothing: Apple's `Sandbox`, or Play's `purchaseType` test. It is separated from `receipt_invalid` for one reason: the device that made the purchase already knows it was a test one, so naming it reveals nothing a forger could iterate on, and it lets the app say why instead of reporting a generic failure. Every other refusal stays lumped together for exactly that reason. + - **Pending**, `payment_pending` — a real purchase the store has not settled. + - **Unreachable**, `provider_unavailable` — the store was not asked or did not answer. + - **Internal**, `internal` — this service's own failure, never the store's answer. + - **App Store.** Apple is verified offline, so it has no "not yet". + - `receipt_invalid`: a JWS that is not three base64url parts or names no `transactionId`; an `x5c` certificate that is not base64; a JWS signature that is not 64 bytes; a leaf whose signature does not verify against the intermediate; a JWS signature that does not verify against the leaf; a transaction with a `revocationDate`, refunded or revoked. + - `test_purchase`: refused by the service after the verifier vouched for it, a `Sandbox` transaction. + - `internal`: whatever this service's own configuration decides — an intermediate whose signature does not verify against the configured root, and another app's `bundleId`, since the configured root or bundle id may be the wrong one as likely as the receipt forged; a transaction from Xcode's StoreKit testing, which Xcode signs and not the App Store, so the configured root does not verify it; evidence in a shape this service does not know — a header that does not name `ES256` or carries no `x5c` of exactly three certificates, a certificate that does not decode, a leaf signature the intermediate's key cannot check, an algorithm or key type the library does not support, a chain without Apple's receipt-signing marker extensions, a leaf key that is not P-256, a payload with a missing or mistyped field or an unknown `environment`; the verifier's own failure or overrun; and, refused by the service, a verified transaction other than the one claimed, or a quantity other than 1. + - `product_unavailable`: a product this service does not price — the verifier vouched for the transaction either way. + - `provider_not_configured`: the deployment has no `[apple]` section. + - **Google Play.** Only a purchase record is a verdict. + - `receipt_invalid`: `purchaseState` canceled, which a purchase token never leaves, and a product id outside the characters Play documents, since no product of this app can have one. + - `test_purchase`: refused by the service after the verifier vouched for it, `purchaseType` test, a license tester's purchase. + - `payment_pending`: `purchaseState` pending. + - `provider_unavailable`: network failure or timeout, and every error response from `purchases.products.get` but 401 and 403 — a 404 included, which Play may answer both for a token it has just issued and not yet recorded and for one that was never a purchase, and a 400 or 410 calling the token invalid; a 5xx or 429 from the token endpoint; and a token this service will not send — whose characters fall outside the grammar it accepts, which is our guess since Play documents none, or which is only dots, which a URL path would resolve away. + - `internal`: Google refusing this service's credentials or permissions — a 401 or 403 from `purchases.products.get`, and any other refusal from the token endpoint; a response that cannot be read, is too large, or names another product; a `purchaseState` this service does not know; and a `purchaseType` other than test or promo — a promo code, which only this app's developer issues, is credited like a purchase. + - `product_unavailable` and `provider_not_configured` as for the App Store, the latter without a `[google]` section. + - Before crediting a purchase of a product it prices, the service acknowledges it, unless Play already reports it acknowledged or consumed. It acknowledges and never consumes, so the app's purchase query still lists the purchase. The app may not be honest, and only acknowledgement stops Play refunding the purchase after three days, so nothing is credited unacknowledged. A failed acknowledgement credits nothing and is answered like a failed read — `provider_unavailable` when Play does not answer, `internal` when it refuses this service, both logged with "acknowledging" in the reason — and the app presents the purchase again. A deployment whose service account lacks the permission to acknowledge therefore answers `internal` to every Play purchase the app has not already acknowledged itself. - Funding by `receipt` is a transfer (post-MVP): the unissued months of the purchase that receipt belongs to move to the signing key, recorded as `debit(transferOut)` on the source and `credit(transferIn)` on the new purchase, and the presented receipt is retired for a fresh one. The transferred period's issuance debits a month like any other. Lifetime badges hold no receipt, so support handles them. - `upgradeBadgeSubscription` → `badgeCredential` — the app-led store subscription change, on the same key: verifies the store evidence of the replaced subscription and records the new plan; an immediate upgrade returns the new credential, a deferred change returns none. Its `badgeRequest` is to be dropped (see above). - `issueBadge` → `badgeCredential` — issues the next period from the balance, the only source of issuance. It carries `balance` alone: the credential is signed with the purchase's stored master key, for the type the balance funds, expiring at the `sundayAfter` of the period issued. The ledger is advanced first; the credential is signed before the `debit(badge)` and issuance rows are written, in one transaction. An exhausted balance yields no `credential`; the `statement` shows why. Issuing on a paused badge resumes it (model 2.13). @@ -70,4 +85,4 @@ An assertion that names an entry the service holds is a prefix: the service proc ## Errors -`retryAfter` marks the transient codes: `payment_pending`, `provider_unavailable`, `rate_limited`. `offer_disabled` calls for a catalog refresh. `code_invalid` covers unknown, malformed and revoked codes alike, so a guesser learns nothing from the difference; `code_used` — all its uses taken by other keys; `code_expired` — past its redemption deadline. `receipt_invalid` covers forged, malformed, another app's, refunded and test receipts alike, so a guesser learns nothing from the difference; `receipt_used` — credited to another key; `provider_not_configured` — no verifier for that store is deployed, so the receipt is neither credited nor refused. All other codes are terminal for the attempted command. +`retryAfter` marks the transient codes: `payment_pending`, `provider_unavailable`, `rate_limited`. `offer_disabled` calls for a catalog refresh. `code_invalid` covers unknown, malformed and revoked codes alike, so a guesser learns nothing from the difference; `code_used` — all its uses taken by other keys; `code_expired` — past its redemption deadline. `receipt_invalid` covers forged, malformed and refunded receipts alike, so a guesser learns nothing from the difference; `test_purchase` is named apart from them because the device that bought it already knows; `receipt_used` — credited to another key; `provider_not_configured` — no verifier for that store is deployed, so the receipt is neither credited nor refused. All other codes are terminal for the attempted command. diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index 56fa0b389e..cebc68abb4 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -325,6 +325,7 @@ export enum BadgeServiceErrorCode { Code_expired = "code_expired", Receipt_invalid = "receipt_invalid", Receipt_used = "receipt_used", + Test_purchase = "test_purchase", Internal = "internal", } diff --git a/packages/simplex-chat-python/src/simplex_chat/types/_types.py b/packages/simplex-chat-python/src/simplex_chat/types/_types.py index eca43f04ed..1befa750c3 100644 --- a/packages/simplex-chat-python/src/simplex_chat/types/_types.py +++ b/packages/simplex-chat-python/src/simplex_chat/types/_types.py @@ -224,7 +224,7 @@ BadgeRedeemError = ( BadgeRedeemError_Tag = Literal["invalidCode", "invalidReceipt", "serviceNotConfigured", "badgeActive", "serviceError", "invalidResponse", "unknownKeyIndex", "credentialNotVerified"] -BadgeServiceErrorCode = Literal["bad_request", "unsupported_version", "unknown_purchase_key", "unknown_offer_id", "offer_disabled", "offer_mismatch", "product_unavailable", "payment_not_entitled", "payment_pending", "provider_unavailable", "provider_not_configured", "rate_limited", "code_invalid", "code_used", "code_expired", "receipt_invalid", "receipt_used", "internal"] +BadgeServiceErrorCode = Literal["bad_request", "unsupported_version", "unknown_purchase_key", "unknown_offer_id", "offer_disabled", "offer_mismatch", "product_unavailable", "payment_not_entitled", "payment_pending", "provider_unavailable", "provider_not_configured", "rate_limited", "code_invalid", "code_used", "code_expired", "receipt_invalid", "receipt_used", "test_purchase", "internal"] BadgeStatus = Literal["active", "expired", "expiredOld", "failed", "unknownKey"] diff --git a/scripts/badge-service/badge_service.ini.example b/scripts/badge-service/badge_service.ini.example index 2dfcecf3f4..542fe5842b 100644 --- a/scripts/badge-service/badge_service.ini.example +++ b/scripts/badge-service/badge_service.ini.example @@ -36,6 +36,22 @@ session_minutes = 60 waiting_seconds = 3 idle_seconds = 60 +; optional; without it every App Store receipt is answered provider_not_configured, which the app retries later. +; root_certificate is https://www.apple.com/certificateauthority/AppleRootCA-G3.cer, in DER; +; uncomment its mount in compose.yml. +;[apple] +;bundle_id = chat.simplex.app +;root_certificate = /etc/simplex-badge-service/AppleRootCA-G3.cer + +; optional; without it every Play receipt is answered provider_not_configured, which the app retries later. +; service_account_file is the JSON key of a service account with the Play Console permissions "View +; financial data, orders, and cancellation survey responses" and "Manage orders and subscriptions", to +; read and acknowledge purchases. Without the second, a purchase the app has not already acknowledged +; itself is answered internal until the permission is granted. Uncomment its mount in compose.yml; the file must be readable by the service's user alone. +;[google] +;package_name = chat.simplex.app +;service_account_file = /etc/simplex-badge-service/play-service-account.json + ; index is the one clients verify against; private_key is from `simplex-chat badge keygen`. ; To rotate, change both together, once clients trust the new index. [issuer] @@ -54,6 +70,7 @@ private_key = replace-me ;description = Welcome to the badges group ; local testing only, in both run modes: accepts any well-formed App Store or Play receipt without -; verifying it, so anyone who can reach this service can mint badges +; verifying it, so anyone who can reach this service can mint badges. The service refuses to start +; with this on beside an [apple] or [google] section. [dev] accept_unverified_store_receipts = off diff --git a/scripts/badge-service/compose.yml b/scripts/badge-service/compose.yml index 1c7e485e08..0656835b9d 100644 --- a/scripts/badge-service/compose.yml +++ b/scripts/badge-service/compose.yml @@ -20,5 +20,7 @@ services: - "/etc/simplex-badge-service/badge_service.ini" volumes: - ./badge_service.ini:/etc/simplex-badge-service/badge_service.ini:ro + # - ./AppleRootCA-G3.cer:/etc/simplex-badge-service/AppleRootCA-G3.cer:ro + # - ./play-service-account.json:/etc/simplex-badge-service/play-service-account.json:ro - ./web:/srv/webapp stop_grace_period: 10s diff --git a/simplex-chat.cabal b/simplex-chat.cabal index d233583511..871eabc140 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -447,6 +447,8 @@ executable simplex-badge-service BadgeService.Store.Invoices BadgeService.Store.Migrate BadgeService.StoreReceipts + BadgeService.StoreReceipts.Apple + BadgeService.StoreReceipts.Google BadgeService.StoreReceipts.Mock BadgeService.Waiters BadgeService.Web.Server @@ -459,6 +461,9 @@ executable simplex-badge-service , base64-bytestring >=1.0 && <1.3 , containers ==0.6.* , crypton ==0.34.* + , crypton-x509 ==1.7.* + , crypton-x509-store ==1.6.* + , crypton-x509-validation ==1.6.* , directory ==1.3.* , filepath ==1.4.* , http-client ==0.7.* @@ -740,6 +745,8 @@ test-suite simplex-chat-test BadgeService.Store.Invoices BadgeService.Store.Migrate BadgeService.StoreReceipts + BadgeService.StoreReceipts.Apple + BadgeService.StoreReceipts.Google BadgeService.StoreReceipts.Mock BadgeService.Waiters BadgeService.Web.Server @@ -748,10 +755,12 @@ test-suite simplex-chat-test Bots.BadgeService.CatalogTests Bots.BadgeService.ConfigTests Bots.BadgeService.FakeBTCPay + Bots.BadgeService.FakePlay Bots.BadgeService.FakeStore Bots.BadgeService.FakeStripe Bots.BadgeService.GroupIntegrationTests Bots.BadgeService.GroupTests + Bots.BadgeService.StoreVerifierTests Bots.BadgeService.StripeTests Bots.BadgeService.WaitersTests Bots.BadgeService.WebTests @@ -798,10 +807,14 @@ test-suite simplex-chat-test , composition ==1.0.* , containers ==0.6.* , crypton ==0.34.* + , crypton-x509 ==1.7.* + , crypton-x509-store ==1.6.* + , crypton-x509-validation ==1.6.* , deepseq ==1.4.* , directory ==1.3.* , filepath ==1.4.* , generic-random ==1.5.* + , hourglass ==0.2.* , http-client ==0.7.* , http-client-tls ==0.3.* , http-types ==0.12.* diff --git a/src/Simplex/Chat/Badges/Types.hs b/src/Simplex/Chat/Badges/Types.hs index 376869f584..f4949848f1 100644 --- a/src/Simplex/Chat/Badges/Types.hs +++ b/src/Simplex/Chat/Badges/Types.hs @@ -244,6 +244,7 @@ data BadgeServiceErrorCode | BSECodeExpired | BSEReceiptInvalid | BSEReceiptUsed + | BSETestPurchase -- the store vouched for a purchase that cost nothing: Apple's sandbox, a Play license tester | BSEInternal | BSEUnknown Text -- forwards-compatible: service is deployed ahead of clients deriving (Eq, Show) @@ -345,6 +346,7 @@ instance TextEncoding BadgeServiceErrorCode where BSECodeExpired -> "code_expired" BSEReceiptInvalid -> "receipt_invalid" BSEReceiptUsed -> "receipt_used" + BSETestPurchase -> "test_purchase" BSEInternal -> "internal" BSEUnknown t -> t textDecode s = Just $ case s of @@ -365,6 +367,7 @@ instance TextEncoding BadgeServiceErrorCode where "code_expired" -> BSECodeExpired "receipt_invalid" -> BSEReceiptInvalid "receipt_used" -> BSEReceiptUsed + "test_purchase" -> BSETestPurchase "internal" -> BSEInternal t -> BSEUnknown t diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 367b2d8a75..f5c48c7e2c 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -5308,6 +5308,7 @@ storeReceiptRefused :: BadgeServiceErrorCode -> Bool storeReceiptRefused = \case BSEReceiptInvalid -> True BSEReceiptUsed -> True + BSETestPurchase -> True _ -> False -- | The same reference the service claims a transaction by, read without verifying anything. diff --git a/tests/BadgeTests.hs b/tests/BadgeTests.hs index da147f81d7..c2410e0423 100644 --- a/tests/BadgeTests.hs +++ b/tests/BadgeTests.hs @@ -716,7 +716,7 @@ testServiceRetryAfter = do badgeErrorRetryAfter BSEInternal `shouldBe` Nothing mapM_ (\code -> badgeErrorRetryAfter code `shouldBe` Nothing) - [BSEBadRequest, BSEUnsupportedVersion, BSEUnknownPurchaseKey, BSECodeInvalid, BSECodeUsed, BSECodeExpired, BSEProviderNotConfigured, BSEUnknown "future_code"] + [BSEBadRequest, BSEUnsupportedVersion, BSEUnknownPurchaseKey, BSECodeInvalid, BSECodeUsed, BSECodeExpired, BSEProviderNotConfigured, BSETestPurchase, BSEUnknown "future_code"] -- The app shows the recorded failure in a sentence, so an agent error is stored as the agent -- error and not as the chat error wrapping it, whether or not it can clear on its own. @@ -901,7 +901,7 @@ testGoogleTokenPath = do mapM_ (\t -> unsent t `shouldBe` True) ["a/b", "../x", "t?x", "t#x", "t x", ""] uncalledVerifier :: StoreVerifier -uncalledVerifier = StoreVerifier {verifyApple = Nothing, verifyGoogle = Just $ \_ _ -> error "verifier called", verifyTimeout = 500000} +uncalledVerifier = StoreVerifier {verifyApple = Nothing, verifyGoogle = Just $ \_ _ -> error "verifier called", acknowledgeGoogle = Nothing, verifyTimeout = 500000} validPlayToken :: T.Text validPlayToken = "fake-play-token.AO-J1Oz9x2kqE7wYt3" diff --git a/tests/Bots/BadgeService/BotTests.hs b/tests/Bots/BadgeService/BotTests.hs index 78d3faa9d4..2c52cc3445 100644 --- a/tests/Bots/BadgeService/BotTests.hs +++ b/tests/Bots/BadgeService/BotTests.hs @@ -28,7 +28,7 @@ import ChatTests.DBUtils import ChatTests.Utils import Control.Concurrent (threadDelay) import Control.Concurrent.Async (async, cancel) -import Control.Concurrent.STM (TQueue, atomically, readTMVar) +import Control.Concurrent.STM (TQueue, atomically, readTMVar, readTQueue) import Control.Monad (forM_, void, when) import Control.Exception (finally) import qualified Data.Aeson as J @@ -134,6 +134,7 @@ badgeServiceTests = do it "should refuse a receipt another key was credited with" testStoreReceiptUsed it "should refuse a receipt the store does not vouch for, with no retry" testStoreReceiptInvalid it "should write nothing for a pending purchase, and credit it once when it settles" testStorePending + it "should acknowledge a Play purchase before crediting it, and credit nothing when acknowledging fails" testStoreAcknowledgesBeforeCrediting it "should refuse a product that grants no badge" testStoreUnknownProduct it "should refuse a store purchase that carries an upgrade" testStoreUpgradeRefused it "should grant the badge of the product the receipt proves" testStoreBadgeTypeFromProduct @@ -168,6 +169,7 @@ badgeServiceTests = do it "should retry a receipt the service could not verify, and credit it with no trigger at all" testStoreReceiptRetried it "should credit a second receipt while an earlier one waits for the store" testStoreReceiptNotBlocked it "should answer a refused receipt from the record, sending nothing, and not list it" testStoreRefusalKept + it "should refuse a test purchase for good, and answer it from the record" testStoreTestPurchaseRefused it "should announce a settlement to an owner that is not active, and print nothing for a hidden one" testStoreSettledOtherProfile it "should resolve one new transaction handed over twice at once to one record" testStoreReceiptTwoAtOnce it "should delete a month-old record that will fund no badge, and keep held and credited ones" testStoreReceiptCleanup @@ -1723,8 +1725,8 @@ testStoreReceiptInvalid ps = refused (googlePayment "badge_supporter_01" "not-a-purchase") `shouldReturn` (BSEReceiptInvalid, Nothing) refused SPApple {jws = "not.a.jws"} `shouldReturn` (BSEReceiptInvalid, Nothing) refused SPApple {jws = unsignedJWS "{\"transactionId\":\"2000000812345699\",\"productId\":\"BADGE_SUPPORTER_01\"}"} `shouldReturn` (BSEReceiptInvalid, Nothing) - -- refused by the service, which the store would have vouched for - refused SPApple {jws = appleSandboxJWS} `shouldReturn` (BSEReceiptInvalid, Nothing) + -- named rather than lumped in with a forgery, since the device that bought it already knows + refused SPApple {jws = appleSandboxJWS} `shouldReturn` (BSETestPurchase, Nothing) nothingPurchased cc testStorePending :: HasCallStack => TestParams -> IO () @@ -1743,6 +1745,34 @@ testStorePending ps = rowCount cc "sx_badge_service_badge_purchases" `shouldReturn` 1 storePayments cc `shouldReturn` [("google", Nothing, Nothing, 1)] +testStoreAcknowledgesBeforeCrediting :: HasCallStack => TestParams -> IO () +testStoreAcknowledgesBeforeCrediting ps = do + acknowledged <- newIORef [] + acknowledgement <- newIORef $ Right () + let acknowledging store = (fakeVerifier store) {acknowledgeGoogle = Just $ \_ token -> modifyIORef' acknowledged (token :) >> readIORef acknowledgement} + withBadgeServiceVerifier ps acknowledging $ \env@BadgeServiceEnv {bsController = cc} -> do + (purchaseKey, masterKey) <- newPurchaseKeys + let purchase payment = serviceCmd env purchaseKey $ purchaseCmd masterKey payment + unsettled <- purchase $ googlePayment "badge_supporter_01" googlePendingToken + fst (refusalOf unsettled) `shouldBe` BSEPaymentPending + unpriced <- purchase $ googlePayment "subscr_badge_supporter_01" googleSubscriptionToken + refusalOf unpriced `shouldBe` (BSEProductUnavailable, Nothing) + readIORef acknowledged `shouldReturn` [] + writeIORef acknowledgement $ Left $ SRUnreachable "acknowledging: fake store is down" + unacknowledged <- purchase supporterPlay + refusalOf unacknowledged `shouldSatisfy` \(code, retryAfter) -> code == BSEProviderUnavailable && isJust retryAfter + writeIORef acknowledgement $ Left $ SRVerifierFailed "acknowledging: the service account lacks the Play Console permission for this call" + forbidden <- purchase supporterPlay + refusalOf forbidden `shouldBe` (BSEInternal, Nothing) + nothingPurchased cc + writeIORef acknowledgement $ Right () + purchased <- purchase supporterPlay + badgeTypeOf purchased `shouldBe` Just BTSupporter + replayed <- purchase supporterPlay + credentialOf replayed `shouldBe` credentialOf purchased + readIORef acknowledged `shouldReturn` replicate 3 googleSupporterToken + rowCount cc "sx_badge_service_badge_purchases" `shouldReturn` 1 + testStoreUnknownProduct :: HasCallStack => TestParams -> IO () testStoreUnknownProduct ps = withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsController = cc} -> do @@ -2166,6 +2196,18 @@ testStoreRefusalKept ps = do verifications `shouldReturn` 1 storeReceiptRows (chatController alice) `shouldReturn` [(1, Nothing, True)] +testStoreTestPurchaseRefused :: HasCallStack => TestParams -> IO () +testStoreTestPurchaseRefused ps = + withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClientCfg, bsStore = FakeStore {appleSandboxJWS}} -> + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + invoiceId <- createInvoice alice 1 + let purchase = purchaseWithInvoice 1 invoiceId SPApple {jws = appleSandboxJWS} + alice ##> purchase + alice <### [StartsWith (invoicePurchase "" invoiceId), ConsoleString (refusedLine "" invoiceId "service_error final test_purchase")] + heldStoreReceipts (chatController alice) `shouldReturn` 0 + alice ##> purchase + alice <## "cannot get badge: badge service error: test_purchase" + testStoreSettledOtherProfile :: HasCallStack => TestParams -> IO () testStoreSettledOtherProfile ps = withBadgeServiceEnv ps $ \BadgeServiceEnv {bsClientCfg} -> @@ -2261,7 +2303,7 @@ testStoreReceiptAfterRestart ps = do pure invoiceId writeIORef broken False withTestChatCfg ps cfg "alice" $ \alice -> do - inAnyOrder alice [["subscribed 1 connections on server localhost"], creditedLines "" invoiceId "1: supporter"] + expectLinesWithin 60 alice (creditedLines "" invoiceId "1: supporter") ["subscribed 1 connections on server localhost"] heldStoreReceipts (chatController alice) `shouldReturn` 0 createInvoice :: HasCallStack => TestCC -> Int -> IO String @@ -2330,6 +2372,27 @@ inAnyOrder cc blocks = do start : _ -> start `isPrefixOf` l [] -> False +-- | The required lines under one budget in any order, and the tolerated ones only if they come at +-- all: the agent announces UP for a subscription that was still pending in the session answering it +-- (simplexmq processSubOk), so "subscribed N connections" may never be printed, and when it is it +-- races a settlement that arrived in the same batch. getTermLine' would bound each line at 20s. +expectLinesWithin :: HasCallStack => Int -> TestCC -> [String] -> [String] -> IO () +expectLinesWithin seconds cc@TestCC {termQ, printOutput} required tolerated = go (seconds * 10) required + where + go n outstanding = + 100000 `timeout` atomically (readTQueue termQ) >>= \case + Just line -> do + when printOutput $ userName cc >>= \name -> putStrLn $ name <> ": " <> line + case break (`isPrefixOf` line) outstanding of + (earlier, _ : others) -> go n (earlier <> others) + _ + | any (`isPrefixOf` line) tolerated -> go n outstanding + | otherwise -> error $ "unexpected " <> show line <> ", awaiting " <> show outstanding + Nothing + | null outstanding -> pure () + | n > 0 -> go (n - 1) outstanding + | otherwise -> error $ "no line starting one of " <> show outstanding <> " in " <> show seconds <> " seconds" + -- | Counts the Google verifications the service makes, re-arming the one-shot hook each time. countGoogleVerifications :: IORef (IO ()) -> IO (IO Int) countGoogleVerifications hook = do diff --git a/tests/Bots/BadgeService/ConfigTests.hs b/tests/Bots/BadgeService/ConfigTests.hs index f8ce3038f5..1542c7a7eb 100644 --- a/tests/Bots/BadgeService/ConfigTests.hs +++ b/tests/Bots/BadgeService/ConfigTests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -51,6 +52,10 @@ badgeConfigTests = describe "badge service config" $ do it "reads accept_unverified_store_receipts = on" testDevUnverifiedReceiptsOn it "reads accept_unverified_store_receipts = off" testDevUnverifiedReceiptsOff it "refuses an accept_unverified_store_receipts that is not on or off" testDevUnverifiedReceiptsNotBoolean + it "configures no store verifier when [apple] and [google] are absent" testStoresAbsent + it "reads [apple] and [google], defaulting Google's endpoints" testStoresRead + it "refuses an incomplete [apple] or [google], naming the key" testStoresIncomplete + it "refuses accept_unverified_store_receipts beside a real store verifier" testDevUnverifiedBesideVerifier groupConfigTests fullIni :: T.Text @@ -380,6 +385,51 @@ testDevUnverifiedReceiptsNotBoolean = withDev "accept_unverified_store_receipts withDev :: T.Text -> (Either String ServiceConfig -> IO a) -> IO a withDev keys act = withIni (fullIni <> "[dev]\n" <> keys) $ \p -> readServiceConfig p >>= act +appleIni, googleIni :: T.Text +appleIni = "[apple]\nbundle_id = chat.simplex.app\nroot_certificate = /etc/badges/AppleRootCA-G3.cer\n" +googleIni = "[google]\npackage_name = chat.simplex.app\nservice_account_file = /etc/badges/play.json\n" + +testStoresAbsent :: IO () +testStoresAbsent = withIni fullIni $ \p -> do + Right cfg <- readServiceConfig p + appleStore cfg `shouldBe` Nothing + playStore cfg `shouldBe` Nothing + +testStoresRead :: IO () +testStoresRead = withIni (fullIni <> appleIni <> googleIni) $ \p -> do + Right cfg <- readServiceConfig p + appleStore cfg `shouldBe` Just AppleStoreConfig {aBundleId = "chat.simplex.app", aRootCertificate = "/etc/badges/AppleRootCA-G3.cer"} + playStore cfg + `shouldBe` Just + PlayStoreConfig + { gPackageName = "chat.simplex.app", + gServiceAccountFile = "/etc/badges/play.json", + gApiHost = "https://androidpublisher.googleapis.com", + gTokenUrl = "https://oauth2.googleapis.com/token" + } + +testStoresIncomplete :: IO () +testStoresIncomplete = do + refused (T.replace "bundle_id = chat.simplex.app\n" "" appleIni) "apple.bundle_id" + refused (T.replace "root_certificate = /etc/badges/AppleRootCA-G3.cer\n" "" appleIni) "apple.root_certificate" + refused (T.replace "package_name = chat.simplex.app\n" "" googleIni) "google.package_name" + refused (T.replace "service_account_file = /etc/badges/play.json\n" "" googleIni) "google.service_account_file" + where + refused section key = + withIni (fullIni <> section) readServiceConfig >>= \case + Left e -> e `shouldContain` key + Right _ -> expectationFailure ("an incomplete section must fail at boot, naming " <> key) + +testDevUnverifiedBesideVerifier :: IO () +testDevUnverifiedBesideVerifier = + mapM_ + ( \stores -> + withIni (fullIni <> stores <> "[dev]\naccept_unverified_store_receipts = on\n") readServiceConfig >>= \case + Left e -> e `shouldContain` "accept_unverified_store_receipts" + Right _ -> expectationFailure "a service that verifies store receipts must not also accept unverified ones" + ) + [appleIni, googleIni] + parseIni :: T.Text -> IO (Either String ServiceConfig) parseIni t = withIni t readServiceConfig diff --git a/tests/Bots/BadgeService/FakePlay.hs b/tests/Bots/BadgeService/FakePlay.hs new file mode 100644 index 0000000000..cc479853c7 --- /dev/null +++ b/tests/Bots/BadgeService/FakePlay.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Bots.BadgeService.FakePlay + ( FakePlay (..), + PlayAnswer (..), + withFakePlay, + answerPurchase, + answerAcknowledgements, + answerTokenRequests, + grantTokensFor, + fakePackageName, + ) +where + +import BadgeService.Config (PlayStoreConfig (..)) +import Control.Concurrent (threadDelay) +import Control.Concurrent.STM +import Control.Monad (forever) +import Crypto.Hash.Algorithms (SHA256 (..)) +import Crypto.Number.Serialize (i2osp) +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Data.Aeson as J +import qualified Data.Aeson.KeyMap as KM +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.Char8 as B8 +import qualified Data.ByteString.Lazy as LB +import qualified Data.Map.Strict as M +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) +import Network.HTTP.Types (Status, badRequest400, hAuthorization, hContentType, methodGet, methodPost, mkStatus, notFound404, ok200, parseSimpleQuery, unauthorized401) +import Network.Wai (Application, Response, pathInfo, requestHeaders, requestMethod, responseLBS, strictRequestBody) +import qualified Network.Wai.Handler.Warp as Warp +import System.Directory (createDirectoryIfMissing) +import System.FilePath (()) +import UnliftIO.Temporary (withTempDirectory) + +data PlayAnswer = PlayRecord J.Value | PlayBody LB.ByteString | PlayStatus Int | PlayHang + +data FakePlay = FakePlay + { fpConfig :: PlayStoreConfig, + fpAnswers :: TVar (M.Map Text PlayAnswer), + -- a status the token endpoint answers instead of granting + fpTokenRefusal :: TVar (Maybe Int), + fpTokenSeconds :: TVar Int, + fpGrantedTokens :: TVar [B.ByteString], + fpPurchasePaths :: TVar [[Text]], + fpAcknowledgeRefusal :: TVar (Maybe Int), + fpAcknowledged :: TVar [Text] + } + +fakePackageName :: Text +fakePackageName = "chat.simplex.app" + +fakeClientEmail :: Text +fakeClientEmail = "badge-verifier@simplex-badges-test.iam.gserviceaccount.com" + +-- | Warp chooses the port, so a server left over from an earlier run cannot answer instead. +-- The service account key is made per run, since a committed one trips secret scanning. +withFakePlay :: (FakePlay -> IO a) -> IO a +withFakePlay action = do + (key, privateKey) <- RSA.generate 128 65537 + fpAnswers <- newTVarIO M.empty + fpTokenRefusal <- newTVarIO Nothing + fpTokenSeconds <- newTVarIO 3600 + fpGrantedTokens <- newTVarIO [] + fpPurchasePaths <- newTVarIO [] + fpAcknowledgeRefusal <- newTVarIO Nothing + fpAcknowledged <- newTVarIO [] + createDirectoryIfMissing True "tests/tmp" + withTempDirectory "tests/tmp" "fake-play" $ \d -> do + let accountFile = d "service-account.json" + fake base = + FakePlay + { fpConfig = PlayStoreConfig {gPackageName = fakePackageName, gServiceAccountFile = accountFile, gApiHost = base, gTokenUrl = base <> "/token"}, + fpAnswers, + fpTokenRefusal, + fpTokenSeconds, + fpGrantedTokens, + fpPurchasePaths, + fpAcknowledgeRefusal, + fpAcknowledged + } + LB.writeFile accountFile $ J.encode $ J.object ["client_email" J..= fakeClientEmail, "private_key" J..= decodeUtf8 (pkcs8Pem privateKey)] + Warp.testWithApplication (pure $ \req respond -> fakeApp key (fake $ origin req) req respond) $ \prt -> + action (fake $ "http://127.0.0.1:" <> T.pack (show prt)) + where + -- the app needs the base URL for the audience it checks, and the request names the port it reached + origin req = maybe "" (("http://" <>) . T.pack . B8.unpack) (lookup "Host" (requestHeaders req)) + +-- | The PKCS#8 PEM Google puts in a service account key, so the service's own parser reads it. +pkcs8Pem :: RSA.PrivateKey -> B.ByteString +pkcs8Pem k = + "-----BEGIN PRIVATE KEY-----\n" <> B8.unlines (chunks $ B64.encode pkcs8) <> "-----END PRIVATE KEY-----\n" + where + RSA.PublicKey {RSA.public_n, RSA.public_e} = RSA.private_pub k + pkcs8 = der 0x30 $ derInteger 0 <> der 0x30 (rsaEncryption <> "\x05\x00") <> der 0x04 pkcs1 + pkcs1 = der 0x30 $ foldMap derInteger [0, public_n, public_e, RSA.private_d k, RSA.private_p k, RSA.private_q k, RSA.private_dP k, RSA.private_dQ k, RSA.private_qinv k] + rsaEncryption = der 0x06 "\x2a\x86\x48\x86\xf7\x0d\x01\x01\x01" + derInteger n = der 0x02 $ case i2osp n of + bs | B.null bs || B.head bs >= 0x80 -> B.cons 0 bs + bs -> bs + der tag content = B.pack (tag : derLength (B.length content)) <> content + derLength n + | n < 0x80 = [fromIntegral n] + | otherwise = let bs = B.unpack (i2osp $ toInteger n) in 0x80 + fromIntegral (length bs) : bs + chunks bs + | B.null bs = [] + | otherwise = let (line, rest) = B.splitAt 64 bs in line : chunks rest + +answerPurchase :: FakePlay -> Text -> PlayAnswer -> IO () +answerPurchase FakePlay {fpAnswers} token answer = atomically $ modifyTVar' fpAnswers $ M.insert token answer + +answerTokenRequests :: FakePlay -> Maybe Int -> IO () +answerTokenRequests FakePlay {fpTokenRefusal} = atomically . writeTVar fpTokenRefusal + +grantTokensFor :: FakePlay -> Int -> IO () +grantTokensFor FakePlay {fpTokenSeconds} = atomically . writeTVar fpTokenSeconds + +answerAcknowledgements :: FakePlay -> Maybe Int -> IO () +answerAcknowledgements FakePlay {fpAcknowledgeRefusal} = atomically . writeTVar fpAcknowledgeRefusal + +fakeApp :: RSA.PublicKey -> FakePlay -> Application +fakeApp key FakePlay {fpConfig = PlayStoreConfig {gTokenUrl}, fpAnswers, fpTokenRefusal, fpTokenSeconds, fpGrantedTokens, fpPurchasePaths, fpAcknowledgeRefusal, fpAcknowledged} req respond = + case (requestMethod req, pathInfo req) of + (m, ["token"]) | m == methodPost -> strictRequestBody req >>= grant + (m, path@["androidpublisher", "v3", "applications", pkg, "purchases", "products", _, "tokens", token]) + | m == methodGet && pkg == fakePackageName -> authorized $ do + atomically $ modifyTVar' fpPurchasePaths (<> [path]) + purchase token + | m == methodPost && pkg == fakePackageName, Just acknowledgedToken <- T.stripSuffix ":acknowledge" token -> authorized $ acknowledge acknowledgedToken + _ -> respond $ status notFound404 + where + authorized act = do + granted <- readTVarIO fpGrantedTokens + case lookup hAuthorization (requestHeaders req) of + Just auth | Just bearer <- B.stripPrefix "Bearer " auth, take 1 (reverse granted) == [bearer] -> act + _ -> respond $ status unauthorized401 + acknowledge token = + readTVarIO fpAcknowledgeRefusal >>= \case + Just code -> respond $ status (mkStatus code "Refused") + Nothing -> do + atomically $ modifyTVar' fpAcknowledged (<> [token]) + respond $ responseLBS ok200 [] "" + grant body = + readTVarIO fpTokenRefusal >>= \case + Just code -> respond $ status (mkStatus code "Refused") + Nothing + | validAssertion (parseSimpleQuery $ LB.toStrict body) -> do + bearer <- atomically $ stateTVar fpGrantedTokens $ \ts -> let t = "fake-access-" <> B8.pack (show (length ts)) in (t, ts <> [t]) + seconds <- readTVarIO fpTokenSeconds + respond $ json ok200 $ J.object ["access_token" J..= B8.unpack bearer, "expires_in" J..= seconds, "token_type" J..= ("Bearer" :: Text)] + | otherwise -> respond $ json badRequest400 $ J.object ["error" J..= ("invalid_grant" :: Text)] + validAssertion form = case (lookup "grant_type" form, B8.split '.' <$> lookup "assertion" form) of + (Just "urn:ietf:params:oauth:grant-type:jwt-bearer", Just [header, claims, sig]) + | Right sigBytes <- B64U.decodeUnpadded sig, + RSA.verify (Just SHA256) key (header <> "." <> claims) sigBytes, + Right claimBytes <- B64U.decodeUnpadded claims, + Just (J.Object c) <- J.decodeStrict' claimBytes -> + KM.lookup "aud" c == Just (J.String gTokenUrl) + && KM.lookup "scope" c == Just (J.String "https://www.googleapis.com/auth/androidpublisher") + && KM.lookup "iss" c == Just (J.String fakeClientEmail) + _ -> False + purchase token = + M.lookup token <$> readTVarIO fpAnswers >>= \case + Just (PlayRecord v) -> respond $ json ok200 v + Just (PlayBody b) -> respond $ responseLBS ok200 [(hContentType, "application/json")] b + Just (PlayStatus code) -> respond $ status (mkStatus code "Answer") + Just PlayHang -> forever $ threadDelay 1000000 + Nothing -> respond $ status notFound404 + +json :: Status -> J.Value -> Response +json st = responseLBS st [(hContentType, "application/json")] . J.encode + +status :: Status -> Response +status st = json st $ J.object ["error" J..= J.object ["code" J..= show st]] diff --git a/tests/Bots/BadgeService/FakeStore.hs b/tests/Bots/BadgeService/FakeStore.hs index 986351c47f..bede2de8e7 100644 --- a/tests/Bots/BadgeService/FakeStore.hs +++ b/tests/Bots/BadgeService/FakeStore.hs @@ -72,7 +72,7 @@ newFakeStore = do ] verifyApple jws | jws == appleThrowingJWS = error "fake verifier bug" - | otherwise = maybe (Left "not a fake receipt") Right $ lookup jws appleReceipts + | otherwise = maybe (Left $ SRInvalid "not a fake receipt") Right $ lookup jws appleReceipts verifyGoogle = googleVerdict pendingSettled googleDown pure FakeStore @@ -84,7 +84,7 @@ newFakeStore = do appleQuantityJWS, pendingSettled, googleDown, - fakeVerifier = StoreVerifier {verifyApple = Just verifyApple, verifyGoogle = Just verifyGoogle, verifyTimeout = 500000} + fakeVerifier = StoreVerifier {verifyApple = Just verifyApple, verifyGoogle = Just verifyGoogle, acknowledgeGoogle = Nothing, verifyTimeout = 500000} } where fixtureJWS name = unsignedJWS <$> B.readFile (fixtureDir name) diff --git a/tests/Bots/BadgeService/StoreVerifierTests.hs b/tests/Bots/BadgeService/StoreVerifierTests.hs new file mode 100644 index 0000000000..be4e6f2e26 --- /dev/null +++ b/tests/Bots/BadgeService/StoreVerifierTests.hs @@ -0,0 +1,560 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Bots.BadgeService.StoreVerifierTests (badgeStoreVerifierTests) where + +import BadgeService.Config (PlayStoreConfig (..), ServiceConfig (..), readServiceConfig) +import BadgeService.Service (ServiceState (..), configureStoreVerifier, newServiceState) +import BadgeService.StoreReceipts +import BadgeService.StoreReceipts.Apple (readAppleRoot, verifyAppleTransaction) +import BadgeService.StoreReceipts.Google (playStoreVerifier) +import Bots.BadgeService.FakePlay +import Control.Concurrent.STM (readTVarIO) +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.Hourglass (Date (..), DateTime (..), Month (..), TimeOfDay (..)) +import Data.List (isInfixOf) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) +import Data.X509 +import Simplex.Chat.PaymentService (ServicePayment (..), appleTransactionId, 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 "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" testReadAppleRoot + it "has nothing to acknowledge" testAppleNoAcknowledgement + 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 "reports an acknowledgement Play refuses or does not answer" testPlayAcknowledgementFails + it "acknowledges through the verifier a [google] section configures" testPlayConfiguredAcknowledges + +-- * 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 jws = seamVerdict noStoreVerifier {verifyApple = Just (verifyAppleTransaction root 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)) + der tag content = B.pack [tag, fromIntegral (B.length content)] <> content + 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")} + appleTransactionId jws `shouldBe` Just "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} <- trustedChain + 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)) + +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 + +-- * Google Play + +playVerifier :: FakePlay -> IO StoreVerifier +playVerifier fake = + playStoreVerifier (fpConfig fake) >>= \case + Right (verify, acknowledge) -> pure noStoreVerifier {verifyGoogle = Just verify, acknowledgeGoogle = Just acknowledge, verifyTimeout = 2000000} + Left e -> expectationFailure e >> undefined + +acknowledgement :: StoreVerifier -> ServicePayment -> IO (Maybe (Either StoreRefusal ())) +acknowledgement verifier payment = case toStoreReceipt verifier payment of + Just (Right StoreReceipt {acknowledgeReceipt}) -> sequence acknowledgeReceipt + _ -> 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} + 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 "not json", + 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] + +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 403 + acknowledgedAs Failed + answerAcknowledgements fake $ Just 503 + acknowledgedAs Unreachable + answerAcknowledgements fake Nothing + answerPurchase fake testToken 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] + diff --git a/tests/Bots/BadgeService/WebTests.hs b/tests/Bots/BadgeService/WebTests.hs index 8365d80b6e..65c5cc3017 100644 --- a/tests/Bots/BadgeService/WebTests.hs +++ b/tests/Bots/BadgeService/WebTests.hs @@ -978,6 +978,8 @@ testServiceConfig staticDir trustForwarded = btcpay = Nothing, stripe = Nothing, poll = PollConfig {pWaitingSeconds = 3, pIdleSeconds = 60}, + appleStore = Nothing, + playStore = Nothing, issuer = Nothing, group = Nothing, devAcceptUnverifiedStoreReceipts = False diff --git a/tests/Test.hs b/tests/Test.hs index 4517a8edb2..ac34f15b0b 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -9,6 +9,7 @@ import Bots.BadgeService.CatalogTests import Bots.BadgeService.ConfigTests import Bots.BadgeService.GroupIntegrationTests import Bots.BadgeService.GroupTests +import Bots.BadgeService.StoreVerifierTests import Bots.BadgeService.StripeTests import Bots.BadgeService.WaitersTests import Bots.BadgeService.WebTests @@ -83,6 +84,7 @@ main = do badgeWaitersTests badgeBTCPayTests badgeStripeTests + badgeStoreVerifierTests describe "SimpleX chat markdown" markdownTests describe "JSON Tests" jsonTests describe "Member relations" memberRelationsTests