{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Byron.Node (
    PBftSignatureThreshold (..)
  , ProtocolParamsByron (..)
  , byronBlockForging
  , defaultPBftSignatureThreshold
  , mkByronConfig
  , protocolClientInfoByron
  , protocolInfoByron
    -- * Secrets
  , ByronLeaderCredentials (..)
  , ByronLeaderCredentialsError
  , mkByronLeaderCredentials
  , mkPBftCanBeLeader
  ) where

import           Control.Monad.Except
import           Data.Coerce (coerce)
import           Data.Maybe
import           Data.Text (Text)
import           Data.Void (Void)

import qualified Cardano.Chain.Delegation as Delegation
import qualified Cardano.Chain.Genesis as Genesis
import           Cardano.Chain.ProtocolConstants (kEpochSlots)
import           Cardano.Chain.Slotting (EpochSlots (..))
import qualified Cardano.Chain.Update as Update
import qualified Cardano.Crypto as Crypto

import           Ouroboros.Network.Magic (NetworkMagic (..))

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended
import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
import           Ouroboros.Consensus.Node.InitStorage
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.NodeId (CoreNodeId)
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Protocol.PBFT
import qualified Ouroboros.Consensus.Protocol.PBFT.State as S
import           Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB (..))
import           Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
import           Ouroboros.Consensus.Util ((....:))

import           Ouroboros.Consensus.Byron.Crypto.DSIGN
import           Ouroboros.Consensus.Byron.Ledger
import           Ouroboros.Consensus.Byron.Ledger.Conversions
import           Ouroboros.Consensus.Byron.Ledger.Inspect ()
import           Ouroboros.Consensus.Byron.Node.Serialisation ()
import           Ouroboros.Consensus.Byron.Protocol

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

-- | Credentials needed to produce blocks in the Byron era.
data ByronLeaderCredentials = ByronLeaderCredentials {
      ByronLeaderCredentials -> SigningKey
blcSignKey    :: Crypto.SigningKey
    , ByronLeaderCredentials -> Certificate
blcDlgCert    :: Delegation.Certificate
      -- | Only core nodes can produce blocks. The 'CoreNodeId' is used to
      -- determine the order (round-robin) in which core nodes produce blocks.
    , ByronLeaderCredentials -> CoreNodeId
blcCoreNodeId :: CoreNodeId
      -- | Identifier for this set of credentials.
      --
      -- Useful when the node is running with multiple sets of credentials.
    , ByronLeaderCredentials -> Text
blcLabel      :: Text
    }
  deriving (Int -> ByronLeaderCredentials -> ShowS
[ByronLeaderCredentials] -> ShowS
ByronLeaderCredentials -> String
(Int -> ByronLeaderCredentials -> ShowS)
-> (ByronLeaderCredentials -> String)
-> ([ByronLeaderCredentials] -> ShowS)
-> Show ByronLeaderCredentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronLeaderCredentials] -> ShowS
$cshowList :: [ByronLeaderCredentials] -> ShowS
show :: ByronLeaderCredentials -> String
$cshow :: ByronLeaderCredentials -> String
showsPrec :: Int -> ByronLeaderCredentials -> ShowS
$cshowsPrec :: Int -> ByronLeaderCredentials -> ShowS
Show)

-- | Make the 'ByronLeaderCredentials', with a couple sanity checks:
--
-- * That the block signing key and the delegation certificate match.
-- * That the delegation certificate does correspond to one of the genesis
--   keys from the genesis file.
--
mkByronLeaderCredentials ::
     Genesis.Config
  -> Crypto.SigningKey
  -> Delegation.Certificate
  -> Text
  -> Either ByronLeaderCredentialsError ByronLeaderCredentials
mkByronLeaderCredentials :: Config
-> SigningKey
-> Certificate
-> Text
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
mkByronLeaderCredentials Config
gc SigningKey
sk Certificate
cert Text
lbl = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
Delegation.delegateVK Certificate
cert VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
== SigningKey -> VerificationKey
Crypto.toVerification SigningKey
sk)
      Maybe ()
-> ByronLeaderCredentialsError
-> Either ByronLeaderCredentialsError ()
forall a e. Maybe a -> e -> Either e a
?! ByronLeaderCredentialsError
NodeSigningKeyDoesNotMatchDelegationCertificate

    let vkGenesis :: VerificationKey
