{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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.Update as Spec
import qualified Byron.Spec.Ledger.UTxO as Spec
import qualified Cardano.Chain.Block as Impl
import qualified Cardano.Chain.Genesis as Impl
import qualified Cardano.Chain.Update as Impl
import qualified Cardano.Chain.Update.Validation.Interface as Impl
import qualified Cardano.Chain.UTxO 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.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           Ouroboros.Consensus.Util ((.....:), (.:))
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)
CanBeLeader (BlockProtocol ByronBlock)
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 (ChainDepState (BlockProtocol ByronBlock))
-> 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 (ChainDepState (BlockProtocol ByronBlock))
-> IsLeader (BlockProtocol ByronBlock)
-> ForgeStateInfo ByronBlock
-> Either (CannotForge ByronBlock) ()
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 :: TopLevelConfig DualByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState DualByronBlock
-> [Validated (GenTx DualByronBlock)]
-> IsLeader (BlockProtocol DualByronBlock)
-> m DualByronBlock
forgeBlock       = DualByronBlock -> m DualByronBlock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DualByronBlock -> m DualByronBlock)
-> (TopLevelConfig DualByronBlock
    -> BlockNo
    -> SlotNo
    -> TickedLedgerState DualByronBlock
    -> [Validated (GenTx DualByronBlock)]
    -> PBftIsLeader PBftByronCrypto
    -> DualByronBlock)
-> TopLevelConfig DualByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState DualByronBlock
-> [Validated (GenTx DualByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> m DualByronBlock
forall y z x0 x1 x2 x3 x4 x5.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> x4 -> x5 -> y)
-> x0
-> x1
-> x2
-> x3
-> x4
-> x5
-> z
.....: HasCallStack =>
TopLevelConfig DualByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState DualByronBlock
-> [Validated (GenTx DualByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> DualByronBlock
TopLevelConfig DualByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState DualByronBlock
-> [Validated (GenTx DualByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> DualByronBlock
forgeDualByronBlock
    }
  where
    BlockForging {Text
CanBeLeader (BlockProtocol ByronBlock)
TopLevelConfig ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> IsLeader (BlockProtocol ByronBlock)
-> m 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) ()
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
-> TopLevelConfig blk
-> BlockNo
-> SlotNo
-> TickedLedgerState blk
-> [Validated (GenTx blk)]
-> IsLeader (BlockProtocol blk)
-> m blk
forgeBlock :: TopLevelConfig ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> IsLeader (BlockProtocol ByronBlock)
-> m ByronBlock
..} = 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
                      -> [CoreNodeId] -- ^ Are we a core node?
                      -> ( 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
Set VKeyGenesis
BlockCount
PParams
UTxO
byronSpecGenesisDelegators :: Set VKeyGenesis
byronSpecGenesisInitUtxo :: UTxO
byronSpecGenesisInitPParams :: PParams
byronSpecGenesisSecurityParam :: BlockCount
byronSpecGenesisSlotLength :: Natural
byronSpecGenesisDelegators :: ByronSpecGenesis -> Set VKeyGenesis
byronSpecGenesisInitUtxo :: ByronSpecGenesis -> UTxO
byronSpecGenesisInitPParams :: ByronSpecGenesis -> PParams
byronSpecGenesisSecurityParam :: ByronSpecGenesis -> BlockCount
byronSpecGenesisSlotLength :: ByronSpecGenesis -> Natural
..} PBftParams
params [CoreNodeId]
credss =
    ( ProtocolInfo {
        pInfoConfig :: TopLevelConfig DualByronBlock
pInfoConfig = TopLevelConfig {
            topLevelConfigProtocol :: ConsensusConfig (BlockProtocol DualByronBlock)
topLevelConfigProtocol = PBftConfig {
                pbftParams :: PBftParams
pbftParams = PBftParams
params
              }
          , topLevelConfigLedger :: LedgerConfig DualByronBlock
topLevelConfigLedger = DualLedgerConfig {
                dualLedgerConfigMain :: LedgerConfig ByronBlock
dualLedgerConfigMain = Config
LedgerConfig ByronBlock
concreteGenesis
              , dualLedgerConfigAux :: LedgerConfig ByronSpecBlock
dualLedgerConfigAux  = LedgerConfig ByronSpecBlock
abstractConfig
              }
          , 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
pInfoInitLedger = ExtLedgerState {
             ledgerState :: LedgerState DualByronBlock
ledgerState = DualLedgerState {
                 dualLedgerStateMain :: LedgerState ByronBlock
dualLedgerStateMain   = LedgerState ByronBlock
initConcreteState
               , dualLedgerStateAux :: LedgerState ByronSpecBlock
dualLedgerStateAux    = LedgerState ByronSpecBlock
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
           }
      }
    , [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
    initConcreteState :: LedgerState ByronBlock

    initAbstractState :: LedgerState ByronSpecBlock
initAbstractState = ByronSpecGenesis -> LedgerState ByronSpecBlock
initByronSpecLedgerState ByronSpecGenesis
abstractGenesis
    initConcreteState :: LedgerState ByronBlock
initConcreteState = Config -> Maybe UTxO -> LedgerState ByronBlock
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 -> ChainValidationState
byronLedgerState LedgerState ByronBlock
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 ([Char] -> ApName
Spec.ApName [Char]
"") (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 ([Char] -> ByronLeaderCredentials
forall a. HasCallStack => [Char] -> a
error [Char]
"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
                    ([Char] -> KeyHash
forall a. HasCallStack => [Char] -> a
error ([Char] -> KeyHash) -> [Char] -> KeyHash
forall a b. (a -> b) -> a -> b
$ [Char]
"mkCredentials: invalid " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CoreNodeId -> [Char]
forall a. Show a => a -> [Char]
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 -> State CHAIN
byronSpecLedgerState LedgerState ByronSpecBlock
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)
getCurrentLedger :: m (LedgerState DualByronBlock)
getCurrentLedger :: forall (m :: * -> *) blk. InitChainDB m blk -> m (LedgerState blk)
getCurrentLedger, DualByronBlock -> m ()
addBlock :: DualByronBlock -> m ()
addBlock :: forall (m :: * -> *) blk. InitChainDB m blk -> blk -> m ()
addBlock } = do
      Point DualByronBlock
tip <- LedgerState DualByronBlock -> Point DualByronBlock
forall blk. UpdateLedger blk => LedgerState blk -> Point blk
ledgerTipPoint (LedgerState DualByronBlock -> Point DualByronBlock)
-> m (LedgerState DualByronBlock) -> m (Point DualByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (LedgerState DualByronBlock)
getCurrentLedger
      case Point DualByronBlock
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