Add "Mithril" named LedgerDB configuration

Author: geo2a

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -48,7 +48,7 @@ import           Ouroboros.Consensus.Node.Genesis (GenesisConfig, GenesisConfigF
 import           Ouroboros.Consensus.Storage.LedgerDB.Args (QueryBatchSize (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots (NumOfDiskSnapshots (..),
                    SnapshotDelayRange (..), SnapshotFrequency (..), SnapshotFrequencyArgs (..),
-                   SnapshotPolicyArgs (..), defaultSnapshotPolicyArgs)
+                   SnapshotPolicyArgs (..), defaultSnapshotPolicyArgs, mithrilSnapshotPolicyArgs)
 import           Ouroboros.Consensus.Util.Args (OverrideOrDefault (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.V1.Args (FlushFrequency (..))
 import           Ouroboros.Network.Diffusion.Configuration as Configuration
@@ -547,8 +547,16 @@ instance FromJSON PartialNodeConfiguration where
 
              mSnapshotsVal <- o .:? "Snapshots"
              spArgs <- case mSnapshotsVal of
-               Nothing -> parseSnapshotOpts o
+               -- A named snapshot policy selects a predefined set of snapshot
+               -- policy arguments as a whole.
+               Just (String name) -> case name of
+                 "Mithril" -> pure mithrilSnapshotPolicyArgs
+                 _ -> fail $ "Unknown named ledger snapshot policy: " <> Text.unpack name
+                          <> ". Expected \"Mithril\" or an object with snapshot options."
+               -- the modern case of the snapshot policy specified under the "Snapshots" key
                Just sv -> flip (withObject "Snapshots") sv parseSnapshotOpts
+               -- the legacy case of the snapshot policy specified at the top-level
+               Nothing -> parseSnapshotOpts o
 
              qsize           <- (fmap RequestedQueryBatchSize <$> o .:? "QueryBatchSize") .!= DefaultQueryBatchSize
              backend         <- o .:? "Backend" .!= "V2InMemory"

cardano-node/test/Test/Cardano/Node/POM.hs

@@ -23,7 +23,8 @@ import           Cardano.Rpc.Server.Config (makeRpcConfig)
 import           Ouroboros.Consensus.Node (NodeDatabasePaths (..))
 import           Ouroboros.Consensus.Node.Genesis (disableGenesisConfig)
 import           Ouroboros.Consensus.Storage.LedgerDB.Args
-import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots (defaultSnapshotPolicyArgs)
+import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots (defaultSnapshotPolicyArgs,
+                   mithrilSnapshotPolicyArgs)
 import           Ouroboros.Network.Block (SlotNo (..))
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import           Ouroboros.Network.TxSubmission.Inbound.V2.Types
@@ -316,17 +317,31 @@ prop_legacySnapshotFormat_POM =
     legacyConfig :: PartialNodeConfiguration <- evalEither $ eitherDecode legacyJson
     newConfig    :: PartialNodeConfiguration <- evalEither $ eitherDecode newJson
     pncLedgerDbConfig legacyConfig === pncLedgerDbConfig newConfig
-  where
-    dummyRequiredValues :: LBS.ByteString
-    dummyRequiredValues = mconcat
-      [ "\"ByronGenesisFile\": \"x\""
-      , ", \"ShelleyGenesisFile\": \"x\""
-      , ", \"AlonzoGenesisFile\": \"x\""
-      , ", \"ConwayGenesisFile\": \"x\""
-      , ", \"LastKnownBlockVersion-Major\": 0"
-      , ", \"LastKnownBlockVersion-Minor\": 0"
-      , ", \"LastKnownBlockVersion-Alt\": 0"
-      ]
+
+-- | Test that the named \"Mithril\" snapshot policy selects
+-- 'mithrilSnapshotPolicyArgs' as a whole.
+prop_mithrilSnapshotPolicy_POM :: Property
+prop_mithrilSnapshotPolicy_POM =
+  withTests 1 . Hedgehog.property $ do
+    let json = "{ " <> dummyRequiredValues <> ", "
+          <> "\"LedgerDB\": {"
+          <> "  \"Backend\": \"V2InMemory\","
+          <> "  \"Snapshots\": \"Mithril\""
+          <> "} }"
+    config :: PartialNodeConfiguration <- evalEither $ eitherDecode json
+    getLast (pncLedgerDbConfig config) ===
+      Just (LedgerDbConfiguration mithrilSnapshotPolicyArgs DefaultQueryBatchSize V2InMemory noDeprecatedOptions)
+
+dummyRequiredValues :: LBS.ByteString
+dummyRequiredValues = mconcat
+  [ "\"ByronGenesisFile\": \"x\""
+  , ", \"ShelleyGenesisFile\": \"x\""
+  , ", \"AlonzoGenesisFile\": \"x\""
+  , ", \"ConwayGenesisFile\": \"x\""
+  , ", \"LastKnownBlockVersion-Major\": 0"
+  , ", \"LastKnownBlockVersion-Minor\": 0"
+  , ", \"LastKnownBlockVersion-Alt\": 0"
+  ]
 
 -- -----------------------------------------------------------------------------
 

configuration/cardano/mainnet-config.yaml

@@ -88,6 +88,8 @@ LedgerDB:
   # QueryUTxOByAddress), the store will be read in batches of this size.
   QueryBatchSize: 100000
 
+  # Instead of an object with individual options, a predefined snapshot
+  # policy can be selected by name, e.g. `Snapshots: Mithril`.
   Snapshots:
     # The time interval between snapshots, in seconds.
     SnapshotInterval: 4320