{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE InstanceSigs        #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Cardano.Node (
    protocolInfoCardano
  , ProtocolParamsTransition (..)
  , ProtocolParamsAllegra (..)
  , ProtocolParamsMary (..)
  , protocolClientInfoCardano
  , CardanoHardForkConstraints
  , MaxMajorProtVer (..)
  , TriggerHardFork (..)
    -- * SupportedNetworkProtocolVersion
  , pattern CardanoNodeToNodeVersion1
  , pattern CardanoNodeToNodeVersion2
  , pattern CardanoNodeToNodeVersion3
  , pattern CardanoNodeToNodeVersion4
  , pattern CardanoNodeToClientVersion1
  , pattern CardanoNodeToClientVersion2
  , pattern CardanoNodeToClientVersion3
  , pattern CardanoNodeToClientVersion4
  , pattern CardanoNodeToClientVersion5
  ) where

import qualified Codec.CBOR.Decoding as CBOR
import           Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import           Control.Exception (assert)
import qualified Data.ByteString.Short as Short
import qualified Data.Map.Strict as Map
import           Data.Maybe (maybeToList)
import           Data.SOP.Strict (K (..), NP (..), NS (..))
import           Data.Word (Word16)

import           Cardano.Binary (DecoderError (..), enforceSize)
import           Cardano.Chain.Slotting (EpochSlots)
import           Cardano.Prelude (cborError)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util.Assert
import           Ouroboros.Consensus.Util.Counting
import           Ouroboros.Consensus.Util.IOLike

import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation

import           Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import qualified Ouroboros.Consensus.Byron.Ledger as Byron
import qualified Ouroboros.Consensus.Byron.Ledger.Conversions as Byron
import           Ouroboros.Consensus.Byron.Ledger.NetworkProtocolVersion
import           Ouroboros.Consensus.Byron.Node

import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion
import           Ouroboros.Consensus.Shelley.Node
import           Ouroboros.Consensus.Shelley.Protocol (TPraosParams (..))
import qualified Ouroboros.Consensus.Shelley.Protocol as Shelley

import           Ouroboros.Consensus.Cardano.Block
import           Ouroboros.Consensus.Cardano.CanHardFork

{-------------------------------------------------------------------------------
  SerialiseHFC
-------------------------------------------------------------------------------}

instance SerialiseConstraintsHFC ByronBlock
instance ShelleyBasedEra era => SerialiseConstraintsHFC (ShelleyBlock era)

-- | Important: we need to maintain binary compatibility with Byron blocks, as
-- they are already stored on disk.
--
-- We also want to be able to efficiently detect (without having to peek far
-- ahead) whether we're dealing with a Byron or Shelley block, so that we can
-- invoke the right decoder. We plan to have a few more hard forks after
-- Shelley (Goguen, Basho, Voltaire), so we want a future-proof envelope for
-- distinguishing the different block types, i.e., a byte indicating the era.
--
-- Byron does not provide such an envelope. However, a Byron block is a CBOR
-- 2-tuple with the first element being a tag ('Word': 0 = EBB; 1 = regular
-- block) and the second being the payload. We can easily extend this encoding
-- format with support for Shelley, Goguen, etc.
--
-- We encode a 'CardanoBlock' as the same CBOR 2-tuple as a Byron block, but
-- we use the tags after 1 for the hard forks after Byron:
--
-- 0. Byron EBB
-- 1. Byron regular block
-- 2. Shelley block
-- 3. Allegra block
-- 4. Mary block
-- 5. Goguen block
-- 6. etc.
--
-- For more details, see:
-- <https://github.com/input-output-hk/ouroboros-network/pull/1175#issuecomment-558147194>
instance CardanoHardForkConstraints c => SerialiseHFC (CardanoEras c) where
  encodeDiskHfcBlock :: CodecConfig (HardForkBlock (CardanoEras c))
-> HardForkBlock (CardanoEras c) -> Encoding
encodeDiskHfcBlock (CardanoCodecConfig CodecConfig ByronBlock
ccfgByron CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgShelley CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgAllegra CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgMary) = \case
      -- We are backwards compatible with Byron and thus use the exact same
      -- encoding.
      BlockByron   ByronBlock
blockByron   ->                CodecConfig ByronBlock -> ByronBlock -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig ByronBlock
ccfgByron ByronBlock
blockByron
      -- For Shelley and later eras, we need to prepend the hard fork envelope.
      BlockShelley ShelleyBlock (ShelleyEra c)
blockShelley -> Word -> Encoding -> Encoding
prependTag Word
2 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ CodecConfig (ShelleyBlock (ShelleyEra c))
-> ShelleyBlock (ShelleyEra c) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgShelley ShelleyBlock (ShelleyEra c)
blockShelley
      BlockAllegra ShelleyBlock (ShelleyEra c)
blockAllegra -> Word -> Encoding -> Encoding
prependTag Word
3 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ CodecConfig (ShelleyBlock (ShelleyEra c))
-> ShelleyBlock (ShelleyEra c) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgAllegra ShelleyBlock (ShelleyEra c)
blockAllegra
      BlockMary    ShelleyBlock (ShelleyEra c)
blockMary    -> Word -> Encoding -> Encoding
prependTag Word
4 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ CodecConfig (ShelleyBlock (ShelleyEra c))
-> ShelleyBlock (ShelleyEra c) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgMary    ShelleyBlock (ShelleyEra c)
blockMary
  decodeDiskHfcBlock :: CodecConfig (HardForkBlock (CardanoEras c))
-> forall s.
   Decoder s (ByteString -> HardForkBlock (CardanoEras c))
decodeDiskHfcBlock (CardanoCodecConfig CodecConfig ByronBlock
ccfgByron CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgShelley CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgAllegra CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgMary) = do
      Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"CardanoBlock" Int
2
      Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord Decoder s Word
-> (Word
    -> Decoder s (ByteString -> HardForkBlock (CardanoEras c)))
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word
0 -> (ByronBlock -> HardForkBlock (CardanoEras c))
-> (ByteString -> ByronBlock)
-> ByteString
-> HardForkBlock (CardanoEras c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronBlock -> HardForkBlock (CardanoEras c)
forall c. ByronBlock -> CardanoBlock c
BlockByron   ((ByteString -> ByronBlock)
 -> ByteString -> HardForkBlock (CardanoEras c))
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (ByteString -> ByronBlock)
forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
Byron.decodeByronBoundaryBlock EpochSlots
epochSlots
        Word
1 -> (ByronBlock -> HardForkBlock (CardanoEras c))
-> (ByteString -> ByronBlock)
-> ByteString
-> HardForkBlock (CardanoEras c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronBlock -> HardForkBlock (CardanoEras c)
forall c. ByronBlock -> CardanoBlock c
BlockByron   ((ByteString -> ByronBlock)
 -> ByteString -> HardForkBlock (CardanoEras c))
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (ByteString -> ByronBlock)
forall s. EpochSlots -> Decoder s (ByteString -> ByronBlock)
Byron.decodeByronRegularBlock  EpochSlots
epochSlots
        -- We don't have to drop the first two bytes from the 'ByteString'
        -- passed to the decoder as slicing already takes care of this.
        Word
2 -> (ShelleyBlock (ShelleyEra c) -> HardForkBlock (CardanoEras c))
-> (ByteString -> ShelleyBlock (ShelleyEra c))
-> ByteString
-> HardForkBlock (CardanoEras c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShelleyBlock (ShelleyEra c) -> HardForkBlock (CardanoEras c)
forall c. ShelleyBlock (ShelleyEra c) -> CardanoBlock c
BlockShelley ((ByteString -> ShelleyBlock (ShelleyEra c))
 -> ByteString -> HardForkBlock (CardanoEras c))
-> Decoder s (ByteString -> ShelleyBlock (ShelleyEra c))
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig (ShelleyBlock (ShelleyEra c))
-> forall s. Decoder s (ByteString -> ShelleyBlock (ShelleyEra c))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgShelley
        Word
3 -> (ShelleyBlock (ShelleyEra c) -> HardForkBlock (CardanoEras c))
-> (ByteString -> ShelleyBlock (ShelleyEra c))
-> ByteString
-> HardForkBlock (CardanoEras c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShelleyBlock (ShelleyEra c) -> HardForkBlock (CardanoEras c)
forall c. ShelleyBlock (ShelleyEra c) -> CardanoBlock c
BlockAllegra ((ByteString -> ShelleyBlock (ShelleyEra c))
 -> ByteString -> HardForkBlock (CardanoEras c))
-> Decoder s (ByteString -> ShelleyBlock (ShelleyEra c))
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig (ShelleyBlock (ShelleyEra c))
-> forall s. Decoder s (ByteString -> ShelleyBlock (ShelleyEra c))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgAllegra
        Word
4 -> (ShelleyBlock (ShelleyEra c) -> HardForkBlock (CardanoEras c))
-> (ByteString -> ShelleyBlock (ShelleyEra c))
-> ByteString
-> HardForkBlock (CardanoEras c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShelleyBlock (ShelleyEra c) -> HardForkBlock (CardanoEras c)
forall c. ShelleyBlock (ShelleyEra c) -> CardanoBlock c
BlockMary    ((ByteString -> ShelleyBlock (ShelleyEra c))
 -> ByteString -> HardForkBlock (CardanoEras c))
-> Decoder s (ByteString -> ShelleyBlock (ShelleyEra c))
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig (ShelleyBlock (ShelleyEra c))
-> forall s. Decoder s (ByteString -> ShelleyBlock (ShelleyEra c))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig (ShelleyBlock (ShelleyEra c))
ccfgMary
        Word
t -> DecoderError
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError
 -> Decoder s (ByteString -> HardForkBlock (CardanoEras c)))
-> DecoderError
-> Decoder s (ByteString -> HardForkBlock (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"CardanoBlock" (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)
    where
      epochSlots :: EpochSlots
epochSlots = CodecConfig ByronBlock -> EpochSlots
Byron.getByronEpochSlots CodecConfig ByronBlock
ccfgByron

  reconstructHfcPrefixLen :: proxy (Header (HardForkBlock (CardanoEras c))) -> PrefixLen
reconstructHfcPrefixLen proxy (Header (HardForkBlock (CardanoEras c)))
_ = Word8 -> PrefixLen
PrefixLen Word8
2

  reconstructHfcNestedCtxt :: proxy (Header (HardForkBlock (CardanoEras c)))
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
reconstructHfcNestedCtxt proxy (Header (HardForkBlock (CardanoEras c)))
_ ShortByteString
prefix SizeInBytes
blockSize =
      case ShortByteString -> Int -> Word8
Short.index ShortByteString
prefix Int
1 of
        Word8
0 -> NestedCtxt
  Header (HardForkBlock (CardanoEras c)) (SlotNo, RawBoundaryHeader)
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt
   Header (HardForkBlock (CardanoEras c)) (SlotNo, RawBoundaryHeader)
 -> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c)))
-> NestedCtxt
     Header (HardForkBlock (CardanoEras c)) (SlotNo, RawBoundaryHeader)
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ NestedCtxt_
  (HardForkBlock (CardanoEras c)) Header (SlotNo, RawBoundaryHeader)
-> NestedCtxt
     Header (HardForkBlock (CardanoEras c)) (SlotNo, RawBoundaryHeader)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
-> NestedCtxt_
     (HardForkBlock (CardanoEras c)) Header (SlotNo, RawBoundaryHeader)
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ (SizeInBytes
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
Byron.CtxtByronBoundary SizeInBytes
blockSize))
        Word8
1 -> NestedCtxt
  Header (HardForkBlock (CardanoEras c)) (AHeader ByteString)
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt
   Header (HardForkBlock (CardanoEras c)) (AHeader ByteString)
 -> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c)))
