badge service: accept unverified store receipts behind a dev option, for testing the store lanes on devices

apps/simplex-badge-service/README.md

@@ -48,7 +48,7 @@ simplex-badge-service --help
 - `--run-cli`: interactive CLI that also processes service requests (mirrors
   `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 `[dev] chat_redeem` does not apply to it,
-  whatever `--service-config` says.
+  whatever `--service-config` says. `[dev] accept_unverified_store_receipts` does.
 - `--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:
 
@@ -81,7 +81,8 @@ 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. An issuer key is still required either way.
+  uses only its `[issuer]` section 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.
 - also accepts the standard SimpleX Chat core options — database path, SMP/XFTP servers,
@@ -216,6 +217,24 @@ there is no client key, so the service generates one and hands it over with the
 means it can link every badge it issues this way. `simplex-chat badge sign` has the same property
 and is the offline equivalent.
 
+### Accepting store receipts unverified, for local testing
+
+```ini
+[dev]
+accept_unverified_store_receipts = on
+```
+
+Without a store verifier every store purchase is answered `provider_not_configured`. With this on,
+the service accepts any well-formed receipt without asking or verifying anything: an Apple JWS for
+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.
+
+With it on, anyone who can reach the service address can mint badges by sending a made-up receipt,
+signed with the issuer key, which startup requires to be one clients trust. Turn it on only where
+no one else can reach the service.
+
 ## Issuing codes
 
 Issuing a code is an operator command sent to the running service in `--run-cli` mode, not a way

apps/simplex-badge-service/badge_service.ini.example

@@ -54,3 +54,6 @@ idle_seconds = 60
 ; with a master key this service generates and can therefore link
 [dev]
 chat_redeem = off
+; 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
+accept_unverified_store_receipts = off

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

@@ -104,7 +104,9 @@ data ServiceConfig = ServiceConfig
     poll :: PollConfig,
     issuer :: Maybe BadgeIssuerKey,
     -- Local testing only; signs credentials with a master key this service can link.
-    devChatRedeem :: Bool
+    devChatRedeem :: Bool,
+    -- Local testing only; anyone who can reach the service can mint badges with any well-formed receipt.
+    devAcceptUnverifiedStoreReceipts :: Bool
   }
   deriving (Eq, Show)
 
@@ -155,7 +157,7 @@ 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"]),
-    ("dev", ["chat_redeem"]),
+    ("dev", ["chat_redeem", "accept_unverified_store_receipts"]),
     ("issuer", ["index", "private_key"])
   ]
 
@@ -189,6 +191,7 @@ parseConfig ini = do
   pWaitingSeconds <- cadence "waiting_seconds" 3
   pIdleSeconds <- cadence "idle_seconds" 60
   devRedeem <- bool "dev" "chat_redeem" False
+  devUnverifiedReceipts <- bool "dev" "accept_unverified_store_receipts" False
   pure
     ServiceConfig
       { listener = ListenerConfig {lHost, lPort, lStaticDir, lServeWebapp, lWebappExportDir, lTrustForwardedFor},
@@ -196,7 +199,8 @@ parseConfig ini = do
         stripe = str,
         poll = PollConfig {pWaitingSeconds, pIdleSeconds},
         issuer = iss,
-        devChatRedeem = devRedeem
+        devChatRedeem = devRedeem,
+        devAcceptUnverifiedStoreReceipts = devUnverifiedReceipts
       }
   where
     hasSection s = s `elem` sections ini

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

@@ -33,6 +33,7 @@ import BadgeService.Store
 import BadgeService.Store.Invoices (seedCatalog, truncateToSecond)
 import BadgeService.Store.Migrate (runBadgeServiceMigrations)
 import BadgeService.StoreReceipts
+import BadgeService.StoreReceipts.Mock (mockStoreVerifier)
 import BadgeService.Waiters (Waiters, newWaiters)
 import BadgeService.Web.Server (exportWebapp, newWebEnv, runWebListener)
 import Control.Applicative (optional)
@@ -131,6 +132,13 @@ 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
+
 badgeService :: BadgeServiceOpts -> ChatConfig -> ServiceState -> IO ()
 badgeService opts@BadgeServiceOpts {serviceConfigFile} cfg env = do
   serviceCfg <- traverse readConfigOrExit serviceConfigFile
@@ -144,6 +152,7 @@ badgeService opts@BadgeServiceOpts {serviceConfigFile} cfg env = do
             preCmdHook = Just badgeCmdHook
           }
   when devRedeem $ logWarn "[dev] chat_redeem is on: /redeem over chat hands out credentials this service can link"
+  requestEnv <- devStoreVerifier serviceCfg env
   -- The reader must not block, since outputQ carries every chat event.
   simplexChatCore cfg {chatHooks} (mkChatOpts opts) $ \_ cc -> do
     lanes <- maybe (pure []) (serviceLanes waiters cc) serviceCfg