vkGenesis = Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
Delegation.issuerVK Certificate
cert
    CoreNodeId
nid <- Config -> VerKeyDSIGN ByronDSIGN -> Maybe CoreNodeId
genesisKeyCoreNodeId Config
gc (VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN VerificationKey
vkGenesis)
             Maybe CoreNodeId
-> ByronLeaderCredentialsError
-> Either ByronLeaderCredentialsError CoreNodeId
forall a e. Maybe a -> e -> Either e a
?! ByronLeaderCredentialsError
DelegationCertificateNotFromGenesisKey

    ByronLeaderCredentials
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
forall (m :: * -> *) a. Monad m => a -> m a
return ByronLeaderCredentials :: SigningKey
-> Certificate -> CoreNodeId -> Text -> ByronLeaderCredentials
ByronLeaderCredentials {
      $sel:blcSignKey:ByronLeaderCredentials :: SigningKey
blcSignKey     = SigningKey
sk
    , $sel:blcDlgCert:ByronLeaderCredentials :: Certificate
blcDlgCert     = Certificate
cert
    , $sel:blcCoreNodeId:ByronLeaderCredentials :: CoreNodeId
blcCoreNodeId  = CoreNodeId
nid
    , $sel:blcLabel:ByronLeaderCredentials :: Text
blcLabel       = Text
lbl
    }
  where
    (?!) :: Maybe a -> e -> Either e a
    Just a
x  ?! :: Maybe a -> e -> Either e a
?! e
_ = a -> Either e a
forall a b. b -> Either a b
Right a
x
    Maybe a
Nothing ?! e
e = e -> Either e a
forall a b. a -> Either a b
Left  e
e

data ByronLeaderCredentialsError =
       NodeSigningKeyDoesNotMatchDelegationCertificate
     | DelegationCertificateNotFromGenesisKey
  deriving (ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
(ByronLeaderCredentialsError
 -> ByronLeaderCredentialsError -> Bool)
-> (ByronLeaderCredentialsError
    -> ByronLeaderCredentialsError -> Bool)
-> Eq ByronLeaderCredentialsError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
$c/= :: ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
== :: ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
$c== :: ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
Eq, Int -> ByronLeaderCredentialsError -> ShowS
[ByronLeaderCredentialsError] -> ShowS
ByronLeaderCredentialsError -> String
(Int -> ByronLeaderCredentialsError -> ShowS)
-> (ByronLeaderCredentialsError -> String)
-> ([ByronLeaderCredentialsError] -> ShowS)
-> Show ByronLeaderCredentialsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronLeaderCredentialsError] -> ShowS
$cshowList :: [ByronLeaderCredentialsError] -> ShowS
show :: ByronLeaderCredentialsError -> String
$cshow :: ByronLeaderCredentialsError -> String
showsPrec :: Int -> ByronLeaderCredentialsError -> ShowS
$cshowsPrec :: Int -> ByronLeaderCredentialsError -> ShowS
Show)

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

type instance CannotForge ByronBlock = PBftCannotForge PBftByronCrypto

type instance ForgeStateInfo ByronBlock = ()

type instance ForgeStateUpdateError ByronBlock = Void

byronBlockForging
  :: Monad m
  => TxLimits.Overrides ByronBlock
  -> ByronLeaderCredentials
  -> BlockForging m ByronBlock
byronBlockForging :: Overrides ByronBlock
-> ByronLeaderCredentials -> BlockForging m ByronBlock
byronBlockForging Overrides ByronBlock
maxTxCapacityOverrides ByronLeaderCredentials
creds = BlockForging :: forall (m :: * -> *) blk.
Text
-> CanBeLeader (BlockProtocol blk)
-> (TopLevelConfig blk
    -> SlotNo
    -> Ticked (ChainDepState (BlockProtocol blk))
    -> m (ForgeStateUpdateInfo blk))
-> (TopLevelConfig blk
    -> SlotNo
    -> Ticked (ChainDepState (BlockProtocol blk))
    -> IsLeader (BlockProtocol blk)
    -> ForgeStateInfo blk
    -> Either (CannotForge blk) ())
