{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.ByronDual.Node (protocolInfoDualByron) where

import qualified Byron.Spec.Ledger.Core as Spec
import qualified Byron.Spec.Ledger.Delegation as Spec
import qualified Byron.Spec.Ledger.UTxO as Spec
import qualified Byron.Spec.Ledger.Update as Spec
import qualified Cardano.Chain.Block as Impl
import qualified Cardano.Chain.Genesis as Impl
import qualified Cardano.Chain.UTxO as Impl
import qualified Cardano.Chain.Update as Impl
import qualified Cardano.Chain.Update.Validation.Interface as Impl
import Data.Either (fromRight)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Byron.Node
import Ouroboros.Consensus.Byron.Protocol
import Ouroboros.Consensus.ByronDual.Ledger
import Ouroboros.Consensus.ByronDual.Node.Serialisation ()
import Ouroboros.Consensus.ByronSpec.Ledger
import qualified Ouroboros.Consensus.ByronSpec.Ledger.Genesis as Genesis
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Dual
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.Peras (initPerasState)
import Ouroboros.Consensus.Node.InitStorage
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.NodeId
import Ouroboros.Consensus.Protocol.PBFT
import qualified Ouroboros.Consensus.Protocol.PBFT.State as S
import Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB (..))
import qualified Test.Cardano.Chain.Elaboration.Block as Spec.Test
import qualified Test.Cardano.Chain.Elaboration.Delegation as Spec.Test
import qualified Test.Cardano.Chain.Elaboration.Keys as Spec.Test
import qualified Test.Cardano.Chain.Elaboration.Update as Spec.Test
import qualified Test.Cardano.Chain.UTxO.Model as Spec.Test

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

dualByronBlockForging ::
  Monad m =>
  ByronLeaderCredentials ->
  BlockForging m DualByronBlock
dualByronBlockForging :: forall (m :: * -> *).
Monad m =>
ByronLeaderCredentials -> BlockForging m DualByronBlock
dualByronBlockForging ByronLeaderCredentials
creds =
  BlockForging
    { forgeLabel :: Text
forgeLabel = Text
forgeLabel
    , canBeLeader :: CanBeLeader (BlockProtocol DualByronBlock)
canBeLeader = CanBeLeader (BlockProtocol DualByronBlock)
PBftCanBeLeader PBftByronCrypto
canBeLeader
    , updateForgeState :: TopLevelConfig DualByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol DualByronBlock))
-> m (ForgeStateUpdateInfo DualByronBlock)
updateForgeState = \TopLevelConfig DualByronBlock
cfg ->
        (ForgeStateUpdateInfo ByronBlock
 -> ForgeStateUpdateInfo DualByronBlock)
-> m (ForgeStateUpdateInfo ByronBlock)
-> m (ForgeStateUpdateInfo DualByronBlock)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForgeStateUpdateInfo ByronBlock
-> ForgeStateUpdateInfo DualByronBlock
forall blk blk'.
(ForgeStateInfo blk ~ ForgeStateInfo blk',
 ForgeStateUpdateError blk ~ ForgeStateUpdateError blk') =>
ForgeStateUpdateInfo blk -> ForgeStateUpdateInfo blk'
castForgeStateUpdateInfo (m (ForgeStateUpdateInfo ByronBlock)
 -> m (ForgeStateUpdateInfo DualByronBlock))
-> (SlotNo
    -> Ticked (PBftState PBftByronCrypto)
    -> m (ForgeStateUpdateInfo ByronBlock))
-> SlotNo
-> Ticked (PBftState PBftByronCrypto)
-> m (ForgeStateUpdateInfo DualByronBlock)
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (PBftState PBftByronCrypto)
-> m (ForgeStateUpdateInfo ByronBlock)
updateForgeState (TopLevelConfig DualByronBlock -> TopLevelConfig ByronBlock
forall m a. TopLevelConfig (DualBlock m a) -> TopLevelConfig m
dualTopLevelConfigMain TopLevelConfig DualByronBlock
cfg)
    , checkCanForge :: TopLevelConfig DualByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol DualByronBlock))
