store: accept dev_keys with test payments

apps/simplex-store-service/README.md

@@ -94,9 +94,15 @@ With `dev_keys`, the service refuses to start:
 
 - unless `[names]` is on and `[chain] chain_id` is 31337, anvil's local chain;
 - unless the node at `rpc_url` answers `eth_chainId` with 31337 as the service starts;
-- when `[btcpay]` or `[stripe]` is configured, since a run with dev keys takes no payments;
+- when `[stripe]` holds a live key: `secret_key` must be a test key (`sk_test_` or `rk_test_`), and
+  `publishable_key` too (`pk_test_`);
+- when `[btcpay]`'s `host` is not on loopback (`127.0.0.1`, `::1` or `localhost`);
 - when a dev key has the index of a key clients trust.
 
+So a run with dev keys takes test payments only: Stripe in test mode, and a BTCPay on the same machine,
+such as one on regtest. `host` must still be https, so put a TLS proxy in front of a local BTCPay and
+have the service trust the proxy's certificate authority with `SYSTEM_CERTIFICATE_PATH`.
+
 It logs a warning naming the dev keys' indexes at every start. Clients never trust a dev key, but the
 service's own chat core does, for the badges it receives, so a contact's badge signed by a dev key is
 accepted in that run. Leave `dev_keys` out everywhere else.

apps/simplex-store-service/src/StoreService/Config.hs

@@ -22,6 +22,7 @@ module StoreService.Config
     defaultSessionMinutes,
     minNameYears,
     localChainId,
+    isLoopbackHost,
     readServiceConfig,
     unknownKeys,
   )
@@ -45,7 +46,7 @@ import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust, isNothing)
+import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -229,6 +230,18 @@ minSessionMinutes, maxSessionMinutes :: Int
 minSessionMinutes = 1
 maxSessionMinutes = 1440
 
+isLoopbackHost :: Text -> Bool
+isLoopbackHost h = h `elem` ["127.0.0.1", "::1", "localhost"]
+
+-- | The host of an absolute URL, lower-cased, without user info, port or an IPv6 literal's brackets.
+urlHost :: Text -> Text
+urlHost url = T.toLower $ case T.stripPrefix "[" hostPort of
+  Just literal -> T.takeWhile (/= ']') literal
+  Nothing -> T.takeWhile (/= ':') hostPort
+  where
+    authority = T.takeWhile (`notElem` ['/', '?', '#']) (T.drop 2 (snd (T.breakOn "//" url)))
+    hostPort = snd (T.breakOnEnd "@" authority)
+
 -- | An http host would carry the API key in the clear on every call.
 requireHttps :: Text -> Either String Text
 requireHttps u
@@ -366,8 +379,15 @@ parseConfig ini = do
   devKeys <- devKeysSetting
   unless (null devKeys || maybe False onLocalChain nms) $
     Left ("issuer.dev_keys is accepted only with [names] on the local chain, [chain] chain_id = " <> show localChainId)
-  unless (null devKeys || (isNothing btc && isNothing str)) $
-    Left "issuer.dev_keys is refused with [btcpay] or [stripe], since a run with dev keys takes no payments"
+  unless (null devKeys) $ do
+    forM_ str $ \StripeConfig {sSecretKey, sPublishableKey} -> do
+      unless (any (`T.isPrefixOf` sSecretKey) ["sk_test_", "rk_test_"]) $
+        Left "issuer.dev_keys is refused with a live Stripe key: stripe.secret_key must be a test key, sk_test_ or rk_test_"
+      unless ("pk_test_" `T.isPrefixOf` sPublishableKey) $
+        Left "issuer.dev_keys is refused with a live Stripe key: stripe.publishable_key must be a test key, pk_test_"
+    forM_ btc $ \BTCPayConfig {bHost} ->
+      unless (isLoopbackHost (urlHost bHost)) $
+        Left "issuer.dev_keys is refused with a remote BTCPay: btcpay.host must be on loopback, 127.0.0.1, ::1 or localhost"
   pWaitingSeconds <- cadence "waiting_seconds" 3
   pIdleSeconds <- cadence "idle_seconds" 60
   apple <- appleSection

apps/simplex-store-service/src/StoreService/Web/Server.hs

@@ -17,7 +17,7 @@ module StoreService.Web.Server
 where
 
 import StoreService.Catalog (PricedOffer (..), priceOffer)
-import StoreService.Config (ListenerConfig (..), ServiceConfig (..), StripeConfig (..))
+import StoreService.Config (ListenerConfig (..), ServiceConfig (..), StripeConfig (..), isLoopbackHost)
 import StoreService.Names.Abi (hex)
 import StoreService.Names.Env (NamesEnv)
 import StoreService.Names.Orders (OrdersEnv (..), ordersEnv)
@@ -579,6 +579,3 @@ warnIfHeaderTrustIsExposed :: ListenerConfig -> IO ()
 warnIfHeaderTrustIsExposed ListenerConfig {lHost, lTrustForwardedFor} =
   when (lTrustForwardedFor && not (isLoopbackHost lHost)) $
     logWarn ("store service: trust_forwarded_for is on and the listener binds " <> lHost <> "; every caller can then choose its own rate limit bucket unless a proxy sets the header")
-
-isLoopbackHost :: Text -> Bool
-isLoopbackHost h = h `elem` ["127.0.0.1", "::1", "localhost"]

tests/Bots/StoreService/ConfigTests.hs

