{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -Wno-orphans  #-}

-- DUPLICATE -- adapted from: cardano-node/src/Cardano/Node/Protocol/Cardano.hs

module Cardano.Node.Protocol.Cardano (
    mkConsensusProtocolCardano
  , mkSomeConsensusProtocolCardano
    -- * Errors
  , CardanoProtocolInstantiationError (..)
  ) where

import           Cardano.Api.Any
import           Cardano.Api.Protocol.Types
import qualified Cardano.Chain.Update as Byron
import qualified Cardano.Ledger.Api.Era as L
import qualified Cardano.Ledger.Api.Transition as SL
import qualified Cardano.Node.Protocol.Alonzo as Alonzo
import qualified Cardano.Node.Protocol.Byron as Byron
import qualified Cardano.Node.Protocol.Conway as Conway
import qualified Cardano.Node.Protocol.Shelley as Shelley
import           Cardano.Node.Protocol.Types
import           Cardano.Node.Types
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT)
import           Ouroboros.Consensus.Cardano
import qualified Ouroboros.Consensus.Cardano as Consensus
import           Ouroboros.Consensus.Cardano.Condense ()
import           Ouroboros.Consensus.Cardano.Node (CardanoProtocolParams (..))
import           Ouroboros.Consensus.Config (emptyCheckpointsMap)
import           Ouroboros.Consensus.HardFork.Combinator.Condense ()
import           Ouroboros.Consensus.Shelley.Crypto (StandardCrypto)


------------------------------------------------------------------------------
-- Real Cardano protocol
--

-- | Make 'SomeConsensusProtocol' using the Cardano instance.
--
-- The Cardano protocol instance is currently the sequential composition of
-- the Byron and Shelley protocols, and will likely be extended in future
-- with further sequentially composed protocol revisions.
--
-- The use of 'SomeConsensusProtocol' lets us handle multiple protocols in a
-- generic way.
--
-- This also serves a purpose as a sanity check that we have all the necessary
-- type class instances available.
--
mkSomeConsensusProtocolCardano ::
     NodeByronProtocolConfiguration
  -> NodeShelleyProtocolConfiguration
  -> NodeAlonzoProtocolConfiguration
  -> NodeConwayProtocolConfiguration
  -> NodeHardForkProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT CardanoProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCardano :: NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeAlonzoProtocolConfiguration
-> NodeConwayProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     CardanoProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration
nbpc NodeShelleyProtocolConfiguration
nspc NodeAlonzoProtocolConfiguration
napc NodeConwayProtocolConfiguration
ncpc NodeHardForkProtocolConfiguration
nhpc Maybe ProtocolFilepaths
files = do
    CardanoProtocolParams StandardCrypto
params <- NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeAlonzoProtocolConfiguration
-> NodeConwayProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (CardanoProtocolParams StandardCrypto)
mkConsensusProtocolCardano NodeByronProtocolConfiguration
nbpc NodeShelleyProtocolConfiguration
nspc NodeAlonzoProtocolConfiguration
napc NodeConwayProtocolConfiguration
ncpc NodeHardForkProtocolConfiguration
nhpc Maybe ProtocolFilepaths
files
    SomeConsensusProtocol
-> ExceptT
     CardanoProtocolInstantiationError IO SomeConsensusProtocol
forall a. a -> ExceptT CardanoProtocolInstantiationError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeConsensusProtocol
 -> ExceptT
      CardanoProtocolInstantiationError IO SomeConsensusProtocol)
-> SomeConsensusProtocol
-> ExceptT
     CardanoProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$!
      BlockType (HardForkBlock (CardanoEras StandardCrypto))
-> ProtocolInfoArgs IO (HardForkBlock (CardanoEras StandardCrypto))
-> SomeConsensusProtocol
forall blk.
Protocol IO blk =>
BlockType blk -> ProtocolInfoArgs IO blk -> SomeConsensusProtocol
SomeConsensusProtocol BlockType (HardForkBlock (CardanoEras StandardCrypto))
CardanoBlockType (ProtocolInfoArgs IO (HardForkBlock (CardanoEras StandardCrypto))
 -> SomeConsensusProtocol)
