diff --git a/ouroboros-consensus-cardano-test/test/Test/ThreadNet/Cardano.hs b/ouroboros-consensus-cardano-test/test/Test/ThreadNet/Cardano.hs index f972caf19c3..87a09da052e 100644 --- a/ouroboros-consensus-cardano-test/test/Test/ThreadNet/Cardano.hs +++ b/ouroboros-consensus-cardano-test/test/Test/ThreadNet/Cardano.hs @@ -751,26 +751,26 @@ mkProtocolCardanoAndHardForkTxs , byronSoftwareVersion = softVerByron , byronLeaderCredentials = Just leaderCredentialsByron } + ProtocolParamsShelleyBased { + shelleyBasedGenesis = genesisShelley + , shelleyBasedInitialNonce = initialNonce + , shelleyBasedLeaderCredentials = Just leaderCredentialsShelley + } ProtocolParamsShelley { - shelleyGenesis = genesisShelley - , shelleyInitialNonce = initialNonce - , shelleyProtVer = SL.ProtVer shelleyMajorVersion 0 - , shelleyLeaderCredentials = Just leaderCredentialsShelley + shelleyProtVer = SL.ProtVer shelleyMajorVersion 0 } ProtocolParamsAllegra { - allegraProtVer = SL.ProtVer allegraMajorVersion 0 - , allegraLeaderCredentials = Nothing + allegraProtVer = SL.ProtVer allegraMajorVersion 0 } ProtocolParamsMary { - maryProtVer = SL.ProtVer maryMajorVersion 0 - , maryLeaderCredentials = Nothing + maryProtVer = SL.ProtVer maryMajorVersion 0 } protocolParamsByronShelley ProtocolParamsTransition { - transitionTrigger = TriggerHardForkAtVersion allegraMajorVersion + transitionTrigger = TriggerHardForkAtVersion allegraMajorVersion } ProtocolParamsTransition { - transitionTrigger = TriggerHardForkAtVersion maryMajorVersion + transitionTrigger = TriggerHardForkAtVersion maryMajorVersion } -- Byron diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs index 1df49960f92..650d2f24877 100644 --- a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs +++ b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs @@ -89,15 +89,17 @@ data Protocol (m :: Type -> Type) blk p where -- | Run TPraos against the real Shelley ledger ProtocolShelley - :: ProtocolParamsShelley StandardCrypto [] + :: ProtocolParamsShelleyBased StandardShelley [] + -> ProtocolParamsShelley -> Protocol m (ShelleyBlockHFC StandardShelley) ProtocolShelley -- | Run the protocols of /the/ Cardano block ProtocolCardano :: ProtocolParamsByron - -> ProtocolParamsShelley StandardCrypto Maybe - -> ProtocolParamsAllegra StandardCrypto Maybe - -> ProtocolParamsMary StandardCrypto Maybe + -> ProtocolParamsShelleyBased StandardShelley Maybe + -> ProtocolParamsShelley + -> ProtocolParamsAllegra + -> ProtocolParamsMary -> ProtocolParamsTransition ByronBlock (ShelleyBlock StandardShelley) @@ -124,11 +126,12 @@ protocolInfo :: forall m blk p. IOLike m protocolInfo (ProtocolByron params) = inject $ protocolInfoByron params -protocolInfo (ProtocolShelley params) = - inject $ protocolInfoShelley params +protocolInfo (ProtocolShelley paramsShelleyBased paramsShelley) = + inject $ protocolInfoShelley paramsShelleyBased paramsShelley protocolInfo (ProtocolCardano paramsByron + paramsShelleyBased paramsShelley paramsAllegra paramsMary @@ -137,6 +140,7 @@ protocolInfo (ProtocolCardano paramsAllegraMary) = protocolInfoCardano paramsByron + paramsShelleyBased paramsShelley paramsAllegra paramsMary diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs index 8653444c36f..c01fa23df63 100644 --- a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs +++ b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -41,7 +42,7 @@ import Control.Exception (assert) import qualified Data.ByteString.Short as Short import qualified Data.Map.Strict as Map import Data.Maybe (maybeToList) -import Data.SOP.Strict (K (..), NP (..), NS (..)) +import Data.SOP.Strict (K (..), NP (..), NS (..), unComp) import Data.Word (Word16) import Cardano.Binary (DecoderError (..), enforceSize) @@ -329,9 +330,10 @@ data ProtocolParamsTransition eraFrom eraTo = ProtocolParamsTransition { protocolInfoCardano :: forall c m. (IOLike m, CardanoHardForkConstraints c) => ProtocolParamsByron - -> ProtocolParamsShelley c Maybe - -> ProtocolParamsAllegra c Maybe - -> ProtocolParamsMary c Maybe + -> ProtocolParamsShelleyBased (ShelleyEra c) Maybe + -> ProtocolParamsShelley + -> ProtocolParamsAllegra + -> ProtocolParamsMary -> ProtocolParamsTransition ByronBlock (ShelleyBlock (ShelleyEra c)) @@ -346,28 +348,28 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron { byronGenesis = genesisByron , byronLeaderCredentials = mCredsByron } + ProtocolParamsShelleyBased { + shelleyBasedGenesis = genesisShelley + , shelleyBasedInitialNonce = initialNonceShelley + , shelleyBasedLeaderCredentials = mCredsShelleyBased + } ProtocolParamsShelley { - shelleyGenesis = genesisShelley - , shelleyInitialNonce = initialNonceShelley - , shelleyProtVer = protVerShelley - , shelleyLeaderCredentials = mCredsShelley + shelleyProtVer = protVerShelley } ProtocolParamsAllegra { - allegraProtVer = protVerAllegra - , allegraLeaderCredentials = mCredsAllegra + allegraProtVer = protVerAllegra } ProtocolParamsMary { - maryProtVer = protVerMary - , maryLeaderCredentials = mCredsMary + maryProtVer = protVerMary } ProtocolParamsTransition { - transitionTrigger = triggerHardForkByronShelley + transitionTrigger = triggerHardForkByronShelley } ProtocolParamsTransition { - transitionTrigger = triggerHardForkShelleyAllegra + transitionTrigger = triggerHardForkShelleyAllegra } ProtocolParamsTransition { - transitionTrigger = triggerHardForkAllegraMary + transitionTrigger = triggerHardForkAllegraMary } = assertWithMsg (validateGenesis genesisShelley) $ ProtocolInfo { @@ -382,23 +384,26 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron { WrapChainDepState $ headerStateChainDep initHeaderStateByron } - , pInfoBlockForging = sequence $ mconcat [ - [ return $ hardForkBlockForging $ Z $ byronBlockForging credsByron - | credsByron <- maybeToList mCredsByron - ] - , [ hardForkBlockForging . S . Z - <$> shelleyBlockForging tpraosParams credsShelley - | credsShelley <- maybeToList mCredsShelley - ] - , [ hardForkBlockForging . S . S . Z - <$> shelleyBlockForging tpraosParams credsAllegra - | credsAllegra <- maybeToList mCredsAllegra - ] - , [ hardForkBlockForging . S . S . S . Z - <$> shelleyBlockForging tpraosParams credsMary - | credsMary <- maybeToList mCredsMary - ] - ] + , pInfoBlockForging = do + let blockForgingByron = + [ hardForkBlockForging $ Z $ byronBlockForging creds + | creds <- maybeToList mCredsByron + ] + blockForgingShelleyBased <- case mCredsShelleyBased of + Nothing -> return [] + Just credsShelleyBased -> do + sharedBlockForgings <- + shelleySharedBlockForging + (Proxy @'[ShelleyEra c, AllegraEra c, MaryEra c]) + tpraosParams + credsShelleyBased + case sharedBlockForgings of + bfShelley :* bfAllegra :* bfMary :* Nil -> return [ + hardForkBlockForging $ S $ Z $ unComp bfShelley + , hardForkBlockForging $ S $ S $ Z $ unComp bfAllegra + , hardForkBlockForging $ S $ S $ S $ Z $ unComp bfMary + ] + return $ blockForgingByron <> blockForgingShelleyBased } where -- The major protocol version of the last era is the maximum major protocol @@ -445,7 +450,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron { Shelley.mkShelleyBlockConfig protVerShelley genesisShelley - (tpraosBlockIssuerVKey <$> maybeToList mCredsShelley) + (tpraosBlockIssuerVKey <$> maybeToList mCredsShelleyBased) partialConsensusConfigShelley :: PartialConsensusConfig (BlockProtocol (ShelleyBlock (ShelleyEra c))) @@ -471,7 +476,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron { Shelley.mkShelleyBlockConfig protVerAllegra genesisAllegra - (tpraosBlockIssuerVKey <$> maybeToList mCredsAllegra) + (tpraosBlockIssuerVKey <$> maybeToList mCredsShelleyBased) partialConsensusConfigAllegra :: PartialConsensusConfig (BlockProtocol (ShelleyBlock (AllegraEra c))) @@ -494,7 +499,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron { Shelley.mkShelleyBlockConfig protVerMary genesisMary - (tpraosBlockIssuerVKey <$> maybeToList mCredsMary) + (tpraosBlockIssuerVKey <$> maybeToList mCredsShelleyBased) partialConsensusConfigMary :: PartialConsensusConfig (BlockProtocol (ShelleyBlock (MaryEra c))) diff --git a/ouroboros-consensus-cardano/tools/db-analyser/Block/Cardano.hs b/ouroboros-consensus-cardano/tools/db-analyser/Block/Cardano.hs index fbd26bd2fc7..3274dce82c6 100644 --- a/ouroboros-consensus-cardano/tools/db-analyser/Block/Cardano.hs +++ b/ouroboros-consensus-cardano/tools/db-analyser/Block/Cardano.hs @@ -97,28 +97,28 @@ mkCardanoProtocolInfo genesisByron signatureThreshold genesisShelley initialNonc , byronSoftwareVersion = Byron.Update.SoftwareVersion (Byron.Update.ApplicationName "db-analyser") 2 , byronLeaderCredentials = Nothing } + ProtocolParamsShelleyBased { + shelleyBasedGenesis = genesisShelley + , shelleyBasedInitialNonce = initialNonce + , shelleyBasedLeaderCredentials = Nothing + } ProtocolParamsShelley { - shelleyGenesis = genesisShelley - , shelleyInitialNonce = initialNonce - , shelleyProtVer = ProtVer 2 0 - , shelleyLeaderCredentials = Nothing + shelleyProtVer = ProtVer 2 0 } ProtocolParamsAllegra { - allegraProtVer = ProtVer 3 0 - , allegraLeaderCredentials = Nothing + allegraProtVer = ProtVer 3 0 } ProtocolParamsMary { - maryProtVer = ProtVer 4 0 - , maryLeaderCredentials = Nothing + maryProtVer = ProtVer 4 0 } ProtocolParamsTransition { - transitionTrigger = TriggerHardForkAtVersion 2 + transitionTrigger = TriggerHardForkAtVersion 2 } ProtocolParamsTransition { - transitionTrigger = TriggerHardForkAtVersion 3 + transitionTrigger = TriggerHardForkAtVersion 3 } ProtocolParamsTransition { - transitionTrigger = TriggerHardForkAtVersion 4 + transitionTrigger = TriggerHardForkAtVersion 4 } castHeaderHash :: diff --git a/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs b/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs index 42bba53f093..913277171f0 100644 --- a/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs +++ b/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs @@ -33,7 +33,8 @@ import Ouroboros.Consensus.Shelley.Eras (ShelleyBasedEra, import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Shelley import Ouroboros.Consensus.Shelley.Node (Nonce (..), - ProtocolParamsShelley (..), ShelleyGenesis, + ProtocolParamsShelley (..), + ProtocolParamsShelleyBased (..), ShelleyGenesis, protocolInfoShelley) import HasAnalysis @@ -75,12 +76,15 @@ mkShelleyProtocolInfo :: -> Nonce -> ProtocolInfo IO (ShelleyBlock StandardShelley) mkShelleyProtocolInfo genesis initialNonce = - protocolInfoShelley $ ProtocolParamsShelley { - shelleyGenesis = genesis - , shelleyInitialNonce = initialNonce - , shelleyProtVer = SL.ProtVer 2 0 - , shelleyLeaderCredentials = [] - } + protocolInfoShelley + ProtocolParamsShelleyBased { + shelleyBasedGenesis = genesis + , shelleyBasedInitialNonce = initialNonce + , shelleyBasedLeaderCredentials = [] + } + ProtocolParamsShelley { + shelleyProtVer = SL.ProtVer 2 0 + } parseShelleyArgs :: Parser ShelleyBlockArgs parseShelleyArgs = ShelleyBlockArgs diff --git a/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs b/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs index 2ca44f2ec0d..4e55ef01dff 100644 --- a/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs +++ b/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs @@ -403,12 +403,15 @@ mkProtocolShelley :: -> CoreNode c -> ProtocolInfo m (ShelleyBlock (ShelleyEra c)) mkProtocolShelley genesis initialNonce protVer coreNode = - protocolInfoShelley $ ProtocolParamsShelley { - shelleyGenesis = genesis - , shelleyInitialNonce = initialNonce - , shelleyProtVer = protVer - , shelleyLeaderCredentials = Just $ mkLeaderCredentials coreNode - } + protocolInfoShelley + ProtocolParamsShelleyBased { + shelleyBasedGenesis = genesis + , shelleyBasedInitialNonce = initialNonce + , shelleyBasedLeaderCredentials = Just $ mkLeaderCredentials coreNode + } + ProtocolParamsShelley { + shelleyProtVer = protVer + } {------------------------------------------------------------------------------- Necessary transactions for updating the 'DecentralizationParam' -------------------------------------------------------------------------------} diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node.hs index 1859de381d3..a913e6edabd 100644 --- a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node.hs +++ b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node.hs @@ -3,18 +3,23 @@ {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.Shelley.Node ( protocolInfoShelley + , ProtocolParamsShelleyBased (..) , ProtocolParamsShelley (..) , ProtocolParamsAllegra (..) , ProtocolParamsMary (..) @@ -23,6 +28,7 @@ module Ouroboros.Consensus.Shelley.Node ( , SL.ShelleyGenesisStaking (..) , TPraosLeaderCredentials (..) , shelleyBlockForging + , shelleySharedBlockForging , tpraosBlockIssuerVKey , SL.ProtVer (..) , SL.Nonce (..) @@ -35,6 +41,7 @@ import Data.Bifunctor (first) import Data.Foldable (toList) import Data.Functor.Identity (Identity) import qualified Data.Map.Strict as Map +import Data.SOP.Strict import Data.Text (Text) import qualified Data.Text as Text @@ -65,6 +72,7 @@ import Ouroboros.Consensus.Shelley.Ledger.Inspect () import Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion () import Ouroboros.Consensus.Shelley.Node.Serialisation () import Ouroboros.Consensus.Shelley.Protocol +import Ouroboros.Consensus.Shelley.Protocol.HotKey (HotKey) import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey {------------------------------------------------------------------------------- @@ -99,33 +107,71 @@ type instance ForgeStateInfo (ShelleyBlock era) = HotKey.KESInfo type instance ForgeStateUpdateError (ShelleyBlock era) = HotKey.KESEvolutionError +-- | Needed in 'shelleySharedBlockForging' because we can't partially apply +-- equality constraints. +class (ShelleyBasedEra era, EraCrypto era ~ c) => ShelleyEraWithCrypto c era +instance (ShelleyBasedEra era, EraCrypto era ~ c) => ShelleyEraWithCrypto c era + shelleyBlockForging :: forall m era. (ShelleyBasedEra era, IOLike m) => TPraosParams -> TPraosLeaderCredentials (EraCrypto era) -> m (BlockForging m (ShelleyBlock era)) -shelleyBlockForging TPraosParams {..} +shelleyBlockForging tpraosParams credentials = + aux <$> shelleySharedBlockForging (Proxy @'[era]) tpraosParams credentials + where + aux :: + NP (BlockForging m :.: ShelleyBlock) '[era] + -> BlockForging m (ShelleyBlock era) + aux = unComp . hd + +-- | Create a 'BlockForging' record for each of the given eras, safely sharing +-- the same set of credentials for all of the eras. +-- +-- The name of the era (separated by a @_@) will be appended to each +-- 'forgeLabel'. +shelleySharedBlockForging :: + forall m c eras. + ( PraosCrypto c + , All (ShelleyEraWithCrypto c) eras + , IOLike m + ) + => Proxy eras + -> TPraosParams + -> TPraosLeaderCredentials c + -> m (NP (BlockForging m :.: ShelleyBlock) eras) +shelleySharedBlockForging + _ + TPraosParams {..} TPraosLeaderCredentials { tpraosLeaderCredentialsInitSignKey = initSignKey , tpraosLeaderCredentialsCanBeLeader = canBeLeader , tpraosLeaderCredentialsLabel = label } = do - hotKey <- HotKey.mkHotKey initSignKey startPeriod tpraosMaxKESEvo - return BlockForging { - forgeLabel = label - , canBeLeader = canBeLeader - , updateForgeState = \curSlot -> - ForgeStateUpdateInfo <$> - HotKey.evolve hotKey (slotToPeriod curSlot) - , checkCanForge = \cfg curSlot _tickedChainDepState -> - tpraosCheckCanForge - (configConsensus cfg) - forgingVRFHash - curSlot - , forgeBlock = forgeShelleyBlock hotKey canBeLeader - } + -- All @eras@ use the same 'HotKey'. A thread periodically trying to evolve + -- the KES key is spawned for each era, but since the 'HotKey' is + -- thread-safe (@MVar@) the KES key will only be evolved at most once. + hotKey <- HotKey.mkHotKey @m @c initSignKey startPeriod tpraosMaxKESEvo + return $ hcpure (Proxy @(ShelleyEraWithCrypto c)) (Comp (aux hotKey)) where - forgingVRFHash :: SL.Hash (EraCrypto era) (SL.VerKeyVRF (EraCrypto era)) + aux :: + forall era. ShelleyEraWithCrypto c era + => HotKey c m -> BlockForging m (ShelleyBlock era) + aux hotKey = BlockForging { + forgeLabel = label <> "_" <> shelleyBasedEraName (Proxy @era) + , canBeLeader = canBeLeader + , updateForgeState = \curSlot -> + ForgeStateUpdateInfo <$> + HotKey.evolve hotKey (slotToPeriod curSlot) + , checkCanForge = \cfg curSlot _tickedChainDepState -> + tpraosCheckCanForge + (configConsensus cfg) + forgingVRFHash + curSlot + , forgeBlock = forgeShelleyBlock hotKey canBeLeader + } + + forgingVRFHash :: SL.Hash c (SL.VerKeyVRF c) forgingVRFHash = SL.hashVerKeyVRF . VRF.deriveVerKeyVRF @@ -155,40 +201,52 @@ validateGenesis = first errsToString . SL.validateGenesis Text.unpack $ Text.unlines ("Invalid genesis config:" : map SL.describeValidationErr errs) --- | Parameters needed to run Shelley -data ProtocolParamsShelley c f = ProtocolParamsShelley { - shelleyGenesis :: SL.ShelleyGenesis (ShelleyEra c) +-- | Parameters common to all Shelley-based ledgers. +-- +-- When running a chain with multiple Shelley-based eras, in addition to the +-- per-era protocol parameters, one value of 'ProtocolParamsShelleyBased' will +-- be needed, which is shared among all Shelley-based eras. +-- +-- The @era@ parameter determines from which era the genesis config will be +-- used. +data ProtocolParamsShelleyBased era f = ProtocolParamsShelleyBased { + shelleyBasedGenesis :: SL.ShelleyGenesis era -- | The initial nonce, typically derived from the hash of Genesis -- config JSON file. -- -- WARNING: chains using different values of this parameter will be -- mutually incompatible. - , shelleyInitialNonce :: SL.Nonce - , shelleyProtVer :: SL.ProtVer - , shelleyLeaderCredentials :: f (TPraosLeaderCredentials c) + , shelleyBasedInitialNonce :: SL.Nonce + , shelleyBasedLeaderCredentials :: f (TPraosLeaderCredentials (EraCrypto era)) + } + +-- | Parameters needed to run Shelley +data ProtocolParamsShelley = ProtocolParamsShelley { + shelleyProtVer :: SL.ProtVer } -- | Parameters needed to run Allegra -data ProtocolParamsAllegra c f = ProtocolParamsAllegra { - allegraProtVer :: SL.ProtVer - , allegraLeaderCredentials :: f (TPraosLeaderCredentials c) +data ProtocolParamsAllegra = ProtocolParamsAllegra { + allegraProtVer :: SL.ProtVer } -- | Parameters needed to run Mary -data ProtocolParamsMary c f = ProtocolParamsMary { - maryProtVer :: SL.ProtVer - , maryLeaderCredentials :: f (TPraosLeaderCredentials c) +data ProtocolParamsMary = ProtocolParamsMary { + maryProtVer :: SL.ProtVer } protocolInfoShelley :: forall m c f. (IOLike m, ShelleyBasedEra (ShelleyEra c), Foldable f) - => ProtocolParamsShelley c f + => ProtocolParamsShelleyBased (ShelleyEra c) f + -> ProtocolParamsShelley -> ProtocolInfo m (ShelleyBlock (ShelleyEra c)) -protocolInfoShelley ProtocolParamsShelley { - shelleyGenesis = genesis - , shelleyInitialNonce = initialNonce - , shelleyProtVer = protVer - , shelleyLeaderCredentials = credentialss +protocolInfoShelley ProtocolParamsShelleyBased { + shelleyBasedGenesis = genesis + , shelleyBasedInitialNonce = initialNonce + , shelleyBasedLeaderCredentials = credentialss + } + ProtocolParamsShelley { + shelleyProtVer = protVer } = assertWithMsg (validateGenesis genesis) $ ProtocolInfo {