{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE PatternSynonyms          #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE ViewPatterns             #-}
module Ouroboros.Consensus.Cardano.Block (
    -- * Eras
    CardanoEras
  , CardanoShelleyEras
  , module Ouroboros.Consensus.Shelley.Eras
    -- * Block
  , CardanoBlock
    -- Note: by exporting the pattern synonyms as part of the matching data
    -- type (instead of as separate patterns), we get better exhaustiveness
    -- checks from GHC. But GHC expects a data type, not a type family, that's
    -- why we sometimes mention the data type of the instance in these exports
    -- instead of the abstract type family.
  , HardForkBlock (BlockAllegra, BlockAlonzo, BlockByron, BlockMary, BlockShelley, BlockBabbage)
    -- * Headers
  , CardanoHeader
  , Header (HeaderAllegra, HeaderAlonzo, HeaderByron, HeaderMary, HeaderShelley, HeaderBabbage)
    -- * Generalised transactions
  , CardanoApplyTxErr
  , CardanoGenTx
  , CardanoGenTxId
  , GenTx (GenTxAllegra, GenTxAlonzo, GenTxByron, GenTxMary, GenTxShelley, GenTxBabbage)
  , HardForkApplyTxErr (ApplyTxErrAllegra, ApplyTxErrAlonzo, ApplyTxErrByron, ApplyTxErrMary, ApplyTxErrShelley, ApplyTxErrWrongEra, ApplyTxErrBabbage)
  , TxId (GenTxIdAllegra, GenTxIdAlonzo, GenTxIdByron, GenTxIdMary, GenTxIdShelley, GenTxIdBabbage)
    -- * LedgerError
  , CardanoLedgerError
  , HardForkLedgerError (LedgerErrorAllegra, LedgerErrorAlonzo, LedgerErrorByron, LedgerErrorMary, LedgerErrorShelley, LedgerErrorWrongEra, LedgerErrorBabbage)
    -- * OtherEnvelopeError
  , CardanoOtherHeaderEnvelopeError
  , HardForkEnvelopeErr (OtherHeaderEnvelopeErrorAllegra, OtherHeaderEnvelopeErrorBabbage, OtherHeaderEnvelopeErrorAlonzo, OtherHeaderEnvelopeErrorByron, OtherHeaderEnvelopeErrorMary, OtherHeaderEnvelopeErrorShelley, OtherHeaderEnvelopeErrorWrongEra)
    -- * TipInfo
  , CardanoTipInfo
  , OneEraTipInfo (TipInfoAllegra, TipInfoAlonzo, TipInfoByron, TipInfoBabbage, TipInfoMary, TipInfoShelley)
    -- * Query
  , BlockQuery (QueryAnytimeAllegra, QueryAnytimeAlonzo, QueryAnytimeBabbage, QueryAnytimeByron, QueryAnytimeMary, QueryAnytimeShelley, QueryHardFork, QueryIfCurrentAllegra, QueryIfCurrentAlonzo, QueryIfCurrentBabbage, QueryIfCurrentByron, QueryIfCurrentMary, QueryIfCurrentShelley)
  , CardanoQuery
  , CardanoQueryResult
  , Either (QueryResultSuccess, QueryResultEraMismatch)
    -- * CodecConfig
  , CardanoCodecConfig
  , CodecConfig (CardanoCodecConfig)
    -- * BlockConfig
  , BlockConfig (CardanoBlockConfig)
  , CardanoBlockConfig
    -- * StorageConfig
  , CardanoStorageConfig
  , StorageConfig (CardanoStorageConfig)
    -- * ConsensusConfig
  , CardanoConsensusConfig
  , ConsensusConfig (CardanoConsensusConfig)
    -- * LedgerConfig
  , CardanoLedgerConfig
  , HardForkLedgerConfig (CardanoLedgerConfig)
    -- * LedgerState
  , CardanoLedgerState
  , LedgerState (LedgerStateAllegra, LedgerStateAlonzo, LedgerStateBabbage, LedgerStateByron, LedgerStateMary, LedgerStateShelley)
    -- * ChainDepState
  , CardanoChainDepState
  , HardForkState (ChainDepStateAllegra, ChainDepStateAlonzo, ChainDepStateBabbage, ChainDepStateByron, ChainDepStateMary, ChainDepStateShelley)
    -- * EraMismatch
  , EraMismatch (..)
  ) where

import           Data.SOP.Strict

import           Ouroboros.Consensus.Block (BlockProtocol)
import           Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError,
                     TipInfo)
import           Ouroboros.Consensus.Ledger.Abstract (LedgerError)
import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr,
                     GenTxId)
import           Ouroboros.Consensus.Protocol.Abstract (ChainDepState)
import           Ouroboros.Consensus.TypeFamilyWrappers

import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State

import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)

import           Ouroboros.Consensus.Protocol.Praos (Praos)
import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
import           Ouroboros.Consensus.Shelley.Eras
import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)

{-------------------------------------------------------------------------------
  The eras of the Cardano blockchain
-------------------------------------------------------------------------------}

-- | The eras in the Cardano blockchain.
--
-- We parameterise over the crypto used in the post-Byron eras: @c@.
--
-- TODO: parameterise ByronBlock over crypto too
type CardanoEras c = ByronBlock ': CardanoShelleyEras c

type CardanoShelleyEras c =
  '[ ShelleyBlock (TPraos c) (ShelleyEra c)
   , ShelleyBlock (TPraos c) (AllegraEra c)
   , ShelleyBlock (TPraos c) (MaryEra c)
   , ShelleyBlock (TPraos c) (AlonzoEra c)
   , ShelleyBlock (Praos c)  (BabbageEra c)
   ]

{-------------------------------------------------------------------------------
  INTERNAL A tag function for each era
-------------------------------------------------------------------------------}

-- Here we use layout and adjacency to make it obvious that we haven't
-- miscounted.

pattern TagByron   :: f ByronBlock                                -> NS f (CardanoEras c)
pattern TagShelley :: f (ShelleyBlock (TPraos c) (ShelleyEra c))  -> NS f (CardanoEras c)
pattern TagAllegra :: f (ShelleyBlock (TPraos c) (AllegraEra c))  -> NS f (CardanoEras c)
pattern TagMary    :: f (ShelleyBlock (TPraos c) (MaryEra    c))  -> NS f (CardanoEras c)
pattern TagAlonzo  :: f (ShelleyBlock (TPraos c) (AlonzoEra  c))  -> NS f (CardanoEras c)
pattern TagBabbage :: f (ShelleyBlock (Praos c)  (BabbageEra  c)) -> NS f (CardanoEras c)

