{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

module Ouroboros.Consensus.Shelley.Node.Praos (
    ProtocolParamsBabbage (..)
  , praosBlockForging
  , praosSharedBlockForging
  , protocolInfoPraosBabbage
  , protocolInfoPraosShelleyBased
  ) where

import qualified Cardano.Ledger.BaseTypes as SL (mkActiveSlotCoeff)
import qualified Cardano.Ledger.Era as Core
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Protocol.TPraos.OCert as Absolute
import qualified Cardano.Protocol.TPraos.OCert as SL
import           Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
import           Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength)
import           Control.Monad.Except (Except)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config (SecurityParam (SecurityParam),
                     TopLevelConfig (..), configConsensus)
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.HeaderValidation
                     (HeaderState (HeaderState))
import           Ouroboros.Consensus.Ledger.Abstract (LedgerConfig)
import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
import           Ouroboros.Consensus.Mempool.TxLimits
import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
import           Ouroboros.Consensus.Node (ProtocolInfo (..))
import           Ouroboros.Consensus.Protocol.Abstract (ConsensusConfig)
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
import           Ouroboros.Consensus.Protocol.Praos (ConsensusConfig (..),
                     Praos, PraosParams (..), PraosState (..),
                     praosCheckCanForge)
import           Ouroboros.Consensus.Protocol.Praos.Common
                     (MaxMajorProtVer (MaxMajorProtVer),
                     PraosCanBeLeader (praosCanBeLeaderOpCert))
import           Ouroboros.Consensus.Shelley.Eras (BabbageEra, EraCrypto,
                     ShelleyBasedEra (shelleyBasedEraName))
import           Ouroboros.Consensus.Shelley.Ledger
                     (CodecConfig (ShelleyCodecConfig), LedgerState (..),
                     ShelleyBlock, ShelleyCompatible, ShelleyTransition (..),
                     StorageConfig (..), forgeShelleyBlock,
                     mkShelleyBlockConfig, mkShelleyLedgerConfig)
import           Ouroboros.Consensus.Shelley.Node
                     (ProtocolParamsShelleyBased (..),
                     ShelleyLeaderCredentials (..), validateGenesis)
import           Ouroboros.Consensus.Shelley.Node.Common (ShelleyEraWithCrypto,
                     shelleyBlockIssuerVKey)
import           Ouroboros.Consensus.Shelley.Protocol.Praos ()
import           Ouroboros.Consensus.Util.Assert (assertWithMsg)
import           Ouroboros.Consensus.Util.IOLike (IOLike)

{-------------------------------------------------------------------------------
  BlockForging
-------------------------------------------------------------------------------}

-- | Create a 'BlockForging' record for a single era.
praosBlockForging ::
  forall m era c.
  ( ShelleyCompatible (Praos c) era,
    c ~ EraCrypto era,
    TxLimits (ShelleyBlock (Praos c) era),
    IOLike m
  ) =>
  PraosParams ->
  TxLimits.Overrides (ShelleyBlock (Praos c) era) ->
  ShelleyLeaderCredentials (EraCrypto era) ->
  m (BlockForging m (ShelleyBlock (Praos c) era))
praosBlockForging :: PraosParams
-> Overrides (ShelleyBlock (Praos c) era)
-> ShelleyLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock (Praos c) era))
praosBlockForging PraosParams
praosParams Overrides (ShelleyBlock (Praos c) era)
maxTxCapacityOverrides ShelleyLeaderCredentials (EraCrypto era)
credentials = do
    HotKey c m
hotKey <- SignKeyKES c -> KESPeriod -> Word64 -> m (HotKey c m)
forall (m :: * -> *) c.
(Crypto c, IOLike m) =>
SignKeyKES c -> KESPeriod -> Word64 -> m (HotKey c m)
HotKey.mkHotKey @m @c SignKeyKES c
initSignKey KESPeriod
startPeriod Word64
praosMaxKESEvo
    BlockForging m (ShelleyBlock (Praos c) era)