-> (TopLevelConfig blk
    -> BlockNo
    -> SlotNo
    -> TickedLedgerState blk
    -> [Validated (GenTx blk)]
    -> IsLeader (BlockProtocol blk)
    -> m blk)
-> BlockForging m blk
BlockForging {
      forgeLabel :: Text
forgeLabel       = ByronLeaderCredentials -> Text
blcLabel ByronLeaderCredentials
creds
    , CanBeLeader (PBft PBftByronCrypto)
CanBeLeader (BlockProtocol ByronBlock)
canBeLeader :: CanBeLeader (BlockProtocol ByronBlock)
canBeLeader :: CanBeLeader (PBft PBftByronCrypto)
canBeLeader
    , updateForgeState :: TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol ByronBlock))
-> m (ForgeStateUpdateInfo ByronBlock)
updateForgeState = \TopLevelConfig ByronBlock
_ SlotNo
_ Ticked (ChainDepState (BlockProtocol ByronBlock))
_ -> ForgeStateUpdateInfo ByronBlock
-> m (ForgeStateUpdateInfo ByronBlock)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForgeStateUpdateInfo ByronBlock
 -> m (ForgeStateUpdateInfo ByronBlock))
-> ForgeStateUpdateInfo ByronBlock
-> m (ForgeStateUpdateInfo ByronBlock)
forall a b. (a -> b) -> a -> b
$ ForgeStateInfo ByronBlock -> ForgeStateUpdateInfo ByronBlock
forall blk. ForgeStateInfo blk -> ForgeStateUpdateInfo blk
ForgeStateUpdated ()
    , checkCanForge :: TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol ByronBlock))
-> IsLeader (BlockProtocol ByronBlock)
-> ForgeStateInfo ByronBlock
-> Either (CannotForge ByronBlock) ()
checkCanForge    = \TopLevelConfig ByronBlock
cfg SlotNo
slot Ticked (ChainDepState (BlockProtocol ByronBlock))
tickedPBftState IsLeader (BlockProtocol ByronBlock)
_isLeader () ->
                             ConsensusConfig (PBft PBftByronCrypto)
-> PBftCanBeLeader PBftByronCrypto
-> SlotNo
-> Ticked (PBftState PBftByronCrypto)
-> Either (PBftCannotForge PBftByronCrypto) ()
forall c.
PBftCrypto c =>
ConsensusConfig (PBft c)
-> PBftCanBeLeader c
-> SlotNo
-> Ticked (PBftState c)
-> Either (PBftCannotForge c) ()
pbftCheckCanForge
                               (TopLevelConfig ByronBlock
-> ConsensusConfig (BlockProtocol ByronBlock)
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig ByronBlock
cfg)
                               PBftCanBeLeader PBftByronCrypto
CanBeLeader (PBft PBftByronCrypto)
canBeLeader
                               SlotNo
slot
                               Ticked (PBftState PBftByronCrypto)
Ticked (ChainDepState (BlockProtocol ByronBlock))
tickedPBftState
    , forgeBlock :: TopLevelConfig ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> IsLeader (BlockProtocol ByronBlock)
-> m ByronBlock
forgeBlock       = \TopLevelConfig ByronBlock
cfg -> ByronBlock -> m ByronBlock
forall (m :: * -> *) a. Monad m => a -> m a
return (ByronBlock -> m ByronBlock)
-> (BlockNo
    -> SlotNo
    -> TickedLedgerState ByronBlock
    -> [Validated (GenTx ByronBlock)]
    -> PBftIsLeader PBftByronCrypto
    -> ByronBlock)
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> m ByronBlock
forall y z x0 x1 x2 x3 x4.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> x4 -> y)
-> x0
-> x1
-> x2
-> x3
-> x4
-> z
....: HasCallStack =>
TopLevelConfig ByronBlock
-> Overrides ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> ByronBlock
TopLevelConfig ByronBlock
-> Overrides ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> ByronBlock
forgeByronBlock TopLevelConfig ByronBlock
cfg Overrides ByronBlock
maxTxCapacityOverrides
    }
  where
    canBeLeader :: CanBeLeader (PBft PBftByronCrypto)
canBeLeader = ByronLeaderCredentials -> CanBeLeader (PBft PBftByronCrypto)
mkPBftCanBeLeader ByronLeaderCredentials
creds

