diff --git a/apps/simplex-badge-service/src/BadgeService/Service.hs b/apps/simplex-badge-service/src/BadgeService/Service.hs index 6707310e61..af815a8645 100644 --- a/apps/simplex-badge-service/src/BadgeService/Service.hs +++ b/apps/simplex-badge-service/src/BadgeService/Service.hs @@ -464,6 +464,8 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTran -- the claim was read from the evidence before it was verified, so it must name the transaction the store vouched for Right VerifiedStoreTransaction {transactionRef} | 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" -- another key's claim is told only once the store vouched for the receipt, or it would reveal which transactions were credited Right tx -> case claim of @@ -478,11 +480,11 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTran Right (Left resp) -> resp _ -> errorResponse BSEInternal -- the product is read only for a receipt not yet credited, so retiring it leaves its replays answered - newPurchase VerifiedStoreTransaction {productId, quantity, paid} = case storeProduct provider productId of + 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 * quantity) (SCPayment Nothing) now >>= \case + signFirstMonth key cc masterKey badgeType months (SCPayment Nothing) now >>= \case Left resp -> pure resp Right firstMonth -> do paymentId <- randomId cc diff --git a/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs b/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs index 23deff5188..7c1d8d4c0e 100644 --- a/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs +++ b/apps/simplex-badge-service/src/BadgeService/StoreReceipts.hs @@ -30,7 +30,7 @@ import System.Timeout (timeout) data VerifiedStoreTransaction = VerifiedStoreTransaction { transactionRef :: Text, -- from what was verified: Apple's transactionId, googlePurchaseRef of the token asked about productId :: Text, - quantity :: Int, + quantity :: Int, -- as the store reported it; the service refuses any but 1, as the apps never buy more -- costs the buyer nothing: Apple's Sandbox, which a public TestFlight build buys in, and Google's license testers testPurchase :: Bool, paid :: Maybe (CurrencyAmount, Text) -- in minor units; Google's purchase record carries no price @@ -46,8 +46,8 @@ data StoreRefusal | SRNotConfigured -- no verifier for this store is deployed; the purchase may be real deriving (Eq, Show) --- | Not a Provider: a receipt is presented once as proof, with nothing to create, watch or cancel. --- Apple is checked offline, so its verifier is pure and cannot be unreachable; only Google is asked. +-- | 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. data StoreVerifier = StoreVerifier { verifyApple :: Maybe (Text -> Either Text VerifiedStoreTransaction), -- the JWS; Left is why Apple did not sign it verifyGoogle :: Maybe (Text -> Text -> IO (Either StoreRefusal VerifiedStoreTransaction)), -- the product id and the token diff --git a/tests/Bots/BadgeService/BotTests.hs b/tests/Bots/BadgeService/BotTests.hs index 6f1faba503..2de8601b1e 100644 --- a/tests/Bots/BadgeService/BotTests.hs +++ b/tests/Bots/BadgeService/BotTests.hs @@ -131,6 +131,7 @@ badgeServiceTests = do it "should credit a transaction claimed twice at once only once" testStoreClaimRace it "should refuse a store with no verifier with no retry, and the client should keep its keys" testPurchaseWithNoVerifier it "should credit nothing when the verified transaction is not the one the evidence names" testStoreVerifiedOtherTransaction + it "should refuse a verified quantity other than one as internal, and the client should keep its keys" testStoreQuantityRefused it "should refuse a store purchase whose purchaseKey is not the verified signer" testStorePurchaseKeyMismatch it "should redeem a Play purchase into a badge, and replay it as the same badge" testPurchaseBadge it "should redeem an App Store purchase by its JWS" testPurchaseBadgeAppStore @@ -1578,6 +1579,18 @@ testStoreVerifiedOtherTransaction ps = refusalOf <$> serviceCmd env purchaseKey (purchaseCmd masterKey SPApple {jws = appleMisnamedJWS}) `shouldReturn` (BSEInternal, Nothing) nothingPurchased cc +testStoreQuantityRefused :: HasCallStack => TestParams -> IO () +testStoreQuantityRefused ps = + withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsClientCfg, bsController = cc, bsStore = FakeStore {appleQuantityJWS}} -> do + (purchaseKey, masterKey) <- newPurchaseKeys + refusalOf <$> serviceCmd env purchaseKey (purchaseCmd masterKey SPApple {jws = appleQuantityJWS}) `shouldReturn` (BSEInternal, Nothing) + nothingPurchased cc + withNewTestChatCfg ps bsClientCfg "alice" aliceProfile $ \alice -> do + alice ##> ("/_badge purchase 1 " <> paymentArg SPApple {jws = appleQuantityJWS}) + alice <## "cannot get badge: badge service error: internal" + rowCount (chatController alice) "badge_store_receipts" `shouldReturn` 1 + nothingPurchased cc + testPurchaseWithNoVerifier :: HasCallStack => TestParams -> IO () testPurchaseWithNoVerifier ps = withBadgeServiceVerifier ps (const noStoreVerifier) $ \env@BadgeServiceEnv {bsClientCfg, bsController = cc} -> do diff --git a/tests/Bots/BadgeService/FakeStore.hs b/tests/Bots/BadgeService/FakeStore.hs index a17a3302b7..e2ff00e0e4 100644 --- a/tests/Bots/BadgeService/FakeStore.hs +++ b/tests/Bots/BadgeService/FakeStore.hs @@ -44,6 +44,7 @@ data FakeStore = FakeStore appleSandboxJWS :: Text, appleThrowingJWS :: Text, appleMisnamedJWS :: Text, + appleQuantityJWS :: Text, pendingSettled :: IORef Bool, googleDown :: IORef Bool, fakeVerifier :: StoreVerifier @@ -56,6 +57,7 @@ newFakeStore = do appleSandboxJWS <- fixtureJWS "transaction-sandbox.json" let appleThrowingJWS = unsignedJWS "{\"transactionId\":\"2000000812345679\",\"productId\":\"BADGE_SUPPORTER_01\"}" appleMisnamedJWS = unsignedJWS "{\"transactionId\":\"2000000812345698\",\"productId\":\"BADGE_SUPPORTER_01\"}" + appleQuantityJWS = unsignedJWS "{\"transactionId\":\"2000000812345697\",\"productId\":\"BADGE_SUPPORTER_01\"}" pendingSettled <- newIORef False googleDown <- newIORef False let appleReceipts = @@ -63,7 +65,8 @@ newFakeStore = do (appleLegendJWS, appleTransaction "2000000812345672" "BADGE_LEGEND_01" False 7000), (appleSandboxJWS, appleTransaction "2000000812345673" "BADGE_LEGEND_01" True 7000), -- a verifier vouching for another transaction than the one the evidence names - (appleMisnamedJWS, appleTransaction "2000000812345671" "BADGE_SUPPORTER_01" False 700) + (appleMisnamedJWS, appleTransaction "2000000812345671" "BADGE_SUPPORTER_01" False 700), + (appleQuantityJWS, (appleTransaction "2000000812345697" "BADGE_SUPPORTER_01" False 1400) {quantity = 2}) ] verifyApple jws | jws == appleThrowingJWS = error "fake verifier bug" @@ -76,6 +79,7 @@ newFakeStore = do appleSandboxJWS, appleThrowingJWS, appleMisnamedJWS, + appleQuantityJWS, pendingSettled, googleDown, fakeVerifier = StoreVerifier {verifyApple = Just verifyApple, verifyGoogle = Just verifyGoogle, verifyTimeout = 500000}