-> ProtocolInfoArgs IO (HardForkBlock (CardanoEras StandardCrypto))
-> SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ CardanoProtocolParams StandardCrypto
-> ProtocolInfoArgs IO (HardForkBlock (CardanoEras StandardCrypto))
forall (m :: * -> *).
CardanoProtocolParams StandardCrypto
-> ProtocolInfoArgs m (HardForkBlock (CardanoEras StandardCrypto))
ProtocolInfoArgsCardano CardanoProtocolParams StandardCrypto
params

mkConsensusProtocolCardano ::
     NodeByronProtocolConfiguration
  -> NodeShelleyProtocolConfiguration
  -> NodeAlonzoProtocolConfiguration
  -> NodeConwayProtocolConfiguration
  -> NodeHardForkProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT CardanoProtocolInstantiationError IO (CardanoProtocolParams StandardCrypto)
mkConsensusProtocolCardano :: NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeAlonzoProtocolConfiguration
-> NodeConwayProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (CardanoProtocolParams StandardCrypto)
mkConsensusProtocolCardano NodeByronProtocolConfiguration {
                             GenesisFile
npcByronGenesisFile :: GenesisFile
npcByronGenesisFile :: NodeByronProtocolConfiguration -> GenesisFile
npcByronGenesisFile,
                             Maybe GenesisHash
npcByronGenesisFileHash :: Maybe GenesisHash
npcByronGenesisFileHash :: NodeByronProtocolConfiguration -> Maybe GenesisHash
npcByronGenesisFileHash,
                             RequiresNetworkMagic
npcByronReqNetworkMagic :: RequiresNetworkMagic
npcByronReqNetworkMagic :: NodeByronProtocolConfiguration -> RequiresNetworkMagic
npcByronReqNetworkMagic,
                             Maybe Double
npcByronPbftSignatureThresh :: Maybe Double
npcByronPbftSignatureThresh :: NodeByronProtocolConfiguration -> Maybe Double
npcByronPbftSignatureThresh,
                             ApplicationName
npcByronApplicationName :: ApplicationName
npcByronApplicationName :: NodeByronProtocolConfiguration -> ApplicationName
npcByronApplicationName,
                             NumSoftwareVersion
npcByronApplicationVersion :: NumSoftwareVersion
npcByronApplicationVersion :: NodeByronProtocolConfiguration -> NumSoftwareVersion
npcByronApplicationVersion,
                             Word16
npcByronSupportedProtocolVersionMajor :: Word16
npcByronSupportedProtocolVersionMajor :: NodeByronProtocolConfiguration -> Word16
npcByronSupportedProtocolVersionMajor,
                             Word16
npcByronSupportedProtocolVersionMinor :: Word16
npcByronSupportedProtocolVersionMinor :: NodeByronProtocolConfiguration -> Word16
npcByronSupportedProtocolVersionMinor,
                             Word8
npcByronSupportedProtocolVersionAlt :: Word8
npcByronSupportedProtocolVersionAlt :: NodeByronProtocolConfiguration -> Word8
npcByronSupportedProtocolVersionAlt
                           }
                           NodeShelleyProtocolConfiguration {
                             GenesisFile
npcShelleyGenesisFile :: GenesisFile
npcShelleyGenesisFile :: NodeShelleyProtocolConfiguration -> GenesisFile
npcShelleyGenesisFile,
                             Maybe GenesisHash
npcShelleyGenesisFileHash :: Maybe GenesisHash
npcShelleyGenesisFileHash :: NodeShelleyProtocolConfiguration -> Maybe GenesisHash
npcShelleyGenesisFileHash
                           }
                           NodeAlonzoProtocolConfiguration {
                             GenesisFile
npcAlonzoGenesisFile :: GenesisFile
npcAlonzoGenesisFile :: NodeAlonzoProtocolConfiguration -> GenesisFile
npcAlonzoGenesisFile,
                             Maybe GenesisHash
npcAlonzoGenesisFileHash :: Maybe GenesisHash
npcAlonzoGenesisFileHash :: NodeAlonzoProtocolConfiguration -> Maybe GenesisHash
npcAlonzoGenesisFileHash
                           }
                           NodeConwayProtocolConfiguration {
                             GenesisFile
npcConwayGenesisFile :: GenesisFile
npcConwayGenesisFile :: NodeConwayProtocolConfiguration -> GenesisFile
npcConwayGenesisFile,
                             Maybe GenesisHash
npcConwayGenesisFileHash :: Maybe GenesisHash
npcConwayGenesisFileHash :: NodeConwayProtocolConfiguration -> Maybe GenesisHash
npcConwayGenesisFileHash
                           }
                           NodeHardForkProtocolConfiguration {
                            npcTestEnableDevelopmentHardForkEras :: NodeHardForkProtocolConfiguration -> Bool
npcTestEnableDevelopmentHardForkEras = Bool
_,
                            -- During testing of the latest unreleased era, we conditionally
                            -- declared that we knew about it. We do so only when a config option
                            -- for testing development/unstable eras is used. This lets us include
                            -- not-yet-ready eras in released node versions without mainnet nodes
                            -- prematurely advertising that they could hard fork into the new era.
                             Maybe EpochNo
npcTestShelleyHardForkAtEpoch :: Maybe EpochNo
npcTestShelleyHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestShelleyHardForkAtEpoch,
                             Maybe EpochNo
npcTestAllegraHardForkAtEpoch :: Maybe EpochNo
npcTestAllegraHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestAllegraHardForkAtEpoch,
                             Maybe EpochNo
npcTestMaryHardForkAtEpoch :: Maybe EpochNo
npcTestMaryHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestMaryHardForkAtEpoch,
                             Maybe EpochNo
npcTestAlonzoHardForkAtEpoch :: Maybe EpochNo
npcTestAlonzoHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestAlonzoHardForkAtEpoch,
                             Maybe EpochNo
npcTestBabbageHardForkAtEpoch :: Maybe EpochNo
npcTestBabbageHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestBabbageHardForkAtEpoch,
                             Maybe EpochNo
npcTestConwayHardForkAtEpoch :: Maybe EpochNo
npcTestConwayHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestConwayHardForkAtEpoch
                           }
                           Maybe ProtocolFilepaths