-> m (BlockForging m (ShelleyBlock (Praos c) era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlockForging m (ShelleyBlock (Praos c) era)
 -> m (BlockForging m (ShelleyBlock (Praos c) era)))
-> BlockForging m (ShelleyBlock (Praos c) era)
-> m (BlockForging m (ShelleyBlock (Praos c) era))
forall a b. (a -> b) -> a -> b
$ HotKey c m
-> (SlotNo -> KESPeriod)
-> ShelleyLeaderCredentials c
-> Overrides (ShelleyBlock (Praos c) era)
-> BlockForging m (ShelleyBlock (Praos c) era)
forall (m :: * -> *) c era.
(ShelleyEraWithCrypto c (Praos c) era, IOLike m) =>
HotKey c m
-> (SlotNo -> KESPeriod)
-> ShelleyLeaderCredentials c
-> Overrides (ShelleyBlock (Praos c) era)
-> BlockForging m (ShelleyBlock (Praos c) era)
praosSharedBlockForging HotKey c m
hotKey SlotNo -> KESPeriod
slotToPeriod ShelleyLeaderCredentials c
ShelleyLeaderCredentials (EraCrypto era)
credentials Overrides (ShelleyBlock (Praos c) era)
maxTxCapacityOverrides
  where
    PraosParams {Word64
praosMaxKESEvo :: PraosParams -> Word64
praosMaxKESEvo :: Word64
praosMaxKESEvo, Word64
praosSlotsPerKESPeriod :: PraosParams -> Word64
praosSlotsPerKESPeriod :: Word64
praosSlotsPerKESPeriod} = PraosParams
praosParams

    ShelleyLeaderCredentials {
        shelleyLeaderCredentialsInitSignKey :: forall c. ShelleyLeaderCredentials c -> SignKeyKES c
shelleyLeaderCredentialsInitSignKey = SignKeyKES c
initSignKey
      , shelleyLeaderCredentialsCanBeLeader :: forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader = PraosCanBeLeader c
canBeLeader
      } = ShelleyLeaderCredentials c
ShelleyLeaderCredentials (EraCrypto era)
credentials

    startPeriod :: Absolute.KESPeriod
    startPeriod :: KESPeriod
startPeriod = OCert c -> KESPeriod
forall crypto. OCert crypto -> KESPeriod
SL.ocertKESPeriod (OCert c -> KESPeriod) -> OCert c -> KESPeriod
forall a b. (a -> b) -> a -> b
$ PraosCanBeLeader c -> OCert c
forall c. PraosCanBeLeader c -> OCert c
praosCanBeLeaderOpCert PraosCanBeLeader c
canBeLeader

    slotToPeriod :: SlotNo -> Absolute.KESPeriod
    slotToPeriod :: SlotNo -> KESPeriod
slotToPeriod (SlotNo Word64
slot) =
      Word -> KESPeriod
SL.KESPeriod (Word -> KESPeriod) -> Word -> KESPeriod
forall a b. (a -> b) -> a -> b
$ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$ Word64
slot Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
praosSlotsPerKESPeriod

-- | Create a 'BlockForging' record safely using the given 'Hotkey'.
--
-- The name of the era (separated by a @_@) will be appended to each
-- 'forgeLabel'.
praosSharedBlockForging ::
  forall m c era.
  ( ShelleyEraWithCrypto c (Praos c) era,
    IOLike m
  )
  => HotKey.HotKey c m
  -> (SlotNo -> Absolute.KESPeriod)
  -> ShelleyLeaderCredentials c
  -> TxLimits.Overrides (ShelleyBlock (Praos c) era)
  -> BlockForging m     (ShelleyBlock (Praos c) era)
praosSharedBlockForging :: HotKey c m
-> (SlotNo -> KESPeriod)
-> ShelleyLeaderCredentials c
-> Overrides (ShelleyBlock (Praos c) era)
-> BlockForging m (ShelleyBlock (Praos c) era)
praosSharedBlockForging
  HotKey c m
hotKey
  SlotNo -> KESPeriod
slotToPeriod
  ShelleyLeaderCredentials
    { shelleyLeaderCredentialsCanBeLeader :: forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader = PraosCanBeLeader c
canBeLeader,
      shelleyLeaderCredentialsLabel :: forall c. ShelleyLeaderCredentials c -> Text
shelleyLeaderCredentialsLabel = Text
label
    }
  Overrides (ShelleyBlock (Praos c) era)
maxTxCapacityOverrides = do
      BlockForging :: forall (m :: * -> *) blk.
Text
-> CanBeLeader (BlockProtocol blk)
-> (TopLevelConfig blk
    -> SlotNo
    -> Ticked (ChainDepState (BlockProtocol blk))
    -> m (ForgeStateUpdateInfo blk))
-> (TopLevelConfig blk
    -> SlotNo
    -> Ticked (ChainDepState (BlockProtocol blk))
    -> IsLeader (BlockProtocol blk)
    -> ForgeStateInfo blk
    -> Either (CannotForge blk) ())
-> (TopLevelConfig blk
    -> BlockNo
    -> SlotNo
    -> TickedLedgerState blk
    -> [Validated (GenTx blk)]
    -> IsLeader (BlockProtocol blk)
    -> m blk)
-> BlockForging m blk
BlockForging
        { forgeLabel :: Text
forgeLabel = Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy era -> Text
forall era (proxy :: * -> *).
ShelleyBasedEra era =>
proxy era -> Text
shelleyBasedEraName (Proxy era
forall k (t :: k). Proxy t
Proxy @era),
          canBeLeader :: CanBeLeader (BlockProtocol (ShelleyBlock (Praos c) era))
canBeLeader = CanBeLeader (BlockProtocol (ShelleyBlock (Praos c) era))
PraosCanBeLeader c
canBeLeader,
          updateForgeState :: TopLevelConfig (ShelleyBlock (Praos c) era)
-> SlotNo
-> Ticked
     (ChainDepState (BlockProtocol (ShelleyBlock (Praos c) era)))
-> m (ForgeStateUpdateInfo (ShelleyBlock (Praos c) era))
updateForgeState = \TopLevelConfig (ShelleyBlock (Praos c) era)
_ SlotNo
curSlot Ticked (ChainDepState (BlockProtocol (ShelleyBlock (Praos c) era)))
_ ->
            UpdateInfo KESInfo KESEvolutionError
-> ForgeStateUpdateInfo (ShelleyBlock (Praos c) era)
forall blk.
UpdateInfo (ForgeStateInfo blk) (ForgeStateUpdateError blk)
-> ForgeStateUpdateInfo blk
forgeStateUpdateInfoFromUpdateInfo
              (UpdateInfo KESInfo KESEvolutionError
 -> ForgeStateUpdateInfo (ShelleyBlock (Praos c) era))
-> m (UpdateInfo KESInfo KESEvolutionError)
-> m (ForgeStateUpdateInfo (ShelleyBlock (Praos c) era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HotKey c m -> KESPeriod -> m (UpdateInfo KESInfo KESEvolutionError)
forall c (m :: * -> *).
HotKey c m -> KESPeriod -> m (UpdateInfo KESInfo KESEvolutionError)
HotKey.evolve HotKey c m
hotKey (SlotNo -> KESPeriod
slotToPeriod SlotNo
curSlot),
          checkCanForge :: TopLevelConfig (ShelleyBlock (Praos c) era)
-> SlotNo
-> Ticked
     (ChainDepState (BlockProtocol (ShelleyBlock (Praos c) era)))
-> IsLeader (BlockProtocol (ShelleyBlock (Praos c) era))
-> ForgeStateInfo (ShelleyBlock (Praos c) era)
-> Either (CannotForge (ShelleyBlock (Praos c) era)) ()
checkCanForge = \TopLevelConfig (ShelleyBlock (Praos c) era)
cfg SlotNo
curSlot Ticked (ChainDepState (BlockProtocol (ShelleyBlock (Praos c) era)))
_tickedChainDepState IsLeader (BlockProtocol (ShelleyBlock (Praos c) era))
_isLeader ->
            ConsensusConfig (Praos c)
-> SlotNo -> KESInfo -> Either (PraosCannotForge c) ()
forall c.
ConsensusConfig (Praos c)
-> SlotNo -> KESInfo -> Either (PraosCannotForge c) ()
praosCheckCanForge
              (TopLevelConfig (ShelleyBlock (Praos c) era)
-> ConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) era))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig (ShelleyBlock (Praos c) era)
cfg)
              SlotNo
curSlot,
          forgeBlock :: TopLevelConfig (ShelleyBlock (Praos c) era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock (Praos c) era)
-> [Validated (GenTx (ShelleyBlock (Praos c) era))]
-> IsLeader (BlockProtocol (ShelleyBlock (Praos c) era))
-> m (ShelleyBlock (Praos c) era)
forgeBlock = \TopLevelConfig (ShelleyBlock (Praos c) era)
cfg ->
            HotKey (EraCrypto era) m
-> CanBeLeader (Praos c)
-> TopLevelConfig (ShelleyBlock (Praos c) era)
-> Overrides (ShelleyBlock (Praos c) era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock (Praos c) era)
-> [Validated (GenTx (ShelleyBlock (Praos c) era))]
-> IsLeader (Praos c)
-> m (ShelleyBlock (Praos c) era)
forall (m :: * -> *) era proto.
(ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era),
 Monad m) =>