mkPBftCanBeLeader :: ByronLeaderCredentials -> CanBeLeader (PBft PBftByronCrypto)
mkPBftCanBeLeader :: ByronLeaderCredentials -> CanBeLeader (PBft PBftByronCrypto)
mkPBftCanBeLeader (ByronLeaderCredentials SigningKey
sk Certificate
cert CoreNodeId
nid Text
_) = PBftCanBeLeader :: forall c.
CoreNodeId
-> SignKeyDSIGN (PBftDSIGN c)
-> PBftDelegationCert c
-> PBftCanBeLeader c
PBftCanBeLeader {
      pbftCanBeLeaderCoreNodeId :: CoreNodeId
pbftCanBeLeaderCoreNodeId = CoreNodeId
nid
    , pbftCanBeLeaderSignKey :: SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftCanBeLeaderSignKey    = SigningKey -> SignKeyDSIGN ByronDSIGN
SignKeyByronDSIGN SigningKey
sk
    , pbftCanBeLeaderDlgCert :: PBftDelegationCert PBftByronCrypto
pbftCanBeLeaderDlgCert    = Certificate
PBftDelegationCert PBftByronCrypto
cert
    }

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

-- | See chapter 4.1 of
--   https://hydra.iohk.io/job/Cardano/cardano-ledger-specs/byronChainSpec/latest/download-by-type/doc-pdf/blockchain-spec
defaultPBftSignatureThreshold :: PBftSignatureThreshold
defaultPBftSignatureThreshold :: PBftSignatureThreshold
defaultPBftSignatureThreshold = Double -> PBftSignatureThreshold
PBftSignatureThreshold Double
0.22

-- | Parameters needed to run Byron
data ProtocolParamsByron = ProtocolParamsByron {
      ProtocolParamsByron -> Config
byronGenesis                :: Genesis.Config
    , ProtocolParamsByron -> Maybe PBftSignatureThreshold
byronPbftSignatureThreshold :: Maybe PBftSignatureThreshold
    , ProtocolParamsByron -> ProtocolVersion
byronProtocolVersion        :: Update.ProtocolVersion
    , ProtocolParamsByron -> SoftwareVersion
byronSoftwareVersion        :: Update.SoftwareVersion
    , ProtocolParamsByron -> Maybe ByronLeaderCredentials
byronLeaderCredentials      :: Maybe ByronLeaderCredentials
    , ProtocolParamsByron -> Overrides ByronBlock
byronMaxTxCapacityOverrides :: TxLimits.Overrides ByronBlock
    }

protocolInfoByron ::
     forall m. Monad m
  => ProtocolParamsByron
  -> ProtocolInfo m ByronBlock
protocolInfoByron :: ProtocolParamsByron -> ProtocolInfo m ByronBlock
protocolInfoByron ProtocolParamsByron {
                      $sel:byronGenesis:ProtocolParamsByron :: ProtocolParamsByron -> Config
byronGenesis                = Config
genesisConfig
                    , $sel:byronPbftSignatureThreshold:ProtocolParamsByron :: ProtocolParamsByron -> Maybe PBftSignatureThreshold
byronPbftSignatureThreshold = Maybe PBftSignatureThreshold
mSigThresh
                    , $sel:byronProtocolVersion:ProtocolParamsByron :: ProtocolParamsByron -> ProtocolVersion
byronProtocolVersion        = ProtocolVersion
pVer
                    , $sel:byronSoftwareVersion:ProtocolParamsByron :: ProtocolParamsByron -> SoftwareVersion
byronSoftwareVersion        = SoftwareVersion
sVer
                    , $sel:byronLeaderCredentials:ProtocolParamsByron :: ProtocolParamsByron -> Maybe ByronLeaderCredentials
byronLeaderCredentials      = Maybe ByronLeaderCredentials
mLeaderCreds
                    , $sel:byronMaxTxCapacityOverrides:ProtocolParamsByron :: ProtocolParamsByron -> Overrides ByronBlock
byronMaxTxCapacityOverrides = Overrides ByronBlock
maxTxCapacityOverrides
                    } =
    ProtocolInfo :: forall (m :: * -> *) b.
