store: warn at boot naming the dev key indexes

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

@@ -46,7 +46,7 @@ import StoreService.Waiters (Waiters, newWaiters)
 import StoreService.Web.Server (exportWebapp, newWebEnv, runWebListener)
 import Control.Applicative (optional)
 import Control.Concurrent.STM
-import StoreService.Log (logError, logInfo)
+import StoreService.Log (logError, logInfo, logWarn)
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.Aeson as J
@@ -55,7 +55,7 @@ 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)
+import Data.Either (fromRight, isRight)
 import Data.Functor (($>), (<&>))
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust, maybeToList)
@@ -110,9 +110,13 @@ welcomeGetOpts = do
 
 -- | 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)
+trustDevKeys serviceCfg cfg@ChatConfig {badgePublicKeys} = do
+  r <- fmap trusted . sequence <$> mapM publicKey devKeys
+  when (isRight r && not (null devKeys)) $
+    logWarn $ "trusting issuer dev_keys at indexes " <> T.intercalate ", " (map (\BadgeIssuerKey {keyIdx} -> tshow keyIdx) devKeys) <> "; no client trusts them, never set them in production"
+  pure r
   where
+    devKeys = maybe [] devIssuerKeys serviceCfg
     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"

tests/Bots/StoreService/GroupIntegrationTests.hs

@@ -20,10 +20,10 @@ import StoreService.Names.Store (NamePhase (..), NameRegistration (..), PrepaidC
 import StoreService.Names.Turns (newTurns, withCodeTurn)
 import StoreService.Options (StoreServiceOpts (..))
 import StoreService.Orders (cancelOpenInvoice, expireOverdue)
-import StoreService.Service (ServiceState (..), storeService, newServiceState)
+import StoreService.Service (ServiceState (..), newServiceState, storeService, trustDevKeys)
 import StoreService.Store (ManagedGroup (..), getManagedGroup)
 import StoreService.Waiters (newWaiters)
-import Bots.StoreService.BotTests (badgeBotName, badgeCmdUsage, badgeProfile, badgeTypeOf, credentialOf, entryOf, issueCode, issueRaw, mkStoreServiceOpts, newPurchaseKeys, operatorCmd, redeemWithQueue, requestObject, revokeRaw, serviceDbPrefix, shouldAnswerError, statementOf, stopStoreService, testIssuerKeyIdx, withStoreService)
+import Bots.StoreService.BotTests (badgeBotName, badgeCmdUsage, badgeProfile, badgeTypeOf, credentialOf, devKeysIni, entryOf, issueCode, issueRaw, mkStoreServiceOpts, newPurchaseKeys, operatorCmd, redeemWithQueue, requestObject, revokeRaw, serviceDbPrefix, shouldAnswerError, statementOf, stopStoreService, testIssuerKeyIdx, withStoreService)
 import Bots.StoreService.ConfigTests (chainSection, controllerAddr, namesSection)
 import Bots.StoreService.FakeEthNode (CallAnswer (..), FakeEthNode (..), answerCall, awaitSent, withFakeEthNode)
 import Bots.StoreService.WebTests (capturingStderr, digestFixture)
@@ -142,7 +142,21 @@ badgeGroupIntegrationTests = do
   it "leaves a tracker it cannot edit alone rather than publishing the code again" testUneditableTrackerLeftAlone
 
 namesBootTests :: SpecWith TestParams
-namesBootTests = it "boots with [names] and [chain], routing fixed /api/name paths ahead of a search, find ahead of registrations, registrations to GET, another name, a reveal, a spend and a retry to POST, a path no route knows and a taken order's code to 404, code checks and orders under one limit, and another name and retries under another" testNamesBoot
+namesBootTests = do
+  it "warns naming the indexes of trusted dev_keys, and says nothing without them" testDevKeysWarned
+  it "boots with [names] and [chain], routing fixed /api/name paths ahead of a search, find ahead of registrations, registrations to GET, another name, a reveal, a spend and a retry to POST, a path no route knows and a taken order's code to 404, code checks and orders under one limit, and another name and retries under another" testNamesBoot
+
+testDevKeysWarned :: HasCallStack => TestParams -> IO ()
+testDevKeysWarned _ = do
+  Right (pk, sk) <- bbsKeyGen
+  Right (_, devSk) <- bbsKeyGen
+  let cfg = testCfg {badgePublicKeys = M.singleton testIssuerKeyIdx pk}
+  Right withDev <- devKeysIni chainSection 9 devSk [(9, devSk), (12, devSk)]
+  warned <- capturingStderr $ trustDevKeys (Just withDev) cfg >>= (`shouldSatisfy` isRight) . fmap badgePublicKeys
+  filter ("[WARN " `T.isInfixOf`) (T.lines warned) `shouldSatisfy` any ("trusting issuer dev_keys at indexes 9, 12" `T.isInfixOf`)
+  Right withoutDev <- devKeysIni chainSection testIssuerKeyIdx sk []
+  quiet <- capturingStderr $ trustDevKeys (Just withoutDev) cfg >>= (`shouldSatisfy` isRight) . fmap badgePublicKeys
+  filter ("dev_keys" `T.isInfixOf`) (T.lines quiet) `shouldBe` []
 
 testNamesBoot :: HasCallStack => TestParams -> IO ()
 testNamesBoot ps = do