HotKey (EraCrypto era) m
-> CanBeLeader proto
-> TopLevelConfig (ShelleyBlock proto era)
-> Overrides (ShelleyBlock proto era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock proto era)
-> [Validated (GenTx (ShelleyBlock proto era))]
-> IsLeader proto
-> m (ShelleyBlock proto era)
forgeShelleyBlock
              HotKey c m
HotKey (EraCrypto era) m
hotKey
              CanBeLeader (Praos c)
PraosCanBeLeader c
canBeLeader
              TopLevelConfig (ShelleyBlock (Praos c) era)
cfg
              Overrides (ShelleyBlock (Praos c) era)
maxTxCapacityOverrides
        }

{-------------------------------------------------------------------------------
  ProtocolInfo
-------------------------------------------------------------------------------}

-- | Parameters needed to run Babbage
data ProtocolParamsBabbage c = ProtocolParamsBabbage
  { ProtocolParamsBabbage c -> ProtVer
babbageProtVer :: SL.ProtVer,
    ProtocolParamsBabbage c
-> Overrides (ShelleyBlock (Praos c) (BabbageEra c))
babbageMaxTxCapacityOverrides :: TxLimits.Overrides (ShelleyBlock (Praos c) (BabbageEra c))
  }

protocolInfoPraosBabbage ::
  forall m c.
  ( IOLike m,
    ShelleyCompatible (Praos c) (BabbageEra c),
    TxLimits (ShelleyBlock (Praos c) (BabbageEra c))
  ) =>
  ProtocolParamsShelleyBased (BabbageEra c) ->
  ProtocolParamsBabbage c ->
  ProtocolInfo m (ShelleyBlock (Praos c) (BabbageEra c))
