{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Shelley.Node.TPraos (
    MaxMajorProtVer (..)
  , ProtocolParamsShelleyBased (..)
  , SL.Nonce (..)
  , SL.ProtVer (..)
  , SL.ShelleyGenesis (..)
  , SL.ShelleyGenesisStaking (..)
  , SL.emptyGenesisStaking
  , ShelleyLeaderCredentials (..)
  , protocolInfoShelley
  , protocolInfoTPraosShelleyBased
  , shelleyBlockForging
  , shelleySharedBlockForging
  , validateGenesis
  ) where

import           Cardano.Crypto.Hash (Hash)
import qualified Cardano.Crypto.VRF as VRF
import qualified Cardano.Ledger.Api.Era as L
import qualified Cardano.Ledger.Api.Transition as L
import           Cardano.Ledger.Hashes (HASH)
import qualified Cardano.Ledger.Shelley.API as SL
import           Cardano.Protocol.Crypto (VRF)
import qualified Cardano.Protocol.TPraos.API as SL
import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..))
import qualified Cardano.Protocol.TPraos.OCert as SL
import           Cardano.Slotting.EpochInfo
import           Cardano.Slotting.Time (mkSlotLength)
import           Control.Monad.Except (Except)
import           Data.Bifunctor (first)
import qualified Data.Text as T
import qualified Data.Text as Text
import           Lens.Micro ((^.))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.SupportsMempool (TxLimits)
import           Ouroboros.Consensus.Ledger.Tables.Utils
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey)
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
import           Ouroboros.Consensus.Protocol.Praos.Common
import           Ouroboros.Consensus.Protocol.TPraos
import           Ouroboros.Consensus.Shelley.Eras
import           Ouroboros.Consensus.Shelley.Ledger
import           Ouroboros.Consensus.Shelley.Ledger.Inspect ()
import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion ()
import           Ouroboros.Consensus.Shelley.Node.Common
                     (ProtocolParamsShelleyBased (..), ShelleyEraWithCrypto,
                     ShelleyLeaderCredentials (..), shelleyBlockIssuerVKey)
import           Ouroboros.Consensus.Shelley.Node.Serialisation ()
import           Ouroboros.Consensus.Shelley.Protocol.TPraos ()
import           Ouroboros.Consensus.Util.Assert
import           Ouroboros.Consensus.Util.IOLike

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

-- | Create a 'BlockForging' record for a single era.
--
-- In case the same credentials should be shared across multiple Shelley-based
-- eras, use 'shelleySharedBlockForging'.
shelleyBlockForging ::
     forall m era c.
      ( ShelleyCompatible (TPraos c) era
      , TxLimits (ShelleyBlock (TPraos c) era)
      , IOLike m
      )
  => TPraosParams
  -> ShelleyLeaderCredentials c
  -> m (BlockForging m (ShelleyBlock (TPraos c) era))
shelleyBlockForging :: forall (m :: * -> *) era c.
(ShelleyCompatible (TPraos c) era,
 TxLimits (ShelleyBlock (TPraos c) era), IOLike m) =>
TPraosParams
-> ShelleyLeaderCredentials c
-> m (BlockForging m (ShelleyBlock (TPraos c) era))
shelleyBlockForging TPraosParams
tpraosParams ShelleyLeaderCredentials c
credentials = do
    hotKey <- forall (m :: * -> *) c.
(Crypto c, IOLike m) =>
UnsoundPureSignKeyKES (KES c)
-> KESPeriod -> Word64 -> m (HotKey c m)
HotKey.mkHotKey @m @c UnsoundPureSignKeyKES (KES c)
initSignKey KESPeriod
startPeriod Word64
tpraosMaxKESEvo
    pure $ shelleySharedBlockForging hotKey slotToPeriod credentials
  where
    TPraosParams {Word64
tpraosMaxKESEvo :: Word64
tpraosMaxKESEvo :: TPraosParams -> Word64
tpraosMaxKESEvo, Word64
tpraosSlotsPerKESPeriod :: Word64
tpraosSlotsPerKESPeriod :: TPraosParams -> Word64
tpraosSlotsPerKESPeriod} = TPraosParams
tpraosParams

    ShelleyLeaderCredentials {
        shelleyLeaderCredentialsInitSignKey :: forall c.
ShelleyLeaderCredentials c -> UnsoundPureSignKeyKES (KES c)
shelleyLeaderCredentialsInitSignKey = UnsoundPureSignKeyKES (KES c)
initSignKey
      , shelleyLeaderCredentialsCanBeLeader :: forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader = PraosCanBeLeader c
canBeLeader
      } = ShelleyLeaderCredentials c