TopLevelConfig b
-> ExtLedgerState b -> m [BlockForging m b] -> ProtocolInfo m b
ProtocolInfo {
        pInfoConfig :: TopLevelConfig ByronBlock
pInfoConfig = TopLevelConfig :: forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
TopLevelConfig {
            topLevelConfigProtocol :: ConsensusConfig (BlockProtocol ByronBlock)
topLevelConfigProtocol = PBftConfig :: forall c. PBftParams -> ConsensusConfig (PBft c)
PBftConfig {
                pbftParams :: PBftParams
pbftParams = Config -> Maybe PBftSignatureThreshold -> PBftParams
byronPBftParams Config
compactedGenesisConfig Maybe PBftSignatureThreshold
mSigThresh
              }
          , topLevelConfigLedger :: LedgerConfig ByronBlock
topLevelConfigLedger  = Config
LedgerConfig ByronBlock
compactedGenesisConfig
          , topLevelConfigBlock :: BlockConfig ByronBlock
topLevelConfigBlock   = BlockConfig ByronBlock
blockConfig
          , topLevelConfigCodec :: CodecConfig ByronBlock
topLevelConfigCodec   = Config -> CodecConfig ByronBlock
mkByronCodecConfig Config
compactedGenesisConfig
          , topLevelConfigStorage :: StorageConfig ByronBlock
topLevelConfigStorage = BlockConfig ByronBlock -> StorageConfig ByronBlock
ByronStorageConfig BlockConfig ByronBlock
blockConfig
          }
      , pInfoInitLedger :: ExtLedgerState ByronBlock
pInfoInitLedger = ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState {
            -- Important: don't pass the compacted genesis config to
            -- 'initByronLedgerState', it needs the full one, including the AVVM
            -- balances.
            ledgerState :: LedgerState ByronBlock
ledgerState = Config -> Maybe UTxO -> LedgerState ByronBlock
initByronLedgerState Config
genesisConfig Maybe UTxO
forall a. Maybe a
Nothing
          , headerState :: HeaderState ByronBlock
headerState = ChainDepState (BlockProtocol ByronBlock) -> HeaderState ByronBlock
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ChainDepState (BlockProtocol ByronBlock)
forall c. PBftState c
S.empty
          }
      , pInfoBlockForging :: m [BlockForging m ByronBlock]
pInfoBlockForging =
            [BlockForging m ByronBlock] -> m [BlockForging m ByronBlock]
forall (m :: * -> *) a. Monad m => a -> m a
return
          ([BlockForging m ByronBlock] -> m [BlockForging m ByronBlock])
-> [BlockForging m ByronBlock] -> m [BlockForging m ByronBlock]
forall a b. (a -> b) -> a -> b
$ (ByronLeaderCredentials -> BlockForging m ByronBlock)
-> [ByronLeaderCredentials] -> [BlockForging m ByronBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Overrides ByronBlock
-> ByronLeaderCredentials -> BlockForging m ByronBlock
forall (m :: * -> *).
Monad m =>
Overrides ByronBlock
-> ByronLeaderCredentials -> BlockForging m ByronBlock
byronBlockForging Overrides ByronBlock
maxTxCapacityOverrides)
          ([ByronLeaderCredentials] -> [BlockForging m ByronBlock])
-> [ByronLeaderCredentials] -> [BlockForging m ByronBlock]
forall a b. (a -> b) -> a -> b
$ Maybe ByronLeaderCredentials -> [ByronLeaderCredentials]
forall a. Maybe a -> [a]
maybeToList Maybe ByronLeaderCredentials
mLeaderCreds
      }
  where
    compactedGenesisConfig :: Config
compactedGenesisConfig = Config -> Config
compactGenesisConfig Config
genesisConfig

    blockConfig :: BlockConfig ByronBlock
blockConfig = Config
-> ProtocolVersion -> SoftwareVersion -> BlockConfig ByronBlock
mkByronConfig Config
compactedGenesisConfig ProtocolVersion
pVer SoftwareVersion
sVer

protocolClientInfoByron :: EpochSlots -> ProtocolClientInfo ByronBlock
protocolClientInfoByron :: EpochSlots -> ProtocolClientInfo ByronBlock
protocolClientInfoByron EpochSlots
epochSlots =
    ProtocolClientInfo :: forall b. CodecConfig b -> ProtocolClientInfo b
