{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}

-- | Transactions in the context of a consensus mode, and other types used in
-- the transaction submission protocol.
module Cardano.Api.Internal.InMode
  ( -- * Transaction in a consensus mode
    TxInMode (..)
  , fromConsensusGenTx
  , toConsensusGenTx

    -- * Transaction id in a consensus mode
  , TxIdInMode (..)
  , toConsensusTxId

    -- * Transaction validation errors
  , TxValidationError (..)
  , TxValidationErrorInCardanoMode (..)
  , fromConsensusApplyTxErr
  )
where

import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Eras
import Cardano.Api.Internal.Modes
import Cardano.Api.Internal.Orphans ()
import Cardano.Api.Internal.Tx.Body
import Cardano.Api.Internal.Tx.Sign
import Cardano.Api.Internal.Utils (textShow)

import Cardano.Protocol.Crypto (StandardCrypto)
import Ouroboros.Consensus.Byron.Ledger qualified as Consensus
import Ouroboros.Consensus.Cardano.Block qualified as Consensus
import Ouroboros.Consensus.HardFork.Combinator qualified as Consensus
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
import Ouroboros.Consensus.Ledger.SupportsMempool qualified as Consensus
import Ouroboros.Consensus.Shelley.HFEras qualified as Consensus
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
import Ouroboros.Consensus.TypeFamilyWrappers qualified as Consensus

import Data.Aeson (ToJSON (..), (.=))
import Data.Aeson qualified as Aeson
import Data.SOP.Strict (NS (S, Z))
import Data.Text qualified as Text
import GHC.Generics

-- ----------------------------------------------------------------------------
-- Transactions in the context of a consensus mode
--

-- | A 'Tx' in one of the eras supported by a given protocol mode.
--
-- For multi-era modes such as the 'CardanoMode' this type is a sum of the
-- different transaction types for all the eras. It is used in the
-- LocalTxSubmission protocol.
data TxInMode where
  -- | Shelley based transactions.
  TxInMode
    :: ShelleyBasedEra era
    -> Tx era
    -> TxInMode
  -- | Legacy Byron transactions and things we can
  -- post to the chain which are not actually transactions.
  -- This covers: update proposals, votes and delegation certs.
  TxInByronSpecial
    :: Consensus.GenTx Consensus.ByronBlock
    -> TxInMode

deriving instance Show TxInMode

fromConsensusGenTx
  :: ()
  => Consensus.CardanoBlock StandardCrypto ~ block
  => Consensus.GenTx block
  -> TxInMode
fromConsensusGenTx :: forall block.
(CardanoBlock StandardCrypto ~ block) =>
GenTx block -> TxInMode
fromConsensusGenTx = \case
  Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z GenTx x
tx')) ->
    GenTx ByronBlock -> TxInMode
