badge service: refuse a store quantity other than one, rather than multiply by it

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

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

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

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}