@@ -155,7 +164,7 @@ badgeService opts@BadgeServiceOpts {serviceConfigFile} cfg env = do
             (_, Right CEvtNewChatItems {chatItems = AChatItem _ SMDRcv (DirectChat ct) ChatItem {content = mc@CIRcvMsgContent {}} : _})
               | devRedeem -> atomically $ writeTQueue (chatRedeemQ env) (ct, ciContentToText mc)
             _ -> pure (),
-        processQueuedRequests key env
+        processQueuedRequests key requestEnv
       ]
         <> [processChatRedeems key env | devRedeem]
         <> lanes
@@ -186,7 +195,7 @@ badgeServiceCLI :: BadgeServiceOpts -> IO ()
 badgeServiceCLI opts@BadgeServiceOpts {serviceConfigFile} = do
   serviceCfg <- traverse readConfigOrExit serviceConfigFile
   key <- requireIssuerKey opts serviceCfg terminalChatConfig
-  env <- newServiceState
+  env <- newServiceState >>= devStoreVerifier serviceCfg
   let eventHook _cc = \case
         Right (CEvtServiceRequest u reqId sigKey reqData) -> do
           atomically $ writeTQueue (serviceRequestQ env) (u, reqId, sigKey, reqData)

apps/simplex-badge-service/src/BadgeService/StoreReceipts/Mock.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module BadgeService.StoreReceipts.Mock (mockStoreVerifier) where
+
+import BadgeService.StoreReceipts
+import qualified Data.Aeson as J
+import qualified Data.Aeson.KeyMap as JM
+import qualified Data.ByteString.Base64.URL as B64U
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Simplex.Chat.PaymentService (appleTransactionId, googlePurchaseRef)
+import Simplex.Messaging.Util (eitherToMaybe)
+
+-- | Vouches for any well-formed receipt without verifying anything. Each transaction is named by
+-- the same function its claim is named by, so the two cannot differ.
+mockStoreVerifier :: StoreVerifier
+mockStoreVerifier = noStoreVerifier {verifyApple = Just mockApple, verifyGoogle = Just mockGoogle}
+
+mockApple :: Text -> Either Text StoreTransaction
+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"
+    productId <- case JM.lookup "productId" o of
+      Just (J.String p) -> Right p
+      _ -> Left "no productId"
+    transactionRef <- maybe (Left "no transactionId") Right $ appleTransactionId signed
+    Right $ vouched transactionRef productId
+  _ -> Left "not three dot-separated parts"
+
+mockGoogle :: Text -> Text -> IO (Either StoreRefusal StoreTransaction)
+mockGoogle productId token = pure $ Right $ vouched (googlePurchaseRef token) productId
+
+vouched :: Text -> Text -> StoreTransaction
+vouched transactionRef productId =
+  -- not SETest, though nothing was paid: a test purchase is refused as receipt_invalid, which is
+  -- terminal and drops the client's keys, so every dev purchase would fail for good
+  StoreTransaction {transactionRef, productId, quantity = 1, environment = SEProduction, paid = Nothing}

simplex-chat.cabal

@@ -444,6 +444,7 @@ executable simplex-badge-service
       BadgeService.Store.Invoices
       BadgeService.Store.Migrate
       BadgeService.StoreReceipts
+      BadgeService.StoreReceipts.Mock
       BadgeService.Waiters
       BadgeService.Web.Server
       Paths_simplex_chat
@@ -733,6 +734,7 @@ test-suite simplex-chat-test
       BadgeService.Store.Invoices
       BadgeService.Store.Migrate
       BadgeService.StoreReceipts
+      BadgeService.StoreReceipts.Mock
       BadgeService.Waiters
       BadgeService.Web.Server
       Bots.BadgeService.BTCPayTests

tests/BadgeTests.hs

@@ -10,7 +10,8 @@
 module BadgeTests (badgeTests) where
 
 import BadgeService.Service (badgeErrorRetryAfter, shownServiceRequest, survive)
-import BadgeService.StoreReceipts (StoreReceipt (..), StoreRefusal (..), StoreVerifier (..), storeReceipt)
+import BadgeService.StoreReceipts (StoreEnvironment (..), StoreReceipt (..), StoreRefusal (..), StoreTransaction (..), StoreVerifier (..), storeReceipt)
+import BadgeService.StoreReceipts.Mock (mockStoreVerifier)
 import Control.Concurrent (forkIO, killThread, threadDelay)
 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Concurrent.STM (atomically)
@@ -109,6 +110,7 @@ badgeTests = do
     it "keys a purchase by the store's transaction id, not by the evidence signed over it" testStoreTransactionRef
     it "shows a service request in the terminal as its type alone" testShownServiceRequest
     it "refuses a Play product id or token that could name another purchase, before any verifier" testGooglePathStrings