-> NestedCtxt
     Header (HardForkBlock (CardanoEras c)) (AHeader ByteString)
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ NestedCtxt_
  (HardForkBlock (CardanoEras c)) Header (AHeader ByteString)
-> NestedCtxt
     Header (HardForkBlock (CardanoEras c)) (AHeader ByteString)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_ ByronBlock Header (AHeader ByteString)
-> NestedCtxt_
     (HardForkBlock (CardanoEras c)) Header (AHeader ByteString)
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ (SizeInBytes -> NestedCtxt_ ByronBlock Header (AHeader ByteString)
Byron.CtxtByronRegular  SizeInBytes
blockSize))
        Word8
2 -> NestedCtxt
  Header
  (HardForkBlock (CardanoEras c))
  (Header (ShelleyBlock (ShelleyEra c)))
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt
   Header
   (HardForkBlock (CardanoEras c))
   (Header (ShelleyBlock (ShelleyEra c)))
 -> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c)))
-> NestedCtxt
     Header
     (HardForkBlock (CardanoEras c))
     (Header (ShelleyBlock (ShelleyEra c)))
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ NestedCtxt_
  (HardForkBlock (CardanoEras c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt
     Header
     (HardForkBlock (CardanoEras c))
     (Header (ShelleyBlock (ShelleyEra c)))
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_
  (HardForkBlock
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)])
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock (CardanoEras c))
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS (NestedCtxt_
  (ShelleyBlock (ShelleyEra c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock
        '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
          ShelleyBlock (ShelleyEra c)])
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ NestedCtxt_
  (ShelleyBlock (ShelleyEra c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
forall era (f :: * -> *).
NestedCtxt_ (ShelleyBlock era) f (f (ShelleyBlock era))
Shelley.CtxtShelley))
        Word8
3 -> NestedCtxt
  Header
  (HardForkBlock (CardanoEras c))
  (Header (ShelleyBlock (ShelleyEra c)))
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt
   Header
   (HardForkBlock (CardanoEras c))
   (Header (ShelleyBlock (ShelleyEra c)))
 -> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c)))
-> NestedCtxt
     Header
     (HardForkBlock (CardanoEras c))
     (Header (ShelleyBlock (ShelleyEra c)))
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ NestedCtxt_
  (HardForkBlock (CardanoEras c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt
     Header
     (HardForkBlock (CardanoEras c))
     (Header (ShelleyBlock (ShelleyEra c)))
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_
  (HardForkBlock
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)])
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock (CardanoEras c))
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS (NestedCtxt_
  (HardForkBlock
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock
        '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
          ShelleyBlock (ShelleyEra c)])
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS (NestedCtxt_
  (ShelleyBlock (ShelleyEra c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock
        '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ NestedCtxt_
  (ShelleyBlock (ShelleyEra c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
forall era (f :: * -> *).
NestedCtxt_ (ShelleyBlock era) f (f (ShelleyBlock era))
Shelley.CtxtShelley)))
        Word8
4 -> NestedCtxt
  Header
  (HardForkBlock (CardanoEras c))
  (Header (ShelleyBlock (ShelleyEra c)))
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (NestedCtxt
   Header
   (HardForkBlock (CardanoEras c))
   (Header (ShelleyBlock (ShelleyEra c)))
 -> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c)))