credentials

    startPeriod :: Absolute.KESPeriod
    startPeriod :: KESPeriod
startPeriod = OCert c -> KESPeriod
forall c. OCert c -> 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
tpraosSlotsPerKESPeriod

-- | Create a 'BlockForging' record safely using a given 'Hotkey'.
--
-- The name of the era (separated by a @_@) will be appended to each
-- 'forgeLabel'.
shelleySharedBlockForging ::
     forall m c era.
     ( ShelleyEraWithCrypto c (TPraos c) era
     , IOLike m
     )
  => HotKey c m
  -> (SlotNo -> Absolute.KESPeriod)
  -> ShelleyLeaderCredentials c
  -> BlockForging m (ShelleyBlock (TPraos c) era)
shelleySharedBlockForging :: forall (m :: * -> *) c era.
(ShelleyEraWithCrypto c (TPraos c) era, IOLike m) =>
HotKey c m
-> (SlotNo -> KESPeriod)
-> ShelleyLeaderCredentials c
-> BlockForging m (ShelleyBlock (TPraos c) era)
shelleySharedBlockForging HotKey c m
hotKey SlotNo -> KESPeriod
slotToPeriod ShelleyLeaderCredentials c
credentials =
    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
<> String -> Text
T.pack (forall era. Era era => String
L.eraName @era)
      , canBeLeader :: CanBeLeader (BlockProtocol (ShelleyBlock (TPraos c) era))
canBeLeader      = CanBeLeader (BlockProtocol (ShelleyBlock (TPraos c) era))
PraosCanBeLeader c
canBeLeader
      , updateForgeState :: TopLevelConfig (ShelleyBlock (TPraos c) era)
-> SlotNo
-> Ticked
     (ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) era)))
-> m (ForgeStateUpdateInfo (ShelleyBlock (TPraos c) era))
updateForgeState = \TopLevelConfig (ShelleyBlock (TPraos c) era)
_ SlotNo
curSlot Ticked
  (ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) era)))
_ ->
                               UpdateInfo
  (ForgeStateInfo (ShelleyBlock (TPraos c) era))
  (ForgeStateUpdateError (ShelleyBlock (TPraos c) era))
-> ForgeStateUpdateInfo (ShelleyBlock (TPraos c) era)
UpdateInfo KESInfo KESEvolutionError
-> ForgeStateUpdateInfo (ShelleyBlock (TPraos c) era)
forall blk.
UpdateInfo (ForgeStateInfo blk) (ForgeStateUpdateError blk)
-> ForgeStateUpdateInfo blk
forgeStateUpdateInfoFromUpdateInfo (UpdateInfo KESInfo KESEvolutionError
 -> ForgeStateUpdateInfo (ShelleyBlock (TPraos c) era))
-> m (UpdateInfo KESInfo KESEvolutionError)
-> m (ForgeStateUpdateInfo (ShelleyBlock (TPraos 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 (TPraos c) era)
-> SlotNo
-> Ticked
     (ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) era)))
-> IsLeader (BlockProtocol (ShelleyBlock (TPraos c) era))
-> ForgeStateInfo (ShelleyBlock (TPraos c) era)
-> Either (CannotForge (ShelleyBlock (TPraos c) era)) ()
checkCanForge    = \TopLevelConfig (ShelleyBlock (TPraos c) era)
cfg SlotNo
curSlot Ticked
  (ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) era)))
_tickedChainDepState ->
                               ConsensusConfig (TPraos c)