pattern $bTagByron :: f ByronBlock -> NS f (CardanoEras c)
$mTagByron :: forall r (f :: * -> *) c.
NS f (CardanoEras c) -> (f ByronBlock -> r) -> (Void# -> r) -> r
TagByron   x =                Z x
pattern $bTagShelley :: f (ShelleyBlock (TPraos c) (ShelleyEra c)) -> NS f (CardanoEras c)
$mTagShelley :: forall r (f :: * -> *) c.
NS f (CardanoEras c)
-> (f (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
TagShelley x =             S (Z x)
pattern $bTagAllegra :: f (ShelleyBlock (TPraos c) (AllegraEra c)) -> NS f (CardanoEras c)
$mTagAllegra :: forall r (f :: * -> *) c.
NS f (CardanoEras c)
-> (f (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
TagAllegra x =          S (S (Z x))
pattern $bTagMary :: f (ShelleyBlock (TPraos c) (MaryEra c)) -> NS f (CardanoEras c)
$mTagMary :: forall r (f :: * -> *) c.
NS f (CardanoEras c)
-> (f (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
TagMary    x =       S (S (S (Z x)))
pattern $bTagAlonzo :: f (ShelleyBlock (TPraos c) (AlonzoEra c)) -> NS f (CardanoEras c)
$mTagAlonzo :: forall r (f :: * -> *) c.
NS f (CardanoEras c)
-> (f (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
TagAlonzo  x =    S (S (S (S (Z x))))
pattern $bTagBabbage :: f (ShelleyBlock (Praos c) (BabbageEra c)) -> NS f (CardanoEras c)
$mTagBabbage :: forall r (f :: * -> *) c.
NS f (CardanoEras c)
-> (f (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
TagBabbage x = S (S (S (S (S (Z x)))))

{-------------------------------------------------------------------------------
  INTERNAL A telescope function for each era

-------------------------------------------------------------------------------}

pattern TeleByron   ::
     f ByronBlock
  -> Telescope g f (CardanoEras c)

pattern TeleShelley ::
     g ByronBlock
  -> f (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> Telescope g f (CardanoEras c)

pattern TeleAllegra ::
     g ByronBlock
  -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> f (ShelleyBlock (TPraos c) (AllegraEra c))
  -> Telescope g f (CardanoEras c)

pattern TeleMary    ::
     g ByronBlock
  -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> g (ShelleyBlock (TPraos c) (AllegraEra c))
  -> f (ShelleyBlock (TPraos c) (MaryEra    c))
  -> Telescope g f (CardanoEras c)

pattern TeleAlonzo  ::
     g ByronBlock
  -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> g (ShelleyBlock (TPraos c) (AllegraEra c))
  -> g (ShelleyBlock (TPraos c) (MaryEra    c))
  -> f (ShelleyBlock (TPraos c) (AlonzoEra  c))
  -> Telescope g f (CardanoEras c)

pattern TeleBabbage  ::
     g ByronBlock
  -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> g (ShelleyBlock (TPraos c) (AllegraEra c))
  -> g (ShelleyBlock (TPraos c) (MaryEra    c))
  -> g (ShelleyBlock (TPraos c) (AlonzoEra  c))
  -> f (ShelleyBlock (Praos c)  (BabbageEra c))
  -> Telescope g f (CardanoEras c)
-- Here we use layout and adjacency to make it obvious that we haven't
-- miscounted.

pattern $bTeleByron :: f ByronBlock -> Telescope g f (CardanoEras c)
$mTeleByron :: forall r (f :: * -> *) (g :: * -> *) c.
Telescope g f (CardanoEras c)
-> (f ByronBlock -> r) -> (Void# -> r) -> r
TeleByron                                     x =                                                       TZ x
pattern $bTeleShelley :: g ByronBlock
-> f (ShelleyBlock (TPraos c) (ShelleyEra c))
-> Telescope g f (CardanoEras c)
$mTeleShelley :: forall r (g :: * -> *) (f :: * -> *) c.
Telescope g f (CardanoEras c)
-> (g ByronBlock
    -> f (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
TeleShelley byron                             x = TS byron                                             (TZ x)
pattern $bTeleAllegra :: g ByronBlock
-> g (ShelleyBlock (TPraos c) (ShelleyEra c))
-> f (ShelleyBlock (TPraos c) (AllegraEra c))
-> Telescope g f (CardanoEras c)
$mTeleAllegra :: forall r (g :: * -> *) c (f :: * -> *).
Telescope g f (CardanoEras c)
-> (g ByronBlock
    -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> f (ShelleyBlock (TPraos c) (AllegraEra c))
    -> r)
-> (Void# -> r)
-> r
TeleAllegra byron shelley                     x = TS byron (TS shelley                                 (TZ x))
pattern $bTeleMary :: g ByronBlock
-> g (ShelleyBlock (TPraos c) (ShelleyEra c))
-> g (ShelleyBlock (TPraos c) (AllegraEra c))
-> f (ShelleyBlock (TPraos c) (MaryEra c))
-> Telescope g f (CardanoEras c)
$mTeleMary :: forall r (g :: * -> *) c (f :: * -> *).
Telescope g f (CardanoEras c)
-> (g ByronBlock
    -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> g (ShelleyBlock (TPraos c) (AllegraEra c))
    -> f (ShelleyBlock (TPraos c) (MaryEra c))
    -> r)
-> (Void# -> r)
-> r
TeleMary    byron shelley allegra             x = TS byron (TS shelley (TS allegra                     (TZ x)))
pattern $bTeleAlonzo :: g ByronBlock
-> g (ShelleyBlock (TPraos c) (ShelleyEra c))
-> g (ShelleyBlock (TPraos c) (AllegraEra c))
-> g (ShelleyBlock (TPraos c) (MaryEra c))
-> f (ShelleyBlock (TPraos c) (AlonzoEra c))
-> Telescope g f (CardanoEras c)
$mTeleAlonzo :: forall r (g :: * -> *) c (f :: * -> *).
Telescope g f (CardanoEras c)
-> (g ByronBlock
    -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> g (ShelleyBlock (TPraos c) (AllegraEra c))
    -> g (ShelleyBlock (TPraos c) (MaryEra c))
    -> f (ShelleyBlock (TPraos c) (AlonzoEra c))
    -> r)
-> (Void# -> r)
-> r
TeleAlonzo  byron shelley allegra mary        x = TS byron (TS shelley (TS allegra (TS mary            (TZ x))))
pattern $bTeleBabbage :: g ByronBlock
-> g (ShelleyBlock (TPraos c) (ShelleyEra c))
-> g (ShelleyBlock (TPraos c) (AllegraEra c))
-> g (ShelleyBlock (TPraos c) (MaryEra c))
-> g (ShelleyBlock (TPraos c) (AlonzoEra c))
-> f (ShelleyBlock (Praos c) (BabbageEra c))
-> Telescope g f (CardanoEras c)
$mTeleBabbage :: forall r (g :: * -> *) c (f :: * -> *).
Telescope g f (CardanoEras c)
-> (g ByronBlock
    -> g (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> g (ShelleyBlock (TPraos c) (AllegraEra c))
    -> g (ShelleyBlock (TPraos c) (MaryEra c))
    -> g (ShelleyBlock (TPraos c) (AlonzoEra c))
    -> f (ShelleyBlock (Praos c) (BabbageEra c))
    -> r)
-> (Void# -> r)
-> r
TeleBabbage byron shelley allegra mary alonzo x = TS byron (TS shelley (TS allegra (TS mary (TS alonzo (TZ x)))))

{-------------------------------------------------------------------------------
  The block type of the Cardano block chain
-------------------------------------------------------------------------------}

-- | /The/ Cardano block.
--
-- Thanks to the pattern synonyms, you can treat this as a sum type with
-- constructors 'BlockByron' and 'BlockShelley'.
--
-- > f :: CardanoBlock c -> _
-- > f (BlockByron   b) = _
-- > f (BlockShelley s) = _
-- > f (BlockAllegra a) = _
-- > f (BlockMary    m) = _
-- > f (BlockAlonzo  m) = _
--
type CardanoBlock c = HardForkBlock (CardanoEras c)

pattern BlockByron :: ByronBlock -> CardanoBlock c
pattern $bBlockByron :: ByronBlock -> CardanoBlock c
$mBlockByron :: forall r c.
CardanoBlock c -> (ByronBlock -> r) -> (Void# -> r) -> r
BlockByron b = HardForkBlock (OneEraBlock (TagByron (I b)))

pattern BlockShelley :: ShelleyBlock (TPraos c) (ShelleyEra c) -> CardanoBlock c
pattern $bBlockShelley :: ShelleyBlock (TPraos c) (ShelleyEra c) -> CardanoBlock c
$mBlockShelley :: forall r c.
CardanoBlock c
-> (ShelleyBlock (TPraos c) (ShelleyEra c) -> r)
-> (Void# -> r)
-> r
BlockShelley b = HardForkBlock (OneEraBlock (TagShelley (I b)))

pattern BlockAllegra :: ShelleyBlock (TPraos c) (AllegraEra c) -> CardanoBlock c
pattern $bBlockAllegra :: ShelleyBlock (TPraos c) (AllegraEra c) -> CardanoBlock c
$mBlockAllegra :: forall r c.
CardanoBlock c
-> (ShelleyBlock (TPraos c) (AllegraEra c) -> r)
-> (Void# -> r)
-> r
BlockAllegra b = HardForkBlock (OneEraBlock (TagAllegra (I b)))

pattern BlockMary :: ShelleyBlock (TPraos c) (MaryEra c) -> CardanoBlock c
pattern $bBlockMary :: ShelleyBlock (TPraos c) (MaryEra c) -> CardanoBlock c
$mBlockMary :: forall r c.
CardanoBlock c
-> (ShelleyBlock (TPraos c) (MaryEra c) -> r) -> (Void# -> r) -> r
BlockMary b = HardForkBlock (OneEraBlock (TagMary (I b)))

pattern BlockAlonzo :: ShelleyBlock (TPraos c) (AlonzoEra c) -> CardanoBlock c
pattern $bBlockAlonzo :: ShelleyBlock (TPraos c) (AlonzoEra c) -> CardanoBlock c
$mBlockAlonzo :: forall r c.
CardanoBlock c
-> (ShelleyBlock (TPraos c) (AlonzoEra c) -> r)
-> (Void# -> r)
-> r
BlockAlonzo b = HardForkBlock (OneEraBlock (TagAlonzo (I b)))

pattern BlockBabbage :: ShelleyBlock (Praos c) (BabbageEra c) -> CardanoBlock c
pattern $bBlockBabbage :: ShelleyBlock (Praos c) (BabbageEra c) -> CardanoBlock c
$mBlockBabbage :: forall r c.
CardanoBlock c
-> (ShelleyBlock (Praos c) (BabbageEra c) -> r)
-> (Void# -> r)
-> r
BlockBabbage b = HardForkBlock (OneEraBlock (TagBabbage (I b)))

{-# COMPLETE
    BlockByron
  , BlockShelley
  , BlockAllegra
  , BlockMary
  , BlockAlonzo
  , BlockBabbage
  #-}


{-------------------------------------------------------------------------------
  Headers
-------------------------------------------------------------------------------}

-- | The Cardano header.
type CardanoHeader c = Header (CardanoBlock c)

pattern HeaderByron :: Header ByronBlock -> CardanoHeader c
pattern $bHeaderByron :: Header ByronBlock -> CardanoHeader c
$mHeaderByron :: forall r c.
CardanoHeader c -> (Header ByronBlock -> r) -> (Void# -> r) -> r
HeaderByron h = HardForkHeader (OneEraHeader (TagByron h))

pattern HeaderShelley ::
     Header (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CardanoHeader c
pattern $bHeaderShelley :: Header (ShelleyBlock (TPraos c) (ShelleyEra c)) -> CardanoHeader c
$mHeaderShelley :: forall r c.
CardanoHeader c
-> (Header (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
HeaderShelley h = HardForkHeader (OneEraHeader (TagShelley h))

pattern HeaderAllegra ::
     Header (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CardanoHeader c
pattern $bHeaderAllegra :: Header (ShelleyBlock (TPraos c) (AllegraEra c)) -> CardanoHeader c
$mHeaderAllegra :: forall r c.
CardanoHeader c
-> (Header (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
HeaderAllegra h = HardForkHeader (OneEraHeader (TagAllegra h))

pattern HeaderMary ::
     Header (ShelleyBlock (TPraos c) (MaryEra c))
  -> CardanoHeader c
pattern $bHeaderMary :: Header (ShelleyBlock (TPraos c) (MaryEra c)) -> CardanoHeader c
$mHeaderMary :: forall r c.
CardanoHeader c
-> (Header (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
HeaderMary h = HardForkHeader (OneEraHeader (TagMary h))

pattern HeaderAlonzo ::
     Header (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CardanoHeader c
pattern $bHeaderAlonzo :: Header (ShelleyBlock (TPraos c) (AlonzoEra c)) -> CardanoHeader c
$mHeaderAlonzo :: forall r c.
CardanoHeader c
-> (Header (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
HeaderAlonzo h = HardForkHeader (OneEraHeader (TagAlonzo h))

pattern HeaderBabbage ::
     Header (ShelleyBlock (Praos c) (BabbageEra c))
  -> CardanoHeader c
pattern $bHeaderBabbage :: Header (ShelleyBlock (Praos c) (BabbageEra c)) -> CardanoHeader c
$mHeaderBabbage :: forall r c.
CardanoHeader c
-> (Header (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
HeaderBabbage h = HardForkHeader (OneEraHeader (TagBabbage h))

{-# COMPLETE HeaderByron
           , HeaderShelley
           , HeaderAllegra
           , HeaderMary
           , HeaderAlonzo
           , HeaderBabbage #-}

{-------------------------------------------------------------------------------
  Generalised transactions
-------------------------------------------------------------------------------}

-- | The Cardano transaction.
type CardanoGenTx c = GenTx (CardanoBlock c)

pattern GenTxByron :: GenTx ByronBlock -> CardanoGenTx c
pattern $bGenTxByron :: GenTx ByronBlock -> CardanoGenTx c
$mGenTxByron :: forall r c.
CardanoGenTx c -> (GenTx ByronBlock -> r) -> (Void# -> r) -> r
GenTxByron tx = HardForkGenTx (OneEraGenTx (TagByron tx))

pattern GenTxShelley :: GenTx (ShelleyBlock (TPraos c) (ShelleyEra c)) -> CardanoGenTx c
pattern $bGenTxShelley :: GenTx (ShelleyBlock (TPraos c) (ShelleyEra c)) -> CardanoGenTx c
$mGenTxShelley :: forall r c.
CardanoGenTx c
-> (GenTx (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
GenTxShelley tx = HardForkGenTx (OneEraGenTx (TagShelley tx))

pattern GenTxAllegra :: GenTx (ShelleyBlock (TPraos c) (AllegraEra c)) -> CardanoGenTx c
pattern $bGenTxAllegra :: GenTx (ShelleyBlock (TPraos c) (AllegraEra c)) -> CardanoGenTx c
$mGenTxAllegra :: forall r c.
CardanoGenTx c
-> (GenTx (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
GenTxAllegra tx = HardForkGenTx (OneEraGenTx (TagAllegra tx))

pattern GenTxMary :: GenTx (ShelleyBlock (TPraos c) (MaryEra c)) -> CardanoGenTx c
pattern $bGenTxMary :: GenTx (ShelleyBlock (TPraos c) (MaryEra c)) -> CardanoGenTx c
$mGenTxMary :: forall r c.
CardanoGenTx c
-> (GenTx (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
GenTxMary tx = HardForkGenTx (OneEraGenTx (TagMary tx))

pattern GenTxAlonzo :: GenTx (ShelleyBlock (TPraos c) (AlonzoEra c)) -> CardanoGenTx c
pattern $bGenTxAlonzo :: GenTx (ShelleyBlock (TPraos c) (AlonzoEra c)) -> CardanoGenTx c
$mGenTxAlonzo :: forall r c.
CardanoGenTx c
-> (GenTx (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
GenTxAlonzo tx = HardForkGenTx (OneEraGenTx (TagAlonzo tx))

pattern GenTxBabbage :: GenTx (ShelleyBlock (Praos c) (BabbageEra c)) -> CardanoGenTx c
pattern $bGenTxBabbage :: GenTx (ShelleyBlock (Praos c) (BabbageEra c)) -> CardanoGenTx c
$mGenTxBabbage :: forall r c.
CardanoGenTx c
-> (GenTx (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
GenTxBabbage tx = HardForkGenTx (OneEraGenTx (TagBabbage tx))

{-# COMPLETE
    GenTxByron
  , GenTxShelley
  , GenTxAllegra
  , GenTxMary
  , GenTxAlonzo
  , GenTxBabbage
  #-}



-- | The ID of a Cardano transaction.
type CardanoGenTxId c = GenTxId (CardanoBlock c)

pattern GenTxIdByron :: GenTxId ByronBlock -> CardanoGenTxId c
pattern $bGenTxIdByron :: GenTxId ByronBlock -> CardanoGenTxId c
$mGenTxIdByron :: forall r c.
CardanoGenTxId c -> (GenTxId ByronBlock -> r) -> (Void# -> r) -> r
GenTxIdByron txid =
    HardForkGenTxId (OneEraGenTxId (TagByron (WrapGenTxId txid)))

pattern GenTxIdShelley ::
     GenTxId (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CardanoGenTxId c
pattern $bGenTxIdShelley :: GenTxId (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CardanoGenTxId c
$mGenTxIdShelley :: forall r c.
CardanoGenTxId c
-> (GenTxId (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
GenTxIdShelley txid =
    HardForkGenTxId (OneEraGenTxId (TagShelley (WrapGenTxId txid)))

pattern GenTxIdAllegra ::
     GenTxId (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CardanoGenTxId c
pattern $bGenTxIdAllegra :: GenTxId (ShelleyBlock (TPraos c) (AllegraEra c))
-> CardanoGenTxId c
$mGenTxIdAllegra :: forall r c.
CardanoGenTxId c
-> (GenTxId (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
GenTxIdAllegra txid =
    HardForkGenTxId (OneEraGenTxId (TagAllegra (WrapGenTxId txid)))

pattern GenTxIdMary ::
     GenTxId (ShelleyBlock (TPraos c) (MaryEra c))
  -> CardanoGenTxId c
pattern $bGenTxIdMary :: GenTxId (ShelleyBlock (TPraos c) (MaryEra c)) -> CardanoGenTxId c
$mGenTxIdMary :: forall r c.
CardanoGenTxId c
-> (GenTxId (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
GenTxIdMary txid =
    HardForkGenTxId (OneEraGenTxId (TagMary (WrapGenTxId txid)))

pattern GenTxIdAlonzo ::
     GenTxId (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CardanoGenTxId c
pattern $bGenTxIdAlonzo :: GenTxId (ShelleyBlock (TPraos c) (AlonzoEra c)) -> CardanoGenTxId c
$mGenTxIdAlonzo :: forall r c.
CardanoGenTxId c
-> (GenTxId (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
GenTxIdAlonzo txid =
    HardForkGenTxId (OneEraGenTxId (TagAlonzo (WrapGenTxId txid)))

pattern GenTxIdBabbage ::
     GenTxId (ShelleyBlock (Praos c) (BabbageEra c))
  -> CardanoGenTxId c
pattern $bGenTxIdBabbage :: GenTxId (ShelleyBlock (Praos c) (BabbageEra c)) -> CardanoGenTxId c
$mGenTxIdBabbage :: forall r c.
CardanoGenTxId c
-> (GenTxId (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
GenTxIdBabbage txid =
    HardForkGenTxId (OneEraGenTxId (TagBabbage (WrapGenTxId txid)))

{-# COMPLETE GenTxIdByron
           , GenTxIdShelley
           , GenTxIdAllegra
           , GenTxIdMary
           , GenTxIdAlonzo
           , GenTxIdBabbage #-}

-- | An error resulting from applying a 'CardanoGenTx' to the ledger.
--
-- Thanks to the pattern synonyms, you can treat this as a sum type with
-- constructors 'ApplyTxByronErr', 'ApplyTxErrShelley', and
-- 'ApplyTxErrWrongEra'.
--
-- > toText :: CardanoApplyTxErr c -> Text
-- > toText (ApplyTxErrByron b) = byronApplyTxErrToText b
-- > toText (ApplyTxErrShelley s) = shelleyApplyTxErrToText s
-- > toText (ApplyTxErrAllegra a) = allegraApplyTxErrToText a
-- > toText (ApplyTxErrMary m) = maryApplyTxErrToText m
-- > toText (ApplyTxErrWrongEra eraMismatch) =
-- >   "Transaction from the " <> otherEraName eraMismatch <>
-- >   " era applied to a ledger from the " <>
-- >   ledgerEraName eraMismatch <> " era"
--
type CardanoApplyTxErr c = HardForkApplyTxErr (CardanoEras c)

pattern ApplyTxErrByron :: ApplyTxErr ByronBlock -> CardanoApplyTxErr c
pattern $bApplyTxErrByron :: ApplyTxErr ByronBlock -> CardanoApplyTxErr c
$mApplyTxErrByron :: forall r c.
CardanoApplyTxErr c
-> (ApplyTxErr ByronBlock -> r) -> (Void# -> r) -> r
ApplyTxErrByron err =
    HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagByron (WrapApplyTxErr err)))

pattern ApplyTxErrShelley ::
     ApplyTxErr (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CardanoApplyTxErr c
pattern $bApplyTxErrShelley :: ApplyTxErr (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CardanoApplyTxErr c
$mApplyTxErrShelley :: forall r c.
CardanoApplyTxErr c
-> (ApplyTxErr (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
ApplyTxErrShelley err =
    HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagShelley (WrapApplyTxErr err)))

pattern ApplyTxErrAllegra ::
     ApplyTxErr (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CardanoApplyTxErr c
pattern $bApplyTxErrAllegra :: ApplyTxErr (ShelleyBlock (TPraos c) (AllegraEra c))
-> CardanoApplyTxErr c
$mApplyTxErrAllegra :: forall r c.
CardanoApplyTxErr c
-> (ApplyTxErr (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
ApplyTxErrAllegra err =
    HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagAllegra (WrapApplyTxErr err)))

pattern ApplyTxErrMary ::
     ApplyTxErr (ShelleyBlock (TPraos c) (MaryEra c))
  -> CardanoApplyTxErr c
pattern $bApplyTxErrMary :: ApplyTxErr (ShelleyBlock (TPraos c) (MaryEra c))
-> CardanoApplyTxErr c
$mApplyTxErrMary :: forall r c.
CardanoApplyTxErr c
-> (ApplyTxErr (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
ApplyTxErrMary err =
    HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagMary (WrapApplyTxErr err)))

pattern ApplyTxErrAlonzo ::
     ApplyTxErr (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CardanoApplyTxErr c
pattern $bApplyTxErrAlonzo :: ApplyTxErr (ShelleyBlock (TPraos c) (AlonzoEra c))
-> CardanoApplyTxErr c
$mApplyTxErrAlonzo :: forall r c.
CardanoApplyTxErr c
-> (ApplyTxErr (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
ApplyTxErrAlonzo err =
    HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagAlonzo (WrapApplyTxErr err)))

pattern ApplyTxErrBabbage ::
     ApplyTxErr (ShelleyBlock (Praos c) (BabbageEra c))
  -> CardanoApplyTxErr c
pattern $bApplyTxErrBabbage :: ApplyTxErr (ShelleyBlock (Praos c) (BabbageEra c))
-> CardanoApplyTxErr c
$mApplyTxErrBabbage :: forall r c.
CardanoApplyTxErr c
-> (ApplyTxErr (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
ApplyTxErrBabbage err =
    HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagBabbage (WrapApplyTxErr err)))

pattern ApplyTxErrWrongEra :: EraMismatch -> CardanoApplyTxErr c
pattern $mApplyTxErrWrongEra :: forall r c.
CardanoApplyTxErr c -> (EraMismatch -> r) -> (Void# -> r) -> r
ApplyTxErrWrongEra eraMismatch <-
    HardForkApplyTxErrWrongEra (mkEraMismatch -> eraMismatch)

{-# COMPLETE ApplyTxErrByron
           , ApplyTxErrShelley
           , ApplyTxErrAllegra
           , ApplyTxErrMary
           , ApplyTxErrAlonzo
           , ApplyTxErrBabbage
           , ApplyTxErrWrongEra #-}

{-------------------------------------------------------------------------------
  LedgerError
-------------------------------------------------------------------------------}

-- | An error resulting from applying a 'CardanoBlock' to the ledger.
--
-- Thanks to the pattern synonyms, you can treat this as a sum type with
-- constructors 'LedgerErrorByron', 'LedgerErrorShelley', and
-- 'LedgerErrorWrongEra'.
--
-- > toText :: CardanoLedgerError c -> Text
-- > toText (LedgerErrorByron b) = byronLedgerErrorToText b
-- > toText (LedgerErrorShelley s) = shelleyLedgerErrorToText s
-- > toText (LedgerErrorAllegra a) = allegraLedgerErrorToText a
-- > toText (LedgerErrorMary m) = maryLedgerErrorToText m
-- > toText (LedgerErrorWrongEra eraMismatch) =
-- >   "Block from the " <> otherEraName eraMismatch <>
-- >   " era applied to a ledger from the " <>
-- >   ledgerEraName eraMismatch <> " era"
--
type CardanoLedgerError c = HardForkLedgerError (CardanoEras c)

pattern LedgerErrorByron :: LedgerError ByronBlock -> CardanoLedgerError c
pattern $bLedgerErrorByron :: LedgerError ByronBlock -> CardanoLedgerError c
$mLedgerErrorByron :: forall r c.
CardanoLedgerError c
-> (LedgerError ByronBlock -> r) -> (Void# -> r) -> r
LedgerErrorByron err =
    HardForkLedgerErrorFromEra (OneEraLedgerError (TagByron (WrapLedgerErr err)))

pattern LedgerErrorShelley ::
     LedgerError (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CardanoLedgerError c
pattern $bLedgerErrorShelley :: LedgerError (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CardanoLedgerError c
$mLedgerErrorShelley :: forall r c.
CardanoLedgerError c
-> (LedgerError (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
LedgerErrorShelley err =
    HardForkLedgerErrorFromEra
      (OneEraLedgerError (TagShelley (WrapLedgerErr err)))

pattern LedgerErrorAllegra ::
     LedgerError (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CardanoLedgerError c
pattern $bLedgerErrorAllegra :: LedgerError (ShelleyBlock (TPraos c) (AllegraEra c))
-> CardanoLedgerError c
$mLedgerErrorAllegra :: forall r c.
CardanoLedgerError c
-> (LedgerError (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
LedgerErrorAllegra err =
    HardForkLedgerErrorFromEra
      (OneEraLedgerError (TagAllegra (WrapLedgerErr err)))

pattern LedgerErrorMary ::
     LedgerError (ShelleyBlock (TPraos c) (MaryEra c))
  -> CardanoLedgerError c
pattern $bLedgerErrorMary :: LedgerError (ShelleyBlock (TPraos c) (MaryEra c))
-> CardanoLedgerError c
$mLedgerErrorMary :: forall r c.
CardanoLedgerError c
-> (LedgerError (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
LedgerErrorMary err =
    HardForkLedgerErrorFromEra
      (OneEraLedgerError (TagMary (WrapLedgerErr err)))

pattern LedgerErrorAlonzo ::
     LedgerError (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CardanoLedgerError c
pattern $bLedgerErrorAlonzo :: LedgerError (ShelleyBlock (TPraos c) (AlonzoEra c))
-> CardanoLedgerError c
$mLedgerErrorAlonzo :: forall r c.
CardanoLedgerError c
-> (LedgerError (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
LedgerErrorAlonzo err =
    HardForkLedgerErrorFromEra
      (OneEraLedgerError (TagAlonzo (WrapLedgerErr err)))

pattern LedgerErrorBabbage ::
     LedgerError (ShelleyBlock (Praos c) (BabbageEra c))
  -> CardanoLedgerError c
pattern $bLedgerErrorBabbage :: LedgerError (ShelleyBlock (Praos c) (BabbageEra c))
-> CardanoLedgerError c
$mLedgerErrorBabbage :: forall r c.
CardanoLedgerError c
-> (LedgerError (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
LedgerErrorBabbage err =
    HardForkLedgerErrorFromEra
      (OneEraLedgerError (TagBabbage (WrapLedgerErr err)))

pattern LedgerErrorWrongEra :: EraMismatch -> CardanoLedgerError c
pattern $mLedgerErrorWrongEra :: forall r c.
CardanoLedgerError c -> (EraMismatch -> r) -> (Void# -> r) -> r
LedgerErrorWrongEra eraMismatch <-
    HardForkLedgerErrorWrongEra (mkEraMismatch -> eraMismatch)

{-# COMPLETE LedgerErrorByron
           , LedgerErrorShelley
           , LedgerErrorAllegra
           , LedgerErrorMary
           , LedgerErrorAlonzo
           , LedgerErrorBabbage
           , LedgerErrorWrongEra #-}

{-------------------------------------------------------------------------------
  OtherEnvelopeError
-------------------------------------------------------------------------------}

-- | An error resulting from validating a 'CardanoHeader'.
type CardanoOtherHeaderEnvelopeError c = HardForkEnvelopeErr (CardanoEras c)

pattern OtherHeaderEnvelopeErrorByron
  :: OtherHeaderEnvelopeError ByronBlock
  -> CardanoOtherHeaderEnvelopeError c
pattern $bOtherHeaderEnvelopeErrorByron :: OtherHeaderEnvelopeError ByronBlock
-> CardanoOtherHeaderEnvelopeError c
$mOtherHeaderEnvelopeErrorByron :: forall r c.
CardanoOtherHeaderEnvelopeError c
-> (OtherHeaderEnvelopeError ByronBlock -> r) -> (Void# -> r) -> r
OtherHeaderEnvelopeErrorByron err =
    HardForkEnvelopeErrFromEra
      (OneEraEnvelopeErr (TagByron (WrapEnvelopeErr err)))

pattern OtherHeaderEnvelopeErrorShelley
  :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CardanoOtherHeaderEnvelopeError c
pattern $bOtherHeaderEnvelopeErrorShelley :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CardanoOtherHeaderEnvelopeError c
$mOtherHeaderEnvelopeErrorShelley :: forall r c.
CardanoOtherHeaderEnvelopeError c
-> (OtherHeaderEnvelopeError
      (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> r)
-> (Void# -> r)
-> r
OtherHeaderEnvelopeErrorShelley err =
    HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagShelley (WrapEnvelopeErr err)))

pattern OtherHeaderEnvelopeErrorAllegra
  :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CardanoOtherHeaderEnvelopeError c
pattern $bOtherHeaderEnvelopeErrorAllegra :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (AllegraEra c))
-> CardanoOtherHeaderEnvelopeError c
$mOtherHeaderEnvelopeErrorAllegra :: forall r c.
CardanoOtherHeaderEnvelopeError c
-> (OtherHeaderEnvelopeError
      (ShelleyBlock (TPraos c) (AllegraEra c))
    -> r)
-> (Void# -> r)
-> r
OtherHeaderEnvelopeErrorAllegra err =
    HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagAllegra (WrapEnvelopeErr err)))

pattern OtherHeaderEnvelopeErrorMary
  :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (MaryEra c))
  -> CardanoOtherHeaderEnvelopeError c
pattern $bOtherHeaderEnvelopeErrorMary :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (MaryEra c))
-> CardanoOtherHeaderEnvelopeError c
$mOtherHeaderEnvelopeErrorMary :: forall r c.
CardanoOtherHeaderEnvelopeError c
-> (OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (MaryEra c))
    -> r)
-> (Void# -> r)
-> r
OtherHeaderEnvelopeErrorMary err =
    HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagMary (WrapEnvelopeErr err)))

pattern OtherHeaderEnvelopeErrorAlonzo
  :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CardanoOtherHeaderEnvelopeError c
pattern $bOtherHeaderEnvelopeErrorAlonzo :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (AlonzoEra c))
-> CardanoOtherHeaderEnvelopeError c
$mOtherHeaderEnvelopeErrorAlonzo :: forall r c.
CardanoOtherHeaderEnvelopeError c
-> (OtherHeaderEnvelopeError
      (ShelleyBlock (TPraos c) (AlonzoEra c))
    -> r)
-> (Void# -> r)
-> r
OtherHeaderEnvelopeErrorAlonzo err =
    HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagAlonzo (WrapEnvelopeErr err)))

pattern OtherHeaderEnvelopeErrorBabbage
  :: OtherHeaderEnvelopeError (ShelleyBlock (Praos c) (BabbageEra c))
  -> CardanoOtherHeaderEnvelopeError c
pattern $bOtherHeaderEnvelopeErrorBabbage :: OtherHeaderEnvelopeError (ShelleyBlock (Praos c) (BabbageEra c))
-> CardanoOtherHeaderEnvelopeError c
$mOtherHeaderEnvelopeErrorBabbage :: forall r c.
CardanoOtherHeaderEnvelopeError c
-> (OtherHeaderEnvelopeError
      (ShelleyBlock (Praos c) (BabbageEra c))
    -> r)
-> (Void# -> r)
-> r
OtherHeaderEnvelopeErrorBabbage err =
    HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagBabbage (WrapEnvelopeErr err)))

pattern OtherHeaderEnvelopeErrorWrongEra
  :: EraMismatch
  -> CardanoOtherHeaderEnvelopeError c
pattern $mOtherHeaderEnvelopeErrorWrongEra :: forall r c.
CardanoOtherHeaderEnvelopeError c
-> (EraMismatch -> r) -> (Void# -> r) -> r
OtherHeaderEnvelopeErrorWrongEra eraMismatch <-
    HardForkEnvelopeErrWrongEra (mkEraMismatch -> eraMismatch)

{-# COMPLETE OtherHeaderEnvelopeErrorByron
           , OtherHeaderEnvelopeErrorShelley
           , OtherHeaderEnvelopeErrorAllegra
           , OtherHeaderEnvelopeErrorMary
           , OtherHeaderEnvelopeErrorAlonzo
           , OtherHeaderEnvelopeErrorBabbage
           , OtherHeaderEnvelopeErrorWrongEra #-}

{-------------------------------------------------------------------------------
  TipInfo
-------------------------------------------------------------------------------}

-- | The 'TipInfo' of the Cardano chain.
type CardanoTipInfo c = OneEraTipInfo (CardanoEras c)

pattern TipInfoByron :: TipInfo ByronBlock -> CardanoTipInfo c
pattern $bTipInfoByron :: TipInfo ByronBlock -> CardanoTipInfo c
$mTipInfoByron :: forall r c.
CardanoTipInfo c -> (TipInfo ByronBlock -> r) -> (Void# -> r) -> r
TipInfoByron ti = OneEraTipInfo (TagByron (WrapTipInfo ti))

pattern TipInfoShelley ::
     TipInfo (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CardanoTipInfo c
pattern $bTipInfoShelley :: TipInfo (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CardanoTipInfo c
$mTipInfoShelley :: forall r c.
CardanoTipInfo c
-> (TipInfo (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
TipInfoShelley ti = OneEraTipInfo (TagShelley (WrapTipInfo ti))

pattern TipInfoAllegra ::
     TipInfo (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CardanoTipInfo c
pattern $bTipInfoAllegra :: TipInfo (ShelleyBlock (TPraos c) (AllegraEra c))
-> CardanoTipInfo c
$mTipInfoAllegra :: forall r c.
CardanoTipInfo c
-> (TipInfo (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
TipInfoAllegra ti = OneEraTipInfo (TagAllegra (WrapTipInfo ti))

pattern TipInfoMary ::
     TipInfo (ShelleyBlock (TPraos c) (MaryEra c))
  -> CardanoTipInfo c
pattern $bTipInfoMary :: TipInfo (ShelleyBlock (TPraos c) (MaryEra c)) -> CardanoTipInfo c
$mTipInfoMary :: forall r c.
CardanoTipInfo c
-> (TipInfo (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
TipInfoMary ti = OneEraTipInfo (TagMary (WrapTipInfo ti))

pattern TipInfoAlonzo ::
     TipInfo (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CardanoTipInfo c
pattern $bTipInfoAlonzo :: TipInfo (ShelleyBlock (TPraos c) (AlonzoEra c)) -> CardanoTipInfo c
$mTipInfoAlonzo :: forall r c.
CardanoTipInfo c
-> (TipInfo (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
TipInfoAlonzo ti = OneEraTipInfo (TagAlonzo (WrapTipInfo ti))

pattern TipInfoBabbage ::
     TipInfo (ShelleyBlock (Praos c) (BabbageEra c))
  -> CardanoTipInfo c
pattern $bTipInfoBabbage :: TipInfo (ShelleyBlock (Praos c) (BabbageEra c)) -> CardanoTipInfo c
$mTipInfoBabbage :: forall r c.
CardanoTipInfo c
-> (TipInfo (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
TipInfoBabbage ti = OneEraTipInfo (TagBabbage (WrapTipInfo ti))

{-# COMPLETE TipInfoByron
           , TipInfoShelley
           , TipInfoAllegra
           , TipInfoMary
           , TipInfoAlonzo
           , TipInfoBabbage #-}

{-------------------------------------------------------------------------------
  Query
-------------------------------------------------------------------------------}

-- | The 'Query' of Cardano chain.
type CardanoQuery c = BlockQuery (CardanoBlock c)

-- | Byron-specific query that can only be answered when the ledger is in the
-- Byron era.
pattern QueryIfCurrentByron
  :: ()
  => CardanoQueryResult c result ~ a
  => BlockQuery ByronBlock result
  -> CardanoQuery c a

-- | Shelley-specific query that can only be answered when the ledger is in the
-- Shelley era.
pattern QueryIfCurrentShelley
  :: ()
  => CardanoQueryResult c result ~ a
  => BlockQuery (ShelleyBlock (TPraos c) (ShelleyEra c)) result
  -> CardanoQuery c a

-- | Allegra-specific query that can only be answered when the ledger is in the
-- Allegra era.
pattern QueryIfCurrentAllegra
  :: ()
  => CardanoQueryResult c result ~ a
  => BlockQuery (ShelleyBlock (TPraos c) (AllegraEra c)) result
  -> CardanoQuery c a

-- | Mary-specific query that can only be answered when the ledger is in the
-- Mary era.
pattern QueryIfCurrentMary
  :: ()
  => CardanoQueryResult c result ~ a
  => BlockQuery (ShelleyBlock (TPraos c) (MaryEra c)) result
  -> CardanoQuery c a

-- | Alonzo-specific query that can only be answered when the ledger is in the
-- Alonzo era.
pattern QueryIfCurrentAlonzo
  :: ()
  => CardanoQueryResult c result ~ a
  => BlockQuery (ShelleyBlock (TPraos c) (AlonzoEra c)) result
  -> CardanoQuery c a

-- | Babbage-specific query that can only be answered when the ledger is in the
-- Babbage era.
pattern QueryIfCurrentBabbage
  :: ()
  => CardanoQueryResult c result ~ a
  => BlockQuery (ShelleyBlock (Praos c) (BabbageEra c)) result
  -> CardanoQuery c a

-- Here we use layout and adjacency to make it obvious that we haven't
-- miscounted.

pattern $bQueryIfCurrentByron :: BlockQuery ByronBlock result -> CardanoQuery c a
$mQueryIfCurrentByron :: forall r c a.
CardanoQuery c a
-> (forall result.
    (CardanoQueryResult c result ~ a) =>
    BlockQuery ByronBlock result -> r)
-> (Void# -> r)
-> r
QueryIfCurrentByron   q = QueryIfCurrent                     (QZ q)
pattern $bQueryIfCurrentShelley :: BlockQuery (ShelleyBlock (TPraos c) (ShelleyEra c)) result
-> CardanoQuery c a
$mQueryIfCurrentShelley :: forall r c a.
CardanoQuery c a
-> (forall result.
    (CardanoQueryResult c result ~ a) =>
    BlockQuery (ShelleyBlock (TPraos c) (ShelleyEra c)) result -> r)
-> (Void# -> r)
-> r
QueryIfCurrentShelley q = QueryIfCurrent                 (QS (QZ q))
pattern $bQueryIfCurrentAllegra :: BlockQuery (ShelleyBlock (TPraos c) (AllegraEra c)) result
-> CardanoQuery c a
$mQueryIfCurrentAllegra :: forall r c a.
CardanoQuery c a
-> (forall result.
    (CardanoQueryResult c result ~ a) =>
    BlockQuery (ShelleyBlock (TPraos c) (AllegraEra c)) result -> r)
-> (Void# -> r)
-> r
QueryIfCurrentAllegra q = QueryIfCurrent             (QS (QS (QZ q)))
pattern $bQueryIfCurrentMary :: BlockQuery (ShelleyBlock (TPraos c) (MaryEra c)) result
-> CardanoQuery c a
$mQueryIfCurrentMary :: forall r c a.
CardanoQuery c a
-> (forall result.
    (CardanoQueryResult c result ~ a) =>
    BlockQuery (ShelleyBlock (TPraos c) (MaryEra c)) result -> r)
-> (Void# -> r)
-> r
QueryIfCurrentMary    q = QueryIfCurrent         (QS (QS (QS (QZ q))))
pattern $bQueryIfCurrentAlonzo :: BlockQuery (ShelleyBlock (TPraos c) (AlonzoEra c)) result
-> CardanoQuery c a
$mQueryIfCurrentAlonzo :: forall r c a.
CardanoQuery c a
-> (forall result.
    (CardanoQueryResult c result ~ a) =>
    BlockQuery (ShelleyBlock (TPraos c) (AlonzoEra c)) result -> r)
-> (Void# -> r)
-> r
QueryIfCurrentAlonzo  q = QueryIfCurrent     (QS (QS (QS (QS (QZ q)))))
pattern $bQueryIfCurrentBabbage :: BlockQuery (ShelleyBlock (Praos c) (BabbageEra c)) result
-> CardanoQuery c a
$mQueryIfCurrentBabbage :: forall r c a.
CardanoQuery c a
-> (forall result.
    (CardanoQueryResult c result ~ a) =>
    BlockQuery (ShelleyBlock (Praos c) (BabbageEra c)) result -> r)
-> (Void# -> r)
-> r
QueryIfCurrentBabbage q = QueryIfCurrent (QS (QS (QS (QS (QS (QZ q))))))

-- | Query about the Byron era that can be answered anytime, i.e.,
-- independent from where the tip of the ledger is.
--
-- For example, to ask for the start of the Byron era (whether the tip of
-- the ledger is in the Byron, Shelley, ... era), use:
--
-- > QueryAnytimeByron EraStart
--
pattern QueryAnytimeByron
  :: QueryAnytime result
  -> CardanoQuery c result
pattern $bQueryAnytimeByron :: QueryAnytime result -> CardanoQuery c result
$mQueryAnytimeByron :: forall r result c.
CardanoQuery c result
-> (QueryAnytime result -> r) -> (Void# -> r) -> r
QueryAnytimeByron q = QueryAnytime q (EraIndex (TagByron (K ())))

-- | Query about the Shelley era that can be answered anytime, i.e.,
-- independent from where the tip of the ledger is.
--
-- For example, to ask for the start of the Shelley era (whether the tip of the
-- ledger is in the Byron, Shelley, ... era), use:
--
-- > QueryAnytimeShelley EraStart
--
pattern QueryAnytimeShelley
  :: QueryAnytime result
  -> CardanoQuery c result
pattern $bQueryAnytimeShelley :: QueryAnytime result -> CardanoQuery c result
$mQueryAnytimeShelley :: forall r result c.
CardanoQuery c result
-> (QueryAnytime result -> r) -> (Void# -> r) -> r
QueryAnytimeShelley q = QueryAnytime q (EraIndex (TagShelley (K ())))

-- | Query about the Allegra era that can be answered anytime, i.e.,
-- independent from where the tip of the ledger is.
--
-- For example, to ask for the start of the Allegra era (whether the tip of the
-- ledger is in the Byron, Shelley, ... era), use:
--
-- > QueryAnytimeAllegra EraStart
--
pattern QueryAnytimeAllegra
  :: QueryAnytime result
  -> CardanoQuery c result
pattern $bQueryAnytimeAllegra :: QueryAnytime result -> CardanoQuery c result
$mQueryAnytimeAllegra :: forall r result c.
CardanoQuery c result
-> (QueryAnytime result -> r) -> (Void# -> r) -> r
QueryAnytimeAllegra q = QueryAnytime q (EraIndex (TagAllegra (K ())))

-- | Query about the Mary era that can be answered anytime, i.e.,
-- independent from where the tip of the ledger is.
--
-- For example, to ask for the start of the Mary era (whether the tip of the
-- ledger is in the Byron, Shelley, ... era), use:
--
-- > QueryAnytimeMary EraStart
--
pattern QueryAnytimeMary
  :: QueryAnytime result
  -> CardanoQuery c result
pattern $bQueryAnytimeMary :: QueryAnytime result -> CardanoQuery c result
$mQueryAnytimeMary :: forall r result c.
CardanoQuery c result
-> (QueryAnytime result -> r) -> (Void# -> r) -> r
QueryAnytimeMary q = QueryAnytime q (EraIndex (TagMary (K ())))

-- | Query about the Alonzo era that can be answered anytime, i.e., independent
-- from where the tip of the ledger is.
--
-- For example, to ask for the start of the Alonzo era (whether the tip of the
-- ledger is in the Byron, Shelley, ... era), use:
--
-- > QueryAnytimeAlonzo EraStart
--
pattern QueryAnytimeAlonzo
  :: QueryAnytime result
  -> CardanoQuery c result
pattern $bQueryAnytimeAlonzo :: QueryAnytime result -> CardanoQuery c result
$mQueryAnytimeAlonzo :: forall r result c.
CardanoQuery c result
-> (QueryAnytime result -> r) -> (Void# -> r) -> r
QueryAnytimeAlonzo q = QueryAnytime q (EraIndex (TagAlonzo (K ())))

-- | Query about the Babbage era that can be answered anytime, i.e., independent
-- from where the tip of the ledger is.
--
-- For example, to ask for the start of the Babbage era (whether the tip of the
-- ledger is in the Byron, Shelley, ... era), use:
--
-- > QueryAnytimeBabbage EraStart
--
pattern QueryAnytimeBabbage
  :: QueryAnytime result
  -> CardanoQuery c result
pattern $bQueryAnytimeBabbage :: QueryAnytime result -> CardanoQuery c result
$mQueryAnytimeBabbage :: forall r result c.
CardanoQuery c result
-> (QueryAnytime result -> r) -> (Void# -> r) -> r
QueryAnytimeBabbage q = QueryAnytime q (EraIndex (TagBabbage (K ())))

{-# COMPLETE QueryIfCurrentByron
           , QueryIfCurrentShelley
           , QueryIfCurrentAllegra
           , QueryIfCurrentMary
           , QueryIfCurrentAlonzo
           , QueryIfCurrentBabbage
           , QueryAnytimeByron
           , QueryAnytimeShelley
           , QueryAnytimeAllegra
           , QueryAnytimeMary
           , QueryAnytimeAlonzo
           , QueryAnytimeBabbage
           , QueryHardFork #-}

-- | The result of a 'CardanoQuery'
--
-- Thanks to the pattern synonyms, you can treat this as a sum type with
-- constructors 'QueryResultSuccess' and 'QueryResultEraMismatch'.
type CardanoQueryResult c = HardForkQueryResult (CardanoEras c)

pattern QueryResultSuccess :: result -> CardanoQueryResult c result
pattern $bQueryResultSuccess :: result -> CardanoQueryResult c result
$mQueryResultSuccess :: forall r result c.
CardanoQueryResult c result -> (result -> r) -> (Void# -> r) -> r
QueryResultSuccess result = Right result

-- | A query from a different era than the ledger's era was sent.
pattern QueryResultEraMismatch :: EraMismatch -> CardanoQueryResult c result
pattern $mQueryResultEraMismatch :: forall r c result.
CardanoQueryResult c result
-> (EraMismatch -> r) -> (Void# -> r) -> r
QueryResultEraMismatch eraMismatch <- Left (mkEraMismatch -> eraMismatch)

{-# COMPLETE QueryResultSuccess, QueryResultEraMismatch #-}

{-------------------------------------------------------------------------------
  CodecConfig
-------------------------------------------------------------------------------}

-- | The 'CodecConfig' for 'CardanoBlock'.
--
-- Thanks to the pattern synonyms, you can treat this as the product of
-- the Byron, Shelley, ... 'CodecConfig's.
type CardanoCodecConfig c = CodecConfig (CardanoBlock c)

pattern CardanoCodecConfig
  :: CodecConfig ByronBlock
  -> CodecConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CodecConfig (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CodecConfig (ShelleyBlock (TPraos c) (MaryEra c))
  -> CodecConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CodecConfig (ShelleyBlock (Praos c)  (BabbageEra c))
  -> CardanoCodecConfig c
pattern $bCardanoCodecConfig :: CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (AllegraEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (MaryEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
-> CodecConfig (ShelleyBlock (Praos c) (BabbageEra c))
-> CardanoCodecConfig c
$mCardanoCodecConfig :: forall r c.
CardanoCodecConfig c
-> (CodecConfig ByronBlock
    -> CodecConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> CodecConfig (ShelleyBlock (TPraos c) (AllegraEra c))
    -> CodecConfig (ShelleyBlock (TPraos c) (MaryEra c))
    -> CodecConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
    -> CodecConfig (ShelleyBlock (Praos c) (BabbageEra c))
    -> r)
-> (Void# -> r)
-> r
CardanoCodecConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage =
    HardForkCodecConfig {
        hardForkCodecConfigPerEra = PerEraCodecConfig
          (  cfgByron
          :* cfgShelley
          :* cfgAllegra
          :* cfgMary
          :* cfgAlonzo
          :* cfgBabbage
          :* Nil
          )
      }

{-# COMPLETE CardanoCodecConfig #-}

{-------------------------------------------------------------------------------
  BlockConfig
-------------------------------------------------------------------------------}

-- | The 'BlockConfig' for 'CardanoBlock'.
--
-- Thanks to the pattern synonyms, you can treat this as the product of
-- the Byron, Shelley, ... 'BlockConfig's.
type CardanoBlockConfig c = BlockConfig (CardanoBlock c)

pattern CardanoBlockConfig
  :: BlockConfig ByronBlock
  -> BlockConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> BlockConfig (ShelleyBlock (TPraos c) (AllegraEra c))
  -> BlockConfig (ShelleyBlock (TPraos c) (MaryEra c))
  -> BlockConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> BlockConfig (ShelleyBlock (Praos c)  (BabbageEra c))
  -> CardanoBlockConfig c
pattern $bCardanoBlockConfig :: BlockConfig ByronBlock
-> BlockConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
-> BlockConfig (ShelleyBlock (TPraos c) (AllegraEra c))
-> BlockConfig (ShelleyBlock (TPraos c) (MaryEra c))
-> BlockConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
-> BlockConfig (ShelleyBlock (Praos c) (BabbageEra c))
-> CardanoBlockConfig c
$mCardanoBlockConfig :: forall r c.
CardanoBlockConfig c
-> (BlockConfig ByronBlock
    -> BlockConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> BlockConfig (ShelleyBlock (TPraos c) (AllegraEra c))
    -> BlockConfig (ShelleyBlock (TPraos c) (MaryEra c))
    -> BlockConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
    -> BlockConfig (ShelleyBlock (Praos c) (BabbageEra c))
    -> r)
-> (Void# -> r)
-> r
CardanoBlockConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage =
    HardForkBlockConfig {
        hardForkBlockConfigPerEra = PerEraBlockConfig
          (  cfgByron
          :* cfgShelley
          :* cfgAllegra
          :* cfgMary
          :* cfgAlonzo
          :* cfgBabbage
          :* Nil
          )
      }

{-# COMPLETE CardanoBlockConfig #-}

{-------------------------------------------------------------------------------
  StorageConfig
-------------------------------------------------------------------------------}

-- | The 'StorageConfig' for 'CardanoBlock'.
--
-- Thanks to the pattern synonyms, you can treat this as the product of
-- the Byron, Shelley, ... 'StorageConfig's.
type CardanoStorageConfig c = StorageConfig (CardanoBlock c)

pattern CardanoStorageConfig
  :: StorageConfig ByronBlock
  -> StorageConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> StorageConfig (ShelleyBlock (TPraos c) (AllegraEra c))
  -> StorageConfig (ShelleyBlock (TPraos c) (MaryEra c))
  -> StorageConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> StorageConfig (ShelleyBlock (Praos c)  (BabbageEra c))
  -> CardanoStorageConfig c
pattern $bCardanoStorageConfig :: StorageConfig ByronBlock
-> StorageConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
-> StorageConfig (ShelleyBlock (TPraos c) (AllegraEra c))
-> StorageConfig (ShelleyBlock (TPraos c) (MaryEra c))
-> StorageConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
-> StorageConfig (ShelleyBlock (Praos c) (BabbageEra c))
-> CardanoStorageConfig c
$mCardanoStorageConfig :: forall r c.
CardanoStorageConfig c
-> (StorageConfig ByronBlock
    -> StorageConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> StorageConfig (ShelleyBlock (TPraos c) (AllegraEra c))
    -> StorageConfig (ShelleyBlock (TPraos c) (MaryEra c))
    -> StorageConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
    -> StorageConfig (ShelleyBlock (Praos c) (BabbageEra c))
    -> r)
-> (Void# -> r)
-> r
CardanoStorageConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage =
    HardForkStorageConfig {
        hardForkStorageConfigPerEra = PerEraStorageConfig
          (  cfgByron
          :* cfgShelley
          :* cfgAllegra
          :* cfgMary
          :* cfgAlonzo
          :* cfgBabbage
          :* Nil
          )
      }

{-# COMPLETE CardanoStorageConfig #-}

{-------------------------------------------------------------------------------
  ConsensusConfig
-------------------------------------------------------------------------------}

-- | The 'ConsensusConfig' for 'CardanoBlock'.
--
-- Thanks to the pattern synonyms, you can treat this as the product of the
-- Byron, Shelley, ... 'PartialConsensusConfig's.
--
-- NOTE: not 'ConsensusConfig', but 'PartialConsensusConfig'.
type CardanoConsensusConfig c =
  ConsensusConfig (HardForkProtocol (CardanoEras c))

pattern CardanoConsensusConfig
  :: PartialConsensusConfig (BlockProtocol ByronBlock)
  -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (ShelleyEra c)))
  -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (AllegraEra c)))
  -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (MaryEra c)))
  -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (AlonzoEra c)))
  -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c)  (BabbageEra c)))
  -> CardanoConsensusConfig c
pattern $mCardanoConsensusConfig :: forall r c.
CardanoConsensusConfig c
-> (PartialConsensusConfig (BlockProtocol ByronBlock)
    -> PartialConsensusConfig
         (BlockProtocol (ShelleyBlock (TPraos c) (ShelleyEra c)))
    -> PartialConsensusConfig
         (BlockProtocol (ShelleyBlock (TPraos c) (AllegraEra c)))
    -> PartialConsensusConfig
         (BlockProtocol (ShelleyBlock (TPraos c) (MaryEra c)))
    -> PartialConsensusConfig
         (BlockProtocol (ShelleyBlock (TPraos c) (AlonzoEra c)))
    -> PartialConsensusConfig
         (BlockProtocol (ShelleyBlock (Praos c) (BabbageEra c)))
    -> r)
-> (Void# -> r)
-> r
CardanoConsensusConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage <-
    HardForkConsensusConfig {
        hardForkConsensusConfigPerEra = PerEraConsensusConfig
          (  WrapPartialConsensusConfig cfgByron
          :* WrapPartialConsensusConfig cfgShelley
          :* WrapPartialConsensusConfig cfgAllegra
          :* WrapPartialConsensusConfig cfgMary
          :* WrapPartialConsensusConfig cfgAlonzo
          :* WrapPartialConsensusConfig cfgBabbage
          :* Nil
          )
      }

{-# COMPLETE CardanoConsensusConfig #-}

{-------------------------------------------------------------------------------
  LedgerConfig
-------------------------------------------------------------------------------}

-- | The 'LedgerConfig' for 'CardanoBlock'.
--
-- Thanks to the pattern synonyms, you can treat this as the product of the
-- Byron, Shelley, ... 'PartialLedgerConfig's.
--
-- NOTE: not 'LedgerConfig', but 'PartialLedgerConfig'.
type CardanoLedgerConfig c = HardForkLedgerConfig (CardanoEras c)

pattern CardanoLedgerConfig
  :: PartialLedgerConfig ByronBlock
  -> PartialLedgerConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> PartialLedgerConfig (ShelleyBlock (TPraos c) (AllegraEra c))
  -> PartialLedgerConfig (ShelleyBlock (TPraos c) (MaryEra c))
  -> PartialLedgerConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> PartialLedgerConfig (ShelleyBlock (Praos c)  (BabbageEra c))
  -> CardanoLedgerConfig c
pattern $mCardanoLedgerConfig :: forall r c.
CardanoLedgerConfig c
-> (PartialLedgerConfig ByronBlock
    -> PartialLedgerConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
    -> PartialLedgerConfig (ShelleyBlock (TPraos c) (AllegraEra c))
    -> PartialLedgerConfig (ShelleyBlock (TPraos c) (MaryEra c))
    -> PartialLedgerConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
    -> PartialLedgerConfig (ShelleyBlock (Praos c) (BabbageEra c))
    -> r)
-> (Void# -> r)
-> r
CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage <-
    HardForkLedgerConfig {
        hardForkLedgerConfigPerEra = PerEraLedgerConfig
          (  WrapPartialLedgerConfig cfgByron
          :* WrapPartialLedgerConfig cfgShelley
          :* WrapPartialLedgerConfig cfgAllegra
          :* WrapPartialLedgerConfig cfgMary
          :* WrapPartialLedgerConfig cfgAlonzo
          :* WrapPartialLedgerConfig cfgBabbage
          :* Nil
          )
      }

{-# COMPLETE CardanoLedgerConfig #-}

{-------------------------------------------------------------------------------
  LedgerState
-------------------------------------------------------------------------------}

-- | The 'LedgerState' for 'CardanoBlock'.
--
-- NOTE: the 'CardanoLedgerState' contains more than just the current era's
-- 'LedgerState'. We don't give access to those internal details through the
-- pattern synonyms. This is also the reason the pattern synonyms are not
-- bidirectional.
type CardanoLedgerState c = LedgerState (CardanoBlock c)

pattern LedgerStateByron
  :: LedgerState ByronBlock
  -> CardanoLedgerState c
pattern $mLedgerStateByron :: forall r c.
CardanoLedgerState c
-> (LedgerState ByronBlock -> r) -> (Void# -> r) -> r
LedgerStateByron st <-
    HardForkLedgerState
      (State.HardForkState
        (TeleByron (State.Current { currentState = st })))

pattern LedgerStateShelley
  :: LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
  -> CardanoLedgerState c
pattern $mLedgerStateShelley :: forall r c.
CardanoLedgerState c
-> (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)) -> r)
-> (Void# -> r)
-> r
LedgerStateShelley st <-
    HardForkLedgerState
      (State.HardForkState
        (TeleShelley _ (State.Current { currentState = st })))

pattern LedgerStateAllegra
  :: LedgerState (ShelleyBlock (TPraos c) (AllegraEra c))
  -> CardanoLedgerState c
pattern $mLedgerStateAllegra :: forall r c.
CardanoLedgerState c
-> (LedgerState (ShelleyBlock (TPraos c) (AllegraEra c)) -> r)
-> (Void# -> r)
-> r
LedgerStateAllegra st <-
    HardForkLedgerState
      (State.HardForkState
        (TeleAllegra _ _  (State.Current { currentState = st })))

pattern LedgerStateMary
  :: LedgerState (ShelleyBlock (TPraos c) (MaryEra c))
  -> CardanoLedgerState c
pattern $mLedgerStateMary :: forall r c.
CardanoLedgerState c
-> (LedgerState (ShelleyBlock (TPraos c) (MaryEra c)) -> r)
-> (Void# -> r)
-> r
LedgerStateMary st <-
    HardForkLedgerState
      (State.HardForkState
        (TeleMary _ _ _ (State.Current { currentState = st })))

pattern LedgerStateAlonzo
  :: LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c))
  -> CardanoLedgerState c
pattern $mLedgerStateAlonzo :: forall r c.
CardanoLedgerState c
-> (LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c)) -> r)
-> (Void# -> r)
-> r
LedgerStateAlonzo st <-
    HardForkLedgerState
      (State.HardForkState
        (TeleAlonzo _ _ _ _ (State.Current { currentState = st })))

pattern LedgerStateBabbage
  :: LedgerState (ShelleyBlock (Praos c) (BabbageEra c))
  -> CardanoLedgerState c
pattern $mLedgerStateBabbage :: forall r c.
CardanoLedgerState c
-> (LedgerState (ShelleyBlock (Praos c) (BabbageEra c)) -> r)
-> (Void# -> r)
-> r
LedgerStateBabbage st <-
    HardForkLedgerState
      (State.HardForkState
        (TeleBabbage _ _ _ _ _ (State.Current { currentState = st })))

{-# COMPLETE LedgerStateByron
           , LedgerStateShelley
           , LedgerStateAllegra
           , LedgerStateMary
           , LedgerStateAlonzo
           , LedgerStateBabbage #-}

{-------------------------------------------------------------------------------
  ChainDepState
-------------------------------------------------------------------------------}

-- | The 'ChainDepState' for 'CardanoBlock'.
--
-- NOTE: the 'CardanoChainDepState' contains more than just the current era's
-- 'ChainDepState'. We don't give access to those internal details through the
-- pattern synonyms. This is also the reason the pattern synonyms are not
-- bidirectional.
type CardanoChainDepState c = HardForkChainDepState (CardanoEras c)

pattern ChainDepStateByron
  :: ChainDepState (BlockProtocol ByronBlock)
  -> CardanoChainDepState c
pattern $mChainDepStateByron :: forall r c.
CardanoChainDepState c
-> (ChainDepState (BlockProtocol ByronBlock) -> r)
-> (Void# -> r)
-> r
ChainDepStateByron st <-
    State.HardForkState
      (TeleByron (State.Current { currentState = WrapChainDepState st }))

pattern ChainDepStateShelley
  :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (ShelleyEra c)))
  -> CardanoChainDepState c
pattern $mChainDepStateShelley :: forall r c.
CardanoChainDepState c
-> (ChainDepState
      (BlockProtocol (ShelleyBlock (TPraos c) (ShelleyEra c)))
    -> r)
-> (Void# -> r)
-> r
ChainDepStateShelley st <-
    State.HardForkState
      (TeleShelley _ (State.Current { currentState = WrapChainDepState st }))

pattern ChainDepStateAllegra
  :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (AllegraEra c)))
  -> CardanoChainDepState c
pattern $mChainDepStateAllegra :: forall r c.
CardanoChainDepState c
-> (ChainDepState
      (BlockProtocol (ShelleyBlock (TPraos c) (AllegraEra c)))
    -> r)
-> (Void# -> r)
-> r
ChainDepStateAllegra st <-
    State.HardForkState
      (TeleAllegra _ _ (State.Current { currentState = WrapChainDepState st }))

pattern ChainDepStateMary
  :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (MaryEra c)))
  -> CardanoChainDepState c
pattern $mChainDepStateMary :: forall r c.
CardanoChainDepState c
-> (ChainDepState
      (BlockProtocol (ShelleyBlock (TPraos c) (MaryEra c)))
    -> r)
-> (Void# -> r)
-> r
ChainDepStateMary st <-
    State.HardForkState
      (TeleMary _ _ _ (State.Current { currentState = WrapChainDepState st }))

pattern ChainDepStateAlonzo
  :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (AlonzoEra c)))
  -> CardanoChainDepState c
pattern $mChainDepStateAlonzo :: forall r c.
CardanoChainDepState c
-> (ChainDepState
      (BlockProtocol (ShelleyBlock (TPraos c) (AlonzoEra c)))
    -> r)
-> (Void# -> r)
-> r
ChainDepStateAlonzo st <-
    State.HardForkState
      (TeleAlonzo _ _ _ _ (State.Current { currentState = WrapChainDepState st }))

pattern ChainDepStateBabbage
  :: ChainDepState (BlockProtocol (ShelleyBlock (Praos c) (BabbageEra c)))
  -> CardanoChainDepState c
pattern $mChainDepStateBabbage :: forall r c.
CardanoChainDepState c
-> (ChainDepState
      (BlockProtocol (ShelleyBlock (Praos c) (BabbageEra c)))
    -> r)
-> (Void# -> r)
-> r
ChainDepStateBabbage st <-
    State.HardForkState
      (TeleBabbage _ _ _ _ _ (State.Current { currentState = WrapChainDepState st }))

{-# COMPLETE ChainDepStateByron
           , ChainDepStateShelley
           , ChainDepStateAllegra
           , ChainDepStateMary
           , ChainDepStateAlonzo
           , ChainDepStateBabbage #-}