From 449b526f381961398b6c8007ce29203851e48a10 Mon Sep 17 00:00:00 2001 From: Alexander Esgen Date: Wed, 4 Dec 2024 19:05:59 +0100 Subject: [PATCH] Optionally support lightweight checkpointing see the PR description for details --- .../Cardano/TxGenerator/Setup/NodeConfig.hs | 6 +- cardano-node/cardano-node.cabal | 1 + .../src/Cardano/Node/Configuration/POM.hs | 9 ++ cardano-node/src/Cardano/Node/Protocol.hs | 4 +- .../src/Cardano/Node/Protocol/Cardano.hs | 16 ++- .../src/Cardano/Node/Protocol/Checkpoints.hs | 114 ++++++++++++++++++ cardano-node/src/Cardano/Node/Types.hs | 38 +++++- cardano-testnet/src/Testnet/Types.hs | 2 +- 8 files changed, 181 insertions(+), 9 deletions(-) create mode 100644 cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs index 6e6e97c37e3..ee62e2aa914 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs @@ -42,15 +42,15 @@ getGenesis (SomeConsensusProtocol CardanoBlockType proto) getGenesisPath :: NodeConfiguration -> Maybe GenesisFile getGenesisPath nodeConfig = case ncProtocolConfig nodeConfig of - NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ -> + NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ _ -> Just $ npcShelleyGenesisFile shelleyConfig mkConsensusProtocol :: NodeConfiguration -> IO (Either TxGenError SomeConsensusProtocol) mkConsensusProtocol nodeConfig = case ncProtocolConfig nodeConfig of - NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig -> + NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig checkpointsConfig -> first ProtocolError - <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig Nothing) + <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig checkpointsConfig Nothing) -- | Creates a NodeConfiguration from a config file; -- the result is devoid of any keys/credentials diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index c2f8e5c5873..654d1803d9f 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -82,6 +82,7 @@ library Cardano.Node.Protocol.Alonzo Cardano.Node.Protocol.Byron Cardano.Node.Protocol.Cardano + Cardano.Node.Protocol.Checkpoints Cardano.Node.Protocol.Conway Cardano.Node.Protocol.Shelley Cardano.Node.Protocol.Types diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 3ce3341e431..50ead3b098b 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -289,6 +289,7 @@ instance FromJSON PartialNodeConfiguration where <*> parseAlonzoProtocol v <*> parseConwayProtocol v <*> parseHardForkProtocol v + <*> parseCheckpoints v pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v -- Network timeouts @@ -489,6 +490,14 @@ instance FromJSON PartialNodeConfiguration where , npcTestConwayHardForkAtVersion } + parseCheckpoints v = do + npcCheckpointsFile <- v .:? "CheckpointsFile" + npcCheckpointsFileHash <- v .:? "CheckpointsFileHash" + pure NodeCheckpointsConfiguration + { npcCheckpointsFile + , npcCheckpointsFileHash + } + -- | Default configuration is mainnet defaultPartialNodeConfiguration :: PartialNodeConfiguration defaultPartialNodeConfiguration = diff --git a/cardano-node/src/Cardano/Node/Protocol.hs b/cardano-node/src/Cardano/Node/Protocol.hs index fff927b6776..8fff29fdad0 100644 --- a/cardano-node/src/Cardano/Node/Protocol.hs +++ b/cardano-node/src/Cardano/Node/Protocol.hs @@ -30,7 +30,8 @@ mkConsensusProtocol ncProtocolConfig mProtocolFiles = shelleyConfig alonzoConfig conwayConfig - hardForkConfig -> + hardForkConfig + checkpointsConfig -> firstExceptT CardanoProtocolInstantiationError $ mkSomeConsensusProtocolCardano byronConfig @@ -38,6 +39,7 @@ mkConsensusProtocol ncProtocolConfig mProtocolFiles = alonzoConfig conwayConfig hardForkConfig + checkpointsConfig mProtocolFiles ------------------------------------------------------------------------------ diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index caa24132d04..910ed295274 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -23,6 +23,7 @@ import qualified Cardano.Ledger.Api.Transition as Ledger import Cardano.Ledger.BaseTypes (natVersion) import qualified Cardano.Node.Protocol.Alonzo as Alonzo import qualified Cardano.Node.Protocol.Byron as Byron +import Cardano.Node.Protocol.Checkpoints import qualified Cardano.Node.Protocol.Conway as Conway import qualified Cardano.Node.Protocol.Shelley as Shelley import Cardano.Node.Protocol.Types @@ -34,7 +35,6 @@ import qualified Ouroboros.Consensus.Cardano as Consensus import qualified Ouroboros.Consensus.Cardano.CanHardFork as Consensus import Ouroboros.Consensus.Cardano.Condense () import qualified Ouroboros.Consensus.Cardano.Node as Consensus -import Ouroboros.Consensus.Config (emptyCheckpointsMap) import Ouroboros.Consensus.HardFork.Combinator.Condense () import Prelude @@ -61,6 +61,7 @@ mkSomeConsensusProtocolCardano -> NodeAlonzoProtocolConfiguration -> NodeConwayProtocolConfiguration -> NodeHardForkProtocolConfiguration + -> NodeCheckpointsConfiguration -> Maybe ProtocolFilepaths -> ExceptT CardanoProtocolInstantiationError IO SomeConsensusProtocol mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { @@ -103,6 +104,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { npcTestConwayHardForkAtEpoch, npcTestConwayHardForkAtVersion } + checkpointsConfiguration files = do byronGenesis <- firstExceptT CardanoProtocolInstantiationErrorByron $ @@ -140,6 +142,10 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $ Shelley.readLeaderCredentials files + checkpointsMap <- + firstExceptT CardanoProtocolInstantiationCheckpointsReadError $ + readCheckpointsMap checkpointsConfiguration + return $! SomeConsensusProtocol CardanoBlockType $ ProtocolInfoArgsCardano $ Consensus.CardanoProtocolParams { Consensus.byronProtocolParams = @@ -234,8 +240,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { (maybe 9 fromIntegral npcTestConwayHardForkAtVersion) Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo } - -- TODO: once https://github.com/IntersectMBO/cardano-node/issues/5730 is implemented 'emptyCheckpointsMap' needs to be replaced with the checkpoints map read from a configuration file. - , Consensus.cardanoCheckpoints = emptyCheckpointsMap + , Consensus.cardanoCheckpoints = checkpointsMap } ---------------------------------------------------------------------- @@ -265,6 +270,9 @@ data CardanoProtocolInstantiationError = | CardanoProtocolInstantiationErrorAlonzo Alonzo.AlonzoProtocolInstantiationError + + | CardanoProtocolInstantiationCheckpointsReadError + CheckpointsReadError deriving Show instance Error CardanoProtocolInstantiationError where @@ -280,3 +288,5 @@ instance Error CardanoProtocolInstantiationError where prettyError err prettyError (CardanoProtocolInstantiationErrorAlonzo err) = prettyError err + prettyError (CardanoProtocolInstantiationCheckpointsReadError err) = + prettyError err diff --git a/cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs b/cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs new file mode 100644 index 00000000000..9d91789e01d --- /dev/null +++ b/cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | Configuration for lightweight checkpointing. +module Cardano.Node.Protocol.Checkpoints + ( CheckpointsReadError(..) + , readCheckpointsMap + ) where + +import Cardano.Api + +import qualified Cardano.Crypto.Hash.Class as Crypto +import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Node.Types +import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Cardano +import Ouroboros.Consensus.Config (CheckpointsMap (..), emptyCheckpointsMap) + +import Control.Exception (IOException) +import Control.Monad (forM, unless, when) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.Foldable (forM_) +import qualified Data.Map.Strict as Map +import Data.Set (Set) +import qualified Data.Set as Set +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + +data CheckpointsReadError = + CheckpointsReadFileError !FilePath !IOException + | CheckpointsHashMismatch + !FilePath + -- | Actual + !CheckpointsHash + -- | Expected + !CheckpointsHash + | CheckpointsDecodeError !FilePath !String + deriving Show + +instance Error CheckpointsReadError where + prettyError (CheckpointsReadFileError fp err) = + "There was an error reading the checkpoints file: " + <> pshow fp <> " Error: " <> pshow err + + prettyError (CheckpointsHashMismatch fp actual expected) = + "Hash mismatch for checkpoints file " <> pshow fp <> ": " + <> "the actual hash is " <> pshow actual <> ", but the expected " + <> "hash given in the node configuration file is " <> pshow expected + + prettyError (CheckpointsDecodeError fp err) = + "There was an error parsing the checkpoints file: " + <> pshow fp <> " Error: " <> pshow err + +readCheckpointsMap + :: NodeCheckpointsConfiguration + -> ExceptT CheckpointsReadError IO (CheckpointsMap (CardanoBlock StandardCrypto)) +readCheckpointsMap NodeCheckpointsConfiguration { + npcCheckpointsFile, + npcCheckpointsFileHash = mExpectedHash + } = case npcCheckpointsFile of + Nothing -> pure emptyCheckpointsMap + Just (CheckpointsFile file) -> do + content <- handleIOExceptT (CheckpointsReadFileError file) $ BS.readFile file + + let actualHash = CheckpointsHash $ Crypto.hashWith id content + forM_ mExpectedHash $ \expectedHash -> + when (actualHash /= expectedHash) $ + throwError (CheckpointsHashMismatch file actualHash expectedHash) + + WrapCheckpointsMap checkpointsMap <- + firstExceptT (CheckpointsDecodeError file) $ hoistEither $ + Aeson.eitherDecodeStrict' content + pure checkpointsMap + +newtype WrapCheckpointsMap = + WrapCheckpointsMap (CheckpointsMap (CardanoBlock StandardCrypto)) + +instance Aeson.FromJSON WrapCheckpointsMap where + parseJSON = Aeson.withObject "CheckpointsMap" $ \o -> do + checkpointList :: [Aeson.Object] <- o Aeson..: "checkpoints" + + checkpoints :: [(BlockNo, HeaderHash (CardanoBlock StandardCrypto))] <- + forM checkpointList $ \c -> do + bno <- c Aeson..: "blockNo" + hash <- parseCardanoHash =<< c Aeson..: "hash" + pure (bno, hash) + + let duplicates :: Set BlockNo + duplicates = + Map.keysSet $ Map.filter (> 1) $ Map.fromListWith (+) $ + (\(bno, _) -> (bno, 1 :: Int)) <$> checkpoints + unless (Set.null duplicates) $ + fail $ "Duplicate checkpoints for block numbers " + <> show (Set.toList duplicates) + + pure $ WrapCheckpointsMap $ CheckpointsMap $ Map.fromList checkpoints + where + parseCardanoHash + :: Aeson.Value + -> Aeson.Parser (HeaderHash (CardanoBlock StandardCrypto)) + parseCardanoHash = Aeson.withText "CheckpointHash" $ \t -> + case B16.decode $ Text.encodeUtf8 t of + Right h -> do + when (BS.length h /= fromIntegral (hashSize p)) $ + fail $ "Invalid hash size for " <> Text.unpack t + pure $ fromRawHash p h + Left e -> + fail $ "Invalid base16 for " <> Text.unpack t <> ": " <> e + where + p = Proxy @(CardanoBlock StandardCrypto) diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index 87cc9c72685..b173dbebc12 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -14,8 +14,10 @@ module Cardano.Node.Types , ConfigYamlFilePath(..) , DbFile(..) , GenesisFile(..) + , CheckpointsFile(..) , ProtocolFilepaths (..) , GenesisHash(..) + , CheckpointsHash(..) , MaxConcurrencyBulkSync(..) , MaxConcurrencyDeadline(..) -- * Networking @@ -29,6 +31,7 @@ module Cardano.Node.Types , NodeShelleyProtocolConfiguration(..) , NodeAlonzoProtocolConfiguration(..) , NodeConwayProtocolConfiguration(..) + , NodeCheckpointsConfiguration(..) , VRFPrivateKeyFilePermissionError(..) , renderVRFPrivateKeyFilePermissionError ) where @@ -38,6 +41,7 @@ import Cardano.Api import Cardano.Crypto (RequiresNetworkMagic (..)) import qualified Cardano.Crypto.Hash as Crypto import Cardano.Node.Configuration.Socket (SocketConfig (..)) +import Cardano.Node.Orphans () import Ouroboros.Network.NodeToNode (DiffusionMode (..)) import Control.Exception @@ -85,6 +89,16 @@ instance FromJSON GenesisFile where parseJSON invalid = fail $ "Parsing of GenesisFile failed due to type mismatch. " <> "Encountered: " <> show invalid +newtype CheckpointsFile = CheckpointsFile + { unCheckpointsFile :: FilePath } + deriving stock (Eq, Ord) + deriving newtype (IsString, Show) + +instance FromJSON CheckpointsFile where + parseJSON (String genFp) = pure . CheckpointsFile $ Text.unpack genFp + parseJSON invalid = fail $ "Parsing of CheckpointsFile failed due to type mismatch. " + <> "Encountered: " <> show invalid + newtype MaxConcurrencyBulkSync = MaxConcurrencyBulkSync { unMaxConcurrencyBulkSync :: Word } deriving stock (Eq, Ord) @@ -129,6 +143,9 @@ data ProtocolFilepaths = newtype GenesisHash = GenesisHash (Crypto.Hash Crypto.Blake2b_256 ByteString) deriving newtype (Eq, Show, ToJSON, FromJSON) +newtype CheckpointsHash = CheckpointsHash (Crypto.Hash Crypto.Blake2b_256 ByteString) + deriving newtype (Eq, Show, ToJSON, FromJSON) + data NodeProtocolConfiguration = NodeProtocolConfigurationCardano NodeByronProtocolConfiguration @@ -136,6 +153,7 @@ data NodeProtocolConfiguration = NodeAlonzoProtocolConfiguration NodeConwayProtocolConfiguration NodeHardForkProtocolConfiguration + NodeCheckpointsConfiguration deriving (Eq, Show) data NodeShelleyProtocolConfiguration = @@ -287,6 +305,14 @@ data NodeHardForkProtocolConfiguration = } deriving (Eq, Show) +-- | See 'Ouroboros.Consensus.Config.CheckpointsMap'. +data NodeCheckpointsConfiguration = + NodeCheckpointsConfiguration { + npcCheckpointsFile :: !(Maybe CheckpointsFile) + , npcCheckpointsFileHash :: !(Maybe CheckpointsHash) + } + deriving (Eq, Show) + -- | Find the starting era for the test network, if it was configured. -- -- Starting eras have zero defined as a forking epoch. So here we're taking the last zeroed configuration value. @@ -344,13 +370,14 @@ newtype TopologyFile = TopologyFile deriving newtype (Show, Eq) instance AdjustFilePaths NodeProtocolConfiguration where - adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pca pcc pch) = + adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pca pcc pch pccp) = NodeProtocolConfigurationCardano (adjustFilePaths f pcb) (adjustFilePaths f pcs) (adjustFilePaths f pca) (adjustFilePaths f pcc) pch + (adjustFilePaths f pccp) instance AdjustFilePaths NodeByronProtocolConfiguration where adjustFilePaths f x@NodeByronProtocolConfiguration { @@ -376,6 +403,12 @@ instance AdjustFilePaths NodeConwayProtocolConfiguration where } = x { npcConwayGenesisFile = adjustFilePaths f npcConwayGenesisFile } +instance AdjustFilePaths NodeCheckpointsConfiguration where + adjustFilePaths f x@NodeCheckpointsConfiguration { + npcCheckpointsFile + } = + x { npcCheckpointsFile = adjustFilePaths f npcCheckpointsFile } + instance AdjustFilePaths SocketConfig where adjustFilePaths f x@SocketConfig{ncSocketPath} = x { ncSocketPath = fmap (mapFile f) ncSocketPath } @@ -383,6 +416,9 @@ instance AdjustFilePaths SocketConfig where instance AdjustFilePaths GenesisFile where adjustFilePaths f (GenesisFile p) = GenesisFile (f p) +instance AdjustFilePaths CheckpointsFile where + adjustFilePaths f (CheckpointsFile p) = CheckpointsFile (f p) + instance AdjustFilePaths a => AdjustFilePaths (Maybe a) where adjustFilePaths f = fmap (adjustFilePaths f) diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs index f5fd5ad3341..60294a875ed 100644 --- a/cardano-testnet/src/Testnet/Types.hs +++ b/cardano-testnet/src/Testnet/Types.hs @@ -194,7 +194,7 @@ getStartTime getStartTime tempRootPath TestnetRuntime{configurationFile} = withFrozenCallStack $ H.evalEither <=< H.evalIO . runExceptT $ do byronGenesisFile <- decodeNodeConfiguration configurationFile >>= \case - NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ -> + NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ _ -> pure $ unGenesisFile npcByronGenesisFile let byronGenesisFilePath = tempRootPath byronGenesisFile G.gdStartTime . G.configGenesisData <$> decodeGenesisFile byronGenesisFilePath