-> Hash HASH (VerKeyVRF (VRF c))
-> SlotNo
-> IsLeader (TPraos c)
-> KESInfo
-> Either (TPraosCannotForge c) ()
forall c.
ConsensusConfig (TPraos c)
-> Hash HASH (VerKeyVRF (VRF c))
-> SlotNo
-> IsLeader (TPraos c)
-> KESInfo
-> Either (TPraosCannotForge c) ()
tpraosCheckCanForge
                                 (TopLevelConfig (ShelleyBlock (TPraos c) era)
-> ConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) era))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig (ShelleyBlock (TPraos c) era)
cfg)
                                 Hash HASH (VerKeyVRF (VRF c))
forgingVRFHash
                                 SlotNo
curSlot
      , forgeBlock :: TopLevelConfig (ShelleyBlock (TPraos c) era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock (TPraos c) era) EmptyMK
-> [Validated (GenTx (ShelleyBlock (TPraos c) era))]
-> IsLeader (BlockProtocol (ShelleyBlock (TPraos c) era))
-> m (ShelleyBlock (TPraos c) era)
forgeBlock       = \TopLevelConfig (ShelleyBlock (TPraos c) era)
cfg ->
          HotKey (ProtoCrypto (TPraos c)) m
-> CanBeLeader (TPraos c)
-> TopLevelConfig (ShelleyBlock (TPraos c) era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock (TPraos c) era) EmptyMK
-> [Validated (GenTx (ShelleyBlock (TPraos c) era))]
-> IsLeader (TPraos c)
-> m (ShelleyBlock (TPraos c) era)
forall (m :: * -> *) era proto (mk :: MapKind).
(ShelleyCompatible proto era, Monad m) =>
HotKey (ProtoCrypto proto) m
-> CanBeLeader proto
-> TopLevelConfig (ShelleyBlock proto era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock proto era) mk
-> [Validated (GenTx (ShelleyBlock proto era))]
-> IsLeader proto
-> m (ShelleyBlock proto era)
forgeShelleyBlock
            HotKey c m
HotKey (ProtoCrypto (TPraos c)) m
hotKey
            CanBeLeader (TPraos c)
PraosCanBeLeader c
canBeLeader
            TopLevelConfig (ShelleyBlock (TPraos c) era)
cfg
      }
  where
    ShelleyLeaderCredentials {
        shelleyLeaderCredentialsCanBeLeader :: forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader = PraosCanBeLeader c
canBeLeader
      , shelleyLeaderCredentialsLabel :: forall c. ShelleyLeaderCredentials c -> Text
shelleyLeaderCredentialsLabel       = Text
label
      } = ShelleyLeaderCredentials c
credentials

    forgingVRFHash :: Hash HASH (VRF.VerKeyVRF (VRF c))
    forgingVRFHash :: Hash HASH (VerKeyVRF (VRF c))
forgingVRFHash =
          VerKeyVRF (VRF c) -> Hash HASH (VerKeyVRF (VRF c))
forall h.
HashAlgorithm h =>
VerKeyVRF (VRF c) -> Hash h (VerKeyVRF (VRF c))
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
VRF.hashVerKeyVRF
        (VerKeyVRF (VRF c) -> Hash HASH (VerKeyVRF (VRF c)))
