{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

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

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           Control.Monad (guard)
import           Data.Coerce (coerce)
import           Data.Maybe
import           Data.Text (Text)
import           Data.Void (Void)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
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
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.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.Network.Magic (NetworkMagic (..))

{-------------------------------------------------------------------------------
  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
$cshowsPrec :: Int -> ByronLeaderCredentials -> ShowS
showsPrec :: Int -> ByronLeaderCredentials -> ShowS
$cshow :: ByronLeaderCredentials -> String
show :: ByronLeaderCredentials -> String
$cshowList :: [ByronLeaderCredentials] -> ShowS
showList :: [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 a. a -> Either ByronLeaderCredentialsError a
forall (m :: * -> *) a. Monad m => a -> m a
return 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  ?! :: forall a e. 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
$c== :: ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
== :: ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
$c/= :: ByronLeaderCredentialsError -> ByronLeaderCredentialsError -> Bool
/= :: 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
$cshowsPrec :: Int -> ByronLeaderCredentialsError -> ShowS
showsPrec :: Int -> ByronLeaderCredentialsError -> ShowS
$cshow :: ByronLeaderCredentialsError -> String
show :: ByronLeaderCredentialsError -> String
$cshowList :: [ByronLeaderCredentialsError] -> ShowS
showList :: [ByronLeaderCredentialsError] -> ShowS
Show)

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

type instance CannotForge ByronBlock = PBftCannotForge PBftByronCrypto

type instance ForgeStateInfo ByronBlock = ()

type instance ForgeStateUpdateError ByronBlock = Void

byronBlockForging ::
     Monad m
  => ByronLeaderCredentials
  -> BlockForging m ByronBlock
byronBlockForging :: forall (m :: * -> *).
Monad m =>
ByronLeaderCredentials -> BlockForging m ByronBlock
byronBlockForging ByronLeaderCredentials
creds = BlockForging {
      forgeLabel :: Text
forgeLabel       = ByronLeaderCredentials -> Text
blcLabel ByronLeaderCredentials
creds
    , CanBeLeader (BlockProtocol ByronBlock)
CanBeLeader (PBft PBftByronCrypto)
canBeLeader :: CanBeLeader (PBft PBftByronCrypto)
canBeLeader :: CanBeLeader (BlockProtocol ByronBlock)
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 a. a -> m a
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)
                               CanBeLeader (PBft PBftByronCrypto)
PBftCanBeLeader PBftByronCrypto
canBeLeader
                               SlotNo
slot
                               Ticked (ChainDepState (BlockProtocol ByronBlock))
Ticked (PBftState PBftByronCrypto)
tickedPBftState
    , forgeBlock :: TopLevelConfig ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> IsLeader (BlockProtocol ByronBlock)
-> m ByronBlock
forgeBlock       = \TopLevelConfig ByronBlock
cfg -> ByronBlock -> m ByronBlock
forall a. a -> m a
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
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> ByronBlock
TopLevelConfig ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> ByronBlock
forgeByronBlock TopLevelConfig ByronBlock
cfg
    }
  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 {
      pbftCanBeLeaderCoreNodeId :: CoreNodeId
pbftCanBeLeaderCoreNodeId = CoreNodeId
nid
    , pbftCanBeLeaderSignKey :: SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftCanBeLeaderSignKey    = SigningKey -> SignKeyDSIGN ByronDSIGN
SignKeyByronDSIGN SigningKey
sk
    , pbftCanBeLeaderDlgCert :: PBftDelegationCert PBftByronCrypto
pbftCanBeLeaderDlgCert    = Certificate
PBftDelegationCert PBftByronCrypto
cert
    }

blockForgingByron :: Monad m
                  => ProtocolParamsByron
                  -> [BlockForging m ByronBlock]
blockForgingByron :: forall (m :: * -> *).
Monad m =>
ProtocolParamsByron -> [BlockForging m ByronBlock]
blockForgingByron ProtocolParamsByron { $sel:byronLeaderCredentials:ProtocolParamsByron :: ProtocolParamsByron -> Maybe ByronLeaderCredentials
byronLeaderCredentials = Maybe ByronLeaderCredentials
mLeaderCreds
                                      } =
            ByronLeaderCredentials -> BlockForging m ByronBlock
forall (m :: * -> *).
Monad m =>
ByronLeaderCredentials -> BlockForging m ByronBlock
byronBlockForging
            (ByronLeaderCredentials -> BlockForging m ByronBlock)
-> [ByronLeaderCredentials] -> [BlockForging m ByronBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByronLeaderCredentials -> [ByronLeaderCredentials]
forall a. Maybe a -> [a]
maybeToList Maybe ByronLeaderCredentials
mLeaderCreds

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

protocolInfoByron :: ProtocolParamsByron
                  -> ProtocolInfo ByronBlock
protocolInfoByron :: ProtocolParamsByron -> ProtocolInfo 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
                    } =
    ProtocolInfo {
        pInfoConfig :: TopLevelConfig ByronBlock
pInfoConfig = TopLevelConfig {
            topLevelConfigProtocol :: ConsensusConfig (BlockProtocol ByronBlock)
topLevelConfigProtocol = 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
          , topLevelConfigCheckpoints :: CheckpointsMap ByronBlock
topLevelConfigCheckpoints = CheckpointsMap ByronBlock
forall blk. CheckpointsMap blk
emptyCheckpointsMap
          }
      , pInfoInitLedger :: ExtLedgerState ByronBlock
pInfoInitLedger = 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)
PBftState PBftByronCrypto
forall c. PBftState c
S.empty
          }
      }
  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 {
      pClientInfoCodecConfig :: CodecConfig ByronBlock
pClientInfoCodecConfig = ByronCodecConfig {
          getByronEpochSlots :: EpochSlots
getByronEpochSlots = EpochSlots
epochSlots
        }
    }

