improve failure message for payload provider configuration JSON parser

src/Chainweb/Chainweb/Configuration.hs

@@ -85,8 +85,7 @@ import Chainweb.BlockHeight
 import Chainweb.Difficulty
 import Chainweb.HostAddress
 import Chainweb.Miner.Config
-import Chainweb.Pact.Types (RewindLimit)
-import Chainweb.Pact.Types (defaultReorgLimit)
+import Chainweb.Pact.Types (RewindLimit, defaultReorgLimit)
 import Chainweb.Pact.Payload.RestAPI (PayloadBatchLimit(..), defaultServicePayloadBatchLimit)
 import Chainweb.PayloadProvider.EVM (EvmProviderConfig, pEvmProviderConfig, defaultEvmProviderConfig, validateEvmProviderConfig)
 import Chainweb.PayloadProvider.Minimal (MinimalProviderConfig, defaultMinimalProviderConfig, pMinimalProviderConfig)
@@ -161,7 +160,7 @@ validatePayloadProviderConfig conf = do
         PactProvider -> return () -- FIXME implement validation
         e -> do
             tell [ "Pact provider configured for chain " <> sshow cid <> ": " <> sshow conf ]
-            throwError $ mconcat $
+            throwError $ mconcat
                 [ "Wrong payload provider type configuration for chain " <> sshow cid
                 , ". Expected " <> sshow e <> " but found Pact"
                 ]
@@ -170,7 +169,7 @@ validatePayloadProviderConfig conf = do
         EvmProvider _ -> validateEvmProviderConfig cid _conf
         e -> do
             tell [ "EVM provider configured for chain " <> sshow cid <> ": " <> sshow conf ]
-            throwError $ mconcat $
+            throwError $ mconcat
                 [ "Wrong payload provider type configuration for chain " <> sshow cid
                 , ". Expected " <> sshow e <> " but found EVM"
                 ]
@@ -209,8 +208,10 @@ instance ToJSON PayloadProviderConfig where
 --
 instance FromJSON (PayloadProviderConfig -> PayloadProviderConfig) where
     parseJSON = withObject "PayloadProviderConfig" $ \o -> do
-        updateMinimal <- payloadProviderConfigMinimal %.: "default" % o
-        ifoldlM go updateMinimal (KM.toMapText o)
+        updateMinimal <- jlabel "minimalPayloadProviderConfig" $
+            payloadProviderConfigMinimal %.: "default" % o
+        jlabel "payloadProviderConfig" $
+            ifoldlM go updateMinimal (KM.toMapText o)
       where
         parseKey k = case T.stripPrefix "chain-" k of
             Nothing -> fail $ "failed to parse chain key: " <> sshow k
@@ -220,27 +221,29 @@ instance FromJSON (PayloadProviderConfig -> PayloadProviderConfig) where
                 Right _ -> fail $ "trailng garabage when parsing chain value: " <> sshow x
 
         go "default" c _ = return c
-        go k c v = do
-            cid <- parseKey k
-            go2 cid c v
+        go k c v = jlabel k $ do
+            cid <- jlabel k $ parseKey k
+            jlabel ("chain:" <> toText cid) $ go2 cid c v
 
         -- disable provider:
-        go2 cid c Null = return $ (payloadProviderConfigPact . at cid .~ Nothing) . c
+        go2 cid c Null = jlabel "provider:null" $
+            return ((payloadProviderConfigPact . at cid .~ Nothing) . c)
 
         -- enabled provider:
         go2 cid c v = flip (withObject ("ProviderConfig for chain " <> sshow cid)) v $ \o -> do
             (o .: "type") >>= \case
-                "pact" ->  do
+                "pact" -> jlabel "provider:pact" $ do
                     x <- parseJSON (Object o)
                     let f Nothing = Just (x defaultPactProviderConfig)
                         f (Just y) = Just (x y)
                     return $ (payloadProviderConfigPact . at cid %~ f) . c
-                "evm" -> do
+                "evm" -> jlabel "provider:evm" $ do
                     x <- parseJSON (Object o)
                     let f Nothing = Just (x defaultEvmProviderConfig)
                         f (Just y) = Just (x y)
                     return $ (payloadProviderConfigEvm . at cid %~ f) . c
-                (x :: T.Text) -> fail $ "unknown payload provider type: " <> sshow x
+                (x :: T.Text) -> jlabel ("provider:" <> x) $
+                    fail $ "unknown payload provider type: " <> sshow x
 
 -- | Command line option parser for the payload provider configuration.
 --
@@ -262,7 +265,7 @@ pPayloadProviderConfig = id
         -- FIXME this is is ugly. At least use the largest know graph. Ideally,
         -- we would use the chainweb version -- but we don't know it yet.
         -- For the help message we just display options for chain 0.