protocolInfoPraosBabbage :: ProtocolParamsShelleyBased (BabbageEra c)
-> ProtocolParamsBabbage c
-> ProtocolInfo m (ShelleyBlock (Praos c) (BabbageEra c))
protocolInfoPraosBabbage
  ProtocolParamsShelleyBased (BabbageEra c)
protocolParamsShelleyBased
  ProtocolParamsBabbage
    { babbageProtVer :: forall c. ProtocolParamsBabbage c -> ProtVer
babbageProtVer = ProtVer
protVer,
      babbageMaxTxCapacityOverrides :: forall c.
ProtocolParamsBabbage c
-> Overrides (ShelleyBlock (Praos c) (BabbageEra c))
babbageMaxTxCapacityOverrides = Overrides (ShelleyBlock (Praos c) (BabbageEra c))
maxTxCapacityOverrides
    } =
    ProtocolParamsShelleyBased (BabbageEra c)
-> TranslationContext (BabbageEra c)
-> ProtVer
-> Overrides (ShelleyBlock (Praos c) (BabbageEra c))
-> ProtocolInfo m (ShelleyBlock (Praos c) (BabbageEra c))
forall (m :: * -> *) era c.
(IOLike m, ShelleyCompatible (Praos c) era,
 TxLimits (ShelleyBlock (Praos c) era), c ~ EraCrypto era) =>