-> NestedCtxt
     Header
     (HardForkBlock (CardanoEras c))
     (Header (ShelleyBlock (ShelleyEra c)))
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ NestedCtxt_
  (HardForkBlock (CardanoEras c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt
     Header
     (HardForkBlock (CardanoEras c))
     (Header (ShelleyBlock (ShelleyEra c)))
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (NestedCtxt_
  (HardForkBlock
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)])
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock (CardanoEras c))
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS (NestedCtxt_
  (HardForkBlock
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock
        '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
          ShelleyBlock (ShelleyEra c)])
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS (NestedCtxt_
  (HardForkBlock '[ShelleyBlock (ShelleyEra c)])
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock
        '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall (xs1 :: [*]) (a :: * -> *) b x.
NestedCtxt_ (HardForkBlock xs1) a b
-> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCS (NestedCtxt_
  (ShelleyBlock (ShelleyEra c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
-> NestedCtxt_
     (HardForkBlock '[ShelleyBlock (ShelleyEra c)])
     Header
     (Header (ShelleyBlock (ShelleyEra c)))
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ NestedCtxt_
  (ShelleyBlock (ShelleyEra c))
  Header
  (Header (ShelleyBlock (ShelleyEra c)))
forall era (f :: * -> *).
NestedCtxt_ (ShelleyBlock era) f (f (ShelleyBlock era))
Shelley.CtxtShelley))))
        Word8
_ -> [Char]
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c)))
-> [Char]
-> SomeSecond (NestedCtxt Header) (HardForkBlock (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ [Char]
"CardanoBlock: invalid prefix " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> [Char]
forall a. Show a => a -> [Char]
show ShortByteString
prefix

  getHfcBinaryBlockInfo :: HardForkBlock (CardanoEras c) -> BinaryBlockInfo
getHfcBinaryBlockInfo = \case
      BlockByron   ByronBlock
blockByron   ->
        ByronBlock -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo ByronBlock
blockByron
      -- For Shelley and the later eras, we need to account for the two extra
      -- bytes of the envelope.
      BlockShelley ShelleyBlock (ShelleyEra c)
blockShelley ->
        Word16 -> BinaryBlockInfo -> BinaryBlockInfo
shiftHeaderOffset Word16
2 (BinaryBlockInfo -> BinaryBlockInfo)
-> BinaryBlockInfo -> BinaryBlockInfo
forall a b. (a -> b) -> a -> b
$ ShelleyBlock (ShelleyEra c) -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo ShelleyBlock (ShelleyEra c)
blockShelley
      BlockAllegra ShelleyBlock (ShelleyEra c)
blockAllegra ->
        Word16 -> BinaryBlockInfo -> BinaryBlockInfo
shiftHeaderOffset Word16
2 (BinaryBlockInfo -> BinaryBlockInfo)
-> BinaryBlockInfo -> BinaryBlockInfo
forall a b. (a -> b) -> a -> b
$ ShelleyBlock (ShelleyEra c) -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo ShelleyBlock (ShelleyEra c)
blockAllegra
      BlockMary ShelleyBlock (ShelleyEra c)
blockMary ->
        Word16 -> BinaryBlockInfo -> BinaryBlockInfo
shiftHeaderOffset Word16
2 (BinaryBlockInfo -> BinaryBlockInfo)
-> BinaryBlockInfo -> BinaryBlockInfo
forall a b. (a -> b) -> a -> b
$ ShelleyBlock (ShelleyEra c) -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo ShelleyBlock (ShelleyEra c)
blockMary
    where
      shiftHeaderOffset :: Word16 -> BinaryBlockInfo -> BinaryBlockInfo
      shiftHeaderOffset :: Word16 -> BinaryBlockInfo -> BinaryBlockInfo
shiftHeaderOffset Word16
shift BinaryBlockInfo
binfo = BinaryBlockInfo
binfo {
            headerOffset :: Word16
headerOffset = BinaryBlockInfo -> Word16
headerOffset BinaryBlockInfo
binfo Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
shift
          }

  estimateHfcBlockSize :: Header (HardForkBlock (CardanoEras c)) -> SizeInBytes
estimateHfcBlockSize = \case
      HeaderByron   Header ByronBlock
headerByron   -> Header ByronBlock -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize Header ByronBlock
headerByron
      -- For Shelley and later eras, we add two extra bytes, see the
      -- 'SerialiseHFC' instance.
      HeaderShelley Header (ShelleyBlock (ShelleyEra c))
headerShelley -> Header (ShelleyBlock (ShelleyEra c)) -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize Header (ShelleyBlock (ShelleyEra c))
headerShelley SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
2
      HeaderAllegra Header (ShelleyBlock (ShelleyEra c))
headerAllegra -> Header (ShelleyBlock (ShelleyEra c)) -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize Header (ShelleyBlock (ShelleyEra c))
headerAllegra SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
2
      HeaderMary    Header (ShelleyBlock (ShelleyEra c))
headerMary    -> Header (ShelleyBlock (ShelleyEra c)) -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize Header (ShelleyBlock (ShelleyEra c))
headerMary    SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
2

-- | Prepend the given tag by creating a CBOR 2-tuple with the tag as the
-- first element and the given 'Encoding' as the second.
prependTag :: Word -> Encoding -> Encoding
prependTag :: Word -> Encoding -> Encoding
prependTag Word
tag Encoding
payload = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
CBOR.encodeListLen Word
2
    , Word -> Encoding
CBOR.encodeWord Word
tag
    , Encoding
payload
    ]

{-------------------------------------------------------------------------------
  SupportedNetworkProtocolVersion instance
-------------------------------------------------------------------------------}

-- Note: we don't support all combinations, so we don't declare them as
-- COMPLETE

-- | We support only Byron V1 with the hard fork disabled, as no other
-- versions have been released before the hard fork
pattern CardanoNodeToNodeVersion1 :: BlockNodeToNodeVersion (CardanoBlock c)
pattern $bCardanoNodeToNodeVersion1 :: BlockNodeToNodeVersion (CardanoBlock c)
$mCardanoNodeToNodeVersion1 :: forall r c.
BlockNodeToNodeVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToNodeVersion1 =
    HardForkNodeToNodeDisabled ByronNodeToNodeVersion1

-- | The hard fork enabled with the latest Byron version and the Shelley era
-- enabled.
pattern CardanoNodeToNodeVersion2 :: BlockNodeToNodeVersion (CardanoBlock c)
pattern $bCardanoNodeToNodeVersion2 :: BlockNodeToNodeVersion (CardanoBlock c)
$mCardanoNodeToNodeVersion2 :: forall r c.
BlockNodeToNodeVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToNodeVersion2 =
    HardForkNodeToNodeEnabled
      HardForkSpecificNodeToNodeVersion1
      (  EraNodeToNodeEnabled ByronNodeToNodeVersion2
      :* EraNodeToNodeEnabled ShelleyNodeToNodeVersion1
      :* EraNodeToNodeDisabled
      :* EraNodeToNodeDisabled
      :* Nil
      )

-- | The hard fork enabled with the latest Byron version, the Shelley and
-- Allegra eras enabled.
pattern CardanoNodeToNodeVersion3 :: BlockNodeToNodeVersion (CardanoBlock c)
pattern $bCardanoNodeToNodeVersion3 :: BlockNodeToNodeVersion (CardanoBlock c)
$mCardanoNodeToNodeVersion3 :: forall r c.
BlockNodeToNodeVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToNodeVersion3 =
    HardForkNodeToNodeEnabled
      HardForkSpecificNodeToNodeVersion1
      (  EraNodeToNodeEnabled ByronNodeToNodeVersion2
      :* EraNodeToNodeEnabled ShelleyNodeToNodeVersion1
      :* EraNodeToNodeEnabled ShelleyNodeToNodeVersion1
      :* EraNodeToNodeDisabled
      :* Nil
      )

-- | The hard fork enabled with the latest Byron version, the Shelley, Allegra,
-- and Mary eras enabled.
pattern CardanoNodeToNodeVersion4 :: BlockNodeToNodeVersion (CardanoBlock c)
pattern $bCardanoNodeToNodeVersion4 :: BlockNodeToNodeVersion (CardanoBlock c)
$mCardanoNodeToNodeVersion4 :: forall r c.
BlockNodeToNodeVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToNodeVersion4 =
    HardForkNodeToNodeEnabled
      HardForkSpecificNodeToNodeVersion1
      (  EraNodeToNodeEnabled ByronNodeToNodeVersion2
      :* EraNodeToNodeEnabled ShelleyNodeToNodeVersion1
      :* EraNodeToNodeEnabled ShelleyNodeToNodeVersion1
      :* EraNodeToNodeEnabled ShelleyNodeToNodeVersion1
      :* Nil
      )

-- | We support the sole Byron version with the hard fork disabled.
pattern CardanoNodeToClientVersion1 :: BlockNodeToClientVersion (CardanoBlock c)
pattern $bCardanoNodeToClientVersion1 :: BlockNodeToClientVersion (CardanoBlock c)
$mCardanoNodeToClientVersion1 :: forall r c.
BlockNodeToClientVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToClientVersion1 =
    HardForkNodeToClientDisabled ByronNodeToClientVersion1

-- | The hard fork enabled and the Shelley era enabled.
pattern CardanoNodeToClientVersion2 :: BlockNodeToClientVersion (CardanoBlock c)
pattern $bCardanoNodeToClientVersion2 :: BlockNodeToClientVersion (CardanoBlock c)
$mCardanoNodeToClientVersion2 :: forall r c.
BlockNodeToClientVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToClientVersion2 =
    HardForkNodeToClientEnabled
      HardForkSpecificNodeToClientVersion1
      (  EraNodeToClientEnabled ByronNodeToClientVersion1
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion1
      :* EraNodeToClientDisabled
      :* EraNodeToClientDisabled
      :* Nil
      )

-- | The hard fork enabled and the Shelley era enabled, but using
-- 'ShelleyNodeToClientVersion2' and 'HardForkSpecificNodeToClientVersion2'.
pattern CardanoNodeToClientVersion3 :: BlockNodeToClientVersion (CardanoBlock c)
pattern $bCardanoNodeToClientVersion3 :: BlockNodeToClientVersion (CardanoBlock c)
$mCardanoNodeToClientVersion3 :: forall r c.
BlockNodeToClientVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToClientVersion3 =
    HardForkNodeToClientEnabled
      HardForkSpecificNodeToClientVersion2
      (  EraNodeToClientEnabled ByronNodeToClientVersion1
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* EraNodeToClientDisabled
      :* EraNodeToClientDisabled
      :* Nil
      )

-- | The hard fork enabled, and the Shelley and Allegra eras enabled.
--
-- We don't bother with 'ShelleyNodeToClientVersion1' and
-- 'HardForkSpecificNodeToClientVersion1'.
pattern CardanoNodeToClientVersion4 :: BlockNodeToClientVersion (CardanoBlock c)
pattern $bCardanoNodeToClientVersion4 :: BlockNodeToClientVersion (CardanoBlock c)
$mCardanoNodeToClientVersion4 :: forall r c.
BlockNodeToClientVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToClientVersion4 =
    HardForkNodeToClientEnabled
      HardForkSpecificNodeToClientVersion2
      (  EraNodeToClientEnabled ByronNodeToClientVersion1
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* EraNodeToClientDisabled
      :* Nil
      )

-- | The hard fork enabled, and the Shelley, Allegra, and Mary eras enabled.
--
-- We don't bother with 'ShelleyNodeToClientVersion1'.
pattern CardanoNodeToClientVersion5 :: BlockNodeToClientVersion (CardanoBlock c)
pattern $bCardanoNodeToClientVersion5 :: BlockNodeToClientVersion (CardanoBlock c)
$mCardanoNodeToClientVersion5 :: forall r c.
BlockNodeToClientVersion (CardanoBlock c)
-> (Void# -> r) -> (Void# -> r) -> r
CardanoNodeToClientVersion5 =
    HardForkNodeToClientEnabled
      HardForkSpecificNodeToClientVersion2
      (  EraNodeToClientEnabled ByronNodeToClientVersion1
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* EraNodeToClientEnabled ShelleyNodeToClientVersion2
      :* Nil
      )

instance CardanoHardForkConstraints c
      => SupportedNetworkProtocolVersion (CardanoBlock c) where
  supportedNodeToNodeVersions :: Proxy (CardanoBlock c)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion (CardanoBlock c))
supportedNodeToNodeVersions Proxy (CardanoBlock c)
_ = [(NodeToNodeVersion,
  HardForkNodeToNodeVersion
    '[ByronBlock, ShelleyBlock (ShelleyEra c),
      ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])]
-> Map
     NodeToNodeVersion
     (HardForkNodeToNodeVersion
        '[ByronBlock, ShelleyBlock (ShelleyEra c),
          ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(NodeToNodeVersion,
   HardForkNodeToNodeVersion
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])]
 -> Map
      NodeToNodeVersion
      (HardForkNodeToNodeVersion
         '[ByronBlock, ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]))
-> [(NodeToNodeVersion,
     HardForkNodeToNodeVersion
       '[ByronBlock, ShelleyBlock (ShelleyEra c),
         ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])]
