diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 6d49261dae5..8c4e156a477 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -153,6 +153,7 @@ library , cardano-ledger-allegra , cardano-ledger-api , cardano-ledger-babbage + , cardano-ledger-binary , cardano-ledger-byron , cardano-ledger-conway , cardano-ledger-core @@ -163,6 +164,7 @@ library , cborg ^>= 0.2.4 , containers , contra-tracer + , data-default-class , deepseq , directory , dns diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index d9ff4255aad..0cb4a22c2ef 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -427,7 +427,7 @@ instance FromJSON PartialNodeConfiguration where } parseConwayProtocol v = do - npcConwayGenesisFile <- v .: "ConwayGenesisFile" + npcConwayGenesisFile <- v .:? "ConwayGenesisFile" npcConwayGenesisFileHash <- v .:? "ConwayGenesisHash" pure NodeConwayProtocolConfiguration { npcConwayGenesisFile diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index 7544a1738c3..eb954339fa6 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -40,6 +40,8 @@ import qualified Ouroboros.Consensus.Shelley.Node.Praos as Praos import Prelude +import Data.Maybe + ------------------------------------------------------------------------------ -- Real Cardano protocol -- @@ -128,8 +130,8 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { (conwayGenesis, _conwayGenesisHash) <- firstExceptT CardanoProtocolInstantiationConwayGenesisReadError $ - Conway.readGenesis npcConwayGenesisFile - npcConwayGenesisFileHash + Conway.readGenesisMaybe npcConwayGenesisFile + npcConwayGenesisFileHash shelleyLeaderCredentials <- firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $ @@ -239,9 +241,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { -- -- If Conway is enabled, this is the Conway protocol version. Praos.conwayProtVer = - if npcExperimentalHardForksEnabled - then ProtVer (natVersion @10) 0 - else ProtVer (natVersion @8) 0, + if isNothing npcConwayGenesisFile + then ProtVer (natVersion @8) 0 + else if npcExperimentalHardForksEnabled + then ProtVer (natVersion @10) 0 + else ProtVer (natVersion @8) 0, Praos.conwayMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure } diff --git a/cardano-node/src/Cardano/Node/Protocol/Conway.hs b/cardano-node/src/Cardano/Node/Protocol/Conway.hs index 83a7c532e04..1136c2e7c7b 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Conway.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Conway.hs @@ -1,16 +1,26 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Node.Protocol.Conway ( ConwayProtocolInstantiationError(..) -- * Reusable parts , readGenesis + , readGenesisMaybe , validateGenesis ) where import Cardano.Api +import qualified Cardano.Crypto.Hash.Class as Crypto +import Cardano.Ledger.BaseTypes +import qualified Cardano.Ledger.Binary as L +import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import qualified Cardano.Ledger.Conway.Genesis as Conway +import Cardano.Ledger.Conway.PParams +import qualified Cardano.Ledger.Plutus.CostModels as L +import qualified Cardano.Ledger.Plutus.Language as L import Cardano.Node.Orphans () import Cardano.Node.Protocol.Shelley (GenesisReadError, readGenesisAny) import Cardano.Node.Types @@ -18,10 +28,82 @@ import Cardano.Tracing.OrphanInstances.HardFork () import Cardano.Tracing.OrphanInstances.Shelley () import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) +import qualified Data.ByteString.Lazy as LB +import qualified Data.Default.Class as DefaultClass +import Data.Functor.Identity (Identity (..)) +import Data.Int +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Word + -- -- Conway genesis -- +-- The Conway genesis values are not going to be ready in time for +-- cardano-node 9.0. Therefore when the conway genesis file is not set +-- we will restrict the max protocol version to 8 and use a dummy conway +-- genesis value. This will prevent an unintentional hardfork. +readGenesisMaybe :: Maybe GenesisFile + -> Maybe GenesisHash + -> ExceptT GenesisReadError IO + (Conway.ConwayGenesis StandardCrypto, GenesisHash) +readGenesisMaybe (Just genFp) mHash = readGenesis genFp mHash +readGenesisMaybe Nothing _ = do + case L.mkCostModelsLenient plutusV3CostModel >>= Map.lookup L.PlutusV3 . L.costModelsValid of + Nothing -> error "readGenesisMaybe: missing PlutusV3 cost model in default cost models." + Just cm -> do + let protocolVerson = L.natVersion @8 -- For empty conway genesis we stay in Babbage (protocol version 8) + conwayGenesis = emptyConwayGenesis cm + genesisHash = GenesisHash (Crypto.hashWith id $ LB.toStrict $ L.serialize protocolVerson conwayGenesis) + return (conwayGenesis, genesisHash) + +plutusV3CostModel :: Map Word8 [Int64] +plutusV3CostModel = Map.singleton 2 plutusV3ExampleValues + +plutusV3ExampleValues :: [Int64] +plutusV3ExampleValues = + [ 205665, 812, 1, 1, 1000, 571, 0, 1, 1000, 24177, 4, 1, 1000, 32, 117366, 10475 + , 4, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 100 + , 100, 23000, 100, 19537, 32, 175354, 32, 46417, 4, 221973, 511, 0, 1, 89141, 32 + , 497525, 14068, 4, 2, 196500, 453240, 220, 0, 1, 1, 1000, 28662, 4, 2, 245000 + , 216773, 62, 1, 1060367, 12586, 1, 208512, 421, 1, 187000, 1000, 52998, 1, 80436 + , 32, 43249, 32, 1000, 32, 80556, 1, 57667, 4, 1000, 10, 197145, 156, 1, 197145 + , 156, 1, 204924, 473, 1, 208896, 511, 1, 52467, 32, 64832, 32, 65493, 32, 22558 + , 32, 16563, 32, 76511, 32, 196500, 453240, 220, 0, 1, 1, 69522, 11687, 0, 1, 60091 + , 32, 196500, 453240, 220, 0, 1, 1, 196500, 453240, 220, 0, 1, 1, 1159724, 392670 + , 0, 2, 806990, 30482, 4, 1927926, 82523, 4, 265318, 0, 4, 0, 85931, 32, 205665, 812 + , 1, 1, 41182, 32, 212342, 32, 31220, 32, 32696, 32, 43357, 32, 32247, 32, 38314, 32 + , 35190005, 10, 57996947, 18975, 10, 39121781, 32260, 10, 23000, 100, 23000, 100, 832808 + , 18, 3209094, 6, 331451, 1, 65990684, 23097, 18, 114242, 18, 94393407, 87060, 18, 16420089 + , 18, 2145798, 36, 3795345, 12, 889023, 1, 204237282, 23271, 36, 129165, 36, 189977790 + , 85902, 36, 33012864, 36, 388443360, 1, 401885761, 72, 2331379, 72, 1927926, 82523 + , 4, 117366, 10475, 4, 1292075, 24469, 74, 0, 1, 936157, 49601, 237, 0, 1 + ] +emptyConwayGenesis :: L.CostModel -> ConwayGenesis StandardCrypto +emptyConwayGenesis cm = + let upgradePParamsDef :: (UpgradeConwayPParams Identity) -- TODO: need to define values + -- the default instance is for StrictMaybe + upgradePParamsDef = UpgradeConwayPParams + { ucppPoolVotingThresholds = DefaultClass.def + , ucppDRepVotingThresholds = DefaultClass.def + , ucppCommitteeMinSize = 0 + , ucppCommitteeMaxTermLength = EpochInterval 0 + , ucppGovActionLifetime = EpochInterval 0 + , ucppGovActionDeposit = 0 + , ucppDRepDeposit = 0 + , ucppDRepActivity = EpochInterval 0 + , ucppMinFeeRefScriptCostPerByte = minBound + , ucppPlutusV3CostModel = cm + } + in ConwayGenesis { cgUpgradePParams = upgradePParamsDef + , cgConstitution = DefaultClass.def + , cgCommittee = DefaultClass.def + , cgDelegs = mempty + , cgInitialDReps = mempty + } + + readGenesis :: GenesisFile -> Maybe GenesisHash -> ExceptT GenesisReadError IO diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index a6a2b20a7c5..6bc31de9d6a 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -150,7 +150,10 @@ data NodeAlonzoProtocolConfiguration = data NodeConwayProtocolConfiguration = NodeConwayProtocolConfiguration { - npcConwayGenesisFile :: !GenesisFile + npcConwayGenesisFile :: !(Maybe GenesisFile) + -- ^ If no conway genesis file is provided, we want + -- to enforce a maximum protocol version of 8 to avoid + -- a permanent hard fork. , npcConwayGenesisFileHash :: !(Maybe GenesisHash) } deriving (Eq, Show) diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index 20d8c99119f..2e16d22037d 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -75,7 +75,7 @@ testNodeAlonzoProtocolConfiguration = testNodeConwayProtocolConfiguration :: NodeConwayProtocolConfiguration testNodeConwayProtocolConfiguration = NodeConwayProtocolConfiguration - { npcConwayGenesisFile = GenesisFile "dummmy-genesis-file" + { npcConwayGenesisFile = Just $ GenesisFile "dummmy-genesis-file" , npcConwayGenesisFileHash = Nothing }