{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Shelley.Node (
protocolInfoShelley
, ProtocolParamsShelley (..)
, ProtocolParamsAllegra (..)
, ProtocolParamsMary (..)
, protocolClientInfoShelley
, SL.ShelleyGenesis (..)
, SL.ShelleyGenesisStaking (..)
, TPraosLeaderCredentials (..)
, shelleyBlockForging
, tpraosBlockIssuerVKey
, SL.ProtVer (..)
, SL.Nonce (..)
, MaxMajorProtVer (..)
, SL.emptyGenesisStaking
, validateGenesis
) where
import Data.Bifunctor (first)
import Data.Foldable (toList)
import Data.Functor.Identity (Identity)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Slotting.EpochInfo
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Config.SupportsNode
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Node.InitStorage
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
import Ouroboros.Consensus.Util.Assert
import Ouroboros.Consensus.Util.IOLike
import Cardano.Ledger.Val ((<->))
import qualified Shelley.Spec.Ledger.API as SL
import qualified Shelley.Spec.Ledger.OCert as Absolute (KESPeriod (..))
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.Serialisation ()
import Ouroboros.Consensus.Shelley.Protocol
import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey
data TPraosLeaderCredentials c = TPraosLeaderCredentials {
TPraosLeaderCredentials c -> SignKeyKES c
tpraosLeaderCredentialsInitSignKey :: SL.SignKeyKES c
, TPraosLeaderCredentials c -> TPraosCanBeLeader c
tpraosLeaderCredentialsCanBeLeader :: TPraosCanBeLeader c
, TPraosLeaderCredentials c -> Text
tpraosLeaderCredentialsLabel :: Text
}
tpraosBlockIssuerVKey ::
TPraosLeaderCredentials c -> SL.VKey 'SL.BlockIssuer c
tpraosBlockIssuerVKey :: TPraosLeaderCredentials c -> VKey 'BlockIssuer c
tpraosBlockIssuerVKey =
TPraosCanBeLeader c -> VKey 'BlockIssuer c
forall c. TPraosCanBeLeader c -> VKey 'BlockIssuer c
tpraosCanBeLeaderColdVerKey (TPraosCanBeLeader c -> VKey 'BlockIssuer c)
-> (TPraosLeaderCredentials c -> TPraosCanBeLeader c)
-> TPraosLeaderCredentials c
-> VKey 'BlockIssuer c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TPraosLeaderCredentials c -> TPraosCanBeLeader c
forall c. TPraosLeaderCredentials c -> TPraosCanBeLeader c
tpraosLeaderCredentialsCanBeLeader
type instance CannotForge (ShelleyBlock era) = TPraosCannotForge (EraCrypto era)
type instance ForgeStateInfo (ShelleyBlock era) = HotKey.KESInfo
type instance ForgeStateUpdateError (ShelleyBlock era) = HotKey.KESEvolutionError
shelleyBlockForging ::
forall m era. (ShelleyBasedEra era, IOLike m)
=> TPraosParams
-> TPraosLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock era))
shelleyBlockForging :: TPraosParams
-> TPraosLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock era))
shelleyBlockForging TPraosParams {Word64
SecurityParam
Nonce
ActiveSlotCoeff
Network
MaxMajorProtVer
tpraosInitialNonce :: TPraosParams -> Nonce
tpraosNetworkId :: TPraosParams -> Network
tpraosMaxLovelaceSupply :: TPraosParams -> Word64
tpraosMaxMajorPV :: TPraosParams -> MaxMajorProtVer
tpraosQuorum :: TPraosParams -> Word64
tpraosMaxKESEvo :: TPraosParams -> Word64
tpraosSecurityParam :: TPraosParams -> SecurityParam
tpraosLeaderF :: TPraosParams -> ActiveSlotCoeff
tpraosSlotsPerKESPeriod :: TPraosParams -> Word64
tpraosInitialNonce :: Nonce
tpraosNetworkId :: Network
tpraosMaxLovelaceSupply :: Word64
tpraosMaxMajorPV :: MaxMajorProtVer
tpraosQuorum :: Word64
tpraosMaxKESEvo :: Word64
tpraosSecurityParam :: SecurityParam
tpraosLeaderF :: ActiveSlotCoeff
tpraosSlotsPerKESPeriod :: Word64
..}
TPraosLeaderCredentials {
$sel:tpraosLeaderCredentialsInitSignKey:TPraosLeaderCredentials :: forall c. TPraosLeaderCredentials c -> SignKeyKES c
tpraosLeaderCredentialsInitSignKey = SignKeyKES (EraCrypto era)
initSignKey
, $sel:tpraosLeaderCredentialsCanBeLeader:TPraosLeaderCredentials :: forall c. TPraosLeaderCredentials c -> TPraosCanBeLeader c
tpraosLeaderCredentialsCanBeLeader = TPraosCanBeLeader (EraCrypto era)
canBeLeader
, $sel:tpraosLeaderCredentialsLabel:TPraosLeaderCredentials :: forall c. TPraosLeaderCredentials c -> Text
tpraosLeaderCredentialsLabel = Text
label
} = do
HotKey (EraCrypto era) m
hotKey <- SignKeyKES (EraCrypto era)
-> KESPeriod -> Word64 -> m (HotKey (EraCrypto era) m)
forall (m :: * -> *) c.
(Crypto c, IOLike m) =>
SignKeyKES c -> KESPeriod -> Word64 -> m (HotKey c m)
HotKey.mkHotKey SignKeyKES (EraCrypto era)
initSignKey KESPeriod
startPeriod Word64
tpraosMaxKESEvo
BlockForging m (ShelleyBlock era)
-> m (BlockForging m (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return BlockForging :: forall (m :: * -> *) blk.
Text
-> CanBeLeader (BlockProtocol blk)
-> (SlotNo -> m (ForgeStateUpdateInfo blk))
-> (forall p.
(BlockProtocol blk ~ p) =>
TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState p)
-> IsLeader p
-> ForgeStateInfo blk
-> Either (CannotForge blk) ())
-> (TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [GenTx blk]
-> IsLeader (BlockProtocol blk)
-> m blk)
-> BlockForging m blk
BlockForging {
forgeLabel :: Text
forgeLabel = Text
label
, canBeLeader :: CanBeLeader (BlockProtocol (ShelleyBlock era))
canBeLeader = CanBeLeader (BlockProtocol (ShelleyBlock era))
TPraosCanBeLeader (EraCrypto era)
canBeLeader
, updateForgeState :: SlotNo -> m (ForgeStateUpdateInfo (ShelleyBlock era))
updateForgeState = \SlotNo
curSlot ->
UpdateInfo KESInfo KESInfo KESEvolutionError
-> ForgeStateUpdateInfo (ShelleyBlock era)
forall blk.
UpdateInfo
(ForgeStateInfo blk)
(ForgeStateInfo blk)
(ForgeStateUpdateError blk)
-> ForgeStateUpdateInfo blk
ForgeStateUpdateInfo (UpdateInfo KESInfo KESInfo KESEvolutionError
-> ForgeStateUpdateInfo (ShelleyBlock era))
-> m (UpdateInfo KESInfo KESInfo KESEvolutionError)
-> m (ForgeStateUpdateInfo (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
HotKey (EraCrypto era) m
-> KESPeriod -> m (UpdateInfo KESInfo KESInfo KESEvolutionError)
forall c (m :: * -> *).
HotKey c m
-> KESPeriod -> m (UpdateInfo KESInfo KESInfo KESEvolutionError)
HotKey.evolve HotKey (EraCrypto era) m
hotKey (SlotNo -> KESPeriod
slotToPeriod SlotNo
curSlot)
, checkCanForge :: forall p.
(BlockProtocol (ShelleyBlock era) ~ p) =>
TopLevelConfig (ShelleyBlock era)
-> SlotNo
-> Ticked (ChainDepState p)
-> IsLeader p
-> ForgeStateInfo (ShelleyBlock era)
-> Either (CannotForge (ShelleyBlock era)) ()
checkCanForge = \TopLevelConfig (ShelleyBlock era)
cfg SlotNo
curSlot Ticked (ChainDepState p)
_tickedChainDepState ->
ConsensusConfig (TPraos (EraCrypto era))
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
-> SlotNo
-> IsLeader (TPraos (EraCrypto era))
-> KESInfo
-> Either (TPraosCannotForge (EraCrypto era)) ()
forall c.
ConsensusConfig (TPraos c)
-> Hash c (VerKeyVRF c)
-> SlotNo
-> IsLeader (TPraos c)
-> KESInfo
-> Either (TPraosCannotForge c) ()
tpraosCheckCanForge
(TopLevelConfig (ShelleyBlock era)
-> ConsensusConfig (BlockProtocol (ShelleyBlock era))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig (ShelleyBlock era)
cfg)
Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
forgingVRFHash
SlotNo
curSlot
, forgeBlock :: TopLevelConfig (ShelleyBlock era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock era)
-> [GenTx (ShelleyBlock era)]
-> IsLeader (BlockProtocol (ShelleyBlock era))
-> m (ShelleyBlock era)
forgeBlock = HotKey (EraCrypto era) m
-> TPraosCanBeLeader (EraCrypto era)
-> TopLevelConfig (ShelleyBlock era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock era)
-> [GenTx (ShelleyBlock era)]
-> TPraosIsLeader (EraCrypto era)
-> m (ShelleyBlock era)
forall (m :: * -> *) era.
(ShelleyBasedEra era, Monad m) =>
HotKey (EraCrypto era) m
-> TPraosCanBeLeader (EraCrypto era)
-> TopLevelConfig (ShelleyBlock era)
-> BlockNo
-> SlotNo
-> TickedLedgerState (ShelleyBlock era)
-> [GenTx (ShelleyBlock era)]
-> TPraosIsLeader (EraCrypto era)
-> m (ShelleyBlock era)
forgeShelleyBlock HotKey (EraCrypto era) m
hotKey TPraosCanBeLeader (EraCrypto era)
canBeLeader
}
where
forgingVRFHash :: SL.Hash (EraCrypto era) (SL.VerKeyVRF (EraCrypto era))
forgingVRFHash :: Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
forgingVRFHash =
VerKeyVRF (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
SL.hashVerKeyVRF
(VerKeyVRF (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era)))
-> (TPraosCanBeLeader (EraCrypto era) -> VerKeyVRF (EraCrypto era))
-> TPraosCanBeLeader (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyVRF (VRF (EraCrypto era)) -> VerKeyVRF (EraCrypto era)
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
VRF.deriveVerKeyVRF
(SignKeyVRF (VRF (EraCrypto era)) -> VerKeyVRF (EraCrypto era))
-> (TPraosCanBeLeader (EraCrypto era)
-> SignKeyVRF (VRF (EraCrypto era)))
-> TPraosCanBeLeader (EraCrypto era)
-> VerKeyVRF (EraCrypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TPraosCanBeLeader (EraCrypto era)
-> SignKeyVRF (VRF (EraCrypto era))
forall c. TPraosCanBeLeader c -> SignKeyVRF c
tpraosCanBeLeaderSignKeyVRF
(TPraosCanBeLeader (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era)))
-> TPraosCanBeLeader (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
forall a b. (a -> b) -> a -> b
$ TPraosCanBeLeader (EraCrypto era)
canBeLeader
startPeriod :: Absolute.KESPeriod
startPeriod :: KESPeriod
startPeriod = OCert (EraCrypto era) -> KESPeriod
forall crypto. OCert crypto -> KESPeriod
SL.ocertKESPeriod (OCert (EraCrypto era) -> KESPeriod)
-> OCert (EraCrypto era) -> KESPeriod
forall a b. (a -> b) -> a -> b
$ TPraosCanBeLeader (EraCrypto era) -> OCert (EraCrypto era)
forall c. TPraosCanBeLeader c -> OCert c
tpraosCanBeLeaderOpCert TPraosCanBeLeader (EraCrypto era)
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
validateGenesis ::
ShelleyBasedEra era
=> SL.ShelleyGenesis era -> Either String ()
validateGenesis :: ShelleyGenesis era -> Either String ()
validateGenesis = ([ValidationErr] -> String)
-> Either [ValidationErr] () -> Either String ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [ValidationErr] -> String
errsToString (Either [ValidationErr] () -> Either String ())
-> (ShelleyGenesis era -> Either [ValidationErr] ())
-> ShelleyGenesis era
-> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis era -> Either [ValidationErr] ()
forall era.
Era era =>
ShelleyGenesis era -> 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)
data ProtocolParamsShelley c f = ProtocolParamsShelley {
ProtocolParamsShelley c f -> ShelleyGenesis (ShelleyEra c)
shelleyGenesis :: SL.ShelleyGenesis (ShelleyEra c)
, ProtocolParamsShelley c f -> Nonce
shelleyInitialNonce :: SL.Nonce
, ProtocolParamsShelley c f -> ProtVer
shelleyProtVer :: SL.ProtVer
, ProtocolParamsShelley c f -> f (TPraosLeaderCredentials c)
shelleyLeaderCredentials :: f (TPraosLeaderCredentials c)
}
data ProtocolParamsAllegra c f = ProtocolParamsAllegra {
ProtocolParamsAllegra c f -> ProtVer
allegraProtVer :: SL.ProtVer
, ProtocolParamsAllegra c f -> f (TPraosLeaderCredentials c)
allegraLeaderCredentials :: f (TPraosLeaderCredentials c)
}
data ProtocolParamsMary c f = ProtocolParamsMary {
ProtocolParamsMary c f -> ProtVer
maryProtVer :: SL.ProtVer
, ProtocolParamsMary c f -> f (TPraosLeaderCredentials c)
maryLeaderCredentials :: f (TPraosLeaderCredentials c)
}
protocolInfoShelley ::
forall m c f. (IOLike m, ShelleyBasedEra (ShelleyEra c), Foldable f)
=> ProtocolParamsShelley c f
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
protocolInfoShelley :: ProtocolParamsShelley c f
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
protocolInfoShelley ProtocolParamsShelley {
$sel:shelleyGenesis:ProtocolParamsShelley :: forall c (f :: * -> *).
ProtocolParamsShelley c f -> ShelleyGenesis (ShelleyEra c)
shelleyGenesis = ShelleyGenesis (ShelleyEra c)
genesis
, $sel:shelleyInitialNonce:ProtocolParamsShelley :: forall c (f :: * -> *). ProtocolParamsShelley c f -> Nonce
shelleyInitialNonce = Nonce
initialNonce
, $sel:shelleyProtVer:ProtocolParamsShelley :: forall c (f :: * -> *). ProtocolParamsShelley c f -> ProtVer
shelleyProtVer = ProtVer
protVer
, $sel:shelleyLeaderCredentials:ProtocolParamsShelley :: forall c (f :: * -> *).
ProtocolParamsShelley c f -> f (TPraosLeaderCredentials c)
shelleyLeaderCredentials = f (TPraosLeaderCredentials c)
credentialss
} =
Either String ()
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
forall a. HasCallStack => Either String () -> a -> a
assertWithMsg (ShelleyGenesis (ShelleyEra c) -> Either String ()
forall era.
ShelleyBasedEra era =>
ShelleyGenesis era -> Either String ()
validateGenesis ShelleyGenesis (ShelleyEra c)
genesis) (ProtocolInfo m (ShelleyBlock (ShelleyEra c))
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c)))
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
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 (ShelleyEra c))
pInfoConfig = TopLevelConfig (ShelleyBlock (ShelleyEra c))
topLevelConfig
, pInfoInitLedger :: ExtLedgerState (ShelleyBlock (ShelleyEra c))
pInfoInitLedger = ExtLedgerState (ShelleyBlock (ShelleyEra c))
initExtLedgerState
, pInfoBlockForging :: [m (BlockForging m (ShelleyBlock (ShelleyEra c)))]
pInfoBlockForging = TPraosParams
-> TPraosLeaderCredentials (EraCrypto (ShelleyEra c))
-> m (BlockForging m (ShelleyBlock (ShelleyEra c)))
forall (m :: * -> *) era.
(ShelleyBasedEra era, IOLike m) =>
TPraosParams
-> TPraosLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock era))
shelleyBlockForging TPraosParams
tpraosParams (TPraosLeaderCredentials c
-> m (BlockForging m (ShelleyBlock (ShelleyEra c))))
-> [TPraosLeaderCredentials c]
-> [m (BlockForging m (ShelleyBlock (ShelleyEra c)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (TPraosLeaderCredentials c)
credentialss
}
where
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 (ShelleyEra c))
topLevelConfig :: TopLevelConfig (ShelleyBlock (ShelleyEra c))
topLevelConfig = TopLevelConfig :: forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
TopLevelConfig {
topLevelConfigProtocol :: ConsensusConfig (BlockProtocol (ShelleyBlock (ShelleyEra c)))
topLevelConfigProtocol = ConsensusConfig (BlockProtocol (ShelleyBlock (ShelleyEra c)))
consensusConfig
, topLevelConfigLedger :: LedgerConfig (ShelleyBlock (ShelleyEra c))
topLevelConfigLedger = LedgerConfig (ShelleyBlock (ShelleyEra c))
ledgerConfig
, topLevelConfigBlock :: BlockConfig (ShelleyBlock (ShelleyEra c))
topLevelConfigBlock = BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfig
, topLevelConfigCodec :: CodecConfig (ShelleyBlock (ShelleyEra c))
topLevelConfigCodec = CodecConfig (ShelleyBlock (ShelleyEra c))
forall era. CodecConfig (ShelleyBlock era)
ShelleyCodecConfig
, topLevelConfigStorage :: StorageConfig (ShelleyBlock (ShelleyEra c))
topLevelConfigStorage = StorageConfig (ShelleyBlock (ShelleyEra c))
storageConfig
}
consensusConfig :: ConsensusConfig (BlockProtocol (ShelleyBlock (ShelleyEra c)))
consensusConfig :: ConsensusConfig (BlockProtocol (ShelleyBlock (ShelleyEra c)))
consensusConfig = TPraosConfig :: forall c.
TPraosParams -> EpochInfo Identity -> ConsensusConfig (TPraos c)
TPraosConfig {
TPraosParams
tpraosParams :: TPraosParams
tpraosParams :: TPraosParams
tpraosParams
, tpraosEpochInfo :: EpochInfo Identity
tpraosEpochInfo = EpochInfo Identity
epochInfo
}
ledgerConfig :: LedgerConfig (ShelleyBlock (ShelleyEra c))
ledgerConfig :: LedgerConfig (ShelleyBlock (ShelleyEra c))
ledgerConfig = ShelleyGenesis (ShelleyEra c)
-> EpochInfo Identity
-> MaxMajorProtVer
-> ShelleyLedgerConfig (ShelleyEra c)
forall era.
ShelleyGenesis era
-> EpochInfo Identity -> MaxMajorProtVer -> ShelleyLedgerConfig era
mkShelleyLedgerConfig ShelleyGenesis (ShelleyEra c)
genesis EpochInfo Identity
epochInfo MaxMajorProtVer
maxMajorProtVer
epochInfo :: EpochInfo Identity
epochInfo :: EpochInfo Identity
epochInfo = EpochSize -> EpochInfo Identity
forall (m :: * -> *). Monad m => EpochSize -> EpochInfo m
fixedSizeEpochInfo (EpochSize -> EpochInfo Identity)
-> EpochSize -> EpochInfo Identity
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis (ShelleyEra c) -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength ShelleyGenesis (ShelleyEra c)
genesis
tpraosParams :: TPraosParams
tpraosParams :: TPraosParams
tpraosParams = MaxMajorProtVer
-> Nonce -> ShelleyGenesis (ShelleyEra c) -> TPraosParams
forall era.
MaxMajorProtVer -> Nonce -> ShelleyGenesis era -> TPraosParams
mkTPraosParams MaxMajorProtVer
maxMajorProtVer Nonce
initialNonce ShelleyGenesis (ShelleyEra c)
genesis
blockConfig :: BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfig :: BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfig =
ProtVer
-> ShelleyGenesis (ShelleyEra c)
-> [VKey 'BlockIssuer (EraCrypto (ShelleyEra c))]
-> BlockConfig (ShelleyBlock (ShelleyEra c))
forall era.
ShelleyBasedEra era =>
ProtVer
-> ShelleyGenesis era
-> [VKey 'BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock era)
mkShelleyBlockConfig
ProtVer
protVer
ShelleyGenesis (ShelleyEra c)
genesis
(TPraosLeaderCredentials c -> VKey 'BlockIssuer c
forall c. TPraosLeaderCredentials c -> VKey 'BlockIssuer c
tpraosBlockIssuerVKey (TPraosLeaderCredentials c -> VKey 'BlockIssuer c)
-> [TPraosLeaderCredentials c] -> [VKey 'BlockIssuer c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (TPraosLeaderCredentials c)
credentialss)
storageConfig :: StorageConfig (ShelleyBlock (ShelleyEra c))
storageConfig :: StorageConfig (ShelleyBlock (ShelleyEra c))
storageConfig = ShelleyStorageConfig :: forall era.
Word64 -> SecurityParam -> StorageConfig (ShelleyBlock era)
ShelleyStorageConfig {
shelleyStorageConfigSlotsPerKESPeriod :: Word64
shelleyStorageConfigSlotsPerKESPeriod = TPraosParams -> Word64
tpraosSlotsPerKESPeriod TPraosParams
tpraosParams
, shelleyStorageConfigSecurityParam :: SecurityParam
shelleyStorageConfigSecurityParam = TPraosParams -> SecurityParam
tpraosSecurityParam TPraosParams
tpraosParams
}
initLedgerState :: LedgerState (ShelleyBlock (ShelleyEra c))
initLedgerState :: LedgerState (ShelleyBlock (ShelleyEra c))
initLedgerState = ShelleyLedgerState :: forall era.
WithOrigin (ShelleyTip era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock era)
ShelleyLedgerState {
shelleyLedgerTip :: WithOrigin (ShelleyTip (ShelleyEra c))
shelleyLedgerTip = WithOrigin (ShelleyTip (ShelleyEra c))
forall t. WithOrigin t
Origin
, shelleyLedgerState :: NewEpochState (ShelleyEra c)
shelleyLedgerState = ChainState (ShelleyEra c) -> NewEpochState (ShelleyEra c)
forall era. ChainState era -> NewEpochState era
SL.chainNes ChainState (ShelleyEra c)
initShelleyState
, shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo {shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0}
}
initChainDepState :: TPraosState c
initChainDepState :: TPraosState c
initChainDepState = WithOrigin SlotNo -> ChainDepState c -> TPraosState c
forall c. WithOrigin SlotNo -> ChainDepState c -> TPraosState c
TPraosState WithOrigin SlotNo
forall t. WithOrigin t
Origin (ChainDepState c -> TPraosState c)
-> ChainDepState c -> TPraosState c
forall a b. (a -> b) -> a -> b
$
ChainDepState :: forall crypto.
PrtclState crypto -> TicknState -> Nonce -> ChainDepState crypto
SL.ChainDepState {
csProtocol :: PrtclState c
SL.csProtocol = Map (KeyHash 'BlockIssuer c) Word64
-> Nonce -> Nonce -> PrtclState c
forall crypto.
Map (KeyHash 'BlockIssuer crypto) Word64
-> Nonce -> Nonce -> PrtclState crypto
SL.PrtclState
(ChainState (ShelleyEra c)
-> Map (KeyHash 'BlockIssuer (EraCrypto (ShelleyEra c))) Word64
forall era.
ChainState era -> Map (KeyHash 'BlockIssuer (Crypto era)) Word64
SL.chainOCertIssue ChainState (ShelleyEra c)
initShelleyState)
(ChainState (ShelleyEra c) -> Nonce
forall era. ChainState era -> Nonce
SL.chainEvolvingNonce ChainState (ShelleyEra c)
initShelleyState)
(ChainState (ShelleyEra c) -> Nonce
forall era. ChainState era -> Nonce
SL.chainCandidateNonce ChainState (ShelleyEra c)
initShelleyState)
, csTickn :: TicknState
SL.csTickn = Nonce -> Nonce -> TicknState
SL.TicknState
(ChainState (ShelleyEra c) -> Nonce
forall era. ChainState era -> Nonce
SL.chainEpochNonce ChainState (ShelleyEra c)
initShelleyState)
(ChainState (ShelleyEra c) -> Nonce
forall era. ChainState era -> Nonce
SL.chainPrevEpochNonce ChainState (ShelleyEra c)
initShelleyState)
, csLabNonce :: Nonce
SL.csLabNonce =
(ChainState (ShelleyEra c) -> Nonce
forall era. ChainState era -> Nonce
SL.chainPrevEpochNonce ChainState (ShelleyEra c)
initShelleyState)
}
initialEpochNo :: EpochNo
initialEpochNo :: EpochNo
initialEpochNo = EpochNo
0
initialUtxo :: SL.UTxO (ShelleyEra c)
initialUtxo :: UTxO (ShelleyEra c)
initialUtxo = ShelleyGenesis (ShelleyEra c) -> UTxO (ShelleyEra c)
forall era. ShelleyBased era => ShelleyGenesis era -> UTxO era
SL.genesisUtxO ShelleyGenesis (ShelleyEra c)
genesis
initShelleyState :: SL.ChainState (ShelleyEra c)
initShelleyState :: ChainState (ShelleyEra c)
initShelleyState = ChainState (ShelleyEra c) -> ChainState (ShelleyEra c)
registerGenesisStaking (ChainState (ShelleyEra c) -> ChainState (ShelleyEra c))
-> ChainState (ShelleyEra c) -> ChainState (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$ WithOrigin (LastAppliedBlock (EraCrypto (ShelleyEra c)))
-> EpochNo
-> UTxO (ShelleyEra c)
-> Coin
-> Map
(KeyHash 'Genesis (EraCrypto (ShelleyEra c)))
(GenDelegPair (EraCrypto (ShelleyEra c)))
-> PParams (ShelleyEra c)
-> Nonce
-> ChainState (ShelleyEra c)
forall era.
WithOrigin (LastAppliedBlock (Crypto era))
-> EpochNo
-> UTxO era
-> Coin
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> PParams era
-> Nonce
-> ChainState era
SL.initialShelleyState
WithOrigin (LastAppliedBlock (EraCrypto (ShelleyEra c)))
forall t. WithOrigin t
Origin
EpochNo
initialEpochNo
UTxO (ShelleyEra c)
initialUtxo
(Word64 -> Coin
SL.word64ToCoin (ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgMaxLovelaceSupply ShelleyGenesis (ShelleyEra c)
genesis) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> UTxO (ShelleyEra c) -> Value (ShelleyEra c)
forall era. ShelleyBased era => UTxO era -> Value era
SL.balance UTxO (ShelleyEra c)
initialUtxo)
(ShelleyGenesis (ShelleyEra c)
-> Map
(KeyHash 'Genesis (EraCrypto (ShelleyEra c)))
(GenDelegPair (EraCrypto (ShelleyEra c)))
forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
SL.sgGenDelegs ShelleyGenesis (ShelleyEra c)
genesis)
(ShelleyGenesis (ShelleyEra c) -> PParams (ShelleyEra c)
forall era. ShelleyGenesis era -> PParams era
SL.sgProtocolParams ShelleyGenesis (ShelleyEra c)
genesis)
Nonce
initialNonce
initExtLedgerState :: ExtLedgerState (ShelleyBlock (ShelleyEra c))
initExtLedgerState :: ExtLedgerState (ShelleyBlock (ShelleyEra c))
initExtLedgerState = ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState {
ledgerState :: LedgerState (ShelleyBlock (ShelleyEra c))
ledgerState = LedgerState (ShelleyBlock (ShelleyEra c))
initLedgerState
, headerState :: HeaderState (ShelleyBlock (ShelleyEra c))
headerState = ChainDepState (BlockProtocol (ShelleyBlock (ShelleyEra c)))
-> HeaderState (ShelleyBlock (ShelleyEra c))
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ChainDepState (BlockProtocol (ShelleyBlock (ShelleyEra c)))
TPraosState c
initChainDepState
}
registerGenesisStaking :: SL.ChainState (ShelleyEra c) -> SL.ChainState (ShelleyEra c)
registerGenesisStaking :: ChainState (ShelleyEra c) -> ChainState (ShelleyEra c)
registerGenesisStaking cs :: ChainState (ShelleyEra c)
cs@(SL.ChainState {chainNes :: forall era. ChainState era -> NewEpochState era
chainNes = NewEpochState (ShelleyEra c)
oldChainNes} ) = ChainState (ShelleyEra c)
cs
{ chainNes :: NewEpochState (ShelleyEra c)
SL.chainNes = NewEpochState (ShelleyEra c)
newChainNes }
where
SL.ShelleyGenesisStaking { Map
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
(PoolParams (ShelleyEra c))
sgsPools :: forall era.
ShelleyGenesisStaking era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
sgsPools :: Map
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
(PoolParams (ShelleyEra c))
sgsPools, Map
(KeyHash 'Staking (EraCrypto (ShelleyEra c)))
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
sgsStake :: forall era.
ShelleyGenesisStaking era
-> Map
(KeyHash 'Staking (Crypto era)) (KeyHash 'StakePool (Crypto era))
sgsStake :: Map
(KeyHash 'Staking (EraCrypto (ShelleyEra c)))
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
sgsStake } = ShelleyGenesis (ShelleyEra c)
-> ShelleyGenesisStaking (ShelleyEra c)
forall era. ShelleyGenesis era -> ShelleyGenesisStaking era
SL.sgStaking ShelleyGenesis (ShelleyEra c)
genesis
oldEpochState :: EpochState (ShelleyEra c)
oldEpochState = NewEpochState (ShelleyEra c) -> EpochState (ShelleyEra c)
forall era. NewEpochState era -> EpochState era
SL.nesEs (NewEpochState (ShelleyEra c) -> EpochState (ShelleyEra c))
-> NewEpochState (ShelleyEra c) -> EpochState (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$ NewEpochState (ShelleyEra c)
oldChainNes
oldLedgerState :: LedgerState (ShelleyEra c)
oldLedgerState = EpochState (ShelleyEra c) -> LedgerState (ShelleyEra c)
forall era. EpochState era -> LedgerState era
SL.esLState EpochState (ShelleyEra c)
oldEpochState
oldDPState :: DPState (ShelleyEra c)
oldDPState = LedgerState (ShelleyEra c) -> DPState (ShelleyEra c)
forall era. LedgerState era -> DPState era
SL._delegationState LedgerState (ShelleyEra c)
oldLedgerState
newPoolDistr :: PoolDistr (EraCrypto (ShelleyEra c))
newPoolDistr = SnapShot (ShelleyEra c) -> PoolDistr (EraCrypto (ShelleyEra c))
forall era. SnapShot era -> PoolDistr (Crypto era)
SL.calculatePoolDistr SnapShot (ShelleyEra c)
initSnapShot
newChainNes :: NewEpochState (ShelleyEra c)
newChainNes = NewEpochState (ShelleyEra c)
oldChainNes
{ nesEs :: EpochState (ShelleyEra c)
SL.nesEs = EpochState (ShelleyEra c)
newEpochState
, nesPd :: PoolDistr (EraCrypto (ShelleyEra c))
SL.nesPd = PoolDistr (EraCrypto (ShelleyEra c))
newPoolDistr
}
newEpochState :: EpochState (ShelleyEra c)
newEpochState = EpochState (ShelleyEra c)
oldEpochState
{ esLState :: LedgerState (ShelleyEra c)
SL.esLState = LedgerState (ShelleyEra c)
newLedgerState
, esSnapshots :: SnapShots (ShelleyEra c)
SL.esSnapshots = (EpochState (ShelleyEra c) -> SnapShots (ShelleyEra c)
forall era. EpochState era -> SnapShots era
SL.esSnapshots EpochState (ShelleyEra c)
oldEpochState)
{ $sel:_pstakeMark:SnapShots :: SnapShot (ShelleyEra c)
SL._pstakeMark = SnapShot (ShelleyEra c)
initSnapShot }
}
newLedgerState :: LedgerState (ShelleyEra c)
newLedgerState = LedgerState (ShelleyEra c)
oldLedgerState
{ _delegationState :: DPState (ShelleyEra c)
SL._delegationState = DPState (ShelleyEra c)
newDPState }
newDPState :: DPState (ShelleyEra c)
newDPState = DPState (ShelleyEra c)
oldDPState
{ _dstate :: DState (ShelleyEra c)
SL._dstate = DState (ShelleyEra c)
newDState
, _pstate :: PState (ShelleyEra c)
SL._pstate = PState (ShelleyEra c)
newPState
}
newDState :: SL.DState (ShelleyEra c)
newDState :: DState (ShelleyEra c)
newDState = (DPState (ShelleyEra c) -> DState (ShelleyEra c)
forall era. DPState era -> DState era
SL._dstate DPState (ShelleyEra c)
oldDPState) {
_rewards :: RewardAccounts (ShelleyEra c)
SL._rewards = (KeyHash 'StakePool c -> Coin)
-> Map (Credential 'Staking (ShelleyEra c)) (KeyHash 'StakePool c)
-> RewardAccounts (ShelleyEra c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Coin -> KeyHash 'StakePool c -> Coin
forall a b. a -> b -> a
const (Coin -> KeyHash 'StakePool c -> Coin)
-> Coin -> KeyHash 'StakePool c -> Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
SL.Coin Integer
0)
(Map (Credential 'Staking (ShelleyEra c)) (KeyHash 'StakePool c)
-> RewardAccounts (ShelleyEra c))
-> (Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking (ShelleyEra c)) (KeyHash 'StakePool c))
-> Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
-> RewardAccounts (ShelleyEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHash 'Staking c -> Credential 'Staking (ShelleyEra c))
-> Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking (ShelleyEra c)) (KeyHash 'StakePool c)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys KeyHash 'Staking c -> Credential 'Staking (ShelleyEra c)
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
SL.KeyHashObj
(Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
-> RewardAccounts (ShelleyEra c))
-> Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
-> RewardAccounts (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
Map
(KeyHash 'Staking (EraCrypto (ShelleyEra c)))
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
sgsStake
, _delegations :: Map
(Credential 'Staking (ShelleyEra c))
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
SL._delegations = (KeyHash 'Staking c -> Credential 'Staking (ShelleyEra c))
-> Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking (ShelleyEra c)) (KeyHash 'StakePool c)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys KeyHash 'Staking c -> Credential 'Staking (ShelleyEra c)
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
SL.KeyHashObj Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
Map
(KeyHash 'Staking (EraCrypto (ShelleyEra c)))
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
sgsStake
}
newPState :: SL.PState (ShelleyEra c)
newPState :: PState (ShelleyEra c)
newPState = (DPState (ShelleyEra c) -> PState (ShelleyEra c)
forall era. DPState era -> PState era
SL._pstate DPState (ShelleyEra c)
oldDPState) {
_pParams :: Map
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
(PoolParams (ShelleyEra c))
SL._pParams = Map
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
(PoolParams (ShelleyEra c))
sgsPools
}
initSnapShot :: SnapShot (ShelleyEra c)
initSnapShot = SnapShot :: forall era.
Stake era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> SnapShot era
SL.SnapShot
{ $sel:_stake:SnapShot :: Stake (ShelleyEra c)
SL._stake = RewardAccounts (ShelleyEra c) -> Stake (ShelleyEra c)
forall era. Map (Credential 'Staking era) Coin -> Stake era
SL.Stake (RewardAccounts (ShelleyEra c) -> Stake (ShelleyEra c))
-> ([(Credential 'Staking (ShelleyEra c), Coin)]
-> RewardAccounts (ShelleyEra c))
-> [(Credential 'Staking (ShelleyEra c), Coin)]
-> Stake (ShelleyEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Credential 'Staking (ShelleyEra c), Coin)]
-> RewardAccounts (ShelleyEra c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Credential 'Staking (ShelleyEra c), Coin)]
-> Stake (ShelleyEra c))
-> [(Credential 'Staking (ShelleyEra c), Coin)]
-> Stake (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$
[ (Credential 'Staking (ShelleyEra c)
stakeCred, Coin
stake)
| (Addr (ShelleyEra c)
addr, Coin
stake) <- Map (Addr (ShelleyEra c)) Coin -> [(Addr (ShelleyEra c), Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (ShelleyGenesis (ShelleyEra c) -> Map (Addr (ShelleyEra c)) Coin
forall era. ShelleyGenesis era -> Map (Addr era) Coin
SL.sgInitialFunds ShelleyGenesis (ShelleyEra c)
genesis)
, Just Credential 'Staking (ShelleyEra c)
stakeCred <- [Addr (ShelleyEra c) -> Maybe (Credential 'Staking (ShelleyEra c))
forall era. Addr era -> Maybe (StakeCredential era)
addrStakeCred Addr (ShelleyEra c)
addr]
]
, $sel:_delegations:SnapShot :: Map
(Credential 'Staking (ShelleyEra c))
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
SL._delegations = (KeyHash 'Staking c -> Credential 'Staking (ShelleyEra c))
-> Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking (ShelleyEra c)) (KeyHash 'StakePool c)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys KeyHash 'Staking c -> Credential 'Staking (ShelleyEra c)
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
SL.KeyHashObj Map (KeyHash 'Staking c) (KeyHash 'StakePool c)
Map
(KeyHash 'Staking (EraCrypto (ShelleyEra c)))
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
sgsStake
, $sel:_poolParams:SnapShot :: Map
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
(PoolParams (ShelleyEra c))
SL._poolParams = Map
(KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
(PoolParams (ShelleyEra c))
sgsPools
}
where
addrStakeCred :: Addr era -> Maybe (StakeCredential era)
addrStakeCred (SL.AddrBootstrap BootstrapAddress era
_) = Maybe (StakeCredential era)
forall a. Maybe a
Nothing
addrStakeCred (SL.Addr Network
_ PaymentCredential era
_ StakeReference era
sr) = case StakeReference era
sr of
SL.StakeRefBase StakeCredential era
sc -> StakeCredential era -> Maybe (StakeCredential era)
forall a. a -> Maybe a
Just StakeCredential era
sc
SL.StakeRefPtr Ptr
_ ->
String -> Maybe (StakeCredential era)
forall a. HasCallStack => String -> a
error String
"Pointer stake addresses not allowed in initial snapshot"
StakeReference era
SL.StakeRefNull -> Maybe (StakeCredential era)
forall a. Maybe a
Nothing
protocolClientInfoShelley :: ProtocolClientInfo (ShelleyBlock era)
protocolClientInfoShelley :: ProtocolClientInfo (ShelleyBlock era)
protocolClientInfoShelley =
ProtocolClientInfo :: forall b. CodecConfig b -> ProtocolClientInfo b
ProtocolClientInfo {
pClientInfoCodecConfig :: CodecConfig (ShelleyBlock era)
pClientInfoCodecConfig = CodecConfig (ShelleyBlock era)
forall era. CodecConfig (ShelleyBlock era)
ShelleyCodecConfig
}
instance ConfigSupportsNode (ShelleyBlock era) where
getSystemStart :: BlockConfig (ShelleyBlock era) -> SystemStart
getSystemStart = BlockConfig (ShelleyBlock era) -> SystemStart
forall era. BlockConfig (ShelleyBlock era) -> SystemStart
shelleySystemStart
getNetworkMagic :: BlockConfig (ShelleyBlock era) -> NetworkMagic
getNetworkMagic = BlockConfig (ShelleyBlock era) -> NetworkMagic
forall era. BlockConfig (ShelleyBlock era) -> NetworkMagic
shelleyNetworkMagic
instance ShelleyBasedEra era => NodeInitStorage (ShelleyBlock era) where
nodeImmutableDbChunkInfo :: StorageConfig (ShelleyBlock era) -> ChunkInfo
nodeImmutableDbChunkInfo =
EpochSize -> ChunkInfo
simpleChunkInfo
(EpochSize -> ChunkInfo)
-> (StorageConfig (ShelleyBlock era) -> EpochSize)
-> StorageConfig (ShelleyBlock era)
-> ChunkInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochSize
EpochSize
(Word64 -> EpochSize)
-> (StorageConfig (ShelleyBlock era) -> Word64)
-> StorageConfig (ShelleyBlock era)
-> EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10)
(Word64 -> Word64)
-> (StorageConfig (ShelleyBlock era) -> Word64)
-> StorageConfig (ShelleyBlock era)
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecurityParam -> Word64
maxRollbacks
(SecurityParam -> Word64)
-> (StorageConfig (ShelleyBlock era) -> SecurityParam)
-> StorageConfig (ShelleyBlock era)
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageConfig (ShelleyBlock era) -> SecurityParam
forall era. StorageConfig (ShelleyBlock era) -> SecurityParam
shelleyStorageConfigSecurityParam
nodeCheckIntegrity :: StorageConfig (ShelleyBlock era) -> ShelleyBlock era -> Bool
nodeCheckIntegrity StorageConfig (ShelleyBlock era)
cfg =
Word64 -> ShelleyBlock era -> Bool
forall era.
ShelleyBasedEra era =>
Word64 -> ShelleyBlock era -> Bool
verifyBlockIntegrity (StorageConfig (ShelleyBlock era) -> Word64
forall era. StorageConfig (ShelleyBlock era) -> Word64
shelleyStorageConfigSlotsPerKESPeriod StorageConfig (ShelleyBlock era)
cfg)
instance ShelleyBasedEra era => RunNode (ShelleyBlock era)