store: trust issuer dev_keys on the local chain

apps/simplex-store-service/README.md

@@ -79,6 +79,21 @@ Note that a secret passed as a flag is visible to every user on the machine thro
 in the ini is only as readable as the file: `store_service.ini` is gitignored and already holds the
 provider API keys and webhook secrets.
 
+For a local run, where no client key's secret is at hand, `[issuer] dev_keys` lists keys the service
+trusts beside the clients' keys, as `<index>:<secret>` entries separated by commas, each secret from
+`simplex-chat badge keygen`:
+
+```ini
+[issuer]
+index = 999
+private_key = <secret>
+dev_keys = 999:<secret>
+```
+
+The service refuses to start with `dev_keys` unless `[names]` is on and `[chain] chain_id` is 31337,
+anvil's local chain, and refuses a dev key at the index of a key clients trust. Clients never trust a
+dev key, so nothing it signs verifies outside that run. Leave it out everywhere else.
+
 Other options:
 
 - `--service-config INI_FILE`: path to `store_service.ini`. Omit it to run the chat/RPC side

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

@@ -18,6 +18,7 @@ module StoreService.Config
     defaultExpiryMinutes,
     defaultSessionMinutes,
     minNameYears,
+    localChainId,
     hostName,
     readServiceConfig,
     unknownKeys,
@@ -32,6 +33,7 @@ import qualified Data.ByteArray as BA
 import Data.ByteArray.Encoding (Base (Base16), convertFromBase)
 import qualified Data.ByteString.Char8 as B
 import Data.Ini (Ini, iniGlobals, iniParser, keys, lookupValue, sections)
+import Data.List (nub)
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -159,6 +161,8 @@ data ServiceConfig = ServiceConfig
     stripe :: Maybe StripeConfig,
     poll :: PollConfig,
     issuer :: Maybe BadgeIssuerKey,
+    -- | Trusted beside the clients' keys; only with names on the local chain.
+    devIssuerKeys :: [BadgeIssuerKey],
     group :: Maybe GroupConfig,
     names :: Maybe NamesConfig
   }
@@ -188,6 +192,10 @@ requireHttps u
 minNameYears :: Int
 minNameYears = 2
 
+-- | anvil's chain id, the only chain [issuer] dev_keys are accepted on.
+localChainId :: Word64
+localChainId = 31337
+
 -- | 100 gwei.
 defaultMaxFeePerGas :: Word64
 defaultMaxFeePerGas = 100000000000
@@ -237,7 +245,7 @@ knownSettings =
     ("stripe", ["secret_key", "publishable_key", "webhook_secret", "session_minutes"]),
     ("poll", ["waiting_seconds", "idle_seconds"]),
     ("group", ["display_name", "description"]),
-    ("issuer", ["index", "private_key"]),
+    ("issuer", ["index", "private_key", "dev_keys"]),
     ("names", ["tld", "years", "term_start", "term_slack_seconds", "reveal_margin_seconds", "max_order_moves"]),
     ("chain", ["rpc_url", "chain_id", "controller", "sponsor", "base_registrar", "resolver", "service_key", "confirmations", "gas_limit_cap", "max_fee_per_gas"])
   ]
@@ -274,6 +282,9 @@ parseConfig ini = do
   iss <- issuerSection
   grp <- groupSection
   nms <- namesSection
+  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)
   pWaitingSeconds <- cadence "waiting_seconds" 3
   pIdleSeconds <- cadence "idle_seconds" 60
   pure
@@ -283,6 +294,7 @@ parseConfig ini = do
         stripe = str,
         poll = PollConfig {pWaitingSeconds, pIdleSeconds},
         issuer = iss,
+        devIssuerKeys = devKeys,
         group = grp,
         names = nms
       }
@@ -313,15 +325,27 @@ parseConfig ini = do
           keyIdx <- issuerIndex
           secretKey <- issuerSecret
           pure (Just BadgeIssuerKey {keyIdx, secretKey})
-    issuerIndex = do
-      v <- required "issuer" "index"
-      case readMaybe (T.unpack v) of
-        Just n | n >= 1, n <= toInteger (maxBound :: Int) -> Right (fromInteger n)
-        _ -> Left "issuer.index must be a positive whole number"
-    issuerSecret = do
-      v <- required "issuer" "private_key"
-      either (const (Left "issuer.private_key is not a valid issuer secret; use the value from `simplex-chat badge keygen`")) Right $
+    issuerIndex = required "issuer" "index" >>= keyIndex "issuer.index"
+    issuerSecret = required "issuer" "private_key" >>= keySecret "issuer.private_key"
+    keyIndex k v = case readMaybe (T.unpack v) of
+      Just n | n >= 1, n <= toInteger (maxBound :: Int) -> Right (fromInteger n)
+      _ -> Left (k <> " must be a positive whole number")
+    keySecret k v =
+      either (const (Left (k <> " is not a valid issuer secret; use the value from `simplex-chat badge keygen`"))) Right $
         strDecode (B.pack (T.unpack v))