ProtocolParamsShelleyBased era
-> TranslationContext era
-> ProtVer
-> Overrides (ShelleyBlock (Praos c) era)
-> ProtocolInfo m (ShelleyBlock (Praos c) era)
protocolInfoPraosShelleyBased
      ProtocolParamsShelleyBased (BabbageEra c)
protocolParamsShelleyBased
      ([Char] -> AlonzoGenesis
forall a. HasCallStack => [Char] -> a
error [Char]
"Babbage currently pretending to be Alonzo")
      ProtVer
protVer
      Overrides (ShelleyBlock (Praos c) (BabbageEra c))
maxTxCapacityOverrides

protocolInfoPraosShelleyBased ::
  forall m era c.
  ( IOLike m,
    ShelleyCompatible (Praos c) era,
    TxLimits (ShelleyBlock (Praos c) era),
    c ~ EraCrypto era
  ) =>
  ProtocolParamsShelleyBased era ->
  Core.TranslationContext era ->
  SL.ProtVer ->
  TxLimits.Overrides (ShelleyBlock (Praos c) era) ->
  ProtocolInfo m (ShelleyBlock (Praos c) era)
protocolInfoPraosShelleyBased :: ProtocolParamsShelleyBased era
-> TranslationContext era
-> ProtVer
-> Overrides (ShelleyBlock (Praos c) era)
-> ProtocolInfo m (ShelleyBlock (Praos c) era)
protocolInfoPraosShelleyBased
  ProtocolParamsShelleyBased
    { shelleyBasedGenesis :: forall era. ProtocolParamsShelleyBased era -> ShelleyGenesis era
shelleyBasedGenesis = ShelleyGenesis era
genesis,
      shelleyBasedInitialNonce :: forall era. ProtocolParamsShelleyBased era -> Nonce
shelleyBasedInitialNonce = Nonce
initialNonce,
      shelleyBasedLeaderCredentials :: forall era.
ProtocolParamsShelleyBased era
-> [ShelleyLeaderCredentials (EraCrypto era)]
shelleyBasedLeaderCredentials = [ShelleyLeaderCredentials (EraCrypto era)]
credentialss
    }
  TranslationContext era
transCtxt
  ProtVer
protVer
  Overrides (ShelleyBlock (Praos c) era)
maxTxCapacityOverrides =
    Either [Char] ()
-> ProtocolInfo m (ShelleyBlock (Praos c) era)
-> ProtocolInfo m (ShelleyBlock (Praos c) era)
forall a. HasCallStack => Either [Char] () -> a -> a
assertWithMsg (ShelleyGenesis era -> Either [Char] ()
forall era.
ShelleyBasedEra era =>
ShelleyGenesis era -> Either [Char] ()
validateGenesis ShelleyGenesis era
genesis) (ProtocolInfo m (ShelleyBlock (Praos c) era)
 -> ProtocolInfo m (ShelleyBlock (Praos c) era))
-> ProtocolInfo m (ShelleyBlock (Praos c) era)
-> ProtocolInfo m (ShelleyBlock (Praos c) era)
forall a b. (a -> b) -> a -> b
$
      ProtocolInfo :: forall (m :: * -> *) b.
