From 1fd49e6529e5d6e4f429287a32f70d28afe7672b Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Tue, 30 Jun 2026 16:12:16 +0200 Subject: [PATCH 1/6] Implement `cardano-config migrate` --- README.md | 33 ++++++++-- app/Main.hs | 36 ++++++++++- cardano-config.cabal | 1 + src/Cardano/Configuration/File/Migrate.hs | 76 +++++++++++++++++++++++ test/Main.hs | 36 +++++++++++ 5 files changed, 175 insertions(+), 7 deletions(-) create mode 100644 src/Cardano/Configuration/File/Migrate.hs diff --git a/README.md b/README.md index 70dbaf2..0677c8e 100644 --- a/README.md +++ b/README.md @@ -10,8 +10,8 @@ The goal is one shared parser for applications that need the node's configuratio such as [`cardano-cli`](https://github.com/IntersectMBO/cardano-cli), [`dmq-node`](https://github.com/IntersectMBO/dmq-node/) and [the `ouroboros-consensus` tools](https://github.com/IntersectMBO/ouroboros-consensus/tree/main/ouroboros-consensus-cardano#consensus-db-tools). -The bundled `cardano-config` executable exposes the same via its `resolve` and -`schema` subcommands. +The bundled `cardano-config` executable exposes the same via its `resolve`, +`schema` and `migrate` subcommands. ## Recommended format @@ -42,10 +42,31 @@ pointing to that component's schema (e.g. a `StorageConfig` sub-file uses `schem so editors and validators pick up the right schema for the sub-file. The key is an annotation: the parser accepts and ignores it. -To port an old config to the new format, group the component keys under their -sections inside `Configuration` and add the `Version` / `MinNodeVersion` -envelope. `cardano-config schema` documents the recommended form; -`--legacy-one-file` documents the flat form. +To port an old config to the new format, run `cardano-config migrate` (it reads +`-` as stdin, so you can fetch and convert in one step): + +```console +$ cardano-config migrate old-config.json > config.json +$ curl -sL | cardano-config migrate - > config.json +``` + +It reshapes the document into the envelope as JSON: it adds `$schema` and +`Version`, carries `MinNodeVersion` through, and groups each component's keys +under its section inside `Configuration`. It is a purely structural migration - +it preserves the values as written and does not fill in defaults, inline +referenced sub-files, or read genesis files; follow it with `resolve` to check +the result. + +Unrecognised keys (the vestigial `MaxKnownMajorProtocolVersion`, a stray +`Protocol`, or a typo) are **kept** rather than silently dropped, so nothing is +lost - but they remain unrecognised and so still surface as an +`UnrecognisedKeys` warning on the next parse. Remove them by hand if you want a +warning-free config. + +(To port by hand instead: group the component keys under their sections inside +`Configuration` and add the `Version` / `MinNodeVersion` envelope. `cardano-config +schema` documents the recommended form; `--legacy-one-file` documents the flat +form.) ## Defaults and layering diff --git a/app/Main.hs b/app/Main.hs index 3feac2f..8cdb288 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,4 +1,4 @@ --- | The @cardano-config@ command-line tool. It exposes two subcommands: +-- | The @cardano-config@ command-line tool. It exposes three subcommands: -- -- * @cardano-config resolve@ resolves a @cardano-node@ configuration -- (per-component defaults, the configuration file and the CLI flags), @@ -7,11 +7,17 @@ -- -- * @cardano-config schema@ dumps the configuration JSON Schema (for the -- whole configuration or a single component), derived from the same codecs. +-- +-- * @cardano-config migrate@ reshapes a configuration into the recommended +-- @{ $schema, Version, MinNodeVersion, Configuration }@ envelope and prints +-- it as JSON (a purely structural migration, preserving the values). module Main (main) where import Cardano.Configuration (parseConfigurationFiles, renderConfigWarning, resolveConfiguration) import Cardano.Configuration.CliArgs (CliArgs, configFilePath, parseCliArgs) import Cardano.Configuration.File (componentDefaults) +import Cardano.Configuration.File.Merge (decodeValueFile) +import Cardano.Configuration.File.Migrate (migrate) import Cardano.Configuration.Render (GenesisRendering (..), nodeConfigurationToJSON) import Cardano.Configuration.Schema ( configurationSchemas @@ -28,6 +34,7 @@ import qualified Data.ByteString.Lazy.Char8 as L import Data.Foldable (for_) import Data.List (intercalate) import qualified Data.Text as T +import Data.Yaml (decodeThrow) import Data.Yaml.Pretty (encodePretty, setConfCompare, setConfDropNull) import qualified Data.Yaml.Pretty as Yaml import Options.Applicative @@ -42,6 +49,8 @@ data Command Resolve CliArgs GenesisRendering | -- | @schema@: dump a JSON Schema. Schema SchemaCmd + | -- | @migrate@: reshape a configuration file into the Version1 envelope. + Migrate FilePath -- | What the @schema@ subcommand should print. data SchemaCmd @@ -91,6 +100,20 @@ commandParser = <> footerDoc (Just schemaValidationHelp) ) ) + <> command + "migrate" + ( info + ( Migrate + <$> strArgument + (metavar "CONFIG" <> help "Configuration file to migrate (JSON or YAML), or - for stdin.") + ) + ( progDesc + ( "Reshape a configuration into the recommended " + <> "{ $schema, Version, MinNodeVersion, Configuration } envelope and print it as JSON. " + <> "Preserves the values as written (no defaults are filled, no sub-files inlined)." + ) + ) + ) ) -- | How to validate a configuration against the schema, shown under @@ -148,6 +171,17 @@ withGenesesFlag = run :: Command -> IO () run (Resolve cli geneses) = runResolve cli geneses run (Schema cmd) = runSchema cmd +run (Migrate path) = runMigrate path + +-- | Read a configuration and print it, reshaped into the Version1 envelope, as +-- JSON. A purely structural migration: it does not resolve, default or validate. +-- A path of @-@ reads the configuration from stdin (so it composes with @curl@). +runMigrate :: FilePath -> IO () +runMigrate path = handleAny (die . displayException) $ do + raw <- case path of + "-" -> BS.getContents >>= decodeThrow + _ -> decodeValueFile Nothing path + dump (migrate raw) -- | Resolve a configuration and print it as YAML. runResolve :: CliArgs -> GenesisRendering -> IO () diff --git a/cardano-config.cabal b/cardano-config.cabal index aee9c0b..fdb6ad7 100644 --- a/cardano-config.cabal +++ b/cardano-config.cabal @@ -53,6 +53,7 @@ library internal Cardano.Configuration.File.Lint Cardano.Configuration.File.Mempool Cardano.Configuration.File.Merge + Cardano.Configuration.File.Migrate Cardano.Configuration.File.Network Cardano.Configuration.File.Protocol Cardano.Configuration.File.Storage diff --git a/src/Cardano/Configuration/File/Migrate.hs b/src/Cardano/Configuration/File/Migrate.hs new file mode 100644 index 0000000..3ba1fa0 --- /dev/null +++ b/src/Cardano/Configuration/File/Migrate.hs @@ -0,0 +1,76 @@ +-- | Reshape an existing configuration into the recommended Version1 envelope: +-- @{ $schema, Version, MinNodeVersion, Configuration }@, with every component +-- grouped under its section key inside @Configuration@. +-- +-- This is a purely structural migration: it preserves the values as written and +-- does /not/ fill in defaults, inline referenced sub-files, or read genesis +-- files. It is meant to port a legacy single-file (flat) or otherwise +-- non-enveloped configuration to the new layout; resolution and validation are +-- left to a subsequent @resolve@. +-- +-- The reshaping (see 'migrate'): +-- +-- * @$schema@ (the published schema URL) and @Version@ (1) are added when +-- absent; an existing @Version@\/@MinNodeVersion@ is carried through. +-- * a flat top-level property key is nested under the component section that +-- owns it (e.g. @ConsensusMode@ under @ConsensusConfig@, @LedgerDB@ under +-- @StorageConfig@); +-- * a section key (whether an inline object or a path to a sub-file), the +-- @HermodTracing@ key, and any unrecognised key are kept at the +-- @Configuration@ level as-is (so nothing is silently dropped); +-- * a document already in the envelope is reshaped idempotently. +module Cardano.Configuration.File.Migrate + ( migrate + ) where + +import Cardano.Configuration.File.Merge (mergeValues) +import Cardano.Configuration.Schema (componentPropertyNames, schemaId) +import Data.Aeson (Value (..)) +import qualified Data.Aeson.Key as K +import qualified Data.Aeson.KeyMap as KM +import Data.Maybe (fromMaybe) +import Data.Text (Text) + +-- | Migrate a raw configuration value to the Version1 envelope. A value that is +-- not a JSON\/YAML object is returned unchanged. +migrate :: Value -> Value +migrate (Object top) = + Object $ + KM.insert "$schema" (String (schemaId "config.schema.json")) $ + KM.insert "Version" version $ + withMinNodeVersion $ + KM.singleton "Configuration" (Object configuration) + where + -- Carry an existing Version, otherwise default to the current format (1). + version = fromMaybe (Number 1) (KM.lookup "Version" top) + -- Carry MinNodeVersion through if present; never invent one (it has no + -- default, and its absence is itself a useful warning on the next parse). + withMinNodeVersion = maybe id (KM.insert "MinNodeVersion") (KM.lookup "MinNodeVersion" top) + + -- The configuration body: an already-enveloped document's Configuration + -- object, or (for a legacy\/non-enveloped document) the top-level object + -- minus the envelope annotations. + body = case KM.lookup "Configuration" top of + Just (Object c) -> c + _ -> KM.filterWithKey (\k _ -> K.toText k `notElem` envelopeAnnotations) top + + -- Group each body key under its component section. A flat property key nests + -- under the section that owns it; a section key, HermodTracing or any + -- unrecognised key stays at the Configuration level as-is. A mixed input (a + -- section object plus some of its flat keys) is deep-merged. + configuration = KM.foldrWithKey place KM.empty body + place k v = + case lookup (K.toText k) propertyToSection of + Just section -> KM.insertWith mergeValues (K.fromText section) (Object (KM.singleton k v)) + Nothing -> KM.insertWith mergeValues k v +migrate v = v + +-- | Top-level keys that belong to the envelope, not to the configuration body. +envelopeAnnotations :: [Text] +envelopeAnnotations = ["$schema", "Version", "MinNodeVersion", "Configuration"] + +-- | Each component property name mapped to the section that owns it. Every +-- property belongs to exactly one component (see 'componentPropertyNames'). +propertyToSection :: [(Text, Text)] +propertyToSection = + [(prop, section) | (section, props) <- componentPropertyNames, prop <- props] diff --git a/test/Main.hs b/test/Main.hs index bc6dbf3..3229b8e 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -18,6 +18,7 @@ import Cardano.Configuration (resolveConfiguration) import qualified Cardano.Configuration as C import Cardano.Configuration.CliArgs (CliArgs, parseCliArgs) import Cardano.Configuration.File +import Cardano.Configuration.File.Migrate (migrate) import Cardano.Configuration.File.Storage ( LedgerDbBackendSelector (..) , LedgerDbConfiguration (..) @@ -87,6 +88,7 @@ cases = , shadowWarnCase , envelopeWarningCase , splitSubfileSchemaCase + , migrateCase , subfilePathConfinementCase , minNodeVersionCase , resolveCase @@ -253,6 +255,40 @@ splitSubfileSchemaCase = properties (Object o) | Just (Object p) <- KM.lookup (K.fromString "properties") o = p properties _ = KM.empty +-- | 'migrate' reshapes a legacy flat config into the Version1 envelope: the +-- envelope keys appear at the top, each component's flat keys are grouped under +-- its section (e.g. ConsensusMode under ConsensusConfig), an unrecognised key +-- (MaxKnownMajorProtocolVersion) is kept, and the result is idempotent. +migrateCase :: TestTree +migrateCase = + testCase "migrate test/examples/fullconfig.json (legacy flat -> Version1 envelope)" $ do + res <- decodeData "test/examples/fullconfig.json" :: IO (Either String Value) + expectOk $ case res of + Left err -> Just ("could not read fixture: " <> err) + Right raw -> case migrate raw of + m@(Object top) + | not (all (`KM.member` top) (map K.fromString envelopeKeys)) -> + Just ("missing envelope keys; got " <> show (KM.keys top)) + | otherwise -> case KM.lookup (K.fromString "Configuration") top of + Just (Object cfg) + | not (nested cfg "ProtocolConfig" "ByronGenesisFile") -> + Just "ProtocolConfig.ByronGenesisFile not grouped" + | not (nested cfg "ConsensusConfig" "ConsensusMode") -> + Just "ConsensusConfig.ConsensusMode not grouped" + | not (nested cfg "StorageConfig" "LedgerDB") -> + Just "StorageConfig.LedgerDB not grouped" + | not (KM.member (K.fromString "MaxKnownMajorProtocolVersion") cfg) -> + Just "unrecognised key was dropped (should be kept)" + | migrate m /= m -> Just "migrate is not idempotent" + | otherwise -> Nothing + _ -> Just "Configuration is not an object" + _ -> Just "migrate did not produce an object" + where + envelopeKeys = ["$schema", "Version", "MinNodeVersion", "Configuration"] + nested cfg section key = case KM.lookup (K.fromString section) cfg of + Just (Object s) -> KM.member (K.fromString key) s + _ -> False + -- | The optional top-level @MinNodeVersion@ annotation is read from the same -- level as @Version@: from inside the @{ Version, Configuration }@ envelope, and -- — when the document is not enveloped — from the top level alongside the From ed82c1103c32e2c60058790a2e08b0b09a452e4c Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Jul 2026 13:19:02 +0200 Subject: [PATCH 2/6] Take care of migrating renamed fields --- README.md | 13 ++- src/Cardano/Configuration/File/Migrate.hs | 108 ++++++++++++++++++++-- src/Cardano/Configuration/Schema.hs | 1 + test/Main.hs | 58 ++++++++++++ test/examples/legacy-renamed-fields.json | 21 +++++ 5 files changed, 190 insertions(+), 11 deletions(-) create mode 100644 test/examples/legacy-renamed-fields.json diff --git a/README.md b/README.md index 0677c8e..26b37af 100644 --- a/README.md +++ b/README.md @@ -52,10 +52,15 @@ $ curl -sL | cardano-config migrate - > config.json It reshapes the document into the envelope as JSON: it adds `$schema` and `Version`, carries `MinNodeVersion` through, and groups each component's keys -under its section inside `Configuration`. It is a purely structural migration - -it preserves the values as written and does not fill in defaults, inline -referenced sub-files, or read genesis files; follow it with `resolve` to check -the result. +under its section inside `Configuration`. It also brings field names up to date: +the parser rejects the old names, so `migrate` rewrites the ones that were +renamed (`hardLimit`/`softLimit`/`delay` → `HardLimit`/`SoftLimit`/`Delay`, +`EnableRpc`/`RpcSocketPath` → `EnableGrpc`/`GrpcSocketPath`, `TargetNumberOf*` → +`DeadlineTargetNumberOf*`) and drops the ones that were removed +(`PBftSignatureThreshold`, `LastKnownBlockVersion-Major`/`-Minor`/`-Alt`, now +supplied by consensus defaults). Apart from that it preserves the values as +written and does not fill in defaults, inline referenced sub-files, or read +genesis files; follow it with `resolve` to check the result. Unrecognised keys (the vestigial `MaxKnownMajorProtocolVersion`, a stray `Protocol`, or a typo) are **kept** rather than silently dropped, so nothing is diff --git a/src/Cardano/Configuration/File/Migrate.hs b/src/Cardano/Configuration/File/Migrate.hs index 3ba1fa0..d155988 100644 --- a/src/Cardano/Configuration/File/Migrate.hs +++ b/src/Cardano/Configuration/File/Migrate.hs @@ -2,14 +2,23 @@ -- @{ $schema, Version, MinNodeVersion, Configuration }@, with every component -- grouped under its section key inside @Configuration@. -- --- This is a purely structural migration: it preserves the values as written and --- does /not/ fill in defaults, inline referenced sub-files, or read genesis --- files. It is meant to port a legacy single-file (flat) or otherwise --- non-enveloped configuration to the new layout; resolution and validation are --- left to a subsequent @resolve@. +-- It also rewrites the field names that changed, and drops the fields that were +-- removed, in the rename series that this library no longer parses (see +-- 'renamedFields'\/'removedFields'). This is deliberate: the parser rejects the +-- old names outright, and @migrate@ is the supported way to bring an older +-- configuration up to the current names. +-- +-- Apart from those renames\/removals this is a purely structural migration: it +-- preserves the values as written and does /not/ fill in defaults, inline +-- referenced sub-files, or read genesis files. It is meant to port a legacy +-- single-file (flat) or otherwise non-enveloped configuration to the new layout; +-- resolution and validation are left to a subsequent @resolve@. -- -- The reshaping (see 'migrate'): -- +-- * renamed keys are rewritten to their current names and removed keys are +-- dropped, at every depth (so the grouping below, which keys off the current +-- names, places them correctly); -- * @$schema@ (the published schema URL) and @Version@ (1) are added when -- absent; an existing @Version@\/@MinNodeVersion@ is carried through. -- * a flat top-level property key is nested under the component section that @@ -33,8 +42,93 @@ import Data.Text (Text) -- | Migrate a raw configuration value to the Version1 envelope. A value that is -- not a JSON\/YAML object is returned unchanged. +-- +-- Renames and removals are applied first (recursively, over the whole document) +-- so that the subsequent structural grouping sees only current names. migrate :: Value -> Value -migrate (Object top) = +migrate = reshape . renameLegacy + +-- | The field renames introduced in the current key-naming series, as +-- @(old, new)@. The parser only accepts the new names; @migrate@ rewrites the +-- old ones so a configuration written before the rename can be brought forward. +-- Matching is on the whole key (not a substring), so e.g. +-- @SyncTargetNumberOfRootPeers@ is left untouched by the @TargetNumberOf*@ +-- entries. These names are globally unique, so they are rewritten at any depth; +-- the lower-cased 'acceptedConnectionsLimitFields' are handled separately +-- because those names are too generic to rewrite unconditionally. +renamedFields :: [(Text, Text)] +renamedFields = + [ -- gRPC local-connection keys (were named Rpc) + ("EnableRpc", "EnableGrpc") + , ("RpcSocketPath", "GrpcSocketPath") + , -- Deadline peer targets (gained the Deadline prefix) + ("TargetNumberOfRootPeers", "DeadlineTargetNumberOfRootPeers") + , ("TargetNumberOfKnownPeers", "DeadlineTargetNumberOfKnownPeers") + , ("TargetNumberOfEstablishedPeers", "DeadlineTargetNumberOfEstablishedPeers") + , ("TargetNumberOfActivePeers", "DeadlineTargetNumberOfActivePeers") + , ("TargetNumberOfKnownBigLedgerPeers", "DeadlineTargetNumberOfKnownBigLedgerPeers") + , ("TargetNumberOfEstablishedBigLedgerPeers", "DeadlineTargetNumberOfEstablishedBigLedgerPeers") + , ("TargetNumberOfActiveBigLedgerPeers", "DeadlineTargetNumberOfActiveBigLedgerPeers") + ] + +-- | The @AcceptedConnectionsLimit@ sub-keys that were lower-cased before the +-- rename. Their names (@delay@ especially) are too generic to rewrite wherever +-- they appear, so they are only rewritten inside an @AcceptedConnectionsLimit@ +-- object (see 'renameLegacy'). +acceptedConnectionsLimitFields :: [(Text, Text)] +acceptedConnectionsLimitFields = + [ ("hardLimit", "HardLimit") + , ("softLimit", "SoftLimit") + , ("delay", "Delay") + ] + +-- | The fields removed in the current series. @migrate@ drops them (they are no +-- longer parsed): the Byron @LastKnownBlockVersion-*@ trio and +-- @PBftSignatureThreshold@ now come from consensus defaults rather than config. +removedFields :: [Text] +removedFields = + [ "PBftSignatureThreshold" + , "LastKnownBlockVersion-Major" + , "LastKnownBlockVersion-Minor" + , "LastKnownBlockVersion-Alt" + ] + +-- | Rewrite renamed keys and drop removed keys, everywhere in the document. +-- Recurses through objects and arrays; leaves scalars unchanged. The generic +-- 'acceptedConnectionsLimitFields' are rewritten only within an +-- @AcceptedConnectionsLimit@ object, not wherever those names happen to appear. +renameLegacy :: Value -> Value +renameLegacy (Object o) = + Object + . KM.fromList + . map rekey + . filter (\(k, _) -> K.toText k `notElem` removedFields) + $ KM.toList o + where + rekey (k, v) = (rename renamedFields k, scoped k (renameLegacy v)) + -- Inside an AcceptedConnectionsLimit object, also rewrite its (generic) direct + -- sub-keys; the recursion above has already handled any deeper nesting. + scoped k v + | K.toText k == "AcceptedConnectionsLimit" = renameTopKeys acceptedConnectionsLimitFields v + | otherwise = v +renameLegacy (Array a) = Array (fmap renameLegacy a) +renameLegacy v = v + +-- | Apply a rename table to the direct keys of an object (only), leaving +-- non-objects and unlisted keys unchanged. +renameTopKeys :: [(Text, Text)] -> Value -> Value +renameTopKeys table (Object o) = + Object (KM.fromList [(rename table k, v) | (k, v) <- KM.toList o]) +renameTopKeys _ v = v + +-- | Look a key up in a rename table, returning it unchanged if absent. +rename :: [(Text, Text)] -> K.Key -> K.Key +rename table k = maybe k K.fromText (lookup (K.toText k) table) + +-- | The structural reshape into the Version1 envelope. A value that is not a +-- JSON\/YAML object is returned unchanged. +reshape :: Value -> Value +reshape (Object top) = Object $ KM.insert "$schema" (String (schemaId "config.schema.json")) $ KM.insert "Version" version $ @@ -63,7 +157,7 @@ migrate (Object top) = case lookup (K.toText k) propertyToSection of Just section -> KM.insertWith mergeValues (K.fromText section) (Object (KM.singleton k v)) Nothing -> KM.insertWith mergeValues k v -migrate v = v +reshape v = v -- | Top-level keys that belong to the envelope, not to the configuration body. envelopeAnnotations :: [Text] diff --git a/src/Cardano/Configuration/Schema.hs b/src/Cardano/Configuration/Schema.hs index 702e923..a255f51 100644 --- a/src/Cardano/Configuration/Schema.hs +++ b/src/Cardano/Configuration/Schema.hs @@ -45,6 +45,7 @@ module Cardano.Configuration.Schema , localConnectionsSchema , mempoolSchema , testingSchema + , schemaId ) where import Autodocodec.Schema (jsonSchemaViaCodec) diff --git a/test/Main.hs b/test/Main.hs index 3229b8e..1a7278c 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -89,6 +89,7 @@ cases = , envelopeWarningCase , splitSubfileSchemaCase , migrateCase + , migrateRenameCase , subfilePathConfinementCase , minNodeVersionCase , resolveCase @@ -289,6 +290,63 @@ migrateCase = Just (Object s) -> KM.member (K.fromString key) s _ -> False +-- | 'migrate' rewrites the renamed fields to their current names and drops the +-- removed ones. Renamed flat keys must end up grouped under their section using +-- the /new/ name (a peer target under NetworkConfig, EnableGrpc under +-- LocalConnectionsConfig); AcceptedConnectionsLimit's sub-keys are renamed in +-- place, but that rename is scoped — a stray @delay@ elsewhere is left alone; +-- no removed key survives anywhere; and the result is still idempotent. +migrateRenameCase :: TestTree +migrateRenameCase = + testCase "migrate rewrites renamed fields and drops removed ones" $ do + res <- decodeData "test/examples/legacy-renamed-fields.json" :: IO (Either String Value) + expectOk $ case res of + Left err -> Just ("could not read fixture: " <> err) + Right raw -> case migrate raw of + m@(Object top) + | any (`elem` removed) (allKeys m) -> + Just ("a removed key survived; keys: " <> show (allKeys m)) + | any (`elem` oldNames) (allKeys m) -> + Just ("an old name survived; keys: " <> show (allKeys m)) + | otherwise -> case KM.lookup (K.fromString "Configuration") top of + Just (Object cfg) + | not (nested cfg "NetworkConfig" "DeadlineTargetNumberOfRootPeers") -> + Just "renamed peer target not grouped under NetworkConfig" + | not (nested cfg "LocalConnectionsConfig" "EnableGrpc") -> + Just "EnableGrpc not grouped under LocalConnectionsConfig" + | not (deepNested cfg "NetworkConfig" "AcceptedConnectionsLimit" "HardLimit") -> + Just "AcceptedConnectionsLimit.HardLimit not renamed in place" + | deepNested cfg "NetworkConfig" "AcceptedConnectionsLimit" "hardLimit" -> + Just "AcceptedConnectionsLimit.hardLimit not renamed" + -- The rename is scoped: a stray top-level "delay" is not touched. + | not (KM.member (K.fromString "delay") cfg) -> + Just "a stray 'delay' outside AcceptedConnectionsLimit was renamed (should be scoped)" + | migrate m /= m -> Just "migrate is not idempotent" + | otherwise -> Nothing + _ -> Just "Configuration is not an object" + _ -> Just "migrate did not produce an object" + where + removed = + [ "PBftSignatureThreshold" + , "LastKnownBlockVersion-Major" + , "LastKnownBlockVersion-Minor" + , "LastKnownBlockVersion-Alt" + ] + -- Globally-unique old names that must never survive (the generic + -- AcceptedConnectionsLimit sub-keys are checked in place above, since a stray + -- one is deliberately left unchanged). + oldNames = ["EnableRpc", "RpcSocketPath", "TargetNumberOfRootPeers"] + nested cfg section key = case KM.lookup (K.fromString section) cfg of + Just (Object s) -> KM.member (K.fromString key) s + _ -> False + deepNested cfg section sub key = case KM.lookup (K.fromString section) cfg of + Just (Object s) -> nested s sub key + _ -> False + -- Every object key appearing anywhere in the document. + allKeys (Object o) = map K.toString (KM.keys o) <> concatMap allKeys (KM.elems o) + allKeys (Array a) = concatMap allKeys a + allKeys _ = [] + -- | The optional top-level @MinNodeVersion@ annotation is read from the same -- level as @Version@: from inside the @{ Version, Configuration }@ envelope, and -- — when the document is not enveloped — from the top level alongside the diff --git a/test/examples/legacy-renamed-fields.json b/test/examples/legacy-renamed-fields.json new file mode 100644 index 0000000..99b2c68 --- /dev/null +++ b/test/examples/legacy-renamed-fields.json @@ -0,0 +1,21 @@ +{ + "PBftSignatureThreshold": 0.6, + "LastKnownBlockVersion-Major": 3, + "LastKnownBlockVersion-Minor": 0, + "LastKnownBlockVersion-Alt": 0, + "EnableRpc": true, + "RpcSocketPath": "/run/node.sock", + "TargetNumberOfRootPeers": 60, + "TargetNumberOfKnownPeers": 85, + "TargetNumberOfEstablishedPeers": 30, + "TargetNumberOfActivePeers": 15, + "TargetNumberOfKnownBigLedgerPeers": 15, + "TargetNumberOfEstablishedBigLedgerPeers": 10, + "TargetNumberOfActiveBigLedgerPeers": 5, + "AcceptedConnectionsLimit": { + "hardLimit": 512, + "softLimit": 384, + "delay": 5 + }, + "delay": 99 +} From 979dc7c912d9ef2018b94fe35bf574753d0a1d7f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Jul 2026 13:51:20 +0200 Subject: [PATCH 3/6] Only parse V1 format --- src/Cardano/Configuration/File.hs | 19 +++- src/Cardano/Configuration/File/Lint.hs | 121 +++++++---------------- src/Cardano/Configuration/File/Merge.hs | 13 ++- src/Cardano/Configuration/Schema.hs | 12 ++- test/Main.hs | 69 +++++++------ test/examples/migration-unparseable.json | 3 + test/examples/shadow.json | 20 ++-- 7 files changed, 124 insertions(+), 133 deletions(-) create mode 100644 test/examples/migration-unparseable.json diff --git a/src/Cardano/Configuration/File.hs b/src/Cardano/Configuration/File.hs index 1c3d432..e965ee3 100644 --- a/src/Cardano/Configuration/File.hs +++ b/src/Cardano/Configuration/File.hs @@ -54,8 +54,8 @@ import Cardano.Configuration.File.Consensus import Cardano.Configuration.File.Error (ConfigurationParsingError (..)) import Cardano.Configuration.File.Lint ( ConfigWarning (..) - , checkEnvelope , configWarnings + , inVersion1Format , renderConfigWarning ) import Cardano.Configuration.File.Mempool @@ -67,6 +67,7 @@ import Cardano.Configuration.File.Merge , sectionUserLayer , splitEnvelope ) +import Cardano.Configuration.File.Migrate (migrate) import Cardano.Configuration.File.Network import Cardano.Configuration.File.Protocol import Cardano.Configuration.File.Storage @@ -184,11 +185,19 @@ componentDefaults = parseConfigurationFiles :: HasCallStack => FilePath -> IO (NodeConfigurationFromFile, [ConfigWarning]) parseConfigurationFiles cfgFile = do - mainValue <- decodeValueFile Nothing cfgFile + rawValue <- decodeValueFile Nothing cfgFile + -- The parser accepts only the Version1 format (a top-level @Configuration@ + -- envelope). A document that is not in it is not parsed as-is: it is migrated + -- to the Version1 format first — with a 'MigratedToVersion1' warning — and the + -- result is parsed. If that migrated document still cannot be parsed, the parse + -- error surfaces as usual (so a non-Version1 document whose migration does not + -- yield a parseable configuration is rejected). + let (mainValue, migrationWarnings) = + if inVersion1Format rawValue + then (rawValue, []) + else (migrate rawValue, [MigratedToVersion1]) (version, minNodeVer, configValue) <- splitEnvelope mainValue - -- 'checkEnvelope' inspects the raw top-level document (is it the Version1 - -- envelope?); the rest inspect the unwrapped configuration object. - let warnings = checkEnvelope mainValue <> configWarnings configValue + let warnings = migrationWarnings <> configWarnings configValue root = takeDirectory cfgFile config <- case version of 1 -> parseConfigurationVersion1 root minNodeVer configValue diff --git a/src/Cardano/Configuration/File/Lint.hs b/src/Cardano/Configuration/File/Lint.hs index 8da4d69..afc7ae6 100644 --- a/src/Cardano/Configuration/File/Lint.hs +++ b/src/Cardano/Configuration/File/Lint.hs @@ -1,8 +1,6 @@ --- | Linting of the top-level configuration keys: detecting unrecognised keys, --- keys shadowed by a component supplied as its own section, and use of the legacy --- single-file form. This is the only part of the configuration-file handling that --- depends on the schema (for the set of recognised keys and the per-component key --- listing). +-- | Linting of the top-level configuration keys: detecting unrecognised keys. +-- This is the only part of the configuration-file handling that depends on the +-- schema (for the set of recognised keys). -- -- The checks are pure and return structured 'ConfigWarning's; how (or whether) to -- surface them — print, log via a tracer, treat as fatal — is left to the caller. @@ -11,37 +9,29 @@ module Cardano.Configuration.File.Lint , renderConfigWarning , configWarnings , checkUnknownKeys - , checkShadowedKeys - , checkLegacyFormat - , checkEnvelope + , inVersion1Format ) where -import Cardano.Configuration.Schema (componentPropertyNames, recognisedKeys) +import Cardano.Configuration.Schema (recognisedKeys) import Data.Aeson (Value (..)) import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.List (intercalate) -import Data.Text (Text) -import qualified Data.Text as T -- | A non-fatal observation about a configuration. Returned by the parser so the -- caller decides how to surface it (the @cardano-config@ executable prints them -- to @stderr@; another consumer might log them through its own tracer, or treat -- them as errors). data ConfigWarning - = -- | Top-level keys that no parser recognises (typically typos); they are - -- ignored. + = -- | Top-level keys that no parser recognises: typos, or a component property + -- placed flat under @Configuration@ instead of under its section. They are + -- ignored (not resolved into a section). UnrecognisedKeys [String] - | -- | Top-level keys ignored because their component was also given as its - -- own section (which wins). Each pair is @(section, key)@. - ShadowedKeys [(Text, Text)] - | -- | The configuration uses the legacy single-file form (component keys at the - -- top level) rather than the recommended split-file form. - LegacySingleFileFormat - | -- | The document is not in the recommended Version1 envelope form: one or - -- more of the top-level @$schema@, @Version@, @MinNodeVersion@ and @Configuration@ keys - -- is absent. Carries the missing key names. - NotVersion1Envelope [Text] + | -- | The document was not in the Version1 format (no top-level @Configuration@ + -- envelope), so the parser did not accept it as-is: it was migrated to the + -- Version1 format (see @Cardano.Configuration.File.Migrate.migrate@) before + -- parsing. Run @cardano-config migrate@ to update the file on disk. + MigratedToVersion1 | -- | A consistency check of warning severity did not hold on the resolved -- configuration (e.g. the Mithril snapshot policy under the V2LSM backend -- without an @LSMExportPath@). The configuration is still accepted; the @@ -55,26 +45,27 @@ renderConfigWarning :: ConfigWarning -> String renderConfigWarning = \case UnrecognisedKeys ks -> "unrecognised configuration key(s): " <> intercalate ", " ks <> " (ignored)" - ShadowedKeys sks -> - "top-level configuration key(s) ignored because their component is given as a separate section: " - <> intercalate ", " (map describe sks) - where - describe (section, key) = T.unpack key <> " (shadowed by the " <> T.unpack section <> " section)" - LegacySingleFileFormat -> - "the configuration uses the legacy single-file form (component keys at the top level); " - <> "consider porting it to the split-file form (each component under its section key)" - NotVersion1Envelope missing -> - "the configuration is not in the Version1 envelope form; missing top-level key(s): " - <> intercalate ", " (map T.unpack missing) - <> " (expected { $schema, Version, MinNodeVersion, Configuration })" + MigratedToVersion1 -> + "the configuration was not in the Version1 format (no top-level Configuration envelope); " + <> "it was migrated to the Version1 format before parsing " + <> "(run `cardano-config migrate` to update the file)" ConsistencyWarning msg -> msg -- | All warnings for an (unwrapped) configuration object. +-- +-- With the parser accepting only the Version1 format (a document that is not is +-- migrated first, which groups every component under its section), the only key +-- warning left is for keys that none of the parsers recognise — typos, or a +-- component property placed flat under @Configuration@ rather than under its +-- section. There is no longer any \"shadowed\" or \"legacy single-file\" handling: +-- a misplaced key is simply unrecognised, not resolved. configWarnings :: Value -> [ConfigWarning] -configWarnings value = - checkUnknownKeys value <> checkShadowedKeys value <> checkLegacyFormat value +configWarnings = checkUnknownKeys --- | Top-level keys that none of the parsers recognise. +-- | Top-level keys that none of the parsers recognise. Only the section keys, the +-- tracing keys and the envelope annotations are recognised at the @Configuration@ +-- level; a component's own property names are recognised only under its section, +-- so one placed flat here is reported (and ignored, not resolved). checkUnknownKeys :: Value -> [ConfigWarning] checkUnknownKeys = \case Object o -> @@ -82,48 +73,12 @@ checkUnknownKeys = \case in [UnrecognisedKeys unknown | not (null unknown)] _ -> [] --- | Top-level keys shadowed by a component supplied as its own section: when a --- section key (e.g. @TestingConfig@) is present, that component's keys are read --- from the section, so any sibling top-level key belonging to the same component --- (e.g. a top-level @DijkstraGenesisFile@) is silently ignored. --- --- This looks only at the keys the user wrote in this object; the per-component --- base defaults are merged separately inside --- 'Cardano.Configuration.File.Merge.parseSection' and never appear here, so they --- cannot trigger it. -checkShadowedKeys :: Value -> [ConfigWarning] -checkShadowedKeys = \case - Object o -> - let present = map K.toText (KM.keys o) - shadowed = - [ (section, key) - | (section, keys) <- componentPropertyNames - , section `elem` present - , key <- keys - , key `elem` present - ] - in [ShadowedKeys shadowed | not (null shadowed)] - _ -> [] - --- | Whether the document is in the recommended Version1 envelope form, i.e. has --- the top-level @$schema@, @Version@, @MinNodeVersion@ and @Configuration@ keys. Operates on --- the /raw/ top-level value (before the envelope is split off), unlike the other --- checks here which see the unwrapped configuration object. -checkEnvelope :: Value -> [ConfigWarning] -checkEnvelope = \case - Object o -> - let missing = - [ k | k <- ["$schema", "Version", "MinNodeVersion", "Configuration"], not (KM.member (K.fromText k) o) - ] - in [NotVersion1Envelope missing | not (null missing)] - _ -> [] - --- | Whether the configuration uses the legacy single-file form — i.e. any --- component's keys appear flat at the top level rather than under its section. -checkLegacyFormat :: Value -> [ConfigWarning] -checkLegacyFormat = \case - Object o -> - let present = map K.toText (KM.keys o) - flat = [key | (_, keys) <- componentPropertyNames, key <- keys, key `elem` present] - in [LegacySingleFileFormat | not (null flat)] - _ -> [] +-- | Whether the raw document is in the Version1 format: an object carrying the +-- top-level @Configuration@ envelope. This is the parser's accept\/migrate gate — +-- a document in this form is parsed as-is; one that is not is migrated to it +-- first (see 'MigratedToVersion1'). Operates on the /raw/ top-level value, before +-- the envelope is split off. +inVersion1Format :: Value -> Bool +inVersion1Format = \case + Object o -> KM.member "Configuration" o + _ -> False diff --git a/src/Cardano/Configuration/File/Merge.hs b/src/Cardano/Configuration/File/Merge.hs index 66ed8f8..7b15f33 100644 --- a/src/Cardano/Configuration/File/Merge.hs +++ b/src/Cardano/Configuration/File/Merge.hs @@ -138,15 +138,20 @@ loadBaseDefault section = do then Just <$> decodeValueFile (Just section) fp else pure Nothing --- | The configuration layer the user supplied for a section: the top-level --- object when the section key is absent (its keys live there), an inline object, --- or a referenced sub-file. +-- | The configuration layer the user supplied for a section: an inline object, +-- or a referenced sub-file. A component is read only from its own section key; a +-- section that is absent contributes no user layer (so the component takes its +-- base defaults). Component keys placed flat under @Configuration@ are /not/ +-- resolved into their section — they are left unrecognised (see +-- 'Cardano.Configuration.File.Lint.checkUnknownKeys'). Non-Version1 documents, +-- where the keys are flat, are migrated (grouped into sections) before reaching +-- here. sectionUserLayer :: FilePath -> Value -> String -> IO Value sectionUserLayer root configValue section = case configValue of Object o -> case KM.lookup (K.fromString section) o of - Nothing -> pure configValue + Nothing -> pure (Object KM.empty) Just source -> loadSectionSource root section source _ -> throwIO $ diff --git a/src/Cardano/Configuration/Schema.hs b/src/Cardano/Configuration/Schema.hs index a255f51..65946d0 100644 --- a/src/Cardano/Configuration/Schema.hs +++ b/src/Cardano/Configuration/Schema.hs @@ -292,14 +292,16 @@ schemaRef = ) ] --- | Every top-level configuration key the parsers recognise: the keys of all --- components (read at the top level in the single-file form), the section keys --- used to reference split sub-files, and the envelope keys. Used to detect --- unrecognised (e.g. misspelled) keys. +-- | Every key the parsers recognise at the @Configuration@ level: the section +-- keys (used to reference each component, inline or as a split sub-file), the +-- tracing keys and the envelope keys. Used to detect unrecognised keys (typos, or +-- a component property placed flat here rather than under its section — such a key +-- is reported and ignored, not resolved). A component's own property names are +-- recognised only inside its section, so they are deliberately /not/ listed here. recognisedKeys :: [Text] recognisedKeys = nub $ - envelopeKeys <> sectionKeys <> tracingKeys <> concatMap snd componentPropertyNames + envelopeKeys <> sectionKeys <> tracingKeys where envelopeKeys = ["$schema", "Version", "MinNodeVersion", "Configuration"] sectionKeys = map fst componentPropertyNames diff --git a/test/Main.hs b/test/Main.hs index 1a7278c..670eb9e 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -85,8 +85,9 @@ cases = , parseCase "test/examples/split-all.json" , tracingCase , tracingDefaultParityCase - , shadowWarnCase - , envelopeWarningCase + , misplacedKeyCase + , migrationWarningCase + , migrationErrorCase , splitSubfileSchemaCase , migrateCase , migrateRenameCase @@ -176,47 +177,59 @@ subfilePathConfinementCase = Left (e :: SomeException) -> Just (show e) Right _ -> Nothing --- | A top-level key belonging to a component that is also supplied as its own --- section (here a top-level @DijkstraGenesisFile@ alongside a @TestingConfig@ --- section) is shadowed. Parsing still succeeds, and a 'ShadowedKeys' warning --- naming the offending key is returned for the caller to surface. -shadowWarnCase :: TestTree -shadowWarnCase = - testCase "test/examples/shadow.json (shadowed top-level key returns a warning, still parses)" $ do +-- | A component property placed flat under @Configuration@ (here a +-- @DijkstraGenesisFile@ alongside the @TestingConfig@ section that owns it) is not +-- resolved into that section: it is an unrecognised key. Parsing still succeeds +-- (the component is read from its section) and an 'UnrecognisedKeys' warning names +-- the misplaced key. +misplacedKeyCase :: TestTree +misplacedKeyCase = + testCase "test/examples/shadow.json (a misplaced component key is unrecognised, still parses)" $ do path <- getDataFileName "test/examples/shadow.json" res <- try (parseConfigurationFiles path) expectOk $ case res of Left (e :: SomeException) -> Just (show e) Right (_, warnings) - | any shadowsDijkstra warnings -> Nothing + | any mentionsDijkstra warnings -> Nothing | otherwise -> - Just ("expected a ShadowedKeys warning for DijkstraGenesisFile, got " <> show warnings) + Just ("expected an UnrecognisedKeys warning for DijkstraGenesisFile, got " <> show warnings) where - shadowsDijkstra (ShadowedKeys sks) = - (T.pack "TestingConfig", T.pack "DijkstraGenesisFile") `elem` sks - shadowsDijkstra _ = False - --- | A document not wrapped in the @{ Version, MinNodeVersion, Configuration }@ --- envelope returns a 'NotVersion1Envelope' warning; an enveloped one does not. -envelopeWarningCase :: TestTree -envelopeWarningCase = - testCase "non-enveloped config warns (NotVersion1Envelope); enveloped does not" $ do - flatPath <- getDataFileName "test/examples/split.json" + mentionsDijkstra (UnrecognisedKeys ks) = "DijkstraGenesisFile" `elem` ks + mentionsDijkstra _ = False + +-- | The parser accepts only the Version1 format. A document that is not in it +-- (no top-level @Configuration@ envelope) is migrated to it before parsing and a +-- 'MigratedToVersion1' warning is returned; a document already in the envelope is +-- parsed as-is, with no such warning. +migrationWarningCase :: TestTree +migrationWarningCase = + testCase "non-Version1 config is migrated (warns MigratedToVersion1) and parses; Version1 is not" $ do + legacyPath <- getDataFileName "test/examples/fullconfig.json" envPath <- getDataFileName "test/examples/min-node-version.json" - (_, flatWarnings) <- parseConfigurationFiles flatPath + (_, legacyWarnings) <- parseConfigurationFiles legacyPath (_, envWarnings) <- parseConfigurationFiles envPath expectOk $ - if any isEnvelope flatWarnings && not (any isEnvelope envWarnings) + if MigratedToVersion1 `elem` legacyWarnings && MigratedToVersion1 `notElem` envWarnings then Nothing else Just $ - "expected NotVersion1Envelope only for the non-enveloped config: flat=" - <> show flatWarnings + "expected MigratedToVersion1 only for the non-Version1 config: legacy=" + <> show legacyWarnings <> " enveloped=" <> show envWarnings - where - isEnvelope NotVersion1Envelope{} = True - isEnvelope _ = False + +-- | A document that is not in the Version1 format /and/ whose migration still +-- does not yield a parseable configuration is rejected (the parse error +-- surfaces). Here a legacy document with an ill-typed @ConsensusMode@ migrates to +-- a Version1 envelope, but the component codec then rejects the value. +migrationErrorCase :: TestTree +migrationErrorCase = + testCase "a non-Version1 document whose migration is still unparseable is rejected" $ do + path <- getDataFileName "test/examples/migration-unparseable.json" + res <- try (parseConfigurationFiles path >>= \c -> evaluate (length (show c))) + expectOk $ case res of + Left (_ :: SomeException) -> Nothing + Right _ -> Just "expected a parse error for a document whose migration is unparseable" -- | Each per-component split sub-file declares a @$schema@ pointing to that -- component's schema, and the component schema in turn declares a @$schema@ diff --git a/test/examples/migration-unparseable.json b/test/examples/migration-unparseable.json new file mode 100644 index 0000000..7b23522 --- /dev/null +++ b/test/examples/migration-unparseable.json @@ -0,0 +1,3 @@ +{ + "ConsensusMode": 12345 +} diff --git a/test/examples/shadow.json b/test/examples/shadow.json index 8d7cad6..966bee4 100644 --- a/test/examples/shadow.json +++ b/test/examples/shadow.json @@ -1,10 +1,14 @@ { - "StorageConfig": "storage.json", - "ConsensusConfig": "consensus.json", - "ProtocolConfig": "protocol.json", - "NetworkConfig": "network.json", - "LocalConnectionsConfig": "localconnections.json", - "TestingConfig": "testing.json", - "MempoolConfig": "mempool.json", - "DijkstraGenesisFile": "dijkstra-genesis.json" + "$schema": "https://raw.githubusercontent.com/IntersectMBO/cardano-config/main/schemas/config.schema.json", + "Version": 1, + "Configuration": { + "StorageConfig": "storage.json", + "ConsensusConfig": "consensus.json", + "ProtocolConfig": "protocol.json", + "NetworkConfig": "network.json", + "LocalConnectionsConfig": "localconnections.json", + "TestingConfig": "testing.json", + "MempoolConfig": "mempool.json", + "DijkstraGenesisFile": "dijkstra-genesis.json" + } } From f75f66c9536714bbf50ec23a7f68619691c455ab Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Jul 2026 15:56:08 +0200 Subject: [PATCH 4/6] Drop also other useless keys --- README.md | 19 ++++++++++--------- src/Cardano/Configuration/File/Migrate.hs | 8 +++++++- test/Main.hs | 17 ++++++++++++----- test/examples/legacy-renamed-fields.json | 3 +++ 4 files changed, 32 insertions(+), 15 deletions(-) diff --git a/README.md b/README.md index 26b37af..0b7774f 100644 --- a/README.md +++ b/README.md @@ -58,15 +58,16 @@ renamed (`hardLimit`/`softLimit`/`delay` → `HardLimit`/`SoftLimit`/`Delay`, `EnableRpc`/`RpcSocketPath` → `EnableGrpc`/`GrpcSocketPath`, `TargetNumberOf*` → `DeadlineTargetNumberOf*`) and drops the ones that were removed (`PBftSignatureThreshold`, `LastKnownBlockVersion-Major`/`-Minor`/`-Alt`, now -supplied by consensus defaults). Apart from that it preserves the values as -written and does not fill in defaults, inline referenced sub-files, or read -genesis files; follow it with `resolve` to check the result. - -Unrecognised keys (the vestigial `MaxKnownMajorProtocolVersion`, a stray -`Protocol`, or a typo) are **kept** rather than silently dropped, so nothing is -lost - but they remain unrecognised and so still surface as an -`UnrecognisedKeys` warning on the next parse. Remove them by hand if you want a -warning-free config. +supplied by consensus defaults; the vestigial `Protocol`; and +`MaxKnownMajorProtocolVersion`, a dead key the node never read). Apart from that +it preserves the values as written and does not fill in defaults, inline +referenced sub-files, or read genesis files; follow it with `resolve` to check +the result. + +A genuinely unrecognised key (a typo, say) is **kept** rather than silently +dropped, so nothing is lost - but it remains unrecognised and so still surfaces +as an `UnrecognisedKeys` warning on the next parse. Remove it by hand if you want +a warning-free config. (To port by hand instead: group the component keys under their sections inside `Configuration` and add the `Version` / `MinNodeVersion` envelope. `cardano-config diff --git a/src/Cardano/Configuration/File/Migrate.hs b/src/Cardano/Configuration/File/Migrate.hs index d155988..f04c9d3 100644 --- a/src/Cardano/Configuration/File/Migrate.hs +++ b/src/Cardano/Configuration/File/Migrate.hs @@ -84,13 +84,19 @@ acceptedConnectionsLimitFields = -- | The fields removed in the current series. @migrate@ drops them (they are no -- longer parsed): the Byron @LastKnownBlockVersion-*@ trio and --- @PBftSignatureThreshold@ now come from consensus defaults rather than config. +-- @PBftSignatureThreshold@ now come from consensus defaults rather than config; +-- @Protocol@ is the vestigial protocol selector; and @MaxKnownMajorProtocolVersion@ +-- is a dead key the node never read at all. Unlike a genuine typo (which is kept, +-- so nothing is lost) these are known-obsolete keys, so @migrate@ removes them +-- rather than carry them forward as perpetual unrecognised-key warnings. removedFields :: [Text] removedFields = [ "PBftSignatureThreshold" , "LastKnownBlockVersion-Major" , "LastKnownBlockVersion-Minor" , "LastKnownBlockVersion-Alt" + , "Protocol" + , "MaxKnownMajorProtocolVersion" ] -- | Rewrite renamed keys and drop removed keys, everywhere in the document. diff --git a/test/Main.hs b/test/Main.hs index 670eb9e..f9ba73b 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -271,8 +271,8 @@ splitSubfileSchemaCase = -- | 'migrate' reshapes a legacy flat config into the Version1 envelope: the -- envelope keys appear at the top, each component's flat keys are grouped under --- its section (e.g. ConsensusMode under ConsensusConfig), an unrecognised key --- (MaxKnownMajorProtocolVersion) is kept, and the result is idempotent. +-- its section (e.g. ConsensusMode under ConsensusConfig), a removed key +-- (MaxKnownMajorProtocolVersion) is dropped, and the result is idempotent. migrateCase :: TestTree migrateCase = testCase "migrate test/examples/fullconfig.json (legacy flat -> Version1 envelope)" $ do @@ -291,8 +291,8 @@ migrateCase = Just "ConsensusConfig.ConsensusMode not grouped" | not (nested cfg "StorageConfig" "LedgerDB") -> Just "StorageConfig.LedgerDB not grouped" - | not (KM.member (K.fromString "MaxKnownMajorProtocolVersion") cfg) -> - Just "unrecognised key was dropped (should be kept)" + | KM.member (K.fromString "MaxKnownMajorProtocolVersion") cfg -> + Just "removed key MaxKnownMajorProtocolVersion survived (should be dropped)" | migrate m /= m -> Just "migrate is not idempotent" | otherwise -> Nothing _ -> Just "Configuration is not an object" @@ -308,7 +308,9 @@ migrateCase = -- the /new/ name (a peer target under NetworkConfig, EnableGrpc under -- LocalConnectionsConfig); AcceptedConnectionsLimit's sub-keys are renamed in -- place, but that rename is scoped — a stray @delay@ elsewhere is left alone; --- no removed key survives anywhere; and the result is still idempotent. +-- no removed key survives anywhere (including @Protocol@ and +-- @MaxKnownMajorProtocolVersion@); a genuinely-unrecognised key is kept; and the +-- result is still idempotent. migrateRenameCase :: TestTree migrateRenameCase = testCase "migrate rewrites renamed fields and drops removed ones" $ do @@ -334,6 +336,9 @@ migrateRenameCase = -- The rename is scoped: a stray top-level "delay" is not touched. | not (KM.member (K.fromString "delay") cfg) -> Just "a stray 'delay' outside AcceptedConnectionsLimit was renamed (should be scoped)" + -- A genuinely-unrecognised key (a typo) is kept, not dropped. + | not (KM.member (K.fromString "SomeUnrecognisedKey") cfg) -> + Just "a genuinely-unrecognised key was dropped (should be kept)" | migrate m /= m -> Just "migrate is not idempotent" | otherwise -> Nothing _ -> Just "Configuration is not an object" @@ -344,6 +349,8 @@ migrateRenameCase = , "LastKnownBlockVersion-Major" , "LastKnownBlockVersion-Minor" , "LastKnownBlockVersion-Alt" + , "Protocol" + , "MaxKnownMajorProtocolVersion" ] -- Globally-unique old names that must never survive (the generic -- AcceptedConnectionsLimit sub-keys are checked in place above, since a stray diff --git a/test/examples/legacy-renamed-fields.json b/test/examples/legacy-renamed-fields.json index 99b2c68..d6f6a10 100644 --- a/test/examples/legacy-renamed-fields.json +++ b/test/examples/legacy-renamed-fields.json @@ -3,6 +3,9 @@ "LastKnownBlockVersion-Major": 3, "LastKnownBlockVersion-Minor": 0, "LastKnownBlockVersion-Alt": 0, + "Protocol": "Cardano", + "MaxKnownMajorProtocolVersion": 2, + "SomeUnrecognisedKey": true, "EnableRpc": true, "RpcSocketPath": "/run/node.sock", "TargetNumberOfRootPeers": 60, From 05fb3ff91018a8b627c230216dcde127b31569c3 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 3 Jul 2026 14:43:24 +0200 Subject: [PATCH 5/6] Migrate tracing keys too --- src/Cardano/Configuration/File/Migrate.hs | 65 +++++++++++++++++++---- test/Main.hs | 56 +++++++++++++++++++ 2 files changed, 112 insertions(+), 9 deletions(-) diff --git a/src/Cardano/Configuration/File/Migrate.hs b/src/Cardano/Configuration/File/Migrate.hs index f04c9d3..b2a2cc6 100644 --- a/src/Cardano/Configuration/File/Migrate.hs +++ b/src/Cardano/Configuration/File/Migrate.hs @@ -24,8 +24,13 @@ -- * a flat top-level property key is nested under the component section that -- owns it (e.g. @ConsensusMode@ under @ConsensusConfig@, @LedgerDB@ under -- @StorageConfig@); --- * a section key (whether an inline object or a path to a sub-file), the --- @HermodTracing@ key, and any unrecognised key are kept at the +-- * the flat tracing keys that @trace-dispatcher@'s own parser reads (its +-- legacy format: @TraceOptions@, @TraceOptionForwarder@, …) are gathered into +-- an inline @HermodTracing@ object, and the obsolete keys of the old +-- iohk-monitoring logging system (@setupScribes@, @minSeverity@, … — no longer +-- read by anything) are dropped (see 'tracingLegacyKeys'\/'tracingObsoleteKeys'); +-- * a section key (whether an inline object or a path to a sub-file), an +-- existing @HermodTracing@ key, and any unrecognised key are kept at the -- @Configuration@ level as-is (so nothing is silently dropped); -- * a document already in the envelope is reshaped idempotently. module Cardano.Configuration.File.Migrate @@ -131,6 +136,42 @@ renameTopKeys _ v = v rename :: [(Text, Text)] -> K.Key -> K.Key rename table k = maybe k K.fromText (lookup (K.toText k) table) +-- | The flat top-level tracing keys that @trace-dispatcher@'s own parser reads +-- directly (its \"legacy\" configuration format — see @parseAsLegacy@ in +-- @Cardano.Logging.ConfigurationParser@). These belong inside @HermodTracing@: +-- @migrate@ gathers them into an inline @HermodTracing@ object, which @resolve@ +-- then hands to @trace-dispatcher@ verbatim. @TraceOptions@ is the only one the +-- parser requires; the rest are optional, but all are grouped when present. +tracingLegacyKeys :: [Text] +tracingLegacyKeys = + [ "TraceOptions" + , "TraceOptionForwarder" + , "TraceOptionNodeName" + , "TraceOptionMetricsPrefix" + , "TraceOptionResourceFrequency" + , "TraceOptionLedgerMetricsFrequency" + , "TracePrometheusSimpleRun" + ] + +-- | The obsolete keys of the old iohk-monitoring\/katip logging system, fully +-- superseded by @trace-dispatcher@. Nothing reads them any more (not even the +-- @UseTraceDispatcher@ switch that once selected between the two systems), so +-- @migrate@ drops them. Unlike 'removedFields' these are dropped only at the top +-- level: their names (@options@, @minSeverity@) are too generic to remove +-- wherever they might appear at depth. +tracingObsoleteKeys :: [Text] +tracingObsoleteKeys = + [ "UseTraceDispatcher" + , "TurnOnLogging" + , "TurnOnLogMetrics" + , "defaultBackends" + , "defaultScribes" + , "setupBackends" + , "setupScribes" + , "minSeverity" + , "options" + ] + -- | The structural reshape into the Version1 envelope. A value that is not a -- JSON\/YAML object is returned unchanged. reshape :: Value -> Value @@ -155,14 +196,20 @@ reshape (Object top) = _ -> KM.filterWithKey (\k _ -> K.toText k `notElem` envelopeAnnotations) top -- Group each body key under its component section. A flat property key nests - -- under the section that owns it; a section key, HermodTracing or any - -- unrecognised key stays at the Configuration level as-is. A mixed input (a - -- section object plus some of its flat keys) is deep-merged. + -- under the section that owns it; a flat trace-dispatcher key nests under + -- HermodTracing; an obsolete iohk-monitoring key is dropped; a section key, + -- an existing HermodTracing or any unrecognised key stays at the Configuration + -- level as-is. A mixed input (a section object plus some of its flat keys, or + -- HermodTracing alongside flat tracing keys) is deep-merged. configuration = KM.foldrWithKey place KM.empty body - place k v = - case lookup (K.toText k) propertyToSection of - Just section -> KM.insertWith mergeValues (K.fromText section) (Object (KM.singleton k v)) - Nothing -> KM.insertWith mergeValues k v + place k v + | key `elem` tracingObsoleteKeys = id + | key `elem` tracingLegacyKeys = nestUnder "HermodTracing" + | Just section <- lookup key propertyToSection = nestUnder section + | otherwise = KM.insertWith mergeValues k v + where + key = K.toText k + nestUnder section = KM.insertWith mergeValues (K.fromText section) (Object (KM.singleton k v)) reshape v = v -- | Top-level keys that belong to the envelope, not to the configuration body. diff --git a/test/Main.hs b/test/Main.hs index f9ba73b..98804e2 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -91,6 +91,7 @@ cases = , splitSubfileSchemaCase , migrateCase , migrateRenameCase + , migrateTracingCase , subfilePathConfinementCase , minNodeVersionCase , resolveCase @@ -367,6 +368,61 @@ migrateRenameCase = allKeys (Array a) = concatMap allKeys a allKeys _ = [] +-- | 'migrate' handles the two tracing key families of a legacy flat config: the +-- keys that @trace-dispatcher@'s own parser reads (@TraceOptions@ and friends) +-- are gathered into an inline @HermodTracing@ object under @Configuration@, and +-- the obsolete iohk-monitoring keys (@UseTraceDispatcher@, @minSeverity@, +-- @defaultScribes@, @options@, …) are dropped entirely. The result is idempotent. +migrateTracingCase :: TestTree +migrateTracingCase = + testCase "migrate groups trace-dispatcher keys under HermodTracing and drops obsolete logging keys" $ + expectOk $ case migrate legacyTracing of + m@(Object top) + | any (`elem` obsolete) (allKeys m) -> + Just ("an obsolete logging key survived; keys: " <> show (allKeys m)) + | otherwise -> case KM.lookup (K.fromString "Configuration") top of + Just (Object cfg) -> case KM.lookup (K.fromString "HermodTracing") cfg of + Just (Object h) + | not (all (\k -> KM.member (K.fromString k) h) tracingKeys) -> + Just ("HermodTracing is missing a trace-dispatcher key; has: " <> show (KM.keys h)) + -- The trace-dispatcher keys moved into HermodTracing, not left flat. + | any (\k -> KM.member (K.fromString k) cfg) tracingKeys -> + Just "a trace-dispatcher key was left flat under Configuration" + | migrate m /= m -> Just "migrate is not idempotent" + | otherwise -> Nothing + _ -> Just "HermodTracing was not created as an object" + _ -> Just "Configuration is not an object" + _ -> Just "migrate did not produce an object" + where + -- The trace-dispatcher legacy keys that must end up inside HermodTracing. + tracingKeys = ["TraceOptions", "TraceOptionForwarder", "TraceOptionMetricsPrefix"] + -- The obsolete iohk-monitoring keys that must not survive anywhere. + obsolete = + [ "UseTraceDispatcher" + , "TurnOnLogging" + , "TurnOnLogMetrics" + , "minSeverity" + , "defaultScribes" + , "options" + ] + -- A minimal legacy flat config carrying both tracing families. + legacyTracing = + Object $ + KM.fromList + [ (K.fromString "TraceOptions", Object (KM.fromList [(K.fromString "", Object KM.empty)])) + , (K.fromString "TraceOptionForwarder", Object KM.empty) + , (K.fromString "TraceOptionMetricsPrefix", String (T.pack "cardano.node.metrics.")) + , (K.fromString "UseTraceDispatcher", Bool True) + , (K.fromString "TurnOnLogging", Bool True) + , (K.fromString "TurnOnLogMetrics", Bool True) + , (K.fromString "minSeverity", String (T.pack "Critical")) + , (K.fromString "defaultScribes", Array mempty) + , (K.fromString "options", Object KM.empty) + ] + allKeys (Object o) = map K.toString (KM.keys o) <> concatMap allKeys (KM.elems o) + allKeys (Array a) = concatMap allKeys a + allKeys _ = [] + -- | The optional top-level @MinNodeVersion@ annotation is read from the same -- level as @Version@: from inside the @{ Version, Configuration }@ envelope, and -- — when the document is not enveloped — from the top level alongside the From 994b0cba878df093734a49d113c5f4a25af8733e Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 13 Jul 2026 16:50:56 +0200 Subject: [PATCH 6/6] Address Damian's comments --- app/Main.hs | 4 +- src/Cardano/Configuration/File.hs | 23 +-- src/Cardano/Configuration/File/Lint.hs | 54 ++++--- src/Cardano/Configuration/File/Migrate.hs | 120 +++++++++++---- test/Main.hs | 180 ++++++++++++++++++++-- 5 files changed, 306 insertions(+), 75 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 8cdb288..b860f27 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -181,7 +181,9 @@ runMigrate path = handleAny (die . displayException) $ do raw <- case path of "-" -> BS.getContents >>= decodeThrow _ -> decodeValueFile Nothing path - dump (migrate raw) + let (migrated, warnings) = migrate raw + for_ warnings $ hPutStrLn stderr . ("Warning: " <>) . renderConfigWarning + dump migrated -- | Resolve a configuration and print it as YAML. runResolve :: CliArgs -> GenesisRendering -> IO () diff --git a/src/Cardano/Configuration/File.hs b/src/Cardano/Configuration/File.hs index e965ee3..fe02743 100644 --- a/src/Cardano/Configuration/File.hs +++ b/src/Cardano/Configuration/File.hs @@ -55,7 +55,6 @@ import Cardano.Configuration.File.Error (ConfigurationParsingError (..)) import Cardano.Configuration.File.Lint ( ConfigWarning (..) , configWarnings - , inVersion1Format , renderConfigWarning ) import Cardano.Configuration.File.Mempool @@ -186,16 +185,18 @@ parseConfigurationFiles :: HasCallStack => FilePath -> IO (NodeConfigurationFromFile, [ConfigWarning]) parseConfigurationFiles cfgFile = do rawValue <- decodeValueFile Nothing cfgFile - -- The parser accepts only the Version1 format (a top-level @Configuration@ - -- envelope). A document that is not in it is not parsed as-is: it is migrated - -- to the Version1 format first — with a 'MigratedToVersion1' warning — and the - -- result is parsed. If that migrated document still cannot be parsed, the parse - -- error surfaces as usual (so a non-Version1 document whose migration does not - -- yield a parseable configuration is rejected). - let (mainValue, migrationWarnings) = - if inVersion1Format rawValue - then (rawValue, []) - else (migrate rawValue, [MigratedToVersion1]) + -- Every document is run through 'migrate' before parsing, so an already-enveloped + -- configuration that still uses a pre-rename field name (or carries a stray + -- top-level sibling) is brought up to the current shape too — not only a + -- non-enveloped one. Migration is idempotent, so a configuration already in the + -- canonical form is left untouched; a 'MigratedToCurrentFormat' warning is raised + -- only when migration actually changed the document (@migrated /= rawValue@, an + -- order-independent comparison). 'migrate' also returns its own warnings for the + -- fields it had to reconcile. If the migrated document still cannot be parsed, the + -- parse error surfaces as usual. + let (mainValue, migrateWarnings) = migrate rawValue + migrationWarnings = + [MigratedToCurrentFormat | mainValue /= rawValue] <> migrateWarnings (version, minNodeVer, configValue) <- splitEnvelope mainValue let warnings = migrationWarnings <> configWarnings configValue root = takeDirectory cfgFile diff --git a/src/Cardano/Configuration/File/Lint.hs b/src/Cardano/Configuration/File/Lint.hs index afc7ae6..2a211f1 100644 --- a/src/Cardano/Configuration/File/Lint.hs +++ b/src/Cardano/Configuration/File/Lint.hs @@ -9,7 +9,6 @@ module Cardano.Configuration.File.Lint , renderConfigWarning , configWarnings , checkUnknownKeys - , inVersion1Format ) where import Cardano.Configuration.Schema (recognisedKeys) @@ -17,6 +16,8 @@ import Data.Aeson (Value (..)) import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.List (intercalate) +import Data.Text (Text) +import qualified Data.Text as T -- | A non-fatal observation about a configuration. Returned by the parser so the -- caller decides how to surface it (the @cardano-config@ executable prints them @@ -27,11 +28,21 @@ data ConfigWarning -- placed flat under @Configuration@ instead of under its section. They are -- ignored (not resolved into a section). UnrecognisedKeys [String] - | -- | The document was not in the Version1 format (no top-level @Configuration@ - -- envelope), so the parser did not accept it as-is: it was migrated to the - -- Version1 format (see @Cardano.Configuration.File.Migrate.migrate@) before - -- parsing. Run @cardano-config migrate@ to update the file on disk. - MigratedToVersion1 + | -- | The document was not in the current canonical format, so migrating it (see + -- @Cardano.Configuration.File.Migrate.migrate@) changed it before parsing — + -- either it was not in the Version1 envelope, or it still used a pre-rename + -- field name, or it carried an obsolete key. Run @cardano-config migrate@ to + -- update the file on disk. + MigratedToCurrentFormat + | -- | While migrating, both the old and the current name of a renamed field + -- were present at the same level (@(old, new)@). The value under the current + -- name is kept and the one under the old name is dropped. Reconcile the two by + -- hand if the dropped value was the one you meant to keep. + RenamedKeyCollision Text Text + | -- | While migrating, a key appeared both as a top-level sibling of the + -- @Configuration@ envelope and inside it. The value inside @Configuration@ (the + -- canonical location) is kept and the top-level one is dropped. + EnvelopeKeyCollision Text | -- | A consistency check of warning severity did not hold on the resolved -- configuration (e.g. the Mithril snapshot policy under the V2LSM backend -- without an @LSMExportPath@). The configuration is still accepted; the @@ -45,10 +56,25 @@ renderConfigWarning :: ConfigWarning -> String renderConfigWarning = \case UnrecognisedKeys ks -> "unrecognised configuration key(s): " <> intercalate ", " ks <> " (ignored)" - MigratedToVersion1 -> - "the configuration was not in the Version1 format (no top-level Configuration envelope); " - <> "it was migrated to the Version1 format before parsing " + MigratedToCurrentFormat -> + "the configuration was not in the current canonical format; " + <> "it was migrated before parsing " <> "(run `cardano-config migrate` to update the file)" + RenamedKeyCollision old new -> + "both the old key \"" + <> T.unpack old + <> "\" and its current name \"" + <> T.unpack new + <> "\" are present; keeping \"" + <> T.unpack new + <> "\" and dropping \"" + <> T.unpack old + <> "\"" + EnvelopeKeyCollision key -> + "the key \"" + <> T.unpack key + <> "\" appears both at the top level and inside Configuration; " + <> "keeping the value inside Configuration" ConsistencyWarning msg -> msg -- | All warnings for an (unwrapped) configuration object. @@ -72,13 +98,3 @@ checkUnknownKeys = \case let unknown = [K.toString k | k <- KM.keys o, K.toText k `notElem` recognisedKeys] in [UnrecognisedKeys unknown | not (null unknown)] _ -> [] - --- | Whether the raw document is in the Version1 format: an object carrying the --- top-level @Configuration@ envelope. This is the parser's accept\/migrate gate — --- a document in this form is parsed as-is; one that is not is migrated to it --- first (see 'MigratedToVersion1'). Operates on the /raw/ top-level value, before --- the envelope is split off. -inVersion1Format :: Value -> Bool -inVersion1Format = \case - Object o -> KM.member "Configuration" o - _ -> False diff --git a/src/Cardano/Configuration/File/Migrate.hs b/src/Cardano/Configuration/File/Migrate.hs index b2a2cc6..c38bb9b 100644 --- a/src/Cardano/Configuration/File/Migrate.hs +++ b/src/Cardano/Configuration/File/Migrate.hs @@ -20,7 +20,8 @@ -- dropped, at every depth (so the grouping below, which keys off the current -- names, places them correctly); -- * @$schema@ (the published schema URL) and @Version@ (1) are added when --- absent; an existing @Version@\/@MinNodeVersion@ is carried through. +-- absent; an existing @$schema@\/@Version@\/@MinNodeVersion@ is carried through +-- (so a pinned @$schema@ URL is not clobbered); -- * a flat top-level property key is nested under the component section that -- owns it (e.g. @ConsensusMode@ under @ConsensusConfig@, @LedgerDB@ under -- @StorageConfig@); @@ -32,11 +33,18 @@ -- * a section key (whether an inline object or a path to a sub-file), an -- existing @HermodTracing@ key, and any unrecognised key are kept at the -- @Configuration@ level as-is (so nothing is silently dropped); +-- * a top-level sibling of an existing @Configuration@ envelope (e.g. a stray +-- @ByronGenesisFile@) is merged into the body and regrouped, not dropped; if it +-- collides with a key already inside @Configuration@ the enveloped value wins +-- and an 'EnvelopeKeyCollision' warning is raised; +-- * where both the old and the current name of a renamed field are present the +-- current name wins, with a 'RenamedKeyCollision' warning; -- * a document already in the envelope is reshaped idempotently. module Cardano.Configuration.File.Migrate ( migrate ) where +import Cardano.Configuration.File.Lint (ConfigWarning (..)) import Cardano.Configuration.File.Merge (mergeValues) import Cardano.Configuration.Schema (componentPropertyNames, schemaId) import Data.Aeson (Value (..)) @@ -45,13 +53,19 @@ import qualified Data.Aeson.KeyMap as KM import Data.Maybe (fromMaybe) import Data.Text (Text) --- | Migrate a raw configuration value to the Version1 envelope. A value that is --- not a JSON\/YAML object is returned unchanged. +-- | Migrate a raw configuration value to the Version1 envelope, together with the +-- non-fatal 'ConfigWarning's raised while doing so (a renamed field colliding with +-- its current name, or a top-level sibling colliding with a key inside the +-- envelope). A value that is not a JSON\/YAML object is returned unchanged, with no +-- warnings. -- -- Renames and removals are applied first (recursively, over the whole document) -- so that the subsequent structural grouping sees only current names. -migrate :: Value -> Value -migrate = reshape . renameLegacy +migrate :: Value -> (Value, [ConfigWarning]) +migrate value = + let (renamed, renameWarnings) = renameLegacy value + (reshaped, reshapeWarnings) = reshape renamed + in (reshaped, renameWarnings <> reshapeWarnings) -- | The field renames introduced in the current key-naming series, as -- @(old, new)@. The parser only accepts the new names; @migrate@ rewrites the @@ -104,26 +118,43 @@ removedFields = , "MaxKnownMajorProtocolVersion" ] --- | Rewrite renamed keys and drop removed keys, everywhere in the document. --- Recurses through objects and arrays; leaves scalars unchanged. The generic +-- | Rewrite renamed keys and drop removed keys, everywhere in the document, +-- accumulating a 'RenamedKeyCollision' warning wherever both the old and the +-- current name of a renamed field sit in the same object. Recurses through objects +-- and arrays; leaves scalars unchanged. The generic -- 'acceptedConnectionsLimitFields' are rewritten only within an -- @AcceptedConnectionsLimit@ object, not wherever those names happen to appear. -renameLegacy :: Value -> Value +renameLegacy :: Value -> (Value, [ConfigWarning]) renameLegacy (Object o) = - Object - . KM.fromList - . map rekey - . filter (\(k, _) -> K.toText k `notElem` removedFields) - $ KM.toList o + (Object (KM.fromList pairs), collisionWarnings <> concatMap snd rekeyed) where - rekey (k, v) = (rename renamedFields k, scoped k (renameLegacy v)) + present = [K.toText k | (k, _) <- KM.toList o] + -- A rename whose target already exists here: keep the (current-name) value that + -- is already present, drop the old-name one, and warn. Without this, KM.fromList + -- below would keep whichever the list order happened to put last. + collisions = [(old, new) | (old, new) <- renamedFields, old `elem` present, new `elem` present] + collidingOld = map fst collisions + collisionWarnings = [RenamedKeyCollision old new | (old, new) <- collisions] + + -- The surviving entries (old names that collide are dropped, removed keys too), + -- each recursed into and rekeyed. + rekeyed = + [ rekey (k, v) + | (k, v) <- KM.toList o + , K.toText k `notElem` removedFields + , K.toText k `notElem` collidingOld + ] + pairs = map fst rekeyed + rekey (k, v) = let (v', w) = renameLegacy v in ((rename renamedFields k, scoped k v'), w) -- Inside an AcceptedConnectionsLimit object, also rewrite its (generic) direct -- sub-keys; the recursion above has already handled any deeper nesting. scoped k v | K.toText k == "AcceptedConnectionsLimit" = renameTopKeys acceptedConnectionsLimitFields v | otherwise = v -renameLegacy (Array a) = Array (fmap renameLegacy a) -renameLegacy v = v +renameLegacy (Array a) = + let results = fmap renameLegacy a + in (Array (fmap fst results), foldMap snd results) +renameLegacy v = (v, []) -- | Apply a rename table to the direct keys of an object (only), leaving -- non-objects and unlisted keys unchanged. @@ -173,27 +204,41 @@ tracingObsoleteKeys = ] -- | The structural reshape into the Version1 envelope. A value that is not a --- JSON\/YAML object is returned unchanged. -reshape :: Value -> Value +-- JSON\/YAML object is returned unchanged (with no warnings). +reshape :: Value -> (Value, [ConfigWarning]) reshape (Object top) = - Object $ - KM.insert "$schema" (String (schemaId "config.schema.json")) $ - KM.insert "Version" version $ - withMinNodeVersion $ - KM.singleton "Configuration" (Object configuration) + ( Object $ + KM.insert "$schema" schemaValue $ + KM.insert "Version" version $ + withMinNodeVersion $ + KM.singleton "Configuration" (Object configuration) + , collisionWarnings + ) where + -- Carry an existing $schema through (so a user's pinned schema URL survives), + -- otherwise default to the published one on the main branch. + schemaValue = fromMaybe (String (schemaId "config.schema.json")) (KM.lookup "$schema" top) -- Carry an existing Version, otherwise default to the current format (1). version = fromMaybe (Number 1) (KM.lookup "Version" top) -- Carry MinNodeVersion through if present; never invent one (it has no -- default, and its absence is itself a useful warning on the next parse). withMinNodeVersion = maybe id (KM.insert "MinNodeVersion") (KM.lookup "MinNodeVersion" top) - -- The configuration body: an already-enveloped document's Configuration - -- object, or (for a legacy\/non-enveloped document) the top-level object - -- minus the envelope annotations. - body = case KM.lookup "Configuration" top of + -- The configuration body is the union of an already-enveloped document's + -- Configuration object with the top-level keys that are not envelope + -- annotations (a legacy\/non-enveloped document has no Configuration object, so + -- the body is just those top-level keys). Nothing at the top level is dropped: + -- a stray sibling such as @ByronGenesisFile@ is folded into the body and then + -- regrouped under its section, rather than discarded. + envelopeBody = case KM.lookup "Configuration" top of Just (Object c) -> c - _ -> KM.filterWithKey (\k _ -> K.toText k `notElem` envelopeAnnotations) top + _ -> KM.empty + siblings = KM.filterWithKey (\k _ -> K.toText k `notElem` envelopeAnnotations) top + -- On a key present both as a sibling and inside Configuration, the value inside + -- Configuration (the right\/\"later\" argument) wins; warn about the drop. + body = KM.unionWith mergeValues siblings envelopeBody + collisionWarnings = + [EnvelopeKeyCollision (K.toText k) | k <- KM.keys siblings, k `KM.member` envelopeBody] -- Group each body key under its component section. A flat property key nests -- under the section that owns it; a flat trace-dispatcher key nests under @@ -206,11 +251,24 @@ reshape (Object top) = | key `elem` tracingObsoleteKeys = id | key `elem` tracingLegacyKeys = nestUnder "HermodTracing" | Just section <- lookup key propertyToSection = nestUnder section - | otherwise = KM.insertWith mergeValues k v + | otherwise = keepFlat where key = K.toText k - nestUnder section = KM.insertWith mergeValues (K.fromText section) (Object (KM.singleton k v)) -reshape v = v + keepFlat = KM.insertWith mergeValues k v + -- Nest a flat property under its target section, unless that section is + -- already present as a non-object — a path to a sub-file. Merging an inline + -- key into a file reference would silently drop the key (a file path is not an + -- object, so 'mergeValues' would keep the path and lose the value), so in that + -- case the property is kept at the Configuration level instead, where it + -- surfaces as an unrecognised-key warning on the next parse rather than being + -- lost. When the section is absent (a purely flat document) or an inline + -- object, the property nests as normal. + nestUnder section = case KM.lookup (K.fromText section) body of + Just v' | not (isObject v') -> keepFlat + _ -> KM.insertWith mergeValues (K.fromText section) (Object (KM.singleton k v)) + isObject Object{} = True + isObject _ = False +reshape v = (v, []) -- | Top-level keys that belong to the envelope, not to the configuration body. envelopeAnnotations :: [Text] diff --git a/test/Main.hs b/test/Main.hs index 98804e2..48b3a64 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -92,6 +92,10 @@ cases = , migrateCase , migrateRenameCase , migrateTracingCase + , migrateSiblingCase + , migrateEnvelopeCollisionCase + , migrateEnvelopedRenameCase + , migrateRenameCollisionCase , subfilePathConfinementCase , minNodeVersionCase , resolveCase @@ -133,6 +137,11 @@ expectOk = maybe (pure ()) assertFailure decodeData :: FromJSON a => FilePath -> IO (Either String a) decodeData p = getDataFileName p >>= eitherDecodeFileStrict' +-- | Build a JSON object from string-keyed pairs (test convenience, mirroring the +-- @KM.fromList . map (first K.fromString)@ used by the inline fixtures). +obj :: [(String, Value)] -> Value +obj = Object . KM.fromList . map (\(k, v) -> (K.fromString k, v)) + -- | Decode a single example via its 'FromJSON' instance, forcing the result. decodeCase :: Show a => String -> IO (Either String a) -> TestTree decodeCase label act = @@ -198,23 +207,23 @@ misplacedKeyCase = mentionsDijkstra (UnrecognisedKeys ks) = "DijkstraGenesisFile" `elem` ks mentionsDijkstra _ = False --- | The parser accepts only the Version1 format. A document that is not in it --- (no top-level @Configuration@ envelope) is migrated to it before parsing and a --- 'MigratedToVersion1' warning is returned; a document already in the envelope is --- parsed as-is, with no such warning. +-- | Every document is migrated before parsing. One that migration changes (here a +-- legacy flat config, reshaped into the envelope) yields a 'MigratedToCurrentFormat' +-- warning; one already in the canonical form (an enveloped config with current +-- field names) migrates to itself and so does not warn. migrationWarningCase :: TestTree migrationWarningCase = - testCase "non-Version1 config is migrated (warns MigratedToVersion1) and parses; Version1 is not" $ do + testCase "a config that migration changes warns MigratedToCurrentFormat; a canonical one does not" $ do legacyPath <- getDataFileName "test/examples/fullconfig.json" envPath <- getDataFileName "test/examples/min-node-version.json" (_, legacyWarnings) <- parseConfigurationFiles legacyPath (_, envWarnings) <- parseConfigurationFiles envPath expectOk $ - if MigratedToVersion1 `elem` legacyWarnings && MigratedToVersion1 `notElem` envWarnings + if MigratedToCurrentFormat `elem` legacyWarnings && MigratedToCurrentFormat `notElem` envWarnings then Nothing else Just $ - "expected MigratedToVersion1 only for the non-Version1 config: legacy=" + "expected MigratedToCurrentFormat only for the non-canonical config: legacy=" <> show legacyWarnings <> " enveloped=" <> show envWarnings @@ -280,7 +289,7 @@ migrateCase = res <- decodeData "test/examples/fullconfig.json" :: IO (Either String Value) expectOk $ case res of Left err -> Just ("could not read fixture: " <> err) - Right raw -> case migrate raw of + Right raw -> case fst (migrate raw) of m@(Object top) | not (all (`KM.member` top) (map K.fromString envelopeKeys)) -> Just ("missing envelope keys; got " <> show (KM.keys top)) @@ -294,7 +303,7 @@ migrateCase = Just "StorageConfig.LedgerDB not grouped" | KM.member (K.fromString "MaxKnownMajorProtocolVersion") cfg -> Just "removed key MaxKnownMajorProtocolVersion survived (should be dropped)" - | migrate m /= m -> Just "migrate is not idempotent" + | fst (migrate m) /= m -> Just "migrate is not idempotent" | otherwise -> Nothing _ -> Just "Configuration is not an object" _ -> Just "migrate did not produce an object" @@ -318,7 +327,7 @@ migrateRenameCase = res <- decodeData "test/examples/legacy-renamed-fields.json" :: IO (Either String Value) expectOk $ case res of Left err -> Just ("could not read fixture: " <> err) - Right raw -> case migrate raw of + Right raw -> case fst (migrate raw) of m@(Object top) | any (`elem` removed) (allKeys m) -> Just ("a removed key survived; keys: " <> show (allKeys m)) @@ -340,7 +349,7 @@ migrateRenameCase = -- A genuinely-unrecognised key (a typo) is kept, not dropped. | not (KM.member (K.fromString "SomeUnrecognisedKey") cfg) -> Just "a genuinely-unrecognised key was dropped (should be kept)" - | migrate m /= m -> Just "migrate is not idempotent" + | fst (migrate m) /= m -> Just "migrate is not idempotent" | otherwise -> Nothing _ -> Just "Configuration is not an object" _ -> Just "migrate did not produce an object" @@ -376,7 +385,7 @@ migrateRenameCase = migrateTracingCase :: TestTree migrateTracingCase = testCase "migrate groups trace-dispatcher keys under HermodTracing and drops obsolete logging keys" $ - expectOk $ case migrate legacyTracing of + expectOk $ case fst (migrate legacyTracing) of m@(Object top) | any (`elem` obsolete) (allKeys m) -> Just ("an obsolete logging key survived; keys: " <> show (allKeys m)) @@ -388,7 +397,7 @@ migrateTracingCase = -- The trace-dispatcher keys moved into HermodTracing, not left flat. | any (\k -> KM.member (K.fromString k) cfg) tracingKeys -> Just "a trace-dispatcher key was left flat under Configuration" - | migrate m /= m -> Just "migrate is not idempotent" + | fst (migrate m) /= m -> Just "migrate is not idempotent" | otherwise -> Nothing _ -> Just "HermodTracing was not created as an object" _ -> Just "Configuration is not an object" @@ -423,6 +432,151 @@ migrateTracingCase = allKeys (Array a) = concatMap allKeys a allKeys _ = [] +-- | 'migrate' does not drop a top-level sibling of an existing @Configuration@ +-- envelope: a stray @ByronGenesisFile@ next to the envelope is folded into the +-- body and regrouped under its owning section (@ProtocolConfig@), and the pre-existing +-- @StorageConfig@ section is preserved. (Regression test for the reviewer's +-- "enveloped file drops its siblings" concern.) +migrateSiblingCase :: TestTree +migrateSiblingCase = + testCase "migrate keeps a top-level sibling of the Configuration envelope (regroups, not drops)" $ + expectOk $ case migrate input of + (Object top, warnings) + | not (null warnings) -> Just ("expected no warnings, got " <> show warnings) + | otherwise -> case KM.lookup (K.fromString "Configuration") top of + Just (Object cfg) + | not (nested cfg "ProtocolConfig" "ByronGenesisFile") -> + Just "the sibling ByronGenesisFile was dropped, not regrouped under ProtocolConfig" + | not (KM.member (K.fromString "StorageConfig") cfg) -> + Just "the pre-existing StorageConfig section was lost" + | otherwise -> Nothing + _ -> Just "Configuration is not an object" + _ -> Just "migrate did not produce an object" + where + input = + obj + [ ("Version", Number 1) + , ("Configuration", obj [("StorageConfig", String (T.pack "storage.json"))]) + , ("ByronGenesisFile", String (T.pack "byron.json")) + ] + nested cfg section key = case KM.lookup (K.fromString section) cfg of + Just (Object s) -> KM.member (K.fromString key) s + _ -> False + +-- | When a key appears both as a top-level sibling and inside the @Configuration@ +-- envelope, 'migrate' keeps the value inside @Configuration@ (the canonical +-- location) and raises an 'EnvelopeKeyCollision' warning naming the key. +migrateEnvelopeCollisionCase :: TestTree +migrateEnvelopeCollisionCase = + testCase + "migrate resolves a sibling/Configuration collision in favour of Configuration (with a warning)" + $ expectOk + $ case migrate input of + (Object top, warnings) + | EnvelopeKeyCollision (T.pack "MempoolConfig") `notElem` warnings -> + Just ("expected an EnvelopeKeyCollision for MempoolConfig, got " <> show warnings) + | otherwise -> case KM.lookup (K.fromString "Configuration") top of + Just (Object cfg) -> case KM.lookup (K.fromString "MempoolConfig") cfg of + Just (Object m) + | KM.lookup (K.fromString "MempoolCapacityOverride") m /= Just (Number 100) -> + Just + ( "the Configuration value (100) should win, got " + <> show (KM.lookup (K.fromString "MempoolCapacityOverride") m) + ) + | otherwise -> Nothing + _ -> Just "MempoolConfig is not an object" + _ -> Just "Configuration is not an object" + _ -> Just "migrate did not produce an object" + where + input = + obj + [ ("Configuration", obj [("MempoolConfig", obj [("MempoolCapacityOverride", Number 100)])]) + , ("MempoolConfig", obj [("MempoolCapacityOverride", Number 999)]) + ] + +-- | 'migrate' rewrites a pre-rename field name even when the document is /already/ +-- enveloped (the parser used to skip migration for enveloped documents, so an +-- enveloped @EnableRpc@ silently reverted to its default). It also carries an +-- existing @$schema@ through unchanged, rather than clobbering a user's pinned URL. +-- (Regression test for the reviewer's "enveloped legacy fields skipped" and +-- "unconditional schema replacement" concerns.) +migrateEnvelopedRenameCase :: TestTree +migrateEnvelopedRenameCase = + testCase "migrate renames fields inside an existing envelope and carries $schema through" $ + expectOk $ case migrate input of + (m@(Object top), _) + | KM.lookup (K.fromString "$schema") top /= Just pinnedSchema -> + Just + ("the pinned $schema was not carried through, got " <> show (KM.lookup (K.fromString "$schema") top)) + | "EnableRpc" `elem` allKeys m -> + Just "the old name EnableRpc survived the rename" + | otherwise -> case KM.lookup (K.fromString "Configuration") top of + Just (Object cfg) + | not (nested cfg "LocalConnectionsConfig" "EnableGrpc") -> + Just "EnableRpc was not renamed to EnableGrpc under LocalConnectionsConfig" + | otherwise -> Nothing + _ -> Just "Configuration is not an object" + (m, _) -> Just ("migrate did not produce an object: " <> show m) + where + pinnedSchema = String (T.pack "https://example.com/pinned/config.schema.json") + input = + obj + [ ("$schema", pinnedSchema) + , ("Version", Number 1) + , ("Configuration", obj [("LocalConnectionsConfig", obj [("EnableRpc", Bool True)])]) + ] + nested cfg section key = case KM.lookup (K.fromString section) cfg of + Just (Object s) -> KM.member (K.fromString key) s + _ -> False + allKeys (Object o) = map K.toString (KM.keys o) <> concatMap allKeys (KM.elems o) + allKeys (Array a) = concatMap allKeys a + allKeys _ = [] + +-- | When both the old and the current name of a renamed field sit in the same +-- object, 'migrate' keeps the current-name value (deterministically, not by +-- iteration order), drops the old-name one, and raises a 'RenamedKeyCollision' +-- warning. (Regression test for the reviewer's "key collision during renames" +-- concern.) +migrateRenameCollisionCase :: TestTree +migrateRenameCollisionCase = + testCase "migrate keeps the current name on an old/new rename collision (with a warning)" $ + expectOk $ case migrate input of + (Object top, warnings) + | expectedWarning `notElem` warnings -> + Just ("expected a RenamedKeyCollision warning, got " <> show warnings) + | otherwise -> case KM.lookup (K.fromString "Configuration") top of + Just (Object cfg) -> case KM.lookup (K.fromString "NetworkConfig") cfg of + Just (Object n) + | KM.member (K.fromString "TargetNumberOfRootPeers") n -> + Just "the old name TargetNumberOfRootPeers survived (should be dropped)" + | KM.lookup (K.fromString "DeadlineTargetNumberOfRootPeers") n /= Just (Number 2) -> + Just + ( "the current-name value (2) should win, got " + <> show (KM.lookup (K.fromString "DeadlineTargetNumberOfRootPeers") n) + ) + | otherwise -> Nothing + _ -> Just "NetworkConfig is not an object" + _ -> Just "Configuration is not an object" + _ -> Just "migrate did not produce an object" + where + expectedWarning = + RenamedKeyCollision (T.pack "TargetNumberOfRootPeers") (T.pack "DeadlineTargetNumberOfRootPeers") + input = + obj + [ + ( "Configuration" + , obj + [ + ( "NetworkConfig" + , obj + [ ("TargetNumberOfRootPeers", Number 1) + , ("DeadlineTargetNumberOfRootPeers", Number 2) + ] + ) + ] + ) + ] + -- | The optional top-level @MinNodeVersion@ annotation is read from the same -- level as @Version@: from inside the @{ Version, Configuration }@ envelope, and -- — when the document is not enveloped — from the top level alongside the