+    -- No error quotes an entry, since each holds a secret.
+    devKeysSetting = do
+      ks <- mapM devKey $ filter (not . T.null) $ map T.strip $ maybe [] (T.splitOn ",") (present "issuer" "dev_keys")
+      let idxs = map (\BadgeIssuerKey {keyIdx} -> keyIdx) ks
+      unless (length (nub idxs) == length idxs) $ Left "issuer.dev_keys names an index twice"
+      pure ks
+    devKey entry = case T.breakOn ":" entry of
+      (i, sk) | not (T.null sk) -> do
+        keyIdx <- keyIndex "issuer.dev_keys index" (T.strip i)
+        secretKey <- keySecret "issuer.dev_keys secret" (T.strip (T.drop 1 sk))
+        pure BadgeIssuerKey {keyIdx, secretKey}
+      _ -> Left "issuer.dev_keys must be <index>:<secret> entries separated by commas"
+    onLocalChain NamesConfig {nChain = ChainConfig {cChainId}} = cChainId == localChainId
     btcpaySection
       | not (hasSection "btcpay") = Right Nothing
       | otherwise = do

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

@@ -8,6 +8,7 @@ module StoreService.Service
   ( ServiceState (..),
     newServiceState,
     welcomeGetOpts,
+    trustDevKeys,
     checkIssuerKey,
     storeService,
     storeServiceCLI,
@@ -51,6 +52,7 @@ import Control.Monad.IO.Class (liftIO)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.KeyMap as KM
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import Data.Char (isSpace)
 import Data.Either (fromRight)
@@ -106,6 +108,16 @@ welcomeGetOpts = do
     putStrLn $ "Service name: " ++ T.unpack serviceName
   pure opts
 
+-- | The ini's dev_keys, trusted beside the clients' keys; the config accepts them only on the local chain.
+trustDevKeys :: Maybe ServiceConfig -> ChatConfig -> IO (Either String ChatConfig)
+trustDevKeys serviceCfg cfg@ChatConfig {badgePublicKeys} =
+  fmap trusted . sequence <$> mapM publicKey (maybe [] devIssuerKeys serviceCfg)
+  where
+    trusted ks = cfg {badgePublicKeys = M.union badgePublicKeys (M.fromList ks)}
+    publicKey BadgeIssuerKey {keyIdx, secretKey}
+      | M.member keyIdx badgePublicKeys = pure $ Left $ "issuer.dev_keys index " <> show keyIdx <> " is the index of a key clients trust"
+      | otherwise = fmap (keyIdx,) . first (("issuer.dev_keys secret at index " <> show keyIdx <> " is not a valid key: ") <>) <$> bbsPublicKey secretKey
+
 checkIssuerKey :: StoreServiceOpts -> Maybe ServiceConfig -> ChatConfig -> IO (Either String BadgeIssuerKey)
 checkIssuerKey StoreServiceOpts {issuerKey} serviceCfg cfg = case issuerKey of
   Left e -> pure (Left e)
@@ -125,7 +137,13 @@ checkOne ChatConfig {badgePublicKeys} k@BadgeIssuerKey {keyIdx, secretKey} =
 
 requireIssuerKey :: StoreServiceOpts -> Maybe ServiceConfig -> ChatConfig -> IO BadgeIssuerKey
 requireIssuerKey opts serviceCfg cfg =
-  checkIssuerKey opts serviceCfg cfg >>= either (\e -> putStrLn ("Error: " <> e) >> exitFailure) pure
+  checkIssuerKey opts serviceCfg cfg >>= orExit
+
+requireDevKeys :: Maybe ServiceConfig -> ChatConfig -> IO ChatConfig
+requireDevKeys serviceCfg cfg = trustDevKeys serviceCfg cfg >>= orExit
+
+orExit :: Either String a -> IO a
+orExit = either (\e -> putStrLn ("Error: " <> e) >> exitFailure) pure
 
 readConfigOrExit :: FilePath -> IO ServiceConfig
 readConfigOrExit path =
@@ -134,8 +152,9 @@ readConfigOrExit path =
     Right sc -> pure sc
 
 storeService :: StoreServiceOpts -> ChatConfig -> ServiceState -> IO ()
-storeService opts@StoreServiceOpts {serviceConfigFile} cfg env = do
+storeService opts@StoreServiceOpts {serviceConfigFile} baseCfg env = do
   serviceCfg <- traverse readConfigOrExit serviceConfigFile
+  cfg <- requireDevKeys serviceCfg baseCfg
   key <- requireIssuerKey opts serviceCfg cfg
   waiters <- newWaiters
   -- The hooks' //revoke takes a prepaid code's turn, so the turns exist before the chat starts.
@@ -205,7 +224,8 @@ seedServiceCatalog st = do
 storeServiceCLI :: StoreServiceOpts -> IO ()
 storeServiceCLI opts@StoreServiceOpts {serviceConfigFile} = do
   serviceCfg <- traverse readConfigOrExit serviceConfigFile
-  key <- requireIssuerKey opts serviceCfg terminalChatConfig
+  cfg <- requireDevKeys serviceCfg terminalChatConfig
+  key <- requireIssuerKey opts serviceCfg cfg
   env <- newServiceState
   -- This mode runs no names lanes, so only its own //revoke takes these turns.
   turns <- newTurns
@@ -223,7 +243,7 @@ storeServiceCLI opts@StoreServiceOpts {serviceConfigFile} = do
             eventHook = Just eventHook
           }
   raceAny_