-> IsLeader (BlockProtocol DualByronBlock)
-> ForgeStateInfo DualByronBlock
-> Either (CannotForge DualByronBlock) ()
checkCanForge = TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (PBftState PBftByronCrypto)
-> PBftIsLeader PBftByronCrypto
-> ()
-> Either (PBftCannotForge PBftByronCrypto) ()
checkCanForge (TopLevelConfig ByronBlock
 -> SlotNo
 -> Ticked (PBftState PBftByronCrypto)
 -> PBftIsLeader PBftByronCrypto
 -> ()
 -> Either (PBftCannotForge PBftByronCrypto) ())
-> (TopLevelConfig DualByronBlock -> TopLevelConfig ByronBlock)
-> TopLevelConfig DualByronBlock
-> SlotNo
-> Ticked (PBftState PBftByronCrypto)
-> PBftIsLeader PBftByronCrypto
-> ()
-> Either (PBftCannotForge PBftByronCrypto) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig DualByronBlock -> TopLevelConfig ByronBlock
forall m a. TopLevelConfig (DualBlock m a) -> TopLevelConfig m
dualTopLevelConfigMain
    , forgeBlock :: ForgeBlockArgs DualByronBlock -> m DualByronBlock
forgeBlock = DualByronBlock -> m DualByronBlock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DualByronBlock -> m DualByronBlock)
-> (ForgeBlockArgs DualByronBlock -> DualByronBlock)
-> ForgeBlockArgs DualByronBlock
-> m DualByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ForgeBlockArgs DualByronBlock -> DualByronBlock
ForgeBlockArgs DualByronBlock -> DualByronBlock
forgeDualByronBlock
    , finalize :: m ()
finalize = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }
 where
  BlockForging{m ()
Text
CanBeLeader (BlockProtocol ByronBlock)
TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol ByronBlock))
-> m (ForgeStateUpdateInfo ByronBlock)
TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol ByronBlock))
-> IsLeader (BlockProtocol ByronBlock)
-> ForgeStateInfo ByronBlock
-> Either (CannotForge ByronBlock) ()
ForgeBlockArgs ByronBlock -> m ByronBlock
forgeLabel :: forall (m :: * -> *) blk. BlockForging m blk -> Text
forgeLabel :: Text
canBeLeader :: forall (m :: * -> *) blk.
BlockForging m blk -> CanBeLeader (BlockProtocol blk)
canBeLeader :: CanBeLeader (BlockProtocol ByronBlock)
updateForgeState :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> m (ForgeStateUpdateInfo blk)
updateForgeState :: TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol ByronBlock))
-> m (ForgeStateUpdateInfo ByronBlock)
checkCanForge :: forall (m :: * -> *) blk.
BlockForging m blk
-> TopLevelConfig blk
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol blk))
-> IsLeader (BlockProtocol blk)
-> ForgeStateInfo blk
-> Either (CannotForge blk) ()
checkCanForge :: TopLevelConfig ByronBlock
-> SlotNo
-> Ticked (ChainDepState (BlockProtocol ByronBlock))
-> IsLeader (BlockProtocol ByronBlock)
-> ForgeStateInfo ByronBlock
-> Either (CannotForge ByronBlock) ()
forgeBlock :: forall (m :: * -> *) blk.
BlockForging m blk -> ForgeBlockArgs blk -> m blk
finalize :: forall (m :: * -> *) blk. BlockForging m blk -> m ()
forgeBlock :: ForgeBlockArgs ByronBlock -> m ByronBlock
finalize :: m ()
..} = ByronLeaderCredentials -> BlockForging m ByronBlock
forall (m :: * -> *).
Monad m =>
ByronLeaderCredentials -> BlockForging m ByronBlock
byronBlockForging ByronLeaderCredentials
creds

{-------------------------------------------------------------------------------
  ProtocolInfo

  Partly modelled after 'applyTrace' in "Test.Cardano.Chain.Block.Model".
-------------------------------------------------------------------------------}

protocolInfoDualByron ::
  forall m.
  Monad m =>
  ByronSpecGenesis ->
  PBftParams ->
  -- | Are we a core node?
  [CoreNodeId] ->
  ( ProtocolInfo DualByronBlock
  , m [BlockForging m DualByronBlock]
  )