TopLevelConfig b
-> ExtLedgerState b -> m [BlockForging m b] -> ProtocolInfo m b
ProtocolInfo
        { pInfoConfig :: TopLevelConfig (ShelleyBlock (Praos c) era)
pInfoConfig = TopLevelConfig (ShelleyBlock (Praos c) era)
topLevelConfig,
          pInfoInitLedger :: ExtLedgerState (ShelleyBlock (Praos c) era)
pInfoInitLedger = ExtLedgerState (ShelleyBlock (Praos c) era)
initExtLedgerState,
          pInfoBlockForging :: m [BlockForging m (ShelleyBlock (Praos c) era)]
pInfoBlockForging =
            (ShelleyLeaderCredentials c
 -> m (BlockForging m (ShelleyBlock (Praos c) era)))
-> [ShelleyLeaderCredentials c]
-> m [BlockForging m (ShelleyBlock (Praos c) era)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
              (PraosParams
-> Overrides (ShelleyBlock (Praos c) era)
-> ShelleyLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock (Praos c) era))
forall (m :: * -> *) era c.
(ShelleyCompatible (Praos c) era, c ~ EraCrypto era,
 TxLimits (ShelleyBlock (Praos c) era), IOLike m) =>
PraosParams
-> Overrides (ShelleyBlock (Praos c) era)
-> ShelleyLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock (Praos c) era))
praosBlockForging PraosParams
praosParams Overrides (ShelleyBlock (Praos c) era)
maxTxCapacityOverrides)
              [ShelleyLeaderCredentials c]
[ShelleyLeaderCredentials (EraCrypto era)]
credentialss
        }
    where
      additionalGenesisConfig :: SL.AdditionalGenesisConfig era
      additionalGenesisConfig :: AdditionalGenesisConfig era
additionalGenesisConfig = TranslationContext era
AdditionalGenesisConfig era
transCtxt

      maxMajorProtVer :: MaxMajorProtVer
      maxMajorProtVer :: MaxMajorProtVer
maxMajorProtVer = Natural -> MaxMajorProtVer
MaxMajorProtVer (Natural -> MaxMajorProtVer) -> Natural -> MaxMajorProtVer
forall a b. (a -> b) -> a -> b
$ ProtVer -> Natural
SL.pvMajor ProtVer
protVer

      topLevelConfig :: TopLevelConfig (ShelleyBlock (Praos c) era)
      topLevelConfig :: TopLevelConfig (ShelleyBlock (Praos c) era)
topLevelConfig =
        TopLevelConfig :: forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
TopLevelConfig
          { topLevelConfigProtocol :: ConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) era))
topLevelConfigProtocol = ConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) era))
consensusConfig,
            topLevelConfigLedger :: LedgerConfig (ShelleyBlock (Praos c) era)
topLevelConfigLedger = LedgerConfig (ShelleyBlock (Praos c) era)
ledgerConfig,
            topLevelConfigBlock :: BlockConfig (ShelleyBlock (Praos c) era)
topLevelConfigBlock = BlockConfig (ShelleyBlock (Praos c) era)
blockConfig,
            topLevelConfigCodec :: CodecConfig (ShelleyBlock (Praos c) era)
topLevelConfigCodec = CodecConfig (ShelleyBlock (Praos c) era)
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig,
            topLevelConfigStorage :: StorageConfig (ShelleyBlock (Praos c) era)
topLevelConfigStorage = StorageConfig (ShelleyBlock (Praos c) era)
storageConfig
          }

      consensusConfig :: ConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) era))
      consensusConfig :: ConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) era))
consensusConfig =
        PraosConfig :: forall c.
PraosParams
-> EpochInfo (Except PastHorizonException)
-> ConsensusConfig (Praos c)
PraosConfig
          { PraosParams
praosParams :: PraosParams
praosParams :: PraosParams
praosParams,
            praosEpochInfo :: EpochInfo (Except PastHorizonException)
praosEpochInfo = EpochInfo (Except PastHorizonException)
epochInfo
          }

      ledgerConfig :: LedgerConfig (ShelleyBlock (Praos c) era)
      ledgerConfig :: LedgerConfig (ShelleyBlock (Praos c) era)