-> Map
     NodeToNodeVersion
     (HardForkNodeToNodeVersion
        '[ByronBlock, ShelleyBlock (ShelleyEra c),
          ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
forall a b. (a -> b) -> a -> b
$
      [ (NodeToNodeVersion
NodeToNodeV_1, HardForkNodeToNodeVersion
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall c. BlockNodeToNodeVersion (CardanoBlock c)
CardanoNodeToNodeVersion1)
      , (NodeToNodeVersion
NodeToNodeV_2, HardForkNodeToNodeVersion
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall c. BlockNodeToNodeVersion (CardanoBlock c)
CardanoNodeToNodeVersion2)
      , (NodeToNodeVersion
NodeToNodeV_3, HardForkNodeToNodeVersion
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall c. BlockNodeToNodeVersion (CardanoBlock c)
CardanoNodeToNodeVersion2)
      -- TODO #2670 enable these
      -- , (NodeToNodeV_4, CardanoNodeToNodeVersion3)
      -- , (NodeToNodeV_5, CardanoNodeToNodeVersion4)
      ]

  supportedNodeToClientVersions :: Proxy (CardanoBlock c)
-> Map
     NodeToClientVersion (BlockNodeToClientVersion (CardanoBlock c))
supportedNodeToClientVersions Proxy (CardanoBlock c)
_ = [(NodeToClientVersion,
  HardForkNodeToClientVersion
    '[ByronBlock, ShelleyBlock (ShelleyEra c),
      ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])]
-> Map
     NodeToClientVersion
     (HardForkNodeToClientVersion
        '[ByronBlock, ShelleyBlock (ShelleyEra c),
          ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(NodeToClientVersion,
   HardForkNodeToClientVersion
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])]
 -> Map
      NodeToClientVersion
      (HardForkNodeToClientVersion
         '[ByronBlock, ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]))
-> [(NodeToClientVersion,
     HardForkNodeToClientVersion
       '[ByronBlock, ShelleyBlock (ShelleyEra c),
         ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])]