TxInByronSpecial GenTx x
GenTx ByronBlock
tx'
  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (Z GenTx x
tx'))) ->
    let Consensus.ShelleyTx TxId
_txid Tx ShelleyEra
shelleyEraTx = GenTx x
tx'
     in ShelleyBasedEra ShelleyEra -> Tx ShelleyEra -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley (ShelleyBasedEra ShelleyEra
-> Tx (ShelleyLedgerEra ShelleyEra) -> Tx ShelleyEra
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley Tx ShelleyEra
Tx (ShelleyLedgerEra ShelleyEra)
shelleyEraTx)
  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (Z GenTx x
tx')))) ->
    let Consensus.ShelleyTx TxId
_txid Tx AllegraEra
shelleyEraTx = GenTx x
tx'
     in ShelleyBasedEra AllegraEra -> Tx AllegraEra -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra (ShelleyBasedEra AllegraEra
-> Tx (ShelleyLedgerEra AllegraEra) -> Tx AllegraEra
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra Tx AllegraEra
Tx (ShelleyLedgerEra AllegraEra)
shelleyEraTx)
  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (Z GenTx x
tx'))))) ->
    let Consensus.ShelleyTx TxId
_txid Tx MaryEra
shelleyEraTx = GenTx x
tx'
     in ShelleyBasedEra MaryEra -> Tx MaryEra -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra MaryEra
ShelleyBasedEraMary (ShelleyBasedEra MaryEra
-> Tx (ShelleyLedgerEra MaryEra) -> Tx MaryEra
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra MaryEra
ShelleyBasedEraMary Tx MaryEra
Tx (ShelleyLedgerEra MaryEra)
shelleyEraTx)
  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (Z GenTx x
tx')))))) ->
    let Consensus.ShelleyTx TxId
_txid Tx AlonzoEra
shelleyEraTx = GenTx x
tx'
     in ShelleyBasedEra AlonzoEra -> Tx AlonzoEra -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo (ShelleyBasedEra AlonzoEra
-> Tx (ShelleyLedgerEra AlonzoEra) -> Tx AlonzoEra
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo Tx AlonzoEra
Tx (ShelleyLedgerEra AlonzoEra)
shelleyEraTx)
  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (Z GenTx x
tx'))))))) ->
    let Consensus.ShelleyTx TxId
_txid Tx BabbageEra
shelleyEraTx = GenTx x
tx'
     in ShelleyBasedEra BabbageEra -> Tx BabbageEra -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage (ShelleyBasedEra BabbageEra
-> Tx (ShelleyLedgerEra BabbageEra) -> Tx BabbageEra
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage Tx BabbageEra
Tx (ShelleyLedgerEra BabbageEra)
shelleyEraTx)
  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (Z GenTx x
tx')))))))) ->
    let Consensus.ShelleyTx TxId
_txid Tx ConwayEra
shelleyEraTx = GenTx x
tx'
     in ShelleyBasedEra ConwayEra -> Tx ConwayEra -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra ConwayEra
ShelleyBasedEraConway (ShelleyBasedEra ConwayEra
-> Tx (ShelleyLedgerEra ConwayEra) -> Tx ConwayEra
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra ConwayEra
ShelleyBasedEraConway Tx ConwayEra
Tx (ShelleyLedgerEra ConwayEra)
shelleyEraTx)

toConsensusGenTx
  :: ()
  => Consensus.CardanoBlock StandardCrypto ~ block
  => TxInMode
  -> Consensus.GenTx block
toConsensusGenTx :: forall block.
(CardanoBlock StandardCrypto ~ block) =>
TxInMode -> GenTx block
toConsensusGenTx (TxInByronSpecial GenTx ByronBlock
gtx) =
  OneEraGenTx (CardanoEras StandardCrypto)
-> GenTx (CardanoBlock StandardCrypto)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
Consensus.HardForkGenTx (NS GenTx (CardanoEras StandardCrypto)
-> OneEraGenTx (CardanoEras StandardCrypto)
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
Consensus.OneEraGenTx (GenTx ByronBlock -> NS GenTx (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z GenTx ByronBlock
gtx))
toConsensusGenTx (TxInMode ShelleyBasedEra era
ShelleyBasedEraShelley (ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx)) =
  OneEraGenTx (CardanoEras StandardCrypto)
-> GenTx (CardanoBlock StandardCrypto)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
Consensus.HardForkGenTx (NS GenTx (CardanoEras StandardCrypto)
-> OneEraGenTx (CardanoEras StandardCrypto)
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
Consensus.OneEraGenTx (NS GenTx (CardanoShelleyEras StandardCrypto)
-> NS GenTx (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (GenTx (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> NS GenTx (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z GenTx (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
tx')))
 where
  tx' :: GenTx (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
tx' = Tx ShelleyEra
-> GenTx (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
Consensus.mkShelleyTx Tx ShelleyEra
Tx (ShelleyLedgerEra era)
tx
toConsensusGenTx (TxInMode ShelleyBasedEra era
ShelleyBasedEraAllegra (ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx)) =
  OneEraGenTx (CardanoEras StandardCrypto)
-> GenTx (CardanoBlock StandardCrypto)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
Consensus.HardForkGenTx (NS GenTx (CardanoEras StandardCrypto)
-> OneEraGenTx (CardanoEras StandardCrypto)
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
Consensus.OneEraGenTx (NS GenTx (CardanoShelleyEras StandardCrypto)
-> NS GenTx (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS GenTx (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (GenTx (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z GenTx (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
tx'))))
 where
  tx' :: GenTx (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
tx' = Tx AllegraEra
-> GenTx (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
Consensus.mkShelleyTx Tx AllegraEra
Tx (ShelleyLedgerEra era)
tx
toConsensusGenTx (TxInMode ShelleyBasedEra era
ShelleyBasedEraMary (ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx)) =
  OneEraGenTx (CardanoEras StandardCrypto)
-> GenTx (CardanoBlock StandardCrypto)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
Consensus.HardForkGenTx (NS GenTx (CardanoEras StandardCrypto)
-> OneEraGenTx (CardanoEras StandardCrypto)
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
Consensus.OneEraGenTx (NS GenTx (CardanoShelleyEras StandardCrypto)
-> NS GenTx (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS GenTx (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (GenTx (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z GenTx (ShelleyBlock (TPraos StandardCrypto) MaryEra)
tx')))))
 where
  tx' :: GenTx (ShelleyBlock (TPraos StandardCrypto) MaryEra)
tx' = Tx MaryEra -> GenTx (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
Consensus.mkShelleyTx Tx MaryEra
Tx (ShelleyLedgerEra era)
tx
toConsensusGenTx (TxInMode ShelleyBasedEra era
ShelleyBasedEraAlonzo (ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx)) =
  OneEraGenTx (CardanoEras StandardCrypto)
-> GenTx (CardanoBlock StandardCrypto)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
Consensus.HardForkGenTx (NS GenTx (CardanoEras StandardCrypto)
-> OneEraGenTx (CardanoEras StandardCrypto)
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
Consensus.OneEraGenTx (NS GenTx (CardanoShelleyEras StandardCrypto)
-> NS GenTx (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS GenTx (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (GenTx (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z GenTx (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
tx'))))))
 where
  tx' :: GenTx (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
tx' = Tx AlonzoEra
-> GenTx (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
Consensus.mkShelleyTx Tx AlonzoEra
Tx (ShelleyLedgerEra era)
tx
toConsensusGenTx (TxInMode ShelleyBasedEra era
ShelleyBasedEraBabbage (ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx)) =
  OneEraGenTx (CardanoEras StandardCrypto)
-> GenTx (CardanoBlock StandardCrypto)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
Consensus.HardForkGenTx (NS GenTx (CardanoEras StandardCrypto)
-> OneEraGenTx (CardanoEras StandardCrypto)
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
Consensus.OneEraGenTx (NS GenTx (CardanoShelleyEras StandardCrypto)
-> NS GenTx (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS GenTx (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (GenTx (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> NS
     GenTx
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z GenTx (ShelleyBlock (Praos StandardCrypto) BabbageEra)
tx')))))))
 where
  tx' :: GenTx (ShelleyBlock (Praos StandardCrypto) BabbageEra)
tx' = Tx BabbageEra
-> GenTx (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
Consensus.mkShelleyTx Tx BabbageEra
Tx (ShelleyLedgerEra era)
tx
toConsensusGenTx (TxInMode ShelleyBasedEra era
ShelleyBasedEraConway (ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
tx)) =
  OneEraGenTx (CardanoEras StandardCrypto)
-> GenTx (CardanoBlock StandardCrypto)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
Consensus.HardForkGenTx (NS GenTx (CardanoEras StandardCrypto)
-> OneEraGenTx (CardanoEras StandardCrypto)
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
Consensus.OneEraGenTx (NS GenTx (CardanoShelleyEras StandardCrypto)
-> NS GenTx (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS GenTx (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  GenTx
  '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS GenTx '[ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     GenTx
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (GenTx (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> NS GenTx '[ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z GenTx (ShelleyBlock (Praos StandardCrypto) ConwayEra)
tx'))))))))
 where
  tx' :: GenTx (ShelleyBlock (Praos StandardCrypto) ConwayEra)
tx' = Tx ConwayEra
-> GenTx (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
Consensus.mkShelleyTx Tx ConwayEra
Tx (ShelleyLedgerEra era)
tx

-- ----------------------------------------------------------------------------
-- Transaction ids in the context of a consensus mode
--

-- | A 'TxId' in one of the eras supported by a given protocol mode.
--
-- For multi-era modes such as the 'CardanoMode' this type is a sum of the
-- different transaction types for all the eras. It is used in the
-- LocalTxMonitoring protocol.
--
-- TODO Rename to TxIdInEra
data TxIdInMode where
  TxIdInMode
    :: CardanoEra era
    -> TxId
    -> TxIdInMode

toConsensusTxId
  :: ()
  => Consensus.CardanoBlock StandardCrypto ~ block
  => TxIdInMode
  -> Consensus.TxId (Consensus.GenTx block)
toConsensusTxId :: forall block.
(CardanoBlock StandardCrypto ~ block) =>
TxIdInMode -> TxId (GenTx block)
toConsensusTxId (TxIdInMode CardanoEra era
ByronEra TxId
txid) =
  OneEraGenTxId (CardanoEras StandardCrypto) -> TxId (GenTx block)
OneEraGenTxId (CardanoEras StandardCrypto)
-> TxId (GenTx (CardanoBlock StandardCrypto))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
Consensus.HardForkGenTxId (OneEraGenTxId (CardanoEras StandardCrypto) -> TxId (GenTx block))
-> (WrapGenTxId ByronBlock
    -> OneEraGenTxId (CardanoEras StandardCrypto))
-> WrapGenTxId ByronBlock
-> TxId (GenTx block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
Consensus.OneEraGenTxId (NS WrapGenTxId (CardanoEras StandardCrypto)
 -> OneEraGenTxId (CardanoEras StandardCrypto))
-> (WrapGenTxId ByronBlock
    -> NS WrapGenTxId (CardanoEras StandardCrypto))
-> WrapGenTxId ByronBlock
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapGenTxId ByronBlock
-> NS WrapGenTxId (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (WrapGenTxId ByronBlock -> TxId (GenTx block))
-> WrapGenTxId ByronBlock -> TxId (GenTx block)
forall a b. (a -> b) -> a -> b
$ GenTxId ByronBlock -> WrapGenTxId ByronBlock
forall blk. GenTxId blk -> WrapGenTxId blk
Consensus.WrapGenTxId GenTxId ByronBlock
txid'
 where
  txid' :: Consensus.TxId (Consensus.GenTx Consensus.ByronBlock)
  txid' :: GenTxId ByronBlock
txid' = TxId -> GenTxId ByronBlock
Consensus.ByronTxId (TxId -> GenTxId ByronBlock) -> TxId -> GenTxId ByronBlock
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
toByronTxId TxId
txid
toConsensusTxId (TxIdInMode CardanoEra era
ShelleyEra TxId
txid) =
  OneEraGenTxId (CardanoEras StandardCrypto)
-> TxId (GenTx (CardanoBlock StandardCrypto))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
Consensus.HardForkGenTxId (NS WrapGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
Consensus.OneEraGenTxId (NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
-> NS WrapGenTxId (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (GenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall blk. GenTxId blk -> WrapGenTxId blk
Consensus.WrapGenTxId GenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
txid'))))
 where
  txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardShelleyBlock)
  txid' :: GenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
txid' = TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
Consensus.ShelleyTxId (TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> TxId
-> GenTxId (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
toShelleyTxId TxId
txid
toConsensusTxId (TxIdInMode CardanoEra era
AllegraEra TxId
txid) =
  OneEraGenTxId (CardanoEras StandardCrypto)
-> TxId (GenTx (CardanoBlock StandardCrypto))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
Consensus.HardForkGenTxId (NS WrapGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
Consensus.OneEraGenTxId (NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
-> NS WrapGenTxId (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (GenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall blk. GenTxId blk -> WrapGenTxId blk
Consensus.WrapGenTxId GenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
txid')))))
 where
  txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardAllegraBlock)
  txid' :: GenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
txid' = TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
Consensus.ShelleyTxId (TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> TxId
-> GenTxId (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
toShelleyTxId TxId
txid
toConsensusTxId (TxIdInMode CardanoEra era
MaryEra TxId
txid) =
  OneEraGenTxId (CardanoEras StandardCrypto)
-> TxId (GenTx (CardanoBlock StandardCrypto))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
Consensus.HardForkGenTxId (NS WrapGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
Consensus.OneEraGenTxId (NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
-> NS WrapGenTxId (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (GenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall blk. GenTxId blk -> WrapGenTxId blk
Consensus.WrapGenTxId GenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra)
txid'))))))
 where
  txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardMaryBlock)
  txid' :: GenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra)
txid' = TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
Consensus.ShelleyTxId (TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
toShelleyTxId TxId
txid
toConsensusTxId (TxIdInMode CardanoEra era
AlonzoEra TxId
txid) =
  OneEraGenTxId (CardanoEras StandardCrypto)
-> TxId (GenTx (CardanoBlock StandardCrypto))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
Consensus.HardForkGenTxId
    (NS WrapGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
Consensus.OneEraGenTxId (NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
-> NS WrapGenTxId (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (GenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> WrapGenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall blk. GenTxId blk -> WrapGenTxId blk
Consensus.WrapGenTxId GenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
txid')))))))
 where
  txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardAlonzoBlock)
  txid' :: GenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
txid' = TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
Consensus.ShelleyTxId (TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> TxId -> GenTxId (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
toShelleyTxId TxId
txid
toConsensusTxId (TxIdInMode CardanoEra era
BabbageEra TxId
txid) =
  OneEraGenTxId (CardanoEras StandardCrypto)
-> TxId (GenTx (CardanoBlock StandardCrypto))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
Consensus.HardForkGenTxId
    (NS WrapGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
Consensus.OneEraGenTxId (NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
-> NS WrapGenTxId (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (WrapGenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> NS
     WrapGenTxId
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (GenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> WrapGenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall blk. GenTxId blk -> WrapGenTxId blk
Consensus.WrapGenTxId GenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra)
txid'))))))))
 where
  txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardBabbageBlock)
  txid' :: GenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra)
txid' = TxId -> GenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
Consensus.ShelleyTxId (TxId -> GenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> TxId -> GenTxId (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
toShelleyTxId TxId
txid
toConsensusTxId (TxIdInMode CardanoEra era
ConwayEra TxId
txid) =
  OneEraGenTxId (CardanoEras StandardCrypto)
-> TxId (GenTx (CardanoBlock StandardCrypto))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
Consensus.HardForkGenTxId
    (NS WrapGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto)
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
Consensus.OneEraGenTxId (NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
-> NS WrapGenTxId (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
    ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS WrapGenTxId (CardanoShelleyEras StandardCrypto)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
    ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
    ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS
  WrapGenTxId
  '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
    ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS WrapGenTxId '[ShelleyBlock (Praos StandardCrypto) ConwayEra]
-> NS
     WrapGenTxId
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (WrapGenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> NS WrapGenTxId '[ShelleyBlock (Praos StandardCrypto) ConwayEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (GenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> WrapGenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall blk. GenTxId blk -> WrapGenTxId blk
Consensus.WrapGenTxId GenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra)
txid')))))))))
 where
  txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardConwayBlock)
  txid' :: GenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra)
txid' = TxId -> GenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
Consensus.ShelleyTxId (TxId -> GenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra))
-> TxId -> GenTxId (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
toShelleyTxId TxId
txid

-- ----------------------------------------------------------------------------
-- Transaction validation errors in the context of eras and consensus modes
--

-- | The transaction validations errors that can occur from trying to submit a
-- transaction to a local node. The errors are specific to an era.
data TxValidationError era where
  ByronTxValidationError
    :: Consensus.ApplyTxErr Consensus.ByronBlock
    -> TxValidationError era
  ShelleyTxValidationError
    :: ShelleyBasedEra era
    -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
    -> TxValidationError era

deriving instance Generic (TxValidationError era)

instance Show (TxValidationError era) where
  showsPrec :: Int -> TxValidationError era -> ShowS
showsPrec Int
p = \case
    ByronTxValidationError ApplyTxErr ByronBlock
err ->
      Bool -> ShowS -> ShowS
showParen
        (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ByronTxValidationError "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ApplyMempoolPayloadErr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ApplyMempoolPayloadErr
ApplyTxErr ByronBlock
err
        )
    ShelleyTxValidationError ShelleyBasedEra era
sbe ApplyTxErr
  (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
err ->
      ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ShowS) -> ShowS
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => ShowS) -> ShowS)
-> (ShelleyBasedEraConstraints era => ShowS) -> ShowS
forall a b. (a -> b) -> a -> b
$
        Bool -> ShowS -> ShowS
showParen
          (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          ( String -> ShowS
showString String
"ShelleyTxValidationError "
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ShelleyBasedEra era -> String
forall a. Show a => a -> String
show ShelleyBasedEra era
sbe)
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ApplyTxError (ShelleyLedgerEra era) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ApplyTxError (ShelleyLedgerEra era)
ApplyTxErr
  (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
err
          )

instance ToJSON (TxValidationError era) where
  toJSON :: TxValidationError era -> Value
toJSON = \case
    ByronTxValidationError ApplyTxErr ByronBlock
err ->
      [Pair] -> Value
Aeson.object
        [ Key
"kind" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"ByronTxValidationError"
        , Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ApplyMempoolPayloadErr -> Value
forall a. ToJSON a => a -> Value
toJSON ApplyMempoolPayloadErr
ApplyTxErr ByronBlock
err
        ]
    ShelleyTxValidationError ShelleyBasedEra era
sbe ApplyTxErr
  (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
err ->
      ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Value) -> Value
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Value) -> Value)
-> (ShelleyBasedEraConstraints era => Value) -> Value
forall a b. (a -> b) -> a -> b
$
        [Pair] -> Value
Aeson.object
          [ Key
"kind" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"ShelleyTxValidationError"
          , Key
"era" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Text
Text.pack (ShelleyBasedEra era -> String
forall a. Show a => a -> String
show ShelleyBasedEra era
sbe))
          , Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> Value
forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> Value
appTxErrToJson ShelleyBasedEra era
sbe ApplyTxErr
  (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
err
          ]

appTxErrToJson
  :: ()
  => ShelleyBasedEra era
  -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
  -> Aeson.Value
appTxErrToJson :: forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> Value
appTxErrToJson ShelleyBasedEra era
w ApplyTxErr
  (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
e = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Value) -> Value
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
w ((ShelleyBasedEraConstraints era => Value) -> Value)
-> (ShelleyBasedEraConstraints era => Value) -> Value
forall a b. (a -> b) -> a -> b
$ ApplyTxError (ShelleyLedgerEra era) -> Value
forall a. ToJSON a => a -> Value
toJSON ApplyTxError (ShelleyLedgerEra era)
ApplyTxErr
  (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
e

-- | A 'TxValidationError' in one of the eras supported by a given protocol
-- mode.
--
-- This is used in the LocalStateQuery protocol.
data TxValidationErrorInCardanoMode where
  TxValidationErrorInCardanoMode
    :: ()
    => TxValidationError era
    -> TxValidationErrorInCardanoMode
  TxValidationEraMismatch
    :: ()
    => EraMismatch
    -> TxValidationErrorInCardanoMode

deriving instance Show TxValidationErrorInCardanoMode

instance ToJSON TxValidationErrorInCardanoMode where
  toJSON :: TxValidationErrorInCardanoMode -> Value
toJSON = \case
    TxValidationErrorInCardanoMode TxValidationError era
err ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"TxValidationErrorInCardanoMode"
        , Key
"contents" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxValidationError era -> Value
forall a. ToJSON a => a -> Value
toJSON TxValidationError era
err
        ]
    TxValidationEraMismatch EraMismatch
err ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"TxValidationEraMismatch"
        , Key
"contents" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON (EraMismatch -> Text
forall a. Show a => a -> Text
textShow EraMismatch
err)
        ]

fromConsensusApplyTxErr
  :: ()
  => Consensus.CardanoBlock StandardCrypto ~ block
  => Consensus.ApplyTxErr block
  -> TxValidationErrorInCardanoMode
fromConsensusApplyTxErr :: forall block.
(CardanoBlock StandardCrypto ~ block) =>
ApplyTxErr block -> TxValidationErrorInCardanoMode
fromConsensusApplyTxErr = \case
  Consensus.ApplyTxErrByron ApplyTxErr ByronBlock
err ->
    TxValidationError Any -> TxValidationErrorInCardanoMode
forall era. TxValidationError era -> TxValidationErrorInCardanoMode
TxValidationErrorInCardanoMode (TxValidationError Any -> TxValidationErrorInCardanoMode)
-> TxValidationError Any -> TxValidationErrorInCardanoMode
forall a b. (a -> b) -> a -> b
$ ApplyTxErr ByronBlock -> TxValidationError Any
forall era. ApplyTxErr ByronBlock -> TxValidationError era
ByronTxValidationError ApplyTxErr ByronBlock
err
  Consensus.ApplyTxErrShelley ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
err ->
    TxValidationError ShelleyEra -> TxValidationErrorInCardanoMode
forall era. TxValidationError era -> TxValidationErrorInCardanoMode
TxValidationErrorInCardanoMode (TxValidationError ShelleyEra -> TxValidationErrorInCardanoMode)
-> TxValidationError ShelleyEra -> TxValidationErrorInCardanoMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra
-> ApplyTxErr
     (ShelleyBlock
        (ConsensusProtocol ShelleyEra) (ShelleyLedgerEra ShelleyEra))
-> TxValidationError ShelleyEra
forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> TxValidationError era
ShelleyTxValidationError ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
ApplyTxErr
  (ShelleyBlock
     (ConsensusProtocol ShelleyEra) (ShelleyLedgerEra ShelleyEra))
err
  Consensus.ApplyTxErrAllegra ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
err ->
    TxValidationError AllegraEra -> TxValidationErrorInCardanoMode
forall era. TxValidationError era -> TxValidationErrorInCardanoMode
TxValidationErrorInCardanoMode (TxValidationError AllegraEra -> TxValidationErrorInCardanoMode)
-> TxValidationError AllegraEra -> TxValidationErrorInCardanoMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra
-> ApplyTxErr
     (ShelleyBlock
        (ConsensusProtocol AllegraEra) (ShelleyLedgerEra AllegraEra))
-> TxValidationError AllegraEra
forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> TxValidationError era
ShelleyTxValidationError ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
ApplyTxErr
  (ShelleyBlock
     (ConsensusProtocol AllegraEra) (ShelleyLedgerEra AllegraEra))
err
  Consensus.ApplyTxErrMary ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) MaryEra)
err ->
    TxValidationError MaryEra -> TxValidationErrorInCardanoMode
forall era. TxValidationError era -> TxValidationErrorInCardanoMode
TxValidationErrorInCardanoMode (TxValidationError MaryEra -> TxValidationErrorInCardanoMode)
-> TxValidationError MaryEra -> TxValidationErrorInCardanoMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra
-> ApplyTxErr
     (ShelleyBlock
        (ConsensusProtocol MaryEra) (ShelleyLedgerEra MaryEra))
-> TxValidationError MaryEra
forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> TxValidationError era
ShelleyTxValidationError ShelleyBasedEra MaryEra
ShelleyBasedEraMary ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) MaryEra)
ApplyTxErr
  (ShelleyBlock
     (ConsensusProtocol MaryEra) (ShelleyLedgerEra MaryEra))
err
  Consensus.ApplyTxErrAlonzo ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
err ->
    TxValidationError AlonzoEra -> TxValidationErrorInCardanoMode
forall era. TxValidationError era -> TxValidationErrorInCardanoMode
TxValidationErrorInCardanoMode (TxValidationError AlonzoEra -> TxValidationErrorInCardanoMode)
-> TxValidationError AlonzoEra -> TxValidationErrorInCardanoMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra
-> ApplyTxErr
     (ShelleyBlock
        (ConsensusProtocol AlonzoEra) (ShelleyLedgerEra AlonzoEra))
-> TxValidationError AlonzoEra
forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> TxValidationError era
ShelleyTxValidationError ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo ApplyTxErr (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
ApplyTxErr
  (ShelleyBlock
     (ConsensusProtocol AlonzoEra) (ShelleyLedgerEra AlonzoEra))
err
  Consensus.ApplyTxErrBabbage ApplyTxErr (ShelleyBlock (Praos StandardCrypto) BabbageEra)
err ->
    TxValidationError BabbageEra -> TxValidationErrorInCardanoMode
forall era. TxValidationError era -> TxValidationErrorInCardanoMode
TxValidationErrorInCardanoMode (TxValidationError BabbageEra -> TxValidationErrorInCardanoMode)
-> TxValidationError BabbageEra -> TxValidationErrorInCardanoMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra
-> ApplyTxErr
     (ShelleyBlock
        (ConsensusProtocol BabbageEra) (ShelleyLedgerEra BabbageEra))
-> TxValidationError BabbageEra
forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> TxValidationError era
ShelleyTxValidationError ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage ApplyTxErr (ShelleyBlock (Praos StandardCrypto) BabbageEra)
ApplyTxErr
  (ShelleyBlock
     (ConsensusProtocol BabbageEra) (ShelleyLedgerEra BabbageEra))
err
  Consensus.ApplyTxErrConway ApplyTxErr (ShelleyBlock (Praos StandardCrypto) ConwayEra)
err ->
    TxValidationError ConwayEra -> TxValidationErrorInCardanoMode
forall era. TxValidationError era -> TxValidationErrorInCardanoMode
TxValidationErrorInCardanoMode (TxValidationError ConwayEra -> TxValidationErrorInCardanoMode)
-> TxValidationError ConwayEra -> TxValidationErrorInCardanoMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra
-> ApplyTxErr
     (ShelleyBlock
        (ConsensusProtocol ConwayEra) (ShelleyLedgerEra ConwayEra))
-> TxValidationError ConwayEra
forall era.
ShelleyBasedEra era
-> ApplyTxErr
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
-> TxValidationError era
ShelleyTxValidationError ShelleyBasedEra ConwayEra
ShelleyBasedEraConway ApplyTxErr (ShelleyBlock (Praos StandardCrypto) ConwayEra)
ApplyTxErr
  (ShelleyBlock
     (ConsensusProtocol ConwayEra) (ShelleyLedgerEra ConwayEra))
err
  Consensus.ApplyTxErrWrongEra EraMismatch
err ->
    EraMismatch -> TxValidationErrorInCardanoMode
TxValidationEraMismatch EraMismatch
err