-> (PraosCanBeLeader c -> VerKeyVRF (VRF c))
-> PraosCanBeLeader c
-> Hash HASH (VerKeyVRF (VRF c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyVRF (VRF c) -> VerKeyVRF (VRF c)
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
VRF.deriveVerKeyVRF
        (SignKeyVRF (VRF c) -> VerKeyVRF (VRF c))
-> (PraosCanBeLeader c -> SignKeyVRF (VRF c))
-> PraosCanBeLeader c
-> VerKeyVRF (VRF c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PraosCanBeLeader c -> SignKeyVRF (VRF c)
forall c. PraosCanBeLeader c -> SignKeyVRF (VRF c)
praosCanBeLeaderSignKeyVRF
        (PraosCanBeLeader c -> Hash HASH (VerKeyVRF (VRF c)))
-> PraosCanBeLeader c -> Hash HASH (VerKeyVRF (VRF c))
forall a b. (a -> b) -> a -> b
$ PraosCanBeLeader c
canBeLeader

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

-- | Check the validity of the genesis config. To be used in conjunction with
-- 'assertWithMsg'.
validateGenesis :: SL.ShelleyGenesis -> Either String ()
validateGenesis :: ShelleyGenesis -> Either String ()
validateGenesis = ([ValidationErr] -> String)
-> Either [ValidationErr] () -> Either String ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: MapKind) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [ValidationErr] -> String
errsToString (Either [ValidationErr] () -> Either String ())
-> (ShelleyGenesis -> Either [ValidationErr] ())
-> ShelleyGenesis
-> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis -> Either [ValidationErr] ()
SL.validateGenesis
  where
    errsToString :: [SL.ValidationErr] -> String
    errsToString :: [ValidationErr] -> String
errsToString [ValidationErr]
errs =
        Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines
          (Text
"Invalid genesis config:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ValidationErr -> Text) -> [ValidationErr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ValidationErr -> Text
SL.describeValidationErr [ValidationErr]
errs)

protocolInfoShelley ::
     forall m c.
      ( IOLike m
      , ShelleyCompatible (TPraos c) ShelleyEra
      , TxLimits (ShelleyBlock (TPraos c) ShelleyEra)
      )
  => SL.ShelleyGenesis
  -> ProtocolParamsShelleyBased c
  -> SL.ProtVer
  -> ( ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra)
     , m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)]
     )
protocolInfoShelley :: forall (m :: * -> *) c.
(IOLike m, ShelleyCompatible (TPraos c) ShelleyEra,
 TxLimits (ShelleyBlock (TPraos c) ShelleyEra)) =>
ShelleyGenesis
-> ProtocolParamsShelleyBased c
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
protocolInfoShelley ShelleyGenesis
shelleyGenesis
                    ProtocolParamsShelleyBased c
protocolParamsShelleyBased
                    ProtVer
protVer =
    ProtocolParamsShelleyBased c
-> TransitionConfig ShelleyEra
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
forall (m :: * -> *) era c.
(IOLike m, ShelleyCompatible (TPraos c) era,
 TxLimits (ShelleyBlock (TPraos c) era)) =>
ProtocolParamsShelleyBased c
-> TransitionConfig era
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
protocolInfoTPraosShelleyBased
      ProtocolParamsShelleyBased c
protocolParamsShelleyBased
      (ShelleyGenesis -> TransitionConfig ShelleyEra
L.mkShelleyTransitionConfig ShelleyGenesis
shelleyGenesis)
      ProtVer
protVer

protocolInfoTPraosShelleyBased ::
     forall m era c.
      ( IOLike m
      , ShelleyCompatible (TPraos c) era
      , TxLimits (ShelleyBlock (TPraos c) era)
      )
  => ProtocolParamsShelleyBased c
  -> L.TransitionConfig era
  -> SL.ProtVer
     -- ^ see 'shelleyProtVer', mutatis mutandi
  -> ( ProtocolInfo (ShelleyBlock (TPraos c) era)
     , m [BlockForging m (ShelleyBlock (TPraos c) era)]
     )
protocolInfoTPraosShelleyBased :: forall (m :: * -> *) era c.
(IOLike m, ShelleyCompatible (TPraos c) era,
 TxLimits (ShelleyBlock (TPraos c) era)) =>
ProtocolParamsShelleyBased c
-> TransitionConfig era
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased {
                             shelleyBasedInitialNonce :: forall c. ProtocolParamsShelleyBased c -> Nonce
shelleyBasedInitialNonce      = Nonce
initialNonce
                           , shelleyBasedLeaderCredentials :: forall c.
ProtocolParamsShelleyBased c -> [ShelleyLeaderCredentials c]
shelleyBasedLeaderCredentials = [ShelleyLeaderCredentials c]
credentialss
                           }
                         TransitionConfig era
transitionCfg
                         ProtVer