-    pevm = foldr (\a b -> a . b) id <$> traverse go cids
+    pevm = foldr (.) id <$> traverse go cids
     go cid
         = parserOptionGroup "EVM [only options for chain 0 are shown]" evmChains
         <|> parserOptionGroup "Pact [only for chain 0 are shown]" pactChains
@@ -294,12 +297,12 @@ providerOpt prov cid a p = f <$> dis <*> ena <*> p cid
 
     ena = switch
         % long ("enable-chain-" <> T.unpack (toText cid) <> "-" <> prov)
-        <> help ("enable the payload provider for this chain")
+        <> help "enable the payload provider for this chain"
         <> mconcat [ hidden <> internal | chainIdInt @Int cid /= 0 ]
 
     dis = switch
         % long ("disable-chain-" <> T.unpack (toText cid) <> "-" <> prov)
-        <> help ("disabled the payload provider for this chain")
+        <> help "disabled the payload provider for this chain"
         <> mconcat [ hidden <> internal | chainIdInt @Int cid /= 0 ]
 
 -- -------------------------------------------------------------------------- --

src/Chainweb/PayloadProvider/EVM.hs

@@ -126,7 +126,7 @@
     -> RocksDb
     -> EVM.Header
     -> EvmDB.Configuration
-payloadDbConfiguration c rdb hdr = EvmDB.configuration c rdb hdr
+payloadDbConfiguration = EvmDB.configuration
 
 -- -------------------------------------------------------------------------- --
 -- Configuration
@@ -301,12 +301,12 @@
 latestStateIO = fmap (_consensusStateLatest . sfst) . stateIO
 
 isPayloadRequestedIO :: EvmPayloadProvider logger -> IO Bool
 isPayloadRequestedIO p = case _evmMinerAddress p of
     Nothing -> return False
     Just _ -> (isJust . ssnd) <$> stateIO p
 
 newBlockCtxIO :: EvmPayloadProvider logger -> IO (Maybe NewBlockCtx)
 newBlockCtxIO p = case _evmMinerAddress p of
     Nothing -> return Nothing
     Just _ -> ssnd <$> stateIO p
 
@@ -1383,7 +1383,7 @@
 --   overhead for this exceptional scenario.
 --
 candidatePruningDepth :: HasVersion => EvmPayloadProvider logger -> BlockHeight -> BlockHeight
 candidatePruningDepth p h = int $ diameter (chainGraphAt h)
 
 pruneCandidates :: HasVersion => EvmPayloadProvider logger -> IO ()
 pruneCandidates p = do
@@ -1449,7 +1449,7 @@
     -> Payload
     -> EvaluationCtx ConsensusPayload
     -> IO ()
 validatePayload p pld ctx = do
 
     -- FIXME: this requires that we have the full evaluation context available,
     -- which includes all transactions. This is potentially expensive.

src/Chainweb/PayloadProvider/Minimal/Payload.hs

@@ -112,7 +112,7 @@ account bs
 encodeAccount :: HasCallStack => Account -> Put
 encodeAccount (Account bs) = do
     let l = BS.length bs
-    void $ when (l > int (maxBound @Word16)) $
+    when (l > int (maxBound @Word16)) $
         error "Chainweb.PayloadProvider.Minimal.encodePayload: account is too large"
     putWord16le (int l)
     putShortByteString bs

src/Chainweb/Utils.hs

@@ -129,6 +129,7 @@ module Chainweb.Utils
 , decodeFileStrictOrThrow'
 , parseJsonFromText
 , JsonTextRepresentation(..)
+, jlabel
 
 -- ** Cassava (CSV)
 , CsvDecimal(..)
@@ -275,6 +276,7 @@ import Control.Monad.Primitive
 import Control.Monad.Reader as Reader
 import Control.Monad.Trans.Resource
 
+import Data.Aeson.Key qualified as Aeson
 import Data.Aeson.Text (encodeToLazyText)
 import Data.Aeson.Types qualified as Aeson
 import Data.Array.Byte
@@ -877,6 +879,9 @@ instance
     parseJSON = fmap JsonTextRepresentation . parseJsonFromText (symbolVal_ @s)
     {-# INLINE parseJSON #-}
 
+jlabel :: T.Text -> Aeson.Parser a -> Aeson.Parser a
+jlabel t = flip (<?>) (Aeson.Key $ Aeson.fromString $ T.unpack t)
+
 -- -------------------------------------------------------------------------- --
 -- ** Cassava (CSV)
 
@@ -885,7 +890,7 @@ newtype CsvDecimal = CsvDecimal { _csvDecimal :: Decimal }
 
 instance CSV.FromField CsvDecimal where
     parseField s = do
-        cs <- either (fail . show) pure $ T.unpack <$> T.decodeUtf8' s
+        cs <- either (fail . show) (pure . T.unpack) $ T.decodeUtf8' s
         either fail pure $ readEither cs
     {-# INLINE parseField #-}