files = do
    Config
byronGenesis <-
      (ByronProtocolInstantiationError
 -> CardanoProtocolInstantiationError)
-> ExceptT ByronProtocolInstantiationError IO Config
-> ExceptT CardanoProtocolInstantiationError IO Config
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronProtocolInstantiationError
-> CardanoProtocolInstantiationError
CardanoProtocolInstantiationErrorByron (ExceptT ByronProtocolInstantiationError IO Config
 -> ExceptT CardanoProtocolInstantiationError IO Config)
-> ExceptT ByronProtocolInstantiationError IO Config
-> ExceptT CardanoProtocolInstantiationError IO Config
forall a b. (a -> b) -> a -> b
$
        GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> ExceptT ByronProtocolInstantiationError IO Config
Byron.readGenesis GenesisFile
npcByronGenesisFile
                          Maybe GenesisHash
npcByronGenesisFileHash
                          RequiresNetworkMagic
npcByronReqNetworkMagic

    Maybe ByronLeaderCredentials
byronLeaderCredentials <-
      (ByronProtocolInstantiationError
 -> CardanoProtocolInstantiationError)
-> ExceptT
     ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
-> ExceptT
     CardanoProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronProtocolInstantiationError
-> CardanoProtocolInstantiationError
CardanoProtocolInstantiationErrorByron (ExceptT
   ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
 -> ExceptT
      CardanoProtocolInstantiationError
      IO
      (Maybe ByronLeaderCredentials))
-> ExceptT
     ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
-> ExceptT
     CardanoProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
forall a b. (a -> b) -> a -> b
$
        Config