+    it "has the dev mock vouch for the transaction its claim names, as a production purchase" testMockVouchesForClaim
   describe "badge service request loop" $ do
     it "survives a request that throws, and still stops when cancelled" testSurviveRequestFailure
 
@@ -876,6 +878,19 @@ testGooglePathStrings = do
     Just (Right StoreReceipt {provider}) -> provider `shouldBe` PPGoogle
     _ -> expectationFailure "a valid product id and token were refused"
 
+testMockVouchesForClaim :: IO ()
+testMockVouchesForClaim = do
+  let part = safeDecodeUtf8 . B64U.encodeUnpadded . encodeUtf8
+      signed = T.intercalate "." [part "{\"alg\":\"ES256\"}", part "{\"transactionId\":\"2000000812345671\",\"productId\":\"BADGE_SUPPORTER_01\"}", "c2lnbmVk"]
+      vouchesForClaim payment = case storeReceipt mockStoreVerifier payment of
+        Just (Right StoreReceipt {providerRef, verifyReceipt}) ->
+          verifyReceipt >>= \case
+            Right StoreTransaction {transactionRef, environment} -> (transactionRef, environment) `shouldBe` (providerRef, SEProduction)
+            Left refusal -> expectationFailure ("the mock refused: " <> show refusal)
+        _ -> expectationFailure "refused before the mock was asked"
+  vouchesForClaim SPApple {jws = signed}
+  vouchesForClaim SPGoogle {productId = "badge_supporter_01", token = "fake-play-token.AO-J1Oz9x2kqE7wYt3"}
+
 testSurviveRequestFailure :: IO ()
 testSurviveRequestFailure = do
   survive "a request" (throwIO $ userError "failed") `shouldReturn` ()

tests/Bots/BadgeService/ConfigTests.hs

@@ -50,6 +50,10 @@ badgeConfigTests = describe "badge service config" $ do
   it "reads chat_redeem = on" testDevRedeemOn
   it "reads chat_redeem = off" testDevRedeemOff
   it "refuses a chat_redeem that is not on or off" testDevRedeemNotBoolean
+  it "verifies store receipts when the dev section is absent" testDevUnverifiedReceiptsAbsent
+  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
 
 fullIni :: T.Text
 fullIni =
@@ -365,5 +369,25 @@ testDevRedeemNotBoolean = withDev "chat_redeem = true\n" $ \r -> case r of
   Left e -> e `shouldContain` "chat_redeem"
   Right _ -> expectationFailure "only on and off are accepted, so a typo cannot silently disarm the gate"
 
+testDevUnverifiedReceiptsAbsent :: IO ()
+testDevUnverifiedReceiptsAbsent = withIni fullIni $ \p -> do
+  Right cfg <- readServiceConfig p
+  devAcceptUnverifiedStoreReceipts cfg `shouldBe` False
+
+testDevUnverifiedReceiptsOn :: IO ()
+testDevUnverifiedReceiptsOn = withDev "accept_unverified_store_receipts = on\n" $ \r -> case r of
+  Right cfg -> devAcceptUnverifiedStoreReceipts cfg `shouldBe` True
+  Left e -> expectationFailure ("[dev] accept_unverified_store_receipts = on is legal: " <> e)
+
+testDevUnverifiedReceiptsOff :: IO ()
+testDevUnverifiedReceiptsOff = withDev "accept_unverified_store_receipts = off\n" $ \r -> case r of
+  Right cfg -> devAcceptUnverifiedStoreReceipts cfg `shouldBe` False
+  Left e -> expectationFailure ("[dev] accept_unverified_store_receipts = off is legal: " <> e)
+
+testDevUnverifiedReceiptsNotBoolean :: IO ()
+testDevUnverifiedReceiptsNotBoolean = withDev "accept_unverified_store_receipts = yes\n" $ \r -> case r of
+  Left e -> e `shouldContain` "accept_unverified_store_receipts"
+  Right _ -> expectationFailure "only on and off are accepted, so a typo cannot silently arm the mock"
+
 withDev :: T.Text -> (Either String ServiceConfig -> IO a) -> IO a
 withDev keys act = withIni (fullIni <> "[dev]\n" <> keys) $ \p -> readServiceConfig p >>= act

tests/Bots/BadgeService/WebTests.hs

@@ -801,7 +801,8 @@ testServiceConfig staticDir trustForwarded =
       stripe = Nothing,
       poll = PollConfig {pWaitingSeconds = 3, pIdleSeconds = 60},
       issuer = Nothing,
-      devChatRedeem = False
+      devChatRedeem = False,
+      devAcceptUnverifiedStoreReceipts = False
     }
 
 testServeWebappOff :: IO ()