@@ -539,7 +539,8 @@ namesConfigTests = describe "StoreService names: config" $ do
   it "names a [names] or [chain] setting nothing reads, and still boots" testNamesUnknownKeys
   it "accepts [issuer] dev_keys on chain 31337 only, with [names] on" testDevKeysLocalChain
   it "refuses a malformed dev_keys entry or an index named twice, quoting no secret" testDevKeysMalformed
-  it "refuses [issuer] dev_keys beside [btcpay] or [stripe]" testDevKeysNoPayments
+  it "accepts [issuer] dev_keys beside Stripe test keys and a BTCPay on loopback" testDevKeysTestPayments
+  it "refuses [issuer] dev_keys beside a live Stripe key or a remote BTCPay, naming which and quoting no key" testDevKeysLivePayments
 
 rpcUrl :: T.Text
 rpcUrl = "https://eth.example.org/v2/rpc-token-value"
@@ -775,12 +776,36 @@ testDevKeysMalformed = do
       parseIni (localNamesIni chainSection <> T.unlines (devKeysIssuer keys))
         >>= either pure (\_ -> "" <$ expectationFailure (T.unpack keys <> " must not boot"))
 
-testDevKeysNoPayments :: IO ()
-testDevKeysNoPayments = do
-  let devKeys = T.unlines (devKeysIssuer ("9:" <> issuerSecret))
-      btcpay = ["[btcpay]", "host = https://btcpay.example.org", "api_key = token-value", "store_id = store-value", "webhook_secret = secret-value"]
-      stripe = ["[stripe]", "secret_key = rk_test_x", "publishable_key = pk_test_x", "webhook_secret = whsec_x"]
-      refused = "issuer.dev_keys is refused with [btcpay] or [stripe], since a run with dev keys takes no payments" :: String
-  forM_ [btcpay, stripe, btcpay <> stripe] $ \provider ->
-    parseIni (localNamesIni (chainSection <> provider) <> devKeys) `shouldReturn` Left refused
-  parseIni (localNamesIni (chainSection <> btcpay)) >>= (`shouldSatisfy` either (const False) (const True))
+devKeysBTCPay :: T.Text -> [T.Text]
+devKeysBTCPay host = ["[btcpay]", "host = " <> host, "api_key = token-value", "store_id = store-value", "webhook_secret = secret-value"]
+
+devKeysStripe :: T.Text -> T.Text -> [T.Text]
+devKeysStripe secret publishable = ["[stripe]", "secret_key = " <> secret, "publishable_key = " <> publishable, "webhook_secret = whsec_x"]
+
+devKeysWith :: [T.Text] -> IO (Either String ServiceConfig)
+devKeysWith provider = parseIni (localNamesIni (chainSection <> provider) <> T.unlines (devKeysIssuer ("9:" <> issuerSecret)))
+
+testDevKeysTestPayments :: IO ()
+testDevKeysTestPayments = do
+  let loopbacks = ["https://127.0.0.1:8443", "https://localhost/", "https://[::1]:8443/btcpay", "https://LOCALHOST"]
+      stripes = [devKeysStripe "sk_test_x" "pk_test_x", devKeysStripe "rk_test_x" "pk_test_x"]
+  forM_ (map devKeysBTCPay loopbacks <> stripes <> [devKeysBTCPay "https://127.0.0.1" <> devKeysStripe "rk_test_x" "pk_test_x"]) $ \provider ->
+    devKeysWith provider >>= \case
+      Right cfg -> length (devIssuerKeys cfg) `shouldBe` 1
+      Left e -> expectationFailure (show provider <> " must boot with dev_keys, got: " <> e)
+  parseIni (localNamesIni (withChainId "1" <> devKeysStripe "rk_test_x" "pk_test_x") <> T.unlines (devKeysIssuer ("9:" <> issuerSecret)))
+    `shouldReturn` Left "issuer.dev_keys is accepted only with [names] on the local chain, [chain] chain_id = 31337"
+
+testDevKeysLivePayments :: IO ()
+testDevKeysLivePayments = do
+  let liveSecret = "issuer.dev_keys is refused with a live Stripe key: stripe.secret_key must be a test key, sk_test_ or rk_test_" :: String
+      livePublishable = "issuer.dev_keys is refused with a live Stripe key: stripe.publishable_key must be a test key, pk_test_" :: String
+      remote = "issuer.dev_keys is refused with a remote BTCPay: btcpay.host must be on loopback, 127.0.0.1, ::1 or localhost" :: String
+  forM_ ["sk_live_secretvalue", "rk_live_secretvalue", "sk_test", "pk_test_x"] $ \secret ->
+    devKeysWith (devKeysStripe secret "pk_test_x") `shouldReturn` Left liveSecret
+  devKeysWith (devKeysStripe "rk_test_x" "pk_live_x") `shouldReturn` Left livePublishable
+  forM_ ["https://btcpay.example.org", "https://127.0.0.2", "https://localhost.example.org", "https://user@btcpay.example.org", "https://[::2]:8443"] $ \host ->
+    devKeysWith (devKeysBTCPay host) `shouldReturn` Left remote
+  devKeysWith (devKeysBTCPay "https://127.0.0.1" <> devKeysStripe "sk_live_secretvalue" "pk_test_x") `shouldReturn` Left liveSecret
+  devKeysWith (devKeysStripe "sk_live_secretvalue" "pk_test_x") >>= either (`shouldNotContain` "secretvalue") (const (expectationFailure "a live key must not boot"))
+  parseIni (localNamesIni (chainSection <> devKeysBTCPay "https://btcpay.example.org" <> devKeysStripe "sk_live_x" "pk_live_x")) >>= (`shouldSatisfy` either (const False) (const True))