-> Maybe ProtocolFilepaths
-> ExceptT
     ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
Byron.readLeaderCredentials Config
byronGenesis Maybe ProtocolFilepaths
files

    (ShelleyGenesis StandardCrypto
shelleyGenesis, GenesisHash
shelleyGenesisHash) <-
      (GenesisReadError -> CardanoProtocolInstantiationError)
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardCrypto, GenesisHash)
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (ShelleyGenesis StandardCrypto, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisReadError -> CardanoProtocolInstantiationError
CardanoProtocolInstantiationShelleyGenesisReadError (ExceptT
   GenesisReadError IO (ShelleyGenesis StandardCrypto, GenesisHash)
 -> ExceptT
      CardanoProtocolInstantiationError
      IO
      (ShelleyGenesis StandardCrypto, GenesisHash))
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardCrypto, GenesisHash)
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (ShelleyGenesis StandardCrypto, GenesisHash)
forall a b. (a -> b) -> a -> b
$
        GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardCrypto, GenesisHash)
Shelley.readGenesis GenesisFile
npcShelleyGenesisFile
                            Maybe GenesisHash
npcShelleyGenesisFileHash

    (AlonzoGenesis
alonzoGenesis, GenesisHash
_alonzoGenesisHash) <-
      (GenesisReadError -> CardanoProtocolInstantiationError)