protVer =
    Either String ()
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
forall a. HasCallStack => Either String () -> a -> a
assertWithMsg (ShelleyGenesis -> Either String ()
validateGenesis ShelleyGenesis
genesis) ((ProtocolInfo (ShelleyBlock (TPraos c) era),
  m [BlockForging m (ShelleyBlock (TPraos c) era)])
 -> (ProtocolInfo (ShelleyBlock (TPraos c) era),
     m [BlockForging m (ShelleyBlock (TPraos c) era)]))
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
-> (ProtocolInfo (ShelleyBlock (TPraos c) era),
    m [BlockForging m (ShelleyBlock (TPraos c) era)])
forall a b. (a -> b) -> a -> b
$
    ( ProtocolInfo {
        pInfoConfig :: TopLevelConfig (ShelleyBlock (TPraos c) era)
pInfoConfig       = TopLevelConfig (ShelleyBlock (TPraos c) era)
topLevelConfig
      , pInfoInitLedger :: ExtLedgerState (ShelleyBlock (TPraos c) era) ValuesMK
pInfoInitLedger   = ExtLedgerState (ShelleyBlock (TPraos c) era) ValuesMK
initExtLedgerState
      }
    , (ShelleyLeaderCredentials c
 -> m (BlockForging m (ShelleyBlock (TPraos c) era)))
-> [ShelleyLeaderCredentials c]
-> m [BlockForging m (ShelleyBlock (TPraos c) era)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
        (TPraosParams
-> ShelleyLeaderCredentials c
-> m (BlockForging m (ShelleyBlock (TPraos c) era))
forall (m :: * -> *) era c.
(ShelleyCompatible (TPraos c) era,
 TxLimits (ShelleyBlock (TPraos c) era), IOLike m) =>
TPraosParams
-> ShelleyLeaderCredentials c
-> m (BlockForging m (ShelleyBlock (TPraos c) era))
shelleyBlockForging TPraosParams
tpraosParams)
        [ShelleyLeaderCredentials c]
credentialss
    )
  where
    genesis :: SL.ShelleyGenesis
    genesis :: ShelleyGenesis
genesis = TransitionConfig era
transitionCfg TransitionConfig era
-> Getting ShelleyGenesis (TransitionConfig era) ShelleyGenesis
-> ShelleyGenesis
forall s a. s -> Getting a s a -> a
^. Getting ShelleyGenesis (TransitionConfig era) ShelleyGenesis
forall era.
EraTransition era =>
Lens' (TransitionConfig era) ShelleyGenesis
Lens' (TransitionConfig era) ShelleyGenesis
L.tcShelleyGenesisL

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

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

    consensusConfig :: ConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) era))
    consensusConfig :: ConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) era))
consensusConfig = TPraosConfig {
        TPraosParams
tpraosParams :: TPraosParams
tpraosParams :: TPraosParams
tpraosParams
      , tpraosEpochInfo :: EpochInfo (Except PastHorizonException)
tpraosEpochInfo = EpochInfo (Except PastHorizonException)
epochInfo
      }

    ledgerConfig :: LedgerConfig (ShelleyBlock (TPraos c) era)
    ledgerConfig :: LedgerConfig (ShelleyBlock (TPraos c) era)
ledgerConfig =
        ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
forall era.
ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
mkShelleyLedgerConfig
         ShelleyGenesis
genesis
         (TransitionConfig era
transitionCfg TransitionConfig era
-> Getting
     (TranslationContext era)
     (TransitionConfig era)
     (TranslationContext era)
-> TranslationContext era
forall s a. s -> Getting a s a -> a
^. Getting
  (TranslationContext era)
  (TransitionConfig era)
  (TranslationContext era)
forall era.
EraTransition era =>
Lens' (TransitionConfig era) (TranslationContext era)
Lens' (TransitionConfig era) (TranslationContext era)
L.tcTranslationContextL)
         EpochInfo (Except PastHorizonException)
epochInfo

    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 -> EpochSize