protocolInfoDualByron :: forall (m :: * -> *).
Monad m =>
ByronSpecGenesis
-> PBftParams
-> [CoreNodeId]
-> (ProtocolInfo DualByronBlock, m [BlockForging m DualByronBlock])
protocolInfoDualByron abstractGenesis :: ByronSpecGenesis
abstractGenesis@ByronSpecGenesis{Natural
BlockCount
PParams
UTxO
Set VKeyGenesis
byronSpecGenesisDelegators :: Set VKeyGenesis
byronSpecGenesisInitUtxo :: UTxO
byronSpecGenesisInitPParams :: PParams
byronSpecGenesisSecurityParam :: BlockCount
byronSpecGenesisSlotLength :: Natural
byronSpecGenesisDelegators :: ByronSpecGenesis -> Set VKeyGenesis
byronSpecGenesisInitPParams :: ByronSpecGenesis -> PParams
byronSpecGenesisInitUtxo :: ByronSpecGenesis -> UTxO
byronSpecGenesisSecurityParam :: ByronSpecGenesis -> BlockCount
byronSpecGenesisSlotLength :: ByronSpecGenesis -> Natural
..} PBftParams
params [CoreNodeId]
credss =
  let ledgerConfig :: DualLedgerConfig ByronBlock ByronSpecBlock
ledgerConfig =
        DualLedgerConfig
          { dualLedgerConfigMain :: LedgerConfig ByronBlock
dualLedgerConfigMain = Config
LedgerConfig ByronBlock
concreteGenesis
          , dualLedgerConfigAux :: LedgerConfig ByronSpecBlock
dualLedgerConfigAux = LedgerConfig ByronSpecBlock
abstractConfig
          }
   in ( ProtocolInfo
          { pInfoConfig :: TopLevelConfig DualByronBlock
pInfoConfig =
              TopLevelConfig
                { topLevelConfigProtocol :: ConsensusConfig (BlockProtocol DualByronBlock)
topLevelConfigProtocol =
                    PBftConfig
                      { pbftParams :: PBftParams
pbftParams = PBftParams
params
                      }
                , topLevelConfigLedger :: LedgerConfig DualByronBlock
topLevelConfigLedger =
                    LedgerConfig DualByronBlock
DualLedgerConfig ByronBlock ByronSpecBlock
ledgerConfig
                , topLevelConfigBlock :: BlockConfig DualByronBlock
topLevelConfigBlock =
                    DualBlockConfig
                      { dualBlockConfigMain :: BlockConfig ByronBlock
dualBlockConfigMain = BlockConfig ByronBlock
concreteConfig
                      , dualBlockConfigAux :: BlockConfig ByronSpecBlock
dualBlockConfigAux = BlockConfig ByronSpecBlock
ByronSpecBlockConfig
                      }
                , topLevelConfigCodec :: CodecConfig DualByronBlock
topLevelConfigCodec =
                    DualCodecConfig
                      { dualCodecConfigMain :: CodecConfig ByronBlock
dualCodecConfigMain = Config -> CodecConfig ByronBlock
mkByronCodecConfig Config
concreteGenesis
                      , dualCodecConfigAux :: CodecConfig ByronSpecBlock
dualCodecConfigAux = CodecConfig ByronSpecBlock
ByronSpecCodecConfig
                      }
                , topLevelConfigStorage :: StorageConfig DualByronBlock
topLevelConfigStorage =
                    DualStorageConfig
                      { dualStorageConfigMain :: StorageConfig ByronBlock
dualStorageConfigMain = BlockConfig ByronBlock -> StorageConfig ByronBlock
ByronStorageConfig BlockConfig ByronBlock
concreteConfig
                      , dualStorageConfigAux :: StorageConfig ByronSpecBlock
dualStorageConfigAux = StorageConfig ByronSpecBlock
ByronSpecStorageConfig
                      }
                , topLevelConfigCheckpoints :: CheckpointsMap DualByronBlock
topLevelConfigCheckpoints = CheckpointsMap DualByronBlock
forall blk. CheckpointsMap blk
emptyCheckpointsMap
                }
          , pInfoInitLedger :: ExtLedgerState DualByronBlock ValuesMK
pInfoInitLedger =
              let ledgerState :: LedgerState DualByronBlock ValuesMK
ledgerState =
                    DualLedgerState
                      { dualLedgerStateMain :: LedgerState ByronBlock ValuesMK
dualLedgerStateMain = LedgerState ByronBlock ValuesMK
initConcreteState
                      , dualLedgerStateAux :: LedgerState ByronSpecBlock ValuesMK
dualLedgerStateAux = LedgerState ByronSpecBlock ValuesMK
initAbstractState
                      , dualLedgerStateBridge :: BridgeLedger ByronBlock ByronSpecBlock
dualLedgerStateBridge = BridgeLedger ByronBlock ByronSpecBlock
initBridge
                      }
                  headerState :: HeaderState DualByronBlock
headerState = ChainDepState (BlockProtocol DualByronBlock)
-> HeaderState DualByronBlock
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ChainDepState (BlockProtocol DualByronBlock)
PBftState PBftByronCrypto
forall c. PBftState c
S.empty
                  perasState :: PerasState DualByronBlock
perasState = LedgerConfig DualByronBlock
-> LedgerState DualByronBlock ValuesMK
-> HeaderState DualByronBlock
-> PerasState DualByronBlock
forall blk (mk :: MapKind).
(All Top (HardForkIndices blk), StateSupportsPerasEpochContext blk,
 HasLedgerTables LedgerState blk) =>
LedgerCfg LedgerState blk
-> LedgerState blk mk -> HeaderState blk -> PerasState blk
initPerasState LedgerConfig DualByronBlock
DualLedgerConfig ByronBlock ByronSpecBlock
ledgerConfig LedgerState DualByronBlock ValuesMK
ledgerState HeaderState DualByronBlock
headerState
               in ExtLedgerState
                    { LedgerState DualByronBlock ValuesMK
ledgerState :: LedgerState DualByronBlock ValuesMK
ledgerState :: LedgerState DualByronBlock ValuesMK
ledgerState
                    , HeaderState DualByronBlock
headerState :: HeaderState DualByronBlock
headerState :: HeaderState DualByronBlock
headerState
                    , PerasState DualByronBlock
perasState :: PerasState DualByronBlock
perasState :: PerasState DualByronBlock
perasState
                    }
          }
      , [BlockForging m DualByronBlock]
-> m [BlockForging m DualByronBlock]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockForging m DualByronBlock]
 -> m [BlockForging m DualByronBlock])