ledgerConfig = ShelleyGenesis era
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> MaxMajorProtVer
-> ShelleyLedgerConfig era
forall era.
ShelleyGenesis era
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> MaxMajorProtVer
-> ShelleyLedgerConfig era
mkShelleyLedgerConfig ShelleyGenesis era
genesis TranslationContext era
transCtxt EpochInfo (Except PastHorizonException)
epochInfo MaxMajorProtVer
maxMajorProtVer

      epochInfo :: EpochInfo (Except History.PastHorizonException)
      epochInfo :: EpochInfo (Except PastHorizonException)
epochInfo =
        EpochSize -> SlotLength -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo
          (ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength ShelleyGenesis era
genesis)
          (NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
SL.sgSlotLength ShelleyGenesis era
genesis)

      praosParams :: PraosParams
      praosParams :: PraosParams
praosParams =
        PraosParams :: Word64
-> ActiveSlotCoeff
-> SecurityParam
-> Word64
-> Word64
-> MaxMajorProtVer
-> Word64
-> Network
-> SystemStart
-> PraosParams
PraosParams
          { praosSlotsPerKESPeriod :: Word64
praosSlotsPerKESPeriod = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSlotsPerKESPeriod ShelleyGenesis era
genesis,
            praosLeaderF :: ActiveSlotCoeff
praosLeaderF = PositiveUnitInterval -> ActiveSlotCoeff
SL.mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> PositiveUnitInterval -> ActiveSlotCoeff
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> PositiveUnitInterval
forall era. ShelleyGenesis era -> PositiveUnitInterval
SL.sgActiveSlotsCoeff ShelleyGenesis era
genesis,
            praosSecurityParam :: SecurityParam
praosSecurityParam = Word64 -> SecurityParam
SecurityParam (Word64 -> SecurityParam) -> Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSecurityParam ShelleyGenesis era
genesis,
            praosMaxKESEvo :: Word64
praosMaxKESEvo = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgMaxKESEvolutions ShelleyGenesis era
genesis,
            praosQuorum :: Word64
praosQuorum = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgUpdateQuorum ShelleyGenesis era
genesis,
            praosMaxMajorPV :: MaxMajorProtVer
praosMaxMajorPV = MaxMajorProtVer
maxMajorProtVer,
            praosMaxLovelaceSupply :: Word64
praosMaxLovelaceSupply = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgMaxLovelaceSupply ShelleyGenesis era
genesis,
            praosNetworkId :: Network
praosNetworkId = ShelleyGenesis era -> Network
forall era. ShelleyGenesis era -> Network
SL.sgNetworkId ShelleyGenesis era
genesis,
            praosSystemStart :: SystemStart
praosSystemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
SL.sgSystemStart ShelleyGenesis era
genesis
          }

      blockConfig :: BlockConfig (ShelleyBlock (Praos c) era)
      blockConfig :: BlockConfig (ShelleyBlock (Praos c) era)
blockConfig =
        ProtVer