SL.sgEpochLength ShelleyGenesis
genesis)
          (NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ NominalDiffTimeMicro -> NominalDiffTime
SL.fromNominalDiffTimeMicro (NominalDiffTimeMicro -> NominalDiffTime)
-> NominalDiffTimeMicro -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> NominalDiffTimeMicro
SL.sgSlotLength ShelleyGenesis
genesis)

    tpraosParams :: TPraosParams
    tpraosParams :: TPraosParams
tpraosParams = MaxMajorProtVer -> Nonce -> ShelleyGenesis -> TPraosParams
mkTPraosParams MaxMajorProtVer
maxMajorProtVer Nonce
initialNonce ShelleyGenesis
genesis

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

    storageConfig :: StorageConfig (ShelleyBlock (TPraos c) era)
    storageConfig :: StorageConfig (ShelleyBlock (TPraos c) era)
storageConfig = ShelleyStorageConfig {
          shelleyStorageConfigSlotsPerKESPeriod :: Word64
shelleyStorageConfigSlotsPerKESPeriod = TPraosParams -> Word64
tpraosSlotsPerKESPeriod TPraosParams
tpraosParams
        , shelleyStorageConfigSecurityParam :: SecurityParam
shelleyStorageConfigSecurityParam     = TPraosParams -> SecurityParam
tpraosSecurityParam     TPraosParams
tpraosParams
        }

    initLedgerState :: LedgerState (ShelleyBlock (TPraos c) era) ValuesMK
    initLedgerState :: LedgerState (ShelleyBlock (TPraos c) era) ValuesMK
initLedgerState = LedgerState (ShelleyBlock (TPraos c) era) EmptyMK
-> LedgerState (ShelleyBlock (TPraos c) era) ValuesMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables ShelleyLedgerState {
        shelleyLedgerTip :: WithOrigin (ShelleyTip (TPraos c) era)
shelleyLedgerTip        = WithOrigin (ShelleyTip (TPraos c) era)
forall t. WithOrigin t
Origin
      , shelleyLedgerState :: NewEpochState era
shelleyLedgerState      =
            TransitionConfig era -> NewEpochState era -> NewEpochState era
forall era.
EraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
L.injectIntoTestState TransitionConfig era
transitionCfg
          (NewEpochState era -> NewEpochState era)
-> NewEpochState era -> NewEpochState era
forall a b. (a -> b) -> a -> b
$ TransitionConfig era -> NewEpochState era
forall era.
(EraTransition era, HasCallStack) =>
TransitionConfig era -> NewEpochState era
L.createInitialState  TransitionConfig era
transitionCfg
      , shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo {shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0}
      , shelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock (TPraos c) era)) EmptyMK
shelleyLedgerTables     = LedgerTables (LedgerState (ShelleyBlock (TPraos c) era)) EmptyMK
forall (mk :: MapKind) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
      }

    initChainDepState :: TPraosState
    initChainDepState :: TPraosState
initChainDepState = WithOrigin SlotNo -> ChainDepState -> TPraosState
TPraosState WithOrigin SlotNo
forall t. WithOrigin t
Origin (ChainDepState -> TPraosState) -> ChainDepState -> TPraosState
forall a b. (a -> b) -> a -> b
$
      Nonce -> Map (KeyHash 'Genesis) GenDelegPair -> ChainDepState
SL.initialChainDepState Nonce
initialNonce (ShelleyGenesis -> Map (KeyHash 'Genesis) GenDelegPair
SL.sgGenDelegs ShelleyGenesis
genesis)

    initExtLedgerState :: ExtLedgerState (ShelleyBlock (TPraos c) era) ValuesMK
    initExtLedgerState :: ExtLedgerState (ShelleyBlock (TPraos c) era) ValuesMK
initExtLedgerState = ExtLedgerState {
        ledgerState :: LedgerState (ShelleyBlock (TPraos c) era) ValuesMK
ledgerState = LedgerState (ShelleyBlock (TPraos c) era) ValuesMK
initLedgerState
      , headerState :: HeaderState (ShelleyBlock (TPraos c) era)
headerState = ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) era))
-> HeaderState (ShelleyBlock (TPraos c) era)
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) era))
TPraosState
initChainDepState
      }