-    [ simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing,
+    [ simplexChatCLI' cfg {chatHooks} (mkChatOpts opts) Nothing,
       processQueuedRequests key Nothing env
     ]
 

tests/Bots/StoreService/BotTests.hs

@@ -11,9 +11,9 @@
 module Bots.StoreService.BotTests where
 
 import StoreService.Codes (issueOneCode)
-import StoreService.Config (BadgeIssuerKey (..), readServiceConfig)
+import StoreService.Config (BadgeIssuerKey (..), ServiceConfig, readServiceConfig)
 import StoreService.Group (GroupEvent)
-import Bots.StoreService.ConfigTests (withIssuer)
+import Bots.StoreService.ConfigTests (chainSection, namesIni, namesSection, withIni, withIssuer)
 import StoreService.Options
 import StoreService.Service
 import StoreService.Store (IssuedCode (..), getBadgeCode)
@@ -91,6 +91,7 @@ storeServiceTests = do
   it "should refuse a request whose purchaseKey is not the verified signer" testPurchaseKeyMismatch
   it "should refuse to start unless the issuer secret is the key trusted at its index" testIssuerKeyMustMatchConfig
   it "should refuse to start when the [issuer] key is not one clients trust" testIssuerIniKeyMustBeTrusted
+  it "should trust [issuer] dev_keys beside the clients' keys, and refuse one at a trusted index" testDevKeysTrusted
   it "should credit a code's months and issue one credential per month" testCodeMonthsRenew
   it "should return the stored credential for a repeat inside an issued period" testRepeatInsideIssuedPeriod
   it "should redeem a multi-use code to its limit with no group to track it" testMultiUseWithoutGroup
@@ -1495,6 +1496,30 @@ testIssuerIniKeyMustBeTrusted ps = do
   checkIssuerKey fromIni (Just unknownIndex) cfg
     `shouldReturn` Left ("no configured badge key at index " <> show (testIssuerKeyIdx + 8) <> ", clients could not verify what this service signs")
 
+testDevKeysTrusted :: HasCallStack => TestParams -> IO ()
+testDevKeysTrusted ps = do
+  Right (pk, sk) <- bbsKeyGen
+  Right (_, devSk) <- bbsKeyGen
+  let cfg = testCfg {badgePublicKeys = M.singleton testIssuerKeyIdx pk}
+      devIdx = testIssuerKeyIdx + 8
+      fromIni = (mkStoreServiceOpts ps sk) {issuerKey = Right Nothing}
+  Right withDev <- devIni devIdx devSk devIdx devSk
+  checkIssuerKey fromIni (Just withDev) cfg >>= (`shouldSatisfy` isLeft)
+  Right trusted <- trustDevKeys (Just withDev) cfg
+  checkIssuerKey fromIni (Just withDev) trusted `shouldReturn` Right (BadgeIssuerKey devIdx devSk)
+  M.keys (badgePublicKeys trusted) `shouldBe` [testIssuerKeyIdx, devIdx]
+  trustedIndexes cfg Nothing `shouldReturn` Right [testIssuerKeyIdx]
+  Right atClientIndex <- devIni testIssuerKeyIdx sk testIssuerKeyIdx devSk
+  trustedIndexes cfg (Just atClientIndex) `shouldReturn` Left ("issuer.dev_keys index " <> show testIssuerKeyIdx <> " is the index of a key clients trust")
+  where
+    trustedIndexes :: ChatConfig -> Maybe ServiceConfig -> IO (Either String [Int])
+    trustedIndexes cfg sc = fmap (M.keys . badgePublicKeys) <$> trustDevKeys sc cfg
+    devIni :: Int -> BBSSecretKey -> Int -> BBSSecretKey -> IO (Either String ServiceConfig)
+    devIni idx k devIdx devK =
+      withIni (namesIni namesSection chainSection <> T.unlines ["[issuer]", "index = " <> tshow idx, "private_key = " <> keyText k, "dev_keys = " <> tshow devIdx <> ":" <> keyText devK]) readServiceConfig
+    keyText :: BBSSecretKey -> T.Text
+    keyText = safeDecodeUtf8 . strEncode
+
 testRedeemUnpaidCode :: HasCallStack => TestParams -> IO ()
 testRedeemUnpaidCode ps =
   withStoreService ps $ \clientCfg _ cc ->

tests/Bots/StoreService/ConfigTests.hs

@@ -432,6 +432,8 @@ namesConfigTests = describe "StoreService names: config" $ do
   it "refuses a bad service key without quoting it" testNamesBadServiceKey
   it "keeps the RPC URL and the service key out of errors and the shown config" testNamesSecretsHidden
   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
 
 rpcUrl :: T.Text
 rpcUrl = "https://eth.example.org/v2/rpc-token-value"
@@ -618,3 +620,36 @@ testNamesUnknownKeys = do
     unknownKeys ini `shouldMatchList` ["names.yeers", "chain.rpc"]
   NamesConfig {nYears} <- parsedNames (namesSection <> ["yeers = 3"]) (chainSection <> ["rpc = x"])
   nYears `shouldBe` 2
+
+devKeysIssuer :: T.Text -> [T.Text]
+devKeysIssuer keys = ["[issuer]", "index = 1", "private_key = " <> issuerSecret, "dev_keys = " <> keys]
+
+withChainId :: T.Text -> [T.Text]
+withChainId v = map (\l -> if "chain_id =" `T.isPrefixOf` l then "chain_id = " <> v else l) chainSection
+
+testDevKeysLocalChain :: IO ()
+testDevKeysLocalChain = do
+  Right sk <- pure (strDecode (B.pack (T.unpack issuerSecret)))
+  Right local <- parseIni (namesIni namesSection chainSection <> T.unlines (devKeysIssuer ("9:" <> issuerSecret <> ", 12:" <> issuerSecret)))
+  devIssuerKeys local `shouldBe` [BadgeIssuerKey {keyIdx = 9, secretKey = sk}, BadgeIssuerKey {keyIdx = 12, secretKey = sk}]
+  Right without <- parseIni (namesIni namesSection chainSection)
+  devIssuerKeys without `shouldBe` []
+  let refused = "issuer.dev_keys is accepted only with [names] on the local chain, [chain] chain_id = 31337" :: String
+  forM_ ["1", "11155111", "31338"] $ \chainId ->
+    parseIni (namesIni namesSection (withChainId chainId) <> T.unlines (devKeysIssuer ("9:" <> issuerSecret))) `shouldReturn` Left refused
+  parseIni (fullIni <> T.unlines (devKeysIssuer ("9:" <> issuerSecret))) `shouldReturn` Left refused
+
+testDevKeysMalformed :: IO ()
+testDevKeysMalformed = do
+  forM_ [issuerSecret, "9=" <> issuerSecret] $ \keys -> do
+    e <- refusal keys
+    e `shouldBe` "issuer.dev_keys must be <index>:<secret> entries separated by commas"
+    e `shouldNotContain` T.unpack issuerSecret
+  refusal ("0:" <> issuerSecret) `shouldReturn` "issuer.dev_keys index must be a positive whole number"
+  refusal "9:not-a-key" `shouldReturn` "issuer.dev_keys secret is not a valid issuer secret; use the value from `simplex-chat badge keygen`"
+  refusal ("9:" <> issuerSecret <> ",9:" <> issuerSecret) `shouldReturn` "issuer.dev_keys names an index twice"
+  where
+    refusal :: T.Text -> IO String
+    refusal keys =
+      parseIni (namesIni namesSection chainSection <> T.unlines (devKeysIssuer keys))
+        >>= either pure (\_ -> "" <$ expectationFailure (T.unpack keys <> " must not boot"))

tests/Bots/StoreService/WebTests.hs

@@ -1033,6 +1033,7 @@ testServiceConfig staticDir trustForwarded =
       stripe = Nothing,
       poll = PollConfig {pWaitingSeconds = 3, pIdleSeconds = 60},
       issuer = Nothing,
+      devIssuerKeys = [],
       group = Nothing,
       names = Nothing
     }