{-# 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

{-------------------------------------------------------------------------------
  Credentials
-------------------------------------------------------------------------------}

data TPraosLeaderCredentials c = TPraosLeaderCredentials {
      -- | The unevolved signing KES key (at evolution 0).
      --
      -- Note that this is not inside 'TPraosCanBeLeader' since it gets evolved
      -- automatically, whereas 'TPraosCanBeLeader' does not change.
      TPraosLeaderCredentials c -> SignKeyKES c
tpraosLeaderCredentialsInitSignKey :: SL.SignKeyKES c
    , TPraosLeaderCredentials c -> TPraosCanBeLeader c
tpraosLeaderCredentialsCanBeLeader :: TPraosCanBeLeader c
      -- | Identifier for this set of credentials.
      --
      -- Useful when the node is running with multiple sets of credentials.
    , 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

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

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

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

-- | Check the validity of the genesis config. To be used in conjunction with
-- 'assertWithMsg'.
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)

-- | Parameters needed to run Shelley
data ProtocolParamsShelley c f = ProtocolParamsShelley {
      ProtocolParamsShelley c f -> ShelleyGenesis (ShelleyEra c)
shelleyGenesis           :: SL.ShelleyGenesis (ShelleyEra c)
      -- | The initial nonce, typically derived from the hash of Genesis
      -- config JSON file.
      --
      -- WARNING: chains using different values of this parameter will be
      -- mutually incompatible.
    , ProtocolParamsShelley c f -> Nonce
shelleyInitialNonce      :: SL.Nonce
    , ProtocolParamsShelley c f -> ProtVer
shelleyProtVer           :: SL.ProtVer
    , ProtocolParamsShelley c f -> f (TPraosLeaderCredentials c)
shelleyLeaderCredentials :: f (TPraosLeaderCredentials c)
    }

-- | Parameters needed to run Allegra
data ProtocolParamsAllegra c f = ProtocolParamsAllegra {
      ProtocolParamsAllegra c f -> ProtVer
allegraProtVer           :: SL.ProtVer
    , ProtocolParamsAllegra c f -> f (TPraosLeaderCredentials c)
allegraLeaderCredentials :: f (TPraosLeaderCredentials c)
    }

-- | Parameters needed to run Mary
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
      }

    -- Register the initial staking.
    --
    -- This function embodies a little more logic than ideal. We might want to
    -- move it into `cardano-ledger-specs.`
    --
    -- HERE BE DRAGONS! This function is intended to help in testing. It should
    -- not be called with anything other than 'emptyGenesisStaking' in
    -- production.
    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

        -- Note that this is only applicable in the initial configuration where
        -- there is no existing stake distribution, since it would completely
        -- overwrite any such thing.
        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
          }
        -- New delegation state. Since we're using base addresses, we only care
        -- about updating the '_delegations' field.
        --
        -- See STS DELEG for details
        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
        }

        -- We consider pools as having been registered in slot 0
        -- See STS POOL for details
        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
        }

        -- The new stake distribution is made on the basis of a snapshot taken
        -- during the previous epoch. We create a "fake" snapshot in order to
        -- establish an initial stake distribution.
        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 {
      -- No particular codec configuration is needed for Shelley
      pClientInfoCodecConfig :: CodecConfig (ShelleyBlock era)
pClientInfoCodecConfig = CodecConfig (ShelleyBlock era)
forall era. CodecConfig (ShelleyBlock era)
ShelleyCodecConfig
    }

{-------------------------------------------------------------------------------
  ConfigSupportsNode instance
-------------------------------------------------------------------------------}

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

{-------------------------------------------------------------------------------
  NodeInitStorage instance
-------------------------------------------------------------------------------}

instance ShelleyBasedEra era => NodeInitStorage (ShelleyBlock era) where
  -- We fix the chunk size to @10k@ so that we have the same chunk size as
  -- Byron. Consequently, a Shelley net will have the same chunk size as the
  -- Byron-to-Shelley net with the same @k@.
  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)

{-------------------------------------------------------------------------------
  RunNode instance
-------------------------------------------------------------------------------}

instance ShelleyBasedEra era => RunNode (ShelleyBlock era)