-> [BlockForging m DualByronBlock]
-> m [BlockForging m DualByronBlock]
forall a b. (a -> b) -> a -> b
$ ByronLeaderCredentials -> BlockForging m DualByronBlock
forall (m :: * -> *).
Monad m =>
ByronLeaderCredentials -> BlockForging m DualByronBlock
dualByronBlockForging (ByronLeaderCredentials -> BlockForging m DualByronBlock)
-> (CoreNodeId -> ByronLeaderCredentials)
-> CoreNodeId
-> BlockForging m DualByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreNodeId -> ByronLeaderCredentials
byronLeaderCredentials (CoreNodeId -> BlockForging m DualByronBlock)
-> [CoreNodeId] -> [BlockForging m DualByronBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoreNodeId]
credss
      )
 where
  initUtxo :: Impl.UTxO
  txIdMap :: Map Spec.TxId Impl.TxId
  (UTxO
initUtxo, Map TxId TxId
txIdMap) = UTxO -> (UTxO, Map TxId TxId)
Spec.Test.elaborateInitialUTxO UTxO
byronSpecGenesisInitUtxo

  -- 'Spec.Test.abEnvToCfg' ignores the UTxO, because the Byron genesis
  -- data doesn't contain a UTxO, but only a 'UTxOConfiguration'.
  --
  -- It also ignores the slot length (the Byron spec does not talk about
  -- slot lengths at all) so we have to set this ourselves.
  concreteGenesis :: Impl.Config
  concreteGenesis :: Config
concreteGenesis =
    Config