-> Map
     NodeToClientVersion
     (HardForkNodeToClientVersion
        '[ByronBlock, ShelleyBlock (ShelleyEra c),
          ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
forall a b. (a -> b) -> a -> b
$
      [ (NodeToClientVersion
NodeToClientV_1, HardForkNodeToClientVersion
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall c. BlockNodeToClientVersion (CardanoBlock c)
CardanoNodeToClientVersion1)
      , (NodeToClientVersion
NodeToClientV_2, HardForkNodeToClientVersion
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall c. BlockNodeToClientVersion (CardanoBlock c)
CardanoNodeToClientVersion1)
      , (NodeToClientVersion
NodeToClientV_3, HardForkNodeToClientVersion
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall c. BlockNodeToClientVersion (CardanoBlock c)
CardanoNodeToClientVersion2)
      , (NodeToClientVersion
NodeToClientV_4, HardForkNodeToClientVersion
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall c. BlockNodeToClientVersion (CardanoBlock c)
CardanoNodeToClientVersion3)
      -- TODO #2670 enable these
      -- , (NodeToClientV_5, CardanoNodeToClientVersion4)
      -- , (NodeToClientV_6, CardanoNodeToClientVersion5)
      ]

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

-- | Parameters needed to transition between two eras.
--
-- The two eras are phantom type parameters of this type to avoid mixing up
-- multiple 'ProtocolParamsTransition's
data ProtocolParamsTransition eraFrom eraTo = ProtocolParamsTransition {
       -- | Lower bound on first epoch of @eraTo@
       --
       -- Setting this to @Just@ when a true lower bound is known may
       -- particularly improve performance of bulk syncing. For example, for the
       -- transition from Byron to Shelley, @Just 208@ would be sound for the
       -- Cardano mainnet, since we know now that the Shelley era began in epoch
       -- 208.
       --
       -- The @Nothing@ case is useful for test and possible alternative nets.
      ProtocolParamsTransition eraFrom eraTo -> Maybe EpochNo
transitionLowerBound :: Maybe EpochNo
    , ProtocolParamsTransition eraFrom eraTo -> TriggerHardFork
transitionTrigger    :: TriggerHardFork
    }

protocolInfoCardano ::
     forall c m. (IOLike m, CardanoHardForkConstraints c)
  => ProtocolParamsByron
  -> ProtocolParamsShelley c Maybe
  -> ProtocolParamsAllegra c Maybe
  -> ProtocolParamsMary    c Maybe
  -> ProtocolParamsTransition
       ByronBlock
       (ShelleyBlock (ShelleyEra c))
  -> ProtocolParamsTransition
       (ShelleyBlock (ShelleyEra c))
       (ShelleyBlock (AllegraEra c))
  -> ProtocolParamsTransition
       (ShelleyBlock (AllegraEra c))
       (ShelleyBlock (MaryEra c))
  -> ProtocolInfo m (CardanoBlock c)
protocolInfoCardano :: ProtocolParamsByron
-> ProtocolParamsShelley c Maybe
-> ProtocolParamsAllegra c Maybe
-> ProtocolParamsMary c Maybe
-> ProtocolParamsTransition
     ByronBlock (ShelleyBlock (ShelleyEra c))
-> ProtocolParamsTransition
     (ShelleyBlock (ShelleyEra c)) (ShelleyBlock (ShelleyEra c))
-> ProtocolParamsTransition
     (ShelleyBlock (ShelleyEra c)) (ShelleyBlock (ShelleyEra c))
-> ProtocolInfo m (CardanoBlock c)
protocolInfoCardano protocolParamsByron :: ProtocolParamsByron
protocolParamsByron@ProtocolParamsByron {
                        $sel:byronGenesis:ProtocolParamsByron :: ProtocolParamsByron -> Config
byronGenesis           = Config
genesisByron
                      , $sel:byronLeaderCredentials:ProtocolParamsByron :: ProtocolParamsByron -> Maybe ByronLeaderCredentials
byronLeaderCredentials = Maybe ByronLeaderCredentials
mCredsByron
                      }
                    ProtocolParamsShelley {
                        $sel:shelleyGenesis:ProtocolParamsShelley :: forall c (f :: * -> *).
ProtocolParamsShelley c f -> ShelleyGenesis (ShelleyEra c)
shelleyGenesis           = ShelleyGenesis (ShelleyEra c)
genesisShelley
                      , $sel:shelleyInitialNonce:ProtocolParamsShelley :: forall c (f :: * -> *). ProtocolParamsShelley c f -> Nonce
shelleyInitialNonce      = Nonce
initialNonceShelley
                      , $sel:shelleyProtVer:ProtocolParamsShelley :: forall c (f :: * -> *). ProtocolParamsShelley c f -> ProtVer
shelleyProtVer           = ProtVer
protVerShelley
                      , $sel:shelleyLeaderCredentials:ProtocolParamsShelley :: forall c (f :: * -> *).
ProtocolParamsShelley c f -> f (TPraosLeaderCredentials c)
shelleyLeaderCredentials = Maybe (TPraosLeaderCredentials c)
mCredsShelley
                      }
                    ProtocolParamsAllegra {
                        $sel:allegraProtVer:ProtocolParamsAllegra :: forall c (f :: * -> *). ProtocolParamsAllegra c f -> ProtVer
allegraProtVer           = ProtVer
protVerAllegra
                      , $sel:allegraLeaderCredentials:ProtocolParamsAllegra :: forall c (f :: * -> *).
ProtocolParamsAllegra c f -> f (TPraosLeaderCredentials c)
allegraLeaderCredentials = Maybe (TPraosLeaderCredentials c)
mCredsAllegra
                      }
                    ProtocolParamsMary {
                        $sel:maryProtVer:ProtocolParamsMary :: forall c (f :: * -> *). ProtocolParamsMary c f -> ProtVer
maryProtVer           = ProtVer
protVerMary
                      , $sel:maryLeaderCredentials:ProtocolParamsMary :: forall c (f :: * -> *).
ProtocolParamsMary c f -> f (TPraosLeaderCredentials c)
maryLeaderCredentials = Maybe (TPraosLeaderCredentials c)
mCredsMary
                      }
                    ProtocolParamsTransition {
                        transitionLowerBound :: forall eraFrom eraTo.
ProtocolParamsTransition eraFrom eraTo -> Maybe EpochNo
transitionLowerBound = Maybe EpochNo
mbLowerBoundShelley
                      , transitionTrigger :: forall eraFrom eraTo.
ProtocolParamsTransition eraFrom eraTo -> TriggerHardFork
transitionTrigger    = TriggerHardFork
triggerHardForkByronShelley
                      }
                    ProtocolParamsTransition {
                        transitionLowerBound :: forall eraFrom eraTo.
ProtocolParamsTransition eraFrom eraTo -> Maybe EpochNo
transitionLowerBound = Maybe EpochNo
mbLowerBoundAllegra
                      , transitionTrigger :: forall eraFrom eraTo.
ProtocolParamsTransition eraFrom eraTo -> TriggerHardFork
transitionTrigger    = TriggerHardFork
triggerHardForkShelleyAllegra
                      }
                    ProtocolParamsTransition {
                        transitionLowerBound :: forall eraFrom eraTo.
ProtocolParamsTransition eraFrom eraTo -> Maybe EpochNo
transitionLowerBound = Maybe EpochNo
mbLowerBoundMary
                      , transitionTrigger :: forall eraFrom eraTo.
ProtocolParamsTransition eraFrom eraTo -> TriggerHardFork
transitionTrigger    = TriggerHardFork
triggerHardForkAllegraMary
                      } =
    Either [Char] ()
-> ProtocolInfo m (CardanoBlock c)
-> ProtocolInfo m (CardanoBlock c)
forall a. HasCallStack => Either [Char] () -> a -> a
assertWithMsg (ShelleyGenesis (ShelleyEra c) -> Either [Char] ()
forall era.
ShelleyBasedEra era =>
ShelleyGenesis era -> Either [Char] ()
validateGenesis ShelleyGenesis (ShelleyEra c)
genesisShelley) (ProtocolInfo m (CardanoBlock c)
 -> ProtocolInfo m (CardanoBlock c))
-> ProtocolInfo m (CardanoBlock c)
-> ProtocolInfo m (CardanoBlock c)
forall a b. (a -> b) -> a -> b
$
    ProtocolInfo :: forall (m :: * -> *) b.
TopLevelConfig b
-> ExtLedgerState b -> [m (BlockForging m b)] -> ProtocolInfo m b
ProtocolInfo {
        pInfoConfig :: TopLevelConfig (CardanoBlock c)
pInfoConfig = TopLevelConfig (CardanoBlock c)
cfg
      , pInfoInitLedger :: ExtLedgerState (CardanoBlock c)
pInfoInitLedger = ExtLedgerState :: forall blk.
LedgerState blk -> HeaderState blk -> ExtLedgerState blk
ExtLedgerState {
            ledgerState :: LedgerState (CardanoBlock c)
ledgerState =
              HardForkState
  LedgerState
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> LedgerState (CardanoBlock c)
forall (xs :: [*]).
HardForkState LedgerState xs -> LedgerState (HardForkBlock xs)
HardForkLedgerState (HardForkState
   LedgerState
   '[ByronBlock, ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> LedgerState (CardanoBlock c))
-> HardForkState
     LedgerState
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> LedgerState (CardanoBlock c)
forall a b. (a -> b) -> a -> b
$
                LedgerState ByronBlock
-> HardForkState
     LedgerState
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall (f :: * -> *) x (xs :: [*]). f x -> HardForkState f (x : xs)
initHardForkState LedgerState ByronBlock
initLedgerStateByron
          , headerState :: HeaderState (CardanoBlock c)
headerState =
              ChainDepState (BlockProtocol (CardanoBlock c))
-> HeaderState (CardanoBlock c)
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState (ChainDepState (BlockProtocol (CardanoBlock c))
 -> HeaderState (CardanoBlock c))
-> ChainDepState (BlockProtocol (CardanoBlock c))
-> HeaderState (CardanoBlock c)
forall a b. (a -> b) -> a -> b
$
                WrapChainDepState ByronBlock
-> HardForkState
     WrapChainDepState
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall (f :: * -> *) x (xs :: [*]). f x -> HardForkState f (x : xs)
initHardForkState (WrapChainDepState ByronBlock
 -> HardForkState
      WrapChainDepState
      '[ByronBlock, ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> WrapChainDepState ByronBlock
-> HardForkState
     WrapChainDepState
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall a b. (a -> b) -> a -> b
$
                  ChainDepState (BlockProtocol ByronBlock)
-> WrapChainDepState ByronBlock
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ChainDepState (BlockProtocol ByronBlock)
 -> WrapChainDepState ByronBlock)
-> ChainDepState (BlockProtocol ByronBlock)
-> WrapChainDepState ByronBlock
forall a b. (a -> b) -> a -> b
$
                    HeaderState ByronBlock -> ChainDepState (BlockProtocol ByronBlock)
forall blk. HeaderState blk -> ChainDepState (BlockProtocol blk)
headerStateChainDep HeaderState ByronBlock
initHeaderStateByron
          }
      , pInfoBlockForging :: [m (BlockForging m (CardanoBlock c))]
pInfoBlockForging = [[m (BlockForging m (CardanoBlock c))]]
-> [m (BlockForging m (CardanoBlock c))]
forall a. Monoid a => [a] -> a
mconcat [
            [ BlockForging m (CardanoBlock c)
-> m (BlockForging m (CardanoBlock c))
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockForging m (CardanoBlock c)
 -> m (BlockForging m (CardanoBlock c)))
-> BlockForging m (CardanoBlock c)
-> m (BlockForging m (CardanoBlock c))
forall a b. (a -> b) -> a -> b
$ NS
  (BlockForging m)
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> BlockForging m (CardanoBlock c)
forall (m :: * -> *) (xs :: [*]).
(CanHardFork xs, Monad m) =>
NS (BlockForging m) xs -> BlockForging m (HardForkBlock xs)
hardForkBlockForging (NS
   (BlockForging m)
   '[ByronBlock, ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> BlockForging m (CardanoBlock c))
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> BlockForging m (CardanoBlock c)
forall a b. (a -> b) -> a -> b
$ BlockForging m ByronBlock
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (BlockForging m ByronBlock
 -> NS
      (BlockForging m)
      '[ByronBlock, ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> BlockForging m ByronBlock
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall a b. (a -> b) -> a -> b
$ ByronLeaderCredentials -> BlockForging m ByronBlock
forall (m :: * -> *).
Monad m =>
ByronLeaderCredentials -> BlockForging m ByronBlock
byronBlockForging ByronLeaderCredentials
credsByron
            | ByronLeaderCredentials
credsByron <- Maybe ByronLeaderCredentials -> [ByronLeaderCredentials]
forall a. Maybe a -> [a]
maybeToList Maybe ByronLeaderCredentials
mCredsByron
            ]
          , [ NS
  (BlockForging m)
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> BlockForging m (CardanoBlock c)
forall (m :: * -> *) (xs :: [*]).
(CanHardFork xs, Monad m) =>
NS (BlockForging m) xs -> BlockForging m (HardForkBlock xs)
hardForkBlockForging (NS
   (BlockForging m)
   '[ByronBlock, ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> BlockForging m (CardanoBlock c))
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ByronBlock, ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> BlockForging m (CardanoBlock c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS
  (BlockForging m)
  '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c)]
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS
   (BlockForging m)
   '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c)]
 -> NS
      (BlockForging m)
      '[ByronBlock, ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z
                (BlockForging m (ShelleyBlock (ShelleyEra c))
 -> BlockForging m (CardanoBlock c))
-> m (BlockForging m (ShelleyBlock (ShelleyEra c)))
-> m (BlockForging m (CardanoBlock c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPraosParams
-> TPraosLeaderCredentials (EraCrypto (ShelleyEra c))
-> m (BlockForging m (ShelleyBlock (ShelleyEra c)))
forall (m :: * -> *) era.
(ShelleyBasedEra era, IOLike m) =>
TPraosParams
-> TPraosLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock era))
shelleyBlockForging TPraosParams
tpraosParams TPraosLeaderCredentials c
TPraosLeaderCredentials (EraCrypto (ShelleyEra c))
credsShelley
            | TPraosLeaderCredentials c
credsShelley <- Maybe (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall a. Maybe a -> [a]
maybeToList Maybe (TPraosLeaderCredentials c)
mCredsShelley
            ]
          , [ NS
  (BlockForging m)
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> BlockForging m (CardanoBlock c)
forall (m :: * -> *) (xs :: [*]).
(CanHardFork xs, Monad m) =>
NS (BlockForging m) xs -> BlockForging m (HardForkBlock xs)
hardForkBlockForging (NS
   (BlockForging m)
   '[ByronBlock, ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> BlockForging m (CardanoBlock c))
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ByronBlock, ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> BlockForging m (CardanoBlock c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS
  (BlockForging m)
  '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c)]
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS
   (BlockForging m)
   '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c)]
 -> NS
      (BlockForging m)
      '[ByronBlock, ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS
  (BlockForging m)
  '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS
   (BlockForging m)
   '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> NS
      (BlockForging m)
      '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c)])
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z
                (BlockForging m (ShelleyBlock (ShelleyEra c))
 -> BlockForging m (CardanoBlock c))
-> m (BlockForging m (ShelleyBlock (ShelleyEra c)))
-> m (BlockForging m (CardanoBlock c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPraosParams
-> TPraosLeaderCredentials (EraCrypto (ShelleyEra c))
-> m (BlockForging m (ShelleyBlock (ShelleyEra c)))
forall (m :: * -> *) era.
(ShelleyBasedEra era, IOLike m) =>
TPraosParams
-> TPraosLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock era))
shelleyBlockForging TPraosParams
tpraosParams TPraosLeaderCredentials c
TPraosLeaderCredentials (EraCrypto (ShelleyEra c))
credsAllegra
            | TPraosLeaderCredentials c
credsAllegra <- Maybe (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall a. Maybe a -> [a]
maybeToList Maybe (TPraosLeaderCredentials c)
mCredsAllegra
            ]
          , [ NS
  (BlockForging m)
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> BlockForging m (CardanoBlock c)
forall (m :: * -> *) (xs :: [*]).
(CanHardFork xs, Monad m) =>
NS (BlockForging m) xs -> BlockForging m (HardForkBlock xs)
hardForkBlockForging (NS
   (BlockForging m)
   '[ByronBlock, ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> BlockForging m (CardanoBlock c))
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ByronBlock, ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> BlockForging m (CardanoBlock c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS
  (BlockForging m)
  '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c)]
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS
   (BlockForging m)
   '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c)]
 -> NS
      (BlockForging m)
      '[ByronBlock, ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
           ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS
  (BlockForging m)
  '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS
   (BlockForging m)
   '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> NS
      (BlockForging m)
      '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c)])
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS
         (BlockForging m)
         '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (BlockForging m) '[ShelleyBlock (ShelleyEra c)]
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (BlockForging m) '[ShelleyBlock (ShelleyEra c)]
 -> NS
      (BlockForging m)
      '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> (BlockForging m (ShelleyBlock (ShelleyEra c))
    -> NS (BlockForging m) '[ShelleyBlock (ShelleyEra c)])
-> BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS
     (BlockForging m)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockForging m (ShelleyBlock (ShelleyEra c))
-> NS (BlockForging m) '[ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z
                (BlockForging m (ShelleyBlock (ShelleyEra c))
 -> BlockForging m (CardanoBlock c))
-> m (BlockForging m (ShelleyBlock (ShelleyEra c)))
-> m (BlockForging m (CardanoBlock c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPraosParams
-> TPraosLeaderCredentials (EraCrypto (ShelleyEra c))
-> m (BlockForging m (ShelleyBlock (ShelleyEra c)))
forall (m :: * -> *) era.
(ShelleyBasedEra era, IOLike m) =>
TPraosParams
-> TPraosLeaderCredentials (EraCrypto era)
-> m (BlockForging m (ShelleyBlock era))
shelleyBlockForging TPraosParams
tpraosParams TPraosLeaderCredentials c
TPraosLeaderCredentials (EraCrypto (ShelleyEra c))
credsMary
            | TPraosLeaderCredentials c
credsMary <- Maybe (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall a. Maybe a -> [a]
maybeToList Maybe (TPraosLeaderCredentials c)
mCredsMary
            ]
          ]
      }
  where
    -- The major protocol version of the last era is the maximum major protocol
    -- version we support.
    maxMajorProtVer :: MaxMajorProtVer
    maxMajorProtVer :: MaxMajorProtVer
maxMajorProtVer = Natural -> MaxMajorProtVer
MaxMajorProtVer (ProtVer -> Natural
pvMajor ProtVer
protVerMary)

    -- Byron
    ProtocolInfo {
        pInfoConfig :: forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig = topLevelConfigByron :: TopLevelConfig ByronBlock
topLevelConfigByron@TopLevelConfig {
            topLevelConfigProtocol :: forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol = ConsensusConfig (BlockProtocol ByronBlock)
consensusConfigByron
          , topLevelConfigLedger :: forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger   = LedgerConfig ByronBlock
ledgerConfigByron
          , topLevelConfigBlock :: forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigBlock    = BlockConfig ByronBlock
blockConfigByron
          }
      , pInfoInitLedger :: forall (m :: * -> *) b. ProtocolInfo m b -> ExtLedgerState b
pInfoInitLedger = ExtLedgerState {
            ledgerState :: forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState = LedgerState ByronBlock
initLedgerStateByron
          , headerState :: forall blk. ExtLedgerState blk -> HeaderState blk
headerState = HeaderState ByronBlock
initHeaderStateByron
          }
      } = ProtocolParamsByron -> ProtocolInfo m ByronBlock
forall (m :: * -> *).
Monad m =>
ProtocolParamsByron -> ProtocolInfo m ByronBlock
protocolInfoByron @m ProtocolParamsByron
protocolParamsByron

    partialConsensusConfigByron :: PartialConsensusConfig (BlockProtocol ByronBlock)
    partialConsensusConfigByron :: PartialConsensusConfig (BlockProtocol ByronBlock)
partialConsensusConfigByron = PartialConsensusConfig (BlockProtocol ByronBlock)
ConsensusConfig (BlockProtocol ByronBlock)
consensusConfigByron

    partialLedgerConfigByron :: PartialLedgerConfig ByronBlock
    partialLedgerConfigByron :: PartialLedgerConfig ByronBlock
partialLedgerConfigByron = ByronPartialLedgerConfig :: LedgerConfig ByronBlock
-> TriggerHardFork -> ByronPartialLedgerConfig
ByronPartialLedgerConfig {
          byronLedgerConfig :: LedgerConfig ByronBlock
byronLedgerConfig    = LedgerConfig ByronBlock
ledgerConfigByron
        , byronTriggerHardFork :: TriggerHardFork
byronTriggerHardFork = TriggerHardFork
triggerHardForkByronShelley
        }

    kByron :: SecurityParam
    kByron :: SecurityParam
kByron = Config -> SecurityParam
Byron.genesisSecurityParam Config
genesisByron

    -- Shelley

    tpraosParams :: TPraosParams
    tpraosParams :: TPraosParams
tpraosParams@TPraosParams { Word64
tpraosSlotsPerKESPeriod :: TPraosParams -> Word64
tpraosSlotsPerKESPeriod :: Word64
tpraosSlotsPerKESPeriod } =
        MaxMajorProtVer
-> Nonce -> ShelleyGenesis (ShelleyEra c) -> TPraosParams
forall era.
MaxMajorProtVer -> Nonce -> ShelleyGenesis era -> TPraosParams
Shelley.mkTPraosParams
          MaxMajorProtVer
maxMajorProtVer
          Nonce
initialNonceShelley
          ShelleyGenesis (ShelleyEra c)
genesisShelley

    blockConfigShelley :: BlockConfig (ShelleyBlock (ShelleyEra c))
    blockConfigShelley :: BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfigShelley =
        ProtVer
-> ShelleyGenesis (ShelleyEra c)
-> [VKey 'BlockIssuer (EraCrypto (ShelleyEra c))]
-> BlockConfig (ShelleyBlock (ShelleyEra c))
forall era.
ShelleyBasedEra era =>
ProtVer
-> ShelleyGenesis era
-> [VKey 'BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock era)
Shelley.mkShelleyBlockConfig
          ProtVer
protVerShelley
          ShelleyGenesis (ShelleyEra c)
genesisShelley
          (TPraosLeaderCredentials c -> VKey 'BlockIssuer c
forall c. TPraosLeaderCredentials c -> VKey 'BlockIssuer c
tpraosBlockIssuerVKey (TPraosLeaderCredentials c -> VKey 'BlockIssuer c)
-> [TPraosLeaderCredentials c] -> [VKey 'BlockIssuer c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall a. Maybe a -> [a]
maybeToList Maybe (TPraosLeaderCredentials c)
mCredsShelley)

    partialConsensusConfigShelley ::
         PartialConsensusConfig (BlockProtocol (ShelleyBlock (ShelleyEra c)))
    partialConsensusConfigShelley :: PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
partialConsensusConfigShelley = PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
TPraosParams
tpraosParams

    partialLedgerConfigShelley :: PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
    partialLedgerConfigShelley :: PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
partialLedgerConfigShelley =
        ShelleyGenesis (ShelleyEra c)
-> MaxMajorProtVer
-> TriggerHardFork
-> PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
forall era.
ShelleyGenesis era
-> MaxMajorProtVer
-> TriggerHardFork
-> PartialLedgerConfig (ShelleyBlock era)
mkPartialLedgerConfigShelley
          ShelleyGenesis (ShelleyEra c)
genesisShelley
          MaxMajorProtVer
maxMajorProtVer
          TriggerHardFork
triggerHardForkShelleyAllegra

    kShelley :: SecurityParam
    kShelley :: SecurityParam
kShelley = Word64 -> SecurityParam
SecurityParam (Word64 -> SecurityParam) -> Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis (ShelleyEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgSecurityParam ShelleyGenesis (ShelleyEra c)
genesisShelley

    -- Allegra

    genesisAllegra :: ShelleyGenesis (AllegraEra c)
    genesisAllegra :: ShelleyGenesis (ShelleyEra c)
genesisAllegra = ShelleyGenesis (ShelleyEra c)
genesisShelley

    blockConfigAllegra :: BlockConfig (ShelleyBlock (AllegraEra c))
    blockConfigAllegra :: BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfigAllegra =
        ProtVer
-> ShelleyGenesis (ShelleyEra c)
-> [VKey 'BlockIssuer (EraCrypto (ShelleyEra c))]
-> BlockConfig (ShelleyBlock (ShelleyEra c))
forall era.
ShelleyBasedEra era =>
ProtVer
-> ShelleyGenesis era
-> [VKey 'BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock era)
Shelley.mkShelleyBlockConfig
          ProtVer
protVerAllegra
          ShelleyGenesis (ShelleyEra c)
genesisAllegra
          (TPraosLeaderCredentials c -> VKey 'BlockIssuer c
forall c. TPraosLeaderCredentials c -> VKey 'BlockIssuer c
tpraosBlockIssuerVKey (TPraosLeaderCredentials c -> VKey 'BlockIssuer c)
-> [TPraosLeaderCredentials c] -> [VKey 'BlockIssuer c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall a. Maybe a -> [a]
maybeToList Maybe (TPraosLeaderCredentials c)
mCredsAllegra)

    partialConsensusConfigAllegra ::
         PartialConsensusConfig (BlockProtocol (ShelleyBlock (AllegraEra c)))
    partialConsensusConfigAllegra :: PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
partialConsensusConfigAllegra = PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
TPraosParams
tpraosParams

    partialLedgerConfigAllegra :: PartialLedgerConfig (ShelleyBlock (AllegraEra c))
    partialLedgerConfigAllegra :: PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
partialLedgerConfigAllegra =
        ShelleyGenesis (ShelleyEra c)
-> MaxMajorProtVer
-> TriggerHardFork
-> PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
forall era.
ShelleyGenesis era
-> MaxMajorProtVer
-> TriggerHardFork
-> PartialLedgerConfig (ShelleyBlock era)
mkPartialLedgerConfigShelley
          ShelleyGenesis (ShelleyEra c)
genesisAllegra
          MaxMajorProtVer
maxMajorProtVer
          TriggerHardFork
triggerHardForkAllegraMary

    -- Mary

    genesisMary :: ShelleyGenesis (MaryEra c)
    genesisMary :: ShelleyGenesis (ShelleyEra c)
genesisMary = ShelleyGenesis (ShelleyEra c)
genesisAllegra

    blockConfigMary :: BlockConfig (ShelleyBlock (MaryEra c))
    blockConfigMary :: BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfigMary =
        ProtVer
-> ShelleyGenesis (ShelleyEra c)
-> [VKey 'BlockIssuer (EraCrypto (ShelleyEra c))]
-> BlockConfig (ShelleyBlock (ShelleyEra c))
forall era.
ShelleyBasedEra era =>
ProtVer
-> ShelleyGenesis era
-> [VKey 'BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock era)
Shelley.mkShelleyBlockConfig
          ProtVer
protVerMary
          ShelleyGenesis (ShelleyEra c)
genesisMary
          (TPraosLeaderCredentials c -> VKey 'BlockIssuer c
forall c. TPraosLeaderCredentials c -> VKey 'BlockIssuer c
tpraosBlockIssuerVKey (TPraosLeaderCredentials c -> VKey 'BlockIssuer c)
-> [TPraosLeaderCredentials c] -> [VKey 'BlockIssuer c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TPraosLeaderCredentials c) -> [TPraosLeaderCredentials c]
forall a. Maybe a -> [a]
maybeToList Maybe (TPraosLeaderCredentials c)
mCredsMary)

    partialConsensusConfigMary ::
         PartialConsensusConfig (BlockProtocol (ShelleyBlock (MaryEra c)))
    partialConsensusConfigMary :: PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
partialConsensusConfigMary = PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
TPraosParams
tpraosParams

    partialLedgerConfigMary :: PartialLedgerConfig (ShelleyBlock (MaryEra c))
    partialLedgerConfigMary :: PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
partialLedgerConfigMary =
        ShelleyGenesis (ShelleyEra c)
-> MaxMajorProtVer
-> TriggerHardFork
-> PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
forall era.
ShelleyGenesis era
-> MaxMajorProtVer
-> TriggerHardFork
-> PartialLedgerConfig (ShelleyBlock era)
mkPartialLedgerConfigShelley
          ShelleyGenesis (ShelleyEra c)
genesisMary
          MaxMajorProtVer
maxMajorProtVer
          TriggerHardFork
TriggerHardForkNever

    -- Cardano

    k :: SecurityParam
    k :: SecurityParam
k = Bool -> SecurityParam -> SecurityParam
forall a. HasCallStack => Bool -> a -> a
assert (SecurityParam
kByron SecurityParam -> SecurityParam -> Bool
forall a. Eq a => a -> a -> Bool
== SecurityParam
kShelley) SecurityParam
kByron

    shape :: History.Shape (CardanoEras c)
    shape :: Shape
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
shape = Exactly
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
  EraParams
-> Shape
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall (xs :: [*]). Exactly xs EraParams -> Shape xs
History.Shape (Exactly
   '[ByronBlock, ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
   EraParams
 -> Shape
      '[ByronBlock, ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)])
-> Exactly
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
     EraParams
-> Shape
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall a b. (a -> b) -> a -> b
$ NP
  (K EraParams)
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> Exactly
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
     EraParams
forall (xs :: [*]) a. NP (K a) xs -> Exactly xs a
Exactly (NP
   (K EraParams)
   '[ByronBlock, ShelleyBlock (ShelleyEra c),
     ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
 -> Exactly
      '[ByronBlock, ShelleyBlock (ShelleyEra c),
        ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
      EraParams)
-> NP
     (K EraParams)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> Exactly
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
     EraParams
forall a b. (a -> b) -> a -> b
$
           EraParams -> K EraParams ByronBlock
forall k a (b :: k). a -> K a b
K (SafeBeforeEpoch -> Config -> EraParams
Byron.byronEraParams     (Maybe EpochNo -> SafeBeforeEpoch
safeBefore Maybe EpochNo
mbLowerBoundShelley) Config
genesisByron)
        K EraParams ByronBlock
-> NP
     (K EraParams)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
-> NP
     (K EraParams)
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* EraParams -> K EraParams (ShelleyBlock (ShelleyEra c))
forall k a (b :: k). a -> K a b
K (SafeBeforeEpoch -> ShelleyGenesis (ShelleyEra c) -> EraParams
forall era. SafeBeforeEpoch -> ShelleyGenesis era -> EraParams
Shelley.shelleyEraParams (Maybe EpochNo -> SafeBeforeEpoch
safeBefore Maybe EpochNo
mbLowerBoundAllegra) ShelleyGenesis (ShelleyEra c)
genesisShelley)
        K EraParams (ShelleyBlock (ShelleyEra c))
-> NP
     (K EraParams)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> NP
     (K EraParams)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* EraParams -> K EraParams (ShelleyBlock (ShelleyEra c))
forall k a (b :: k). a -> K a b
K (SafeBeforeEpoch -> ShelleyGenesis (ShelleyEra c) -> EraParams
forall era. SafeBeforeEpoch -> ShelleyGenesis era -> EraParams
Shelley.shelleyEraParams (Maybe EpochNo -> SafeBeforeEpoch
safeBefore Maybe EpochNo
mbLowerBoundMary)    ShelleyGenesis (ShelleyEra c)
genesisShelley)
        K EraParams (ShelleyBlock (ShelleyEra c))
-> NP (K EraParams) '[ShelleyBlock (ShelleyEra c)]
-> NP
     (K EraParams)
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* EraParams -> K EraParams (ShelleyBlock (ShelleyEra c))
forall k a (b :: k). a -> K a b
K (SafeBeforeEpoch -> ShelleyGenesis (ShelleyEra c) -> EraParams
forall era. SafeBeforeEpoch -> ShelleyGenesis era -> EraParams
Shelley.shelleyEraParams (Maybe EpochNo -> SafeBeforeEpoch
safeBefore Maybe EpochNo
forall a. Maybe a
Nothing)             ShelleyGenesis (ShelleyEra c)
genesisShelley)
        K EraParams (ShelleyBlock (ShelleyEra c))
-> NP (K EraParams) '[]
-> NP (K EraParams) '[ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K EraParams) '[]
forall k (a :: k -> *). NP a '[]
Nil
      where
        safeBefore :: Maybe EpochNo -> History.SafeBeforeEpoch
        safeBefore :: Maybe EpochNo -> SafeBeforeEpoch
safeBefore = SafeBeforeEpoch
-> (EpochNo -> SafeBeforeEpoch) -> Maybe EpochNo -> SafeBeforeEpoch
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SafeBeforeEpoch
History.NoLowerBound EpochNo -> SafeBeforeEpoch
History.LowerBound

    cfg :: TopLevelConfig (CardanoBlock c)
    cfg :: TopLevelConfig (CardanoBlock c)
cfg = TopLevelConfig :: forall blk.
ConsensusConfig (BlockProtocol blk)
-> LedgerConfig blk
-> BlockConfig blk
-> CodecConfig blk
-> StorageConfig blk
-> TopLevelConfig blk
TopLevelConfig {
        topLevelConfigProtocol :: ConsensusConfig (BlockProtocol (CardanoBlock c))
topLevelConfigProtocol = HardForkConsensusConfig :: forall (xs :: [*]).
SecurityParam
-> Shape xs
-> PerEraConsensusConfig xs
-> ConsensusConfig (HardForkProtocol xs)
HardForkConsensusConfig {
            hardForkConsensusConfigK :: SecurityParam
hardForkConsensusConfigK      = SecurityParam
k
          , hardForkConsensusConfigShape :: Shape
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
hardForkConsensusConfigShape  = Shape
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
shape
          , hardForkConsensusConfigPerEra :: PerEraConsensusConfig
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
hardForkConsensusConfigPerEra = NP
  WrapPartialConsensusConfig
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> PerEraConsensusConfig
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall (xs :: [*]).
NP WrapPartialConsensusConfig xs -> PerEraConsensusConfig xs
PerEraConsensusConfig
              (  PartialConsensusConfig (BlockProtocol ByronBlock)
-> WrapPartialConsensusConfig ByronBlock
forall blk.
PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
WrapPartialConsensusConfig PartialConsensusConfig (BlockProtocol ByronBlock)
partialConsensusConfigByron
              WrapPartialConsensusConfig ByronBlock
-> NP
     WrapPartialConsensusConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
-> NP
     WrapPartialConsensusConfig
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
-> WrapPartialConsensusConfig (ShelleyBlock (ShelleyEra c))
forall blk.
PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
WrapPartialConsensusConfig PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
partialConsensusConfigShelley
              WrapPartialConsensusConfig (ShelleyBlock (ShelleyEra c))
-> NP
     WrapPartialConsensusConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> NP
     WrapPartialConsensusConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
-> WrapPartialConsensusConfig (ShelleyBlock (ShelleyEra c))
forall blk.
PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
WrapPartialConsensusConfig PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
partialConsensusConfigAllegra
              WrapPartialConsensusConfig (ShelleyBlock (ShelleyEra c))
-> NP WrapPartialConsensusConfig '[ShelleyBlock (ShelleyEra c)]
-> NP
     WrapPartialConsensusConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
-> WrapPartialConsensusConfig (ShelleyBlock (ShelleyEra c))
forall blk.
PartialConsensusConfig (BlockProtocol blk)
-> WrapPartialConsensusConfig blk
WrapPartialConsensusConfig PartialConsensusConfig
  (BlockProtocol (ShelleyBlock (ShelleyEra c)))
partialConsensusConfigMary
              WrapPartialConsensusConfig (ShelleyBlock (ShelleyEra c))
-> NP WrapPartialConsensusConfig '[]
-> NP WrapPartialConsensusConfig '[ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP WrapPartialConsensusConfig '[]
forall k (a :: k -> *). NP a '[]
Nil
              )
          }
      , topLevelConfigLedger :: LedgerConfig (CardanoBlock c)
topLevelConfigLedger = HardForkLedgerConfig :: forall (xs :: [*]).
Shape xs -> PerEraLedgerConfig xs -> HardForkLedgerConfig xs
HardForkLedgerConfig {
            hardForkLedgerConfigShape :: Shape
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
hardForkLedgerConfigShape  = Shape
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
shape
          , hardForkLedgerConfigPerEra :: PerEraLedgerConfig
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
hardForkLedgerConfigPerEra = NP
  WrapPartialLedgerConfig
  '[ByronBlock, ShelleyBlock (ShelleyEra c),
    ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> PerEraLedgerConfig
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall (xs :: [*]).
NP WrapPartialLedgerConfig xs -> PerEraLedgerConfig xs
PerEraLedgerConfig
              (  PartialLedgerConfig ByronBlock
-> WrapPartialLedgerConfig ByronBlock
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig PartialLedgerConfig ByronBlock
partialLedgerConfigByron
              WrapPartialLedgerConfig ByronBlock
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
-> NP
     WrapPartialLedgerConfig
     '[ByronBlock, ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
-> WrapPartialLedgerConfig (ShelleyBlock (ShelleyEra c))
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
partialLedgerConfigShelley
              WrapPartialLedgerConfig (ShelleyBlock (ShelleyEra c))
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c),
       ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
-> WrapPartialLedgerConfig (ShelleyBlock (ShelleyEra c))
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
partialLedgerConfigAllegra
              WrapPartialLedgerConfig (ShelleyBlock (ShelleyEra c))
-> NP WrapPartialLedgerConfig '[ShelleyBlock (ShelleyEra c)]
-> NP
     WrapPartialLedgerConfig
     '[ShelleyBlock (ShelleyEra c), ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
-> WrapPartialLedgerConfig (ShelleyBlock (ShelleyEra c))
forall blk. PartialLedgerConfig blk -> WrapPartialLedgerConfig blk
WrapPartialLedgerConfig PartialLedgerConfig (ShelleyBlock (ShelleyEra c))
partialLedgerConfigMary
              WrapPartialLedgerConfig (ShelleyBlock (ShelleyEra c))
-> NP WrapPartialLedgerConfig '[]
-> NP WrapPartialLedgerConfig '[ShelleyBlock (ShelleyEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP WrapPartialLedgerConfig '[]
forall k (a :: k -> *). NP a '[]
Nil
              )
          }
      , topLevelConfigBlock :: BlockConfig (CardanoBlock c)
topLevelConfigBlock =
          BlockConfig ByronBlock
-> BlockConfig (ShelleyBlock (ShelleyEra c))
-> BlockConfig (ShelleyBlock (ShelleyEra c))
-> BlockConfig (ShelleyBlock (ShelleyEra c))
-> BlockConfig (CardanoBlock c)
forall c.
BlockConfig ByronBlock
-> BlockConfig (ShelleyBlock (ShelleyEra c))
-> BlockConfig (ShelleyBlock (ShelleyEra c))
-> BlockConfig (ShelleyBlock (ShelleyEra c))
-> CardanoBlockConfig c
CardanoBlockConfig
            BlockConfig ByronBlock
blockConfigByron
            BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfigShelley
            BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfigAllegra
            BlockConfig (ShelleyBlock (ShelleyEra c))
blockConfigMary
      , topLevelConfigCodec :: CodecConfig (CardanoBlock c)
topLevelConfigCodec =
          CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (CardanoBlock c)
forall c.
CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CardanoCodecConfig c
CardanoCodecConfig
            (TopLevelConfig ByronBlock -> CodecConfig ByronBlock
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec TopLevelConfig ByronBlock
topLevelConfigByron)
            CodecConfig (ShelleyBlock (ShelleyEra c))
forall era. CodecConfig (ShelleyBlock era)
Shelley.ShelleyCodecConfig
            CodecConfig (ShelleyBlock (ShelleyEra c))
forall era. CodecConfig (ShelleyBlock era)
Shelley.ShelleyCodecConfig
            CodecConfig (ShelleyBlock (ShelleyEra c))
forall era. CodecConfig (ShelleyBlock era)
Shelley.ShelleyCodecConfig
      , topLevelConfigStorage :: StorageConfig (CardanoBlock c)
topLevelConfigStorage =
          StorageConfig ByronBlock
-> StorageConfig (ShelleyBlock (ShelleyEra c))
-> StorageConfig (ShelleyBlock (ShelleyEra c))
-> StorageConfig (ShelleyBlock (ShelleyEra c))
-> StorageConfig (CardanoBlock c)
forall c.
StorageConfig ByronBlock
-> StorageConfig (ShelleyBlock (ShelleyEra c))
-> StorageConfig (ShelleyBlock (ShelleyEra c))
-> StorageConfig (ShelleyBlock (ShelleyEra c))
-> CardanoStorageConfig c
CardanoStorageConfig
            (TopLevelConfig ByronBlock -> StorageConfig ByronBlock
forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage TopLevelConfig ByronBlock
topLevelConfigByron)
            (Word64
-> SecurityParam -> StorageConfig (ShelleyBlock (ShelleyEra c))
forall era.
Word64 -> SecurityParam -> StorageConfig (ShelleyBlock era)
Shelley.ShelleyStorageConfig Word64
tpraosSlotsPerKESPeriod SecurityParam
k)
            (Word64
-> SecurityParam -> StorageConfig (ShelleyBlock (ShelleyEra c))
forall era.
Word64 -> SecurityParam -> StorageConfig (ShelleyBlock era)
Shelley.ShelleyStorageConfig Word64
tpraosSlotsPerKESPeriod SecurityParam
k)
            (Word64
-> SecurityParam -> StorageConfig (ShelleyBlock (ShelleyEra c))
forall era.
Word64 -> SecurityParam -> StorageConfig (ShelleyBlock era)
Shelley.ShelleyStorageConfig Word64
tpraosSlotsPerKESPeriod SecurityParam
k)
      }

protocolClientInfoCardano
  :: forall c.
     -- Byron
     EpochSlots
  -> ProtocolClientInfo (CardanoBlock c)
protocolClientInfoCardano :: EpochSlots -> ProtocolClientInfo (CardanoBlock c)
protocolClientInfoCardano EpochSlots
epochSlots = ProtocolClientInfo :: forall b. CodecConfig b -> ProtocolClientInfo b
ProtocolClientInfo {
      pClientInfoCodecConfig :: CodecConfig (CardanoBlock c)
pClientInfoCodecConfig =
        CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (CardanoBlock c)
forall c.
CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
-> CardanoCodecConfig c
CardanoCodecConfig
          (ProtocolClientInfo ByronBlock -> CodecConfig ByronBlock
forall b. ProtocolClientInfo b -> CodecConfig b
pClientInfoCodecConfig (EpochSlots -> ProtocolClientInfo ByronBlock
protocolClientInfoByron EpochSlots
epochSlots))
          (ProtocolClientInfo (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
forall b. ProtocolClientInfo b -> CodecConfig b
pClientInfoCodecConfig ProtocolClientInfo (ShelleyBlock (ShelleyEra c))
forall era. ProtocolClientInfo (ShelleyBlock era)
protocolClientInfoShelley)
          (ProtocolClientInfo (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
forall b. ProtocolClientInfo b -> CodecConfig b
pClientInfoCodecConfig ProtocolClientInfo (ShelleyBlock (ShelleyEra c))
forall era. ProtocolClientInfo (ShelleyBlock era)
protocolClientInfoShelley)
          (ProtocolClientInfo (ShelleyBlock (ShelleyEra c))
-> CodecConfig (ShelleyBlock (ShelleyEra c))
forall b. ProtocolClientInfo b -> CodecConfig b
pClientInfoCodecConfig ProtocolClientInfo (ShelleyBlock (ShelleyEra c))
forall era. ProtocolClientInfo (ShelleyBlock era)
protocolClientInfoShelley)
    }

{-------------------------------------------------------------------------------
  Helpers
-------------------------------------------------------------------------------}

mkPartialLedgerConfigShelley ::
     ShelleyGenesis era
  -> MaxMajorProtVer
  -> TriggerHardFork
  -> PartialLedgerConfig (ShelleyBlock era)
mkPartialLedgerConfigShelley :: ShelleyGenesis era
-> MaxMajorProtVer
-> TriggerHardFork
-> PartialLedgerConfig (ShelleyBlock era)
mkPartialLedgerConfigShelley ShelleyGenesis era
genesisShelley MaxMajorProtVer
maxMajorProtVer TriggerHardFork
shelleyTriggerHardFork =
    ShelleyPartialLedgerConfig :: forall era.
ShelleyLedgerConfig era
-> TriggerHardFork -> ShelleyPartialLedgerConfig era
ShelleyPartialLedgerConfig {
          shelleyLedgerConfig :: ShelleyLedgerConfig era
shelleyLedgerConfig =
            ShelleyGenesis era
-> EpochInfo Identity -> MaxMajorProtVer -> ShelleyLedgerConfig era
forall era.
ShelleyGenesis era
-> EpochInfo Identity -> MaxMajorProtVer -> ShelleyLedgerConfig era
Shelley.mkShelleyLedgerConfig
              ShelleyGenesis era
genesisShelley
              -- 'completeLedgerConfig' will replace the 'History.dummyEpochInfo'
              -- in the partial ledger config with the correct one.
              EpochInfo Identity
History.dummyEpochInfo
              MaxMajorProtVer
maxMajorProtVer
        , shelleyTriggerHardFork :: TriggerHardFork
shelleyTriggerHardFork = TriggerHardFork
shelleyTriggerHardFork
        }