byronPBftParams :: Genesis.Config -> Maybe PBftSignatureThreshold -> PBftParams
byronPBftParams :: Config -> Maybe PBftSignatureThreshold -> PBftParams
byronPBftParams Config
cfg Maybe PBftSignatureThreshold
threshold = 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 {
      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
forall a b. Coercible a b => a -> b
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 :: forall (m :: * -> *).
IOLike m =>
StorageConfig ByronBlock -> InitChainDB m ByronBlock -> m ()
nodeInitChainDB StorageConfig ByronBlock
cfg InitChainDB { m (LedgerState ByronBlock)
getCurrentLedger :: m (LedgerState ByronBlock)
getCurrentLedger :: forall (m :: * -> *) blk. InitChainDB m blk -> m (LedgerState blk)
getCurrentLedger, ByronBlock -> m ()
addBlock :: ByronBlock -> m ()
addBlock :: forall (m :: * -> *) blk. InitChainDB m blk -> blk -> m ()
addBlock } = do
      Point ByronBlock
tip <- LedgerState ByronBlock -> Point ByronBlock
forall blk. UpdateLedger blk => LedgerState blk -> Point blk
ledgerTipPoint (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 a. a -> m a
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 {k} (b :: k). 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 BlockSupportsSanityCheck ByronBlock where
  configAllSecurityParams :: TopLevelConfig ByronBlock -> NonEmpty SecurityParam
configAllSecurityParams =
    SecurityParam -> NonEmpty SecurityParam
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecurityParam -> NonEmpty SecurityParam)
-> (TopLevelConfig ByronBlock -> SecurityParam)
-> TopLevelConfig ByronBlock
-> NonEmpty SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBftParams -> SecurityParam
pbftSecurityParam (PBftParams -> SecurityParam)
-> (TopLevelConfig ByronBlock -> PBftParams)
-> TopLevelConfig ByronBlock
-> SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (PBft PBftByronCrypto) -> PBftParams
forall c. ConsensusConfig (PBft c) -> PBftParams
pbftParams (ConsensusConfig (PBft PBftByronCrypto) -> PBftParams)
-> (TopLevelConfig ByronBlock
    -> ConsensusConfig (PBft PBftByronCrypto))
-> TopLevelConfig ByronBlock
-> PBftParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig ByronBlock
-> ConsensusConfig (BlockProtocol ByronBlock)
TopLevelConfig ByronBlock -> ConsensusConfig (PBft PBftByronCrypto)
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol

deriving via SelectViewDiffusionPipelining ByronBlock
  instance BlockSupportsDiffusionPipelining ByronBlock

instance RunNode ByronBlock