translated
      { Impl.configGenesisData =
          configGenesisData
            { Impl.gdProtocolParameters =
                protocolParameters
                  { Impl.ppSlotDuration = byronSpecGenesisSlotLength
                  }
            }
      }
   where
    translated :: Config
translated = Environment CHAIN -> Config
Spec.Test.abEnvToCfg (Environment CHAIN -> Config) -> Environment CHAIN -> Config
forall a b. (a -> b) -> a -> b
$ ByronSpecGenesis -> Environment CHAIN
Genesis.toChainEnv ByronSpecGenesis
abstractGenesis
    configGenesisData :: GenesisData
configGenesisData = Config -> GenesisData
Impl.configGenesisData Config
translated
    protocolParameters :: ProtocolParameters
protocolParameters = GenesisData -> ProtocolParameters
Impl.gdProtocolParameters GenesisData
configGenesisData

  initAbstractState :: LedgerState ByronSpecBlock ValuesMK
  initConcreteState :: LedgerState ByronBlock ValuesMK

  initAbstractState :: LedgerState ByronSpecBlock ValuesMK
initAbstractState = ByronSpecGenesis -> LedgerState ByronSpecBlock ValuesMK
forall (mk :: MapKind).
ByronSpecGenesis -> LedgerState ByronSpecBlock mk
initByronSpecLedgerState ByronSpecGenesis
abstractGenesis
  initConcreteState :: LedgerState ByronBlock ValuesMK
initConcreteState = Config -> Maybe UTxO -> LedgerState ByronBlock ValuesMK
forall (mk :: MapKind).
Config -> Maybe UTxO -> LedgerState ByronBlock mk
initByronLedgerState Config
concreteGenesis (UTxO -> Maybe UTxO
forall a. a -> Maybe a
Just UTxO
initUtxo)

  abstractConfig :: LedgerConfig ByronSpecBlock
  concreteConfig :: BlockConfig ByronBlock

  abstractConfig :: LedgerConfig ByronSpecBlock
abstractConfig = LedgerConfig ByronSpecBlock
ByronSpecGenesis
abstractGenesis
  concreteConfig :: BlockConfig ByronBlock
concreteConfig =
    Config
-> ProtocolVersion -> SoftwareVersion -> BlockConfig ByronBlock
mkByronConfig
      Config
concreteGenesis
      ProtocolVersion
protocolVersion
      SoftwareVersion
softwareVersion
   where
    -- TODO: Take (spec) protocol version and (spec) software version
    -- as arguments instead, and then translate /those/ to Impl types.
    -- <https://github.com/IntersectMBO/ouroboros-network/issues/1495>
    protocolVersion :: Impl.ProtocolVersion
    protocolVersion :: ProtocolVersion
protocolVersion =
      State -> ProtocolVersion
Impl.adoptedProtocolVersion (State -> ProtocolVersion) -> State -> ProtocolVersion
forall a b. (a -> b) -> a -> b
$
        ChainValidationState -> State
Impl.cvsUpdateState (LedgerState ByronBlock ValuesMK -> ChainValidationState
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState LedgerState ByronBlock ValuesMK
initConcreteState)

    -- The spec has a TODO about this; we just copy what 'elaborate' does
    -- (Test.Cardano.Chain.Elaboration.Block)
    softwareVersion :: Impl.SoftwareVersion
    softwareVersion :: SoftwareVersion
softwareVersion =
      SwVer -> SoftwareVersion
Spec.Test.elaborateSoftwareVersion (SwVer -> SoftwareVersion) -> SwVer -> SoftwareVersion
forall a b. (a -> b) -> a -> b
$
        ApName -> ApVer -> SwVer
Spec.SwVer (String -> ApName
Spec.ApName String
"") (Natural -> ApVer
Spec.ApVer Natural
0)

  initBridge :: DualByronBridge
  initBridge :: BridgeLedger ByronBlock ByronSpecBlock
initBridge = ByronSpecGenesis -> Map TxId TxId -> ByronSpecBridge
initByronSpecBridge ByronSpecGenesis
abstractGenesis Map TxId TxId
txIdMap

  byronLeaderCredentials :: CoreNodeId -> ByronLeaderCredentials
  byronLeaderCredentials :: CoreNodeId -> ByronLeaderCredentials