ProtocolClientInfo {
      pClientInfoCodecConfig :: CodecConfig ByronBlock
pClientInfoCodecConfig = ByronCodecConfig :: EpochSlots -> CodecConfig ByronBlock
ByronCodecConfig {
          getByronEpochSlots :: EpochSlots
getByronEpochSlots = EpochSlots
epochSlots
        }
    }

byronPBftParams :: Genesis.Config -> Maybe PBftSignatureThreshold -> PBftParams
byronPBftParams :: Config -> Maybe PBftSignatureThreshold -> PBftParams
byronPBftParams Config
cfg Maybe PBftSignatureThreshold
threshold = PBftParams :: SecurityParam
-> NumCoreNodes -> PBftSignatureThreshold -> PBftParams
PBftParams {
      pbftSecurityParam :: SecurityParam
pbftSecurityParam      = Config -> SecurityParam
genesisSecurityParam Config
cfg
    , pbftNumNodes :: NumCoreNodes
pbftNumNodes           = Config -> NumCoreNodes
genesisNumCoreNodes  Config
cfg
    , pbftSignatureThreshold :: PBftSignatureThreshold
pbftSignatureThreshold = PBftSignatureThreshold
-> Maybe PBftSignatureThreshold -> PBftSignatureThreshold
forall a. a -> Maybe a -> a
fromMaybe PBftSignatureThreshold
defaultPBftSignatureThreshold Maybe PBftSignatureThreshold
threshold
    }

mkByronConfig :: Genesis.Config
              -> Update.ProtocolVersion
              -> Update.SoftwareVersion
              -> BlockConfig ByronBlock
mkByronConfig :: Config
-> ProtocolVersion -> SoftwareVersion -> BlockConfig ByronBlock
mkByronConfig Config
genesisConfig ProtocolVersion
pVer SoftwareVersion
sVer = ByronConfig :: Config
-> ProtocolVersion -> SoftwareVersion -> BlockConfig ByronBlock
ByronConfig {
      byronGenesisConfig :: Config
byronGenesisConfig   = Config
genesisConfig
    , byronProtocolVersion :: ProtocolVersion
byronProtocolVersion = ProtocolVersion
pVer
    , byronSoftwareVersion :: SoftwareVersion
byronSoftwareVersion = SoftwareVersion
sVer
    }

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

instance ConfigSupportsNode ByronBlock where
  getSystemStart :: BlockConfig ByronBlock -> SystemStart
getSystemStart =
      UTCTime -> SystemStart
SystemStart
    (UTCTime -> SystemStart)
-> (BlockConfig ByronBlock -> UTCTime)
-> BlockConfig ByronBlock
-> SystemStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenesisData -> UTCTime
Genesis.gdStartTime
    (GenesisData -> UTCTime)
-> (BlockConfig ByronBlock -> GenesisData)
-> BlockConfig ByronBlock
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> GenesisData
extractGenesisData

  getNetworkMagic :: BlockConfig ByronBlock -> NetworkMagic
getNetworkMagic =
      Word32 -> NetworkMagic
NetworkMagic
    (Word32 -> NetworkMagic)
-> (BlockConfig ByronBlock -> Word32)
-> BlockConfig ByronBlock
-> NetworkMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolMagicId -> Word32
Crypto.unProtocolMagicId
    (ProtocolMagicId -> Word32)
-> (BlockConfig ByronBlock -> ProtocolMagicId)
-> BlockConfig ByronBlock
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenesisData -> ProtocolMagicId
Genesis.gdProtocolMagicId
    (GenesisData -> ProtocolMagicId)
-> (BlockConfig ByronBlock -> GenesisData)
-> BlockConfig ByronBlock
-> ProtocolMagicId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> GenesisData
extractGenesisData

extractGenesisData :: BlockConfig ByronBlock -> Genesis.GenesisData
extractGenesisData :: BlockConfig ByronBlock -> GenesisData
extractGenesisData = Config -> GenesisData
Genesis.configGenesisData (Config -> GenesisData)
-> (BlockConfig ByronBlock -> Config)
-> BlockConfig ByronBlock
-> GenesisData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> Config
byronGenesisConfig

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

instance NodeInitStorage ByronBlock where
  -- The epoch size is fixed and can be derived from @k@ by the ledger
  -- ('kEpochSlots').
  nodeImmutableDbChunkInfo :: StorageConfig ByronBlock -> ChunkInfo