-> ShelleyGenesis era
-> [VKey 'BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock (Praos c) era)
forall era proto.
ShelleyBasedEra era =>
ProtVer
-> ShelleyGenesis era
-> [VKey 'BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock proto era)
mkShelleyBlockConfig
          ProtVer
protVer
          ShelleyGenesis era
genesis
          (ShelleyLeaderCredentials c -> VKey 'BlockIssuer c
forall c. ShelleyLeaderCredentials c -> VKey 'BlockIssuer c
shelleyBlockIssuerVKey (ShelleyLeaderCredentials c -> VKey 'BlockIssuer c)
-> [ShelleyLeaderCredentials c] -> [VKey 'BlockIssuer c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ShelleyLeaderCredentials c]
[ShelleyLeaderCredentials (EraCrypto era)]
credentialss)

      storageConfig :: StorageConfig (ShelleyBlock (Praos c) era)
      storageConfig :: StorageConfig (ShelleyBlock (Praos c) era)
storageConfig =
        ShelleyStorageConfig :: forall proto era.
Word64 -> SecurityParam -> StorageConfig (ShelleyBlock proto era)
ShelleyStorageConfig
          { shelleyStorageConfigSlotsPerKESPeriod :: Word64
shelleyStorageConfigSlotsPerKESPeriod = PraosParams -> Word64
praosSlotsPerKESPeriod PraosParams
praosParams,
            shelleyStorageConfigSecurityParam :: SecurityParam
shelleyStorageConfigSecurityParam = PraosParams -> SecurityParam
praosSecurityParam PraosParams
praosParams
          }

      initLedgerState :: LedgerState (ShelleyBlock (Praos c) era)
      initLedgerState :: LedgerState (ShelleyBlock (Praos c) era)
initLedgerState =
        ShelleyLedgerState :: forall proto era.
WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock proto era)
ShelleyLedgerState
          { shelleyLedgerTip :: WithOrigin (ShelleyTip (Praos c) era)
shelleyLedgerTip = WithOrigin (ShelleyTip (Praos c) era)
forall t. WithOrigin t
Origin,
            shelleyLedgerState :: NewEpochState era
shelleyLedgerState = ShelleyGenesis era
-> AdditionalGenesisConfig era -> NewEpochState era
forall era.
CanStartFromGenesis era =>
ShelleyGenesis era
-> AdditionalGenesisConfig era -> NewEpochState era
SL.initialState ShelleyGenesis era
genesis AdditionalGenesisConfig era
additionalGenesisConfig,
            shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo {shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0}
          }

      initChainDepState :: PraosState c
      initChainDepState :: PraosState c
initChainDepState =
        PraosState :: forall c.
WithOrigin SlotNo
-> Map (KeyHash 'BlockIssuer c) Word64
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> PraosState c
PraosState
          { praosStateLastSlot :: WithOrigin SlotNo
praosStateLastSlot = WithOrigin SlotNo
forall t. WithOrigin t
Origin,
            praosStateOCertCounters :: Map (KeyHash 'BlockIssuer c) Word64
praosStateOCertCounters = Map (KeyHash 'BlockIssuer c) Word64
forall a. Monoid a => a
mempty,
            praosStateEvolvingNonce :: Nonce
praosStateEvolvingNonce = Nonce
initialNonce,
            praosStateCandidateNonce :: Nonce
praosStateCandidateNonce = Nonce
initialNonce,
            praosStateEpochNonce :: Nonce
praosStateEpochNonce = Nonce
initialNonce,
            praosStateLabNonce :: Nonce
praosStateLabNonce = Nonce
initialNonce,
            praosStateLastEpochBlockNonce :: Nonce
praosStateLastEpochBlockNonce = Nonce
initialNonce
          }

      initExtLedgerState :: ExtLedgerState (ShelleyBlock (Praos c) era)
      initExtLedgerState :: ExtLedgerState (ShelleyBlock (Praos c) era)
initExtLedgerState =
        ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState
          { ledgerState :: LedgerState (ShelleyBlock (Praos c) era)
ledgerState = LedgerState (ShelleyBlock (Praos c) era)
initLedgerState,
            headerState :: HeaderState (ShelleyBlock (Praos c) era)
headerState = WithOrigin (AnnTip (ShelleyBlock (Praos c) era))
-> ChainDepState (BlockProtocol (ShelleyBlock (Praos c) era))
-> HeaderState (ShelleyBlock (Praos c) era)
forall blk.
WithOrigin (AnnTip blk)
-> ChainDepState (BlockProtocol blk) -> HeaderState blk
HeaderState WithOrigin (AnnTip (ShelleyBlock (Praos c) era))
forall t. WithOrigin t
Origin ChainDepState (BlockProtocol (ShelleyBlock (Praos c) era))
PraosState c
initChainDepState
          }