byronLeaderCredentials CoreNodeId
nid =
    ByronLeaderCredentials
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
-> ByronLeaderCredentials
forall b a. b -> Either a b -> b
fromRight (String -> ByronLeaderCredentials
forall a. HasCallStack => String -> a
error String
"byronLeaderCredentials: failed to construct credentials") (Either ByronLeaderCredentialsError ByronLeaderCredentials
 -> ByronLeaderCredentials)
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
-> ByronLeaderCredentials
forall a b. (a -> b) -> a -> b
$
      Config
-> SigningKey
-> Certificate
-> Text
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
mkByronLeaderCredentials
        Config
concreteGenesis
        (VKey -> SigningKey
Spec.Test.vKeyToSKey VKey
vkey)
        ( ProtocolMagicId -> DCert -> Certificate
Spec.Test.elaborateDCert
            (Config -> ProtocolMagicId
Impl.configProtocolMagicId Config
concreteGenesis)
            DCert
abstractDCert
        )
        Text
"byronLeaderCredentials"
   where
    -- PBFT constructs the core node ID by the implicit ordering of
    -- the hashes of the verification keys in the genesis config. Here
    -- we go the other way, looking up this hash, and then using our
    -- translation map to find the corresponding abstract key.
    --
    -- TODO: We should be able to use keys that are /not/ in genesis
    -- (so that we can start the node with new delegated keys that aren't
    -- present in the genesis config).
    -- <https://github.com/IntersectMBO/ouroboros-network/issues/1495>
    keyHash :: PBftVerKeyHash PBftByronCrypto
    keyHash :: PBftVerKeyHash PBftByronCrypto
keyHash =
      KeyHash -> Maybe KeyHash -> KeyHash
forall a. a -> Maybe a -> a
fromMaybe
        (String -> KeyHash
forall a. HasCallStack => String -> a
error (String -> KeyHash) -> String -> KeyHash
forall a b. (a -> b) -> a -> b
$ String
"mkCredentials: invalid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CoreNodeId -> String
forall a. Show a => a -> String
show CoreNodeId
nid)
        (Config -> CoreNodeId -> Maybe KeyHash
nodeIdToGenesisKey Config
concreteGenesis CoreNodeId
nid)

    vkey :: Spec.VKey
    vkey :: VKey
vkey = BridgeLedger ByronBlock ByronSpecBlock
-> PBftVerKeyHash PBftByronCrypto -> VKey
bridgeToSpecKey BridgeLedger ByronBlock ByronSpecBlock
initBridge PBftVerKeyHash PBftByronCrypto
keyHash

    abstractDCert :: Spec.DCert
    abstractDCert :: DCert
abstractDCert =
      HasCallStack => VKey -> BlockCount -> State CHAIN -> DCert
VKey -> BlockCount -> State CHAIN -> DCert
Spec.Test.rcDCert
        VKey
vkey
        BlockCount
byronSpecGenesisSecurityParam
        (LedgerState ByronSpecBlock ValuesMK -> State CHAIN
forall (mk :: MapKind).
LedgerState ByronSpecBlock mk -> State CHAIN
byronSpecLedgerState LedgerState ByronSpecBlock ValuesMK
initAbstractState)

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

instance NodeInitStorage DualByronBlock where
  -- Just like Byron, we need to start with an EBB
  nodeInitChainDB :: forall (m :: * -> *).
IOLike m =>
StorageConfig DualByronBlock
-> InitChainDB m DualByronBlock -> m ()
nodeInitChainDB StorageConfig DualByronBlock
cfg InitChainDB{m (LedgerState DualByronBlock EmptyMK)
getCurrentLedger :: m (LedgerState DualByronBlock EmptyMK)
getCurrentLedger :: forall (m :: * -> *) blk.
InitChainDB m blk -> m (LedgerState blk EmptyMK)
getCurrentLedger, DualByronBlock -> m ()
addBlock :: DualByronBlock -> m ()
addBlock :: forall (m :: * -> *) blk. InitChainDB m blk -> blk -> m ()
addBlock} = do
    tip <- LedgerState DualByronBlock EmptyMK -> Point DualByronBlock
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> Point blk
ledgerTipPoint (LedgerState DualByronBlock EmptyMK -> Point DualByronBlock)
-> m (LedgerState DualByronBlock EmptyMK)
-> m (Point DualByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (LedgerState DualByronBlock EmptyMK)
getCurrentLedger
    case tip of
      BlockPoint{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Point DualByronBlock
GenesisPoint -> DualByronBlock -> m ()
addBlock DualByronBlock
genesisEBB
   where
    genesisEBB :: DualByronBlock
    genesisEBB :: DualByronBlock
genesisEBB =
      DualBlock
        { dualBlockMain :: ByronBlock
dualBlockMain = ByronBlock
byronEBB
        , dualBlockAux :: Maybe ByronSpecBlock
dualBlockAux = Maybe ByronSpecBlock
forall a. Maybe a
Nothing
        , dualBlockBridge :: BridgeBlock ByronBlock ByronSpecBlock
dualBlockBridge = BridgeBlock ByronBlock ByronSpecBlock
SpecToImplIds
forall a. Monoid a => a
mempty
        }

    byronEBB :: ByronBlock
    byronEBB :: ByronBlock
byronEBB =
      BlockConfig ByronBlock
-> SlotNo -> BlockNo -> ChainHash ByronBlock -> ByronBlock
forgeEBB
        (StorageConfig ByronBlock -> BlockConfig ByronBlock
getByronBlockConfig (StorageConfig DualByronBlock -> StorageConfig ByronBlock
forall m a. StorageConfig (DualBlock m a) -> StorageConfig m
dualStorageConfigMain StorageConfig DualByronBlock
cfg))
        (Word64 -> SlotNo
SlotNo Word64
0)
        (Word64 -> BlockNo
BlockNo Word64
0)
        ChainHash ByronBlock
forall {k} (b :: k). ChainHash b
GenesisHash

  -- Node config is a consensus concern, determined by the main block only
  nodeImmutableDbChunkInfo :: StorageConfig DualByronBlock -> ChunkInfo
nodeImmutableDbChunkInfo = StorageConfig ByronBlock -> ChunkInfo
forall blk. NodeInitStorage blk => StorageConfig blk -> ChunkInfo
nodeImmutableDbChunkInfo (StorageConfig ByronBlock -> ChunkInfo)
-> (StorageConfig DualByronBlock -> StorageConfig ByronBlock)
-> StorageConfig DualByronBlock
-> ChunkInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageConfig DualByronBlock -> StorageConfig ByronBlock
forall m a. StorageConfig (DualBlock m a) -> StorageConfig m
dualStorageConfigMain

  -- We don't really care too much about data loss or malicious behaviour for
  -- the dual ledger tests, so integrity and match checks can just use the
  -- concrete implementation
  nodeCheckIntegrity :: StorageConfig DualByronBlock -> DualByronBlock -> Bool
nodeCheckIntegrity StorageConfig DualByronBlock
cfg = StorageConfig ByronBlock -> ByronBlock -> Bool
forall blk. NodeInitStorage blk => StorageConfig blk -> blk -> Bool
nodeCheckIntegrity (StorageConfig DualByronBlock -> StorageConfig ByronBlock
forall m a. StorageConfig (DualBlock m a) -> StorageConfig m
dualStorageConfigMain StorageConfig DualByronBlock
cfg) (ByronBlock -> Bool)
-> (DualByronBlock -> ByronBlock) -> DualByronBlock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DualByronBlock -> ByronBlock
forall m a. DualBlock m a -> m
dualBlockMain

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

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

instance BlockSupportsSanityCheck DualByronBlock where
  configAllSecurityParams :: TopLevelConfig DualByronBlock -> NonEmpty SecurityParam
configAllSecurityParams = SecurityParam -> NonEmpty SecurityParam
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecurityParam -> NonEmpty SecurityParam)
-> (TopLevelConfig DualByronBlock -> SecurityParam)
-> TopLevelConfig DualByronBlock
-> NonEmpty SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig DualByronBlock -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam

deriving via
  SelectViewDiffusionPipelining DualByronBlock
  instance
    BlockSupportsDiffusionPipelining DualByronBlock

instance RunNode DualByronBlock