nodeImmutableDbChunkInfo =
        EpochSize -> ChunkInfo
simpleChunkInfo
      (EpochSize -> ChunkInfo)
-> (StorageConfig ByronBlock -> EpochSize)
-> StorageConfig ByronBlock
-> ChunkInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochSlots -> EpochSize
coerce :: EpochSlots -> EpochSize)
      (EpochSlots -> EpochSize)
-> (StorageConfig ByronBlock -> EpochSlots)
-> StorageConfig ByronBlock
-> EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockCount -> EpochSlots
kEpochSlots
      (BlockCount -> EpochSlots)
-> (StorageConfig ByronBlock -> BlockCount)
-> StorageConfig ByronBlock
-> EpochSlots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenesisData -> BlockCount
Genesis.gdK
      (GenesisData -> BlockCount)
-> (StorageConfig ByronBlock -> GenesisData)
-> StorageConfig ByronBlock
-> BlockCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> GenesisData
extractGenesisData
      (BlockConfig ByronBlock -> GenesisData)
-> (StorageConfig ByronBlock -> BlockConfig ByronBlock)
-> StorageConfig ByronBlock
-> GenesisData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageConfig ByronBlock -> BlockConfig ByronBlock
getByronBlockConfig

  -- If the current chain is empty, produce a genesis EBB and add it to the
  -- ChainDB. Only an EBB can have Genesis (= empty chain) as its predecessor.
  nodeInitChainDB :: StorageConfig ByronBlock -> InitChainDB m ByronBlock -> m ()
nodeInitChainDB StorageConfig ByronBlock
cfg InitChainDB { m (LedgerState ByronBlock)
getCurrentLedger :: forall (m :: * -> *) blk. InitChainDB m blk -> m (LedgerState blk)
getCurrentLedger :: m (LedgerState ByronBlock)
getCurrentLedger, ByronBlock -> m ()
addBlock :: forall (m :: * -> *) blk. InitChainDB m blk -> blk -> m ()
addBlock :: ByronBlock -> m ()
addBlock } = do
      Point ByronBlock
tip <- Proxy ByronBlock -> LedgerState ByronBlock -> Point ByronBlock
forall blk.
UpdateLedger blk =>
Proxy blk -> LedgerState blk -> Point blk
ledgerTipPoint (Proxy ByronBlock
forall k (t :: k). Proxy t
Proxy @ByronBlock) (LedgerState ByronBlock -> Point ByronBlock)
-> m (LedgerState ByronBlock) -> m (Point ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (LedgerState ByronBlock)
getCurrentLedger
      case Point ByronBlock
tip of
        BlockPoint {} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Point ByronBlock
GenesisPoint  -> ByronBlock -> m ()
addBlock ByronBlock
genesisEBB
    where
      genesisEBB :: ByronBlock
genesisEBB =
        BlockConfig ByronBlock
-> SlotNo -> BlockNo -> ChainHash ByronBlock -> ByronBlock
forgeEBB (StorageConfig ByronBlock -> BlockConfig ByronBlock
getByronBlockConfig StorageConfig ByronBlock
cfg) (Word64 -> SlotNo
SlotNo Word64
0) (Word64 -> BlockNo
BlockNo Word64
0) ChainHash ByronBlock
forall b. ChainHash b
GenesisHash

  nodeCheckIntegrity :: StorageConfig ByronBlock -> ByronBlock -> Bool
nodeCheckIntegrity = BlockConfig ByronBlock -> ByronBlock -> Bool
verifyBlockIntegrity (BlockConfig ByronBlock -> ByronBlock -> Bool)
-> (StorageConfig ByronBlock -> BlockConfig ByronBlock)
-> StorageConfig ByronBlock
-> ByronBlock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageConfig ByronBlock -> BlockConfig ByronBlock
getByronBlockConfig

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

instance BlockSupportsMetrics ByronBlock where
  isSelfIssued :: BlockConfig ByronBlock -> Header ByronBlock -> WhetherSelfIssued
isSelfIssued = BlockConfig ByronBlock -> Header ByronBlock -> WhetherSelfIssued
forall blk. BlockConfig blk -> Header blk -> WhetherSelfIssued
isSelfIssuedConstUnknown

instance RunNode ByronBlock