-> ExceptT GenesisReadError IO (AlonzoGenesis, GenesisHash)
-> ExceptT
     CardanoProtocolInstantiationError IO (AlonzoGenesis, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisReadError -> CardanoProtocolInstantiationError
CardanoProtocolInstantiationAlonzoGenesisReadError (ExceptT GenesisReadError IO (AlonzoGenesis, GenesisHash)
 -> ExceptT
      CardanoProtocolInstantiationError IO (AlonzoGenesis, GenesisHash))
-> ExceptT GenesisReadError IO (AlonzoGenesis, GenesisHash)
-> ExceptT
     CardanoProtocolInstantiationError IO (AlonzoGenesis, GenesisHash)
forall a b. (a -> b) -> a -> b
$
        GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (AlonzoGenesis, GenesisHash)
Alonzo.readGenesis GenesisFile
npcAlonzoGenesisFile
                           Maybe GenesisHash
npcAlonzoGenesisFileHash

    (ConwayGenesis StandardCrypto
conwayGenesis, GenesisHash
_conwayGenesisHash) <-
      (GenesisReadError -> CardanoProtocolInstantiationError)
-> ExceptT
     GenesisReadError IO (ConwayGenesis StandardCrypto, GenesisHash)
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (ConwayGenesis StandardCrypto, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisReadError -> CardanoProtocolInstantiationError
CardanoProtocolInstantiationConwayGenesisReadError (ExceptT
   GenesisReadError IO (ConwayGenesis StandardCrypto, GenesisHash)
 -> ExceptT
      CardanoProtocolInstantiationError
      IO
      (ConwayGenesis StandardCrypto, GenesisHash))
-> ExceptT
     GenesisReadError IO (ConwayGenesis StandardCrypto, GenesisHash)
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (ConwayGenesis StandardCrypto, GenesisHash)
forall a b. (a -> b) -> a -> b
$
        GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (ConwayGenesis StandardCrypto, GenesisHash)
forall c.
Crypto c =>
GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (ConwayGenesis c, GenesisHash)
Conway.readGenesis GenesisFile
npcConwayGenesisFile
                           Maybe GenesisHash
npcConwayGenesisFileHash

    [ShelleyLeaderCredentials StandardCrypto]
shelleyLeaderCredentials <-
      (PraosLeaderCredentialsError -> CardanoProtocolInstantiationError)
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT PraosLeaderCredentialsError -> CardanoProtocolInstantiationError
CardanoProtocolInstantiationPraosLeaderCredentialsError (ExceptT
   PraosLeaderCredentialsError
   IO
   [ShelleyLeaderCredentials StandardCrypto]
 -> ExceptT
      CardanoProtocolInstantiationError
      IO
      [ShelleyLeaderCredentials StandardCrypto])
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$
        Maybe ProtocolFilepaths
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
Shelley.readLeaderCredentials Maybe ProtocolFilepaths
files

    let transitionLedgerConfig :: TransitionConfig (LatestKnownEra StandardCrypto)
transitionLedgerConfig =
          ShelleyGenesis StandardCrypto
-> AlonzoGenesis
-> ConwayGenesis StandardCrypto
-> TransitionConfig (LatestKnownEra StandardCrypto)
forall c.
Crypto c =>
ShelleyGenesis c
-> AlonzoGenesis
-> ConwayGenesis c
-> TransitionConfig (LatestKnownEra c)
SL.mkLatestTransitionConfig ShelleyGenesis StandardCrypto
shelleyGenesis AlonzoGenesis
alonzoGenesis ConwayGenesis StandardCrypto
conwayGenesis

    --TODO: all these protocol versions below are confusing and unnecessary.
    -- It could and should all be automated and these config entries eliminated.
    CardanoProtocolParams StandardCrypto
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (CardanoProtocolParams StandardCrypto)
forall a. a -> ExceptT CardanoProtocolInstantiationError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CardanoProtocolParams StandardCrypto
 -> ExceptT
      CardanoProtocolInstantiationError
      IO
      (CardanoProtocolParams StandardCrypto))
-> CardanoProtocolParams StandardCrypto
-> ExceptT
     CardanoProtocolInstantiationError
     IO
     (CardanoProtocolParams StandardCrypto)
forall a b. (a -> b) -> a -> b
$!
      ProtocolParamsByron
-> ProtocolParamsShelleyBased StandardCrypto
-> CardanoHardForkTriggers
-> TransitionConfig (LatestKnownEra StandardCrypto)
-> CheckpointsMap (HardForkBlock (CardanoEras StandardCrypto))
-> ProtVer
-> CardanoProtocolParams StandardCrypto
forall c.
ProtocolParamsByron
-> ProtocolParamsShelleyBased c
-> CardanoHardForkTriggers
-> TransitionConfig (LatestKnownEra c)
-> CheckpointsMap (CardanoBlock c)
-> ProtVer
-> CardanoProtocolParams c
CardanoProtocolParams
        Consensus.ProtocolParamsByron {
          $sel:byronGenesis:ProtocolParamsByron :: Config
byronGenesis = Config
byronGenesis,
          $sel:byronPbftSignatureThreshold:ProtocolParamsByron :: Maybe PBftSignatureThreshold
byronPbftSignatureThreshold =
            Double -> PBftSignatureThreshold
PBftSignatureThreshold (Double -> PBftSignatureThreshold)
-> Maybe Double -> Maybe PBftSignatureThreshold
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
npcByronPbftSignatureThresh,

          -- This is /not/ the Byron protocol version. It is the protocol
          -- version that this node will use in blocks it creates. It is used
          -- in the Byron update mechanism to signal that this block-producing
          -- node is ready to move to the new protocol. For example, when the
          -- protocol version (according to the ledger state) is 0, this setting
          -- should be 1 when we are ready to move. Similarly when the current
          -- protocol version is 1, this should be 2 to indicate we are ready
          -- to move into the Shelley era.
          $sel:byronProtocolVersion:ProtocolParamsByron :: ProtocolVersion
byronProtocolVersion =
            Word16 -> Word16 -> Word8 -> ProtocolVersion
Byron.ProtocolVersion
              Word16
npcByronSupportedProtocolVersionMajor
              Word16
npcByronSupportedProtocolVersionMinor
              Word8
npcByronSupportedProtocolVersionAlt,
          $sel:byronSoftwareVersion:ProtocolParamsByron :: SoftwareVersion
byronSoftwareVersion =
            ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Byron.SoftwareVersion
              ApplicationName
npcByronApplicationName
              NumSoftwareVersion
npcByronApplicationVersion,
          $sel:byronLeaderCredentials:ProtocolParamsByron :: Maybe ByronLeaderCredentials
byronLeaderCredentials = Maybe ByronLeaderCredentials
byronLeaderCredentials
        }
        Consensus.ProtocolParamsShelleyBased {
          shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce      = GenesisHash -> Nonce
Shelley.genesisHashToPraosNonce
                                            GenesisHash
shelleyGenesisHash,
          shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials StandardCrypto]
shelleyBasedLeaderCredentials = [ShelleyLeaderCredentials StandardCrypto]
shelleyLeaderCredentials
        }
        -- The 'CardanoHardForkTriggers' specify the parameters needed to
        -- transition between two eras. The comments below also apply for all
        -- subsequent hard forks.
        --
        -- Byron to Shelley hard fork parameters
        Consensus.CardanoHardForkTriggers' {
          triggerHardForkShelley :: CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
triggerHardForkShelley =
            -- What will trigger the Byron -> Shelley hard fork?
            case Maybe EpochNo
npcTestShelleyHardForkAtEpoch of

              -- This specifies the major protocol version number update that will
              -- trigger us moving to the Shelley protocol.
              --
              -- Version 0 is Byron with Ouroboros classic
              -- Version 1 is Byron with Ouroboros Permissive BFT
              -- Version 2 is Shelley
              -- Version 3 is Allegra
              -- Version 4 is Mary
              -- Version 5 is Alonzo
              -- Version 6 is Alonzo (intra era hardfork)
              -- Version 7 is Babbage
              -- Version 8 is Babbage (intra era hardfork)
              -- Version 9 is Conway
              --
              -- But we also provide an override to allow for simpler test setups
              -- such as triggering at the 0 -> 1 transition .
              --
              Maybe EpochNo
Nothing      -> CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall blk. CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtDefaultVersion

              -- Alternatively, for testing we can transition at a specific epoch.
              --
              Just EpochNo
epochNo -> EpochNo
-> CardanoHardForkTrigger
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall blk. EpochNo -> CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtEpoch EpochNo
epochNo
          -- Shelley to Allegra hard fork parameters
        , triggerHardForkAllegra :: CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
triggerHardForkAllegra =
            case Maybe EpochNo
npcTestAllegraHardForkAtEpoch of
              Maybe EpochNo
Nothing      -> CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
forall blk. CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtDefaultVersion
              Just EpochNo
epochNo -> EpochNo
-> CardanoHardForkTrigger
     (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
forall blk. EpochNo -> CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtEpoch EpochNo
epochNo
          -- Allegra to Mary hard fork parameters
        , triggerHardForkMary :: CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
triggerHardForkMary =
            case Maybe EpochNo
npcTestMaryHardForkAtEpoch of
              Maybe EpochNo
Nothing      -> CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
forall blk. CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtDefaultVersion
              Just EpochNo
epochNo -> EpochNo
-> CardanoHardForkTrigger
     (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
forall blk. EpochNo -> CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtEpoch EpochNo
epochNo
          -- Mary to Alonzo hard fork parameters
        , triggerHardForkAlonzo :: CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
triggerHardForkAlonzo =
            case Maybe EpochNo
npcTestAlonzoHardForkAtEpoch of
              Maybe EpochNo
Nothing      -> CardanoHardForkTrigger
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
forall blk. CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtDefaultVersion
              Just EpochNo
epochNo -> EpochNo
-> CardanoHardForkTrigger
     (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
forall blk. EpochNo -> CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtEpoch EpochNo
epochNo
          -- Alonzo to Babbage hard fork parameters
        , triggerHardForkBabbage :: CardanoHardForkTrigger
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
triggerHardForkBabbage =
            case Maybe EpochNo
npcTestBabbageHardForkAtEpoch of
                Maybe EpochNo
Nothing      -> CardanoHardForkTrigger
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
forall blk. CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtDefaultVersion
                Just EpochNo
epochNo -> EpochNo
-> CardanoHardForkTrigger
     (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
forall blk. EpochNo -> CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtEpoch EpochNo
epochNo
          -- Babbage to Conway hard fork parameters
        , triggerHardForkConway :: CardanoHardForkTrigger
  (ShelleyBlock
     (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
triggerHardForkConway =
            case Maybe EpochNo
npcTestConwayHardForkAtEpoch of
                Maybe EpochNo
Nothing      -> CardanoHardForkTrigger
  (ShelleyBlock
     (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
forall blk. CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtDefaultVersion
                Just EpochNo
epochNo -> EpochNo
-> CardanoHardForkTrigger
     (ShelleyBlock
        (Praos StandardCrypto) (LatestKnownEra StandardCrypto))
forall blk. EpochNo -> CardanoHardForkTrigger blk
Consensus.CardanoTriggerHardForkAtEpoch EpochNo
epochNo
        }
        TransitionConfig (LatestKnownEra StandardCrypto)
transitionLedgerConfig
        CheckpointsMap (HardForkBlock (CardanoEras StandardCrypto))
forall blk. CheckpointsMap blk
emptyCheckpointsMap
        (Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
L.eraProtVerHigh @(L.LatestKnownEra StandardCrypto)) Natural
0)

------------------------------------------------------------------------------
-- Errors
--

data CardanoProtocolInstantiationError =
       CardanoProtocolInstantiationErrorByron
         Byron.ByronProtocolInstantiationError

     | CardanoProtocolInstantiationShelleyGenesisReadError
         Shelley.GenesisReadError

     | CardanoProtocolInstantiationAlonzoGenesisReadError
         Shelley.GenesisReadError

     | CardanoProtocolInstantiationConwayGenesisReadError
         Shelley.GenesisReadError

     | CardanoProtocolInstantiationPraosLeaderCredentialsError
         Shelley.PraosLeaderCredentialsError

     | CardanoProtocolInstantiationErrorAlonzo
         Alonzo.AlonzoProtocolInstantiationError
  deriving Int -> CardanoProtocolInstantiationError -> ShowS
[CardanoProtocolInstantiationError] -> ShowS
CardanoProtocolInstantiationError -> String
(Int -> CardanoProtocolInstantiationError -> ShowS)
-> (CardanoProtocolInstantiationError -> String)
-> ([CardanoProtocolInstantiationError] -> ShowS)
-> Show CardanoProtocolInstantiationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CardanoProtocolInstantiationError -> ShowS
showsPrec :: Int -> CardanoProtocolInstantiationError -> ShowS
$cshow :: CardanoProtocolInstantiationError -> String
show :: CardanoProtocolInstantiationError -> String
$cshowList :: [CardanoProtocolInstantiationError] -> ShowS
showList :: [CardanoProtocolInstantiationError] -> ShowS
Show

instance Error CardanoProtocolInstantiationError where
  displayError :: CardanoProtocolInstantiationError -> String
displayError (CardanoProtocolInstantiationErrorByron ByronProtocolInstantiationError
err) =
    ByronProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError ByronProtocolInstantiationError
err
  displayError (CardanoProtocolInstantiationShelleyGenesisReadError GenesisReadError
err) =
    String
"Shelley related: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisReadError -> String
forall e. Error e => e -> String
displayError GenesisReadError
err
  displayError (CardanoProtocolInstantiationAlonzoGenesisReadError GenesisReadError
err) =
    String
"Alonzo related: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisReadError -> String
forall e. Error e => e -> String
displayError GenesisReadError
err
  displayError (CardanoProtocolInstantiationConwayGenesisReadError GenesisReadError
err) =
    String
"Conway related: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisReadError -> String
forall e. Error e => e -> String
displayError GenesisReadError
err
  displayError (CardanoProtocolInstantiationPraosLeaderCredentialsError PraosLeaderCredentialsError
err) =
    PraosLeaderCredentialsError -> String
forall e. Error e => e -> String
displayError PraosLeaderCredentialsError
err
  displayError (CardanoProtocolInstantiationErrorAlonzo AlonzoProtocolInstantiationError
err) =
    AlonzoProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError AlonzoProtocolInstantiationError
err