{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Ouroboros.Consensus.Shelley.Eras (
AllegraEra
, AlonzoEra
, BabbageEra
, ConwayEra
, MaryEra
, ShelleyEra
, StandardAllegra
, StandardAlonzo
, StandardBabbage
, StandardConway
, StandardMary
, StandardShelley
, ConwayEraGovDict (..)
, ShelleyBasedEra (..)
, WrapTx (..)
, EraCrypto
, isBeforeConway
, StandardCrypto
) where
import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Allegra.Translation ()
import Cardano.Ledger.Alonzo (AlonzoEra)
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
import qualified Cardano.Ledger.Alonzo.Translation as Alonzo
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
import qualified Cardano.Ledger.Api.Era as L
import Cardano.Ledger.Babbage (BabbageEra)
import qualified Cardano.Ledger.Babbage.Rules as Babbage
import qualified Cardano.Ledger.Babbage.Translation as Babbage
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Conway (ConwayEra)
import qualified Cardano.Ledger.Conway.Governance as CG
import qualified Cardano.Ledger.Conway.Rules as Conway
import qualified Cardano.Ledger.Conway.Rules as SL
(ConwayLedgerPredFailure (..))
import qualified Cardano.Ledger.Conway.Translation as Conway
import Cardano.Ledger.Core as Core
import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Ledger.Keys (DSignable, Hash)
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Translation ()
import Cardano.Ledger.Shelley (ShelleyEra)
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Ledger.Shelley.Core as Core
import qualified Cardano.Ledger.Shelley.LedgerState as SL
import qualified Cardano.Ledger.Shelley.Rules as SL
import qualified Cardano.Ledger.Shelley.Transition as SL
import qualified Cardano.Protocol.TPraos.API as SL
import Control.Monad.Except
import Control.State.Transition (PredicateFailure)
import Data.Data (Proxy (Proxy))
import Data.List.NonEmpty (NonEmpty ((:|)))
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Ledger.SupportsMempool
(WhetherToIntervene (..))
import qualified Ouroboros.Consensus.Protocol.Praos as Praos
type StandardShelley = ShelleyEra StandardCrypto
type StandardAllegra = AllegraEra StandardCrypto
type StandardMary = MaryEra StandardCrypto
type StandardAlonzo = AlonzoEra StandardCrypto
type StandardBabbage = BabbageEra StandardCrypto
type StandardConway = ConwayEra StandardCrypto
class ( Core.EraSegWits era
, Core.EraGov era
, SL.ApplyTx era
, SL.ApplyBlock era
, SL.EraTransition era
, SL.GetLedgerView era
, NoThunks (SL.StashedAVVMAddresses era)
, EncCBOR (SL.StashedAVVMAddresses era)
, DecCBOR (SL.StashedAVVMAddresses era)
, Show (SL.StashedAVVMAddresses era)
, Eq (SL.StashedAVVMAddresses era)
, DecCBOR (PredicateFailure (EraRule "LEDGER" era))
, EncCBOR (PredicateFailure (EraRule "LEDGER" era))
, DecCBOR (PredicateFailure (EraRule "UTXOW" era))
, EncCBOR (PredicateFailure (EraRule "UTXOW" era))
, DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody)
, NoThunks (PredicateFailure (Core.EraRule "BBODY" era))
, NoThunks (Core.TranslationContext era)
) => ShelleyBasedEra era where
applyShelleyBasedTx ::
SL.Globals
-> SL.LedgerEnv era
-> SL.LedgerState era
-> WhetherToIntervene
-> Core.Tx era
-> Except
(SL.ApplyTxError era)
( SL.LedgerState era
, SL.Validated (Core.Tx era)
)
getConwayEraGovDict :: proxy era -> Maybe (ConwayEraGovDict era)
data ConwayEraGovDict era where
ConwayEraGovDict :: CG.ConwayEraGov era => ConwayEraGovDict era
isBeforeConway :: forall era. L.Era era => Proxy era -> Bool
isBeforeConway :: forall era. Era era => Proxy era -> Bool
isBeforeConway Proxy era
_ =
forall era. Era era => Version
L.eraProtVerLow @era Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< forall era. Era era => Version
L.eraProtVerLow @(L.ConwayEra (L.EraCrypto era))
defaultApplyShelleyBasedTx ::
ShelleyBasedEra era
=> SL.Globals
-> SL.LedgerEnv era
-> SL.LedgerState era
-> WhetherToIntervene
-> Core.Tx era
-> Except
(SL.ApplyTxError era)
( SL.LedgerState era
, SL.Validated (Core.Tx era)
)
defaultApplyShelleyBasedTx :: forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx era))
defaultApplyShelleyBasedTx Globals
globals LedgerEnv era
ledgerEnv LedgerState era
mempoolState WhetherToIntervene
_wti Tx era
tx = do
Globals
-> LedgerEnv era
-> LedgerState era
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx era))
forall era (m :: * -> *).
(ApplyTx era, MonadError (ApplyTxError era) m) =>
Globals
-> MempoolEnv era
-> MempoolState era
-> Tx era
-> m (MempoolState era, Validated (Tx era))
forall (m :: * -> *).
MonadError (ApplyTxError era) m =>
Globals
-> LedgerEnv era
-> LedgerState era
-> Tx era
-> m (LedgerState era, Validated (Tx era))
SL.applyTx
Globals
globals
LedgerEnv era
ledgerEnv
LedgerState era
mempoolState
Tx era
tx
defaultGetConwayEraGovDict :: proxy era -> Maybe (ConwayEraGovDict era)
defaultGetConwayEraGovDict :: forall (proxy :: * -> *) era.
proxy era -> Maybe (ConwayEraGovDict era)
defaultGetConwayEraGovDict proxy era
_ = Maybe (ConwayEraGovDict era)
forall a. Maybe a
Nothing
instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
=> ShelleyBasedEra (ShelleyEra c) where
applyShelleyBasedTx :: Globals
-> LedgerEnv (ShelleyEra c)
-> LedgerState (ShelleyEra c)
-> WhetherToIntervene
-> Tx (ShelleyEra c)
-> Except
(ApplyTxError (ShelleyEra c))
(LedgerState (ShelleyEra c), Validated (Tx (ShelleyEra c)))
applyShelleyBasedTx = Globals
-> LedgerEnv (ShelleyEra c)
-> LedgerState (ShelleyEra c)
-> WhetherToIntervene
-> Tx (ShelleyEra c)
-> Except
(ApplyTxError (ShelleyEra c))
(LedgerState (ShelleyEra c), Validated (Tx (ShelleyEra c)))
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx era))
defaultApplyShelleyBasedTx
getConwayEraGovDict :: forall (proxy :: * -> *).
proxy (ShelleyEra c) -> Maybe (ConwayEraGovDict (ShelleyEra c))
getConwayEraGovDict = proxy (ShelleyEra c) -> Maybe (ConwayEraGovDict (ShelleyEra c))
forall (proxy :: * -> *) era.
proxy era -> Maybe (ConwayEraGovDict era)
defaultGetConwayEraGovDict
instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
=> ShelleyBasedEra (AllegraEra c) where
applyShelleyBasedTx :: Globals
-> LedgerEnv (AllegraEra c)
-> LedgerState (AllegraEra c)
-> WhetherToIntervene
-> Tx (AllegraEra c)
-> Except
(ApplyTxError (AllegraEra c))
(LedgerState (AllegraEra c), Validated (Tx (AllegraEra c)))
applyShelleyBasedTx = Globals
-> LedgerEnv (AllegraEra c)
-> LedgerState (AllegraEra c)
-> WhetherToIntervene
-> Tx (AllegraEra c)
-> Except
(ApplyTxError (AllegraEra c))
(LedgerState (AllegraEra c), Validated (Tx (AllegraEra c)))
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx era))
defaultApplyShelleyBasedTx
getConwayEraGovDict :: forall (proxy :: * -> *).
proxy (AllegraEra c) -> Maybe (ConwayEraGovDict (AllegraEra c))
getConwayEraGovDict = proxy (AllegraEra c) -> Maybe (ConwayEraGovDict (AllegraEra c))
forall (proxy :: * -> *) era.
proxy era -> Maybe (ConwayEraGovDict era)
defaultGetConwayEraGovDict
instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
=> ShelleyBasedEra (MaryEra c) where
applyShelleyBasedTx :: Globals
-> LedgerEnv (MaryEra c)
-> LedgerState (MaryEra c)
-> WhetherToIntervene
-> Tx (MaryEra c)
-> Except
(ApplyTxError (MaryEra c))
(LedgerState (MaryEra c), Validated (Tx (MaryEra c)))
applyShelleyBasedTx = Globals
-> LedgerEnv (MaryEra c)
-> LedgerState (MaryEra c)
-> WhetherToIntervene
-> Tx (MaryEra c)
-> Except
(ApplyTxError (MaryEra c))
(LedgerState (MaryEra c), Validated (Tx (MaryEra c)))
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx era))
defaultApplyShelleyBasedTx
getConwayEraGovDict :: forall (proxy :: * -> *).
proxy (MaryEra c) -> Maybe (ConwayEraGovDict (MaryEra c))
getConwayEraGovDict = proxy (MaryEra c) -> Maybe (ConwayEraGovDict (MaryEra c))
forall (proxy :: * -> *) era.
proxy era -> Maybe (ConwayEraGovDict era)
defaultGetConwayEraGovDict
instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
=> ShelleyBasedEra (AlonzoEra c) where
applyShelleyBasedTx :: Globals
-> LedgerEnv (AlonzoEra c)
-> LedgerState (AlonzoEra c)
-> WhetherToIntervene
-> Tx (AlonzoEra c)
-> Except
(ApplyTxError (AlonzoEra c))
(LedgerState (AlonzoEra c), Validated (Tx (AlonzoEra c)))
applyShelleyBasedTx = Globals
-> LedgerEnv (AlonzoEra c)
-> LedgerState (AlonzoEra c)
-> WhetherToIntervene
-> Tx (AlonzoEra c)
-> Except
(ApplyTxError (AlonzoEra c))
(LedgerState (AlonzoEra c), Validated (Tx (AlonzoEra c)))
Globals
-> LedgerEnv (AlonzoEra c)
-> LedgerState (AlonzoEra c)
-> WhetherToIntervene
-> AlonzoTx (AlonzoEra c)
-> Except
(ApplyTxError (AlonzoEra c))
(LedgerState (AlonzoEra c), Validated (AlonzoTx (AlonzoEra c)))
forall era.
(ShelleyBasedEra era, SupportsTwoPhaseValidation era,
Tx era ~ AlonzoTx era) =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> AlonzoTx era
-> Except
(ApplyTxError era) (LedgerState era, Validated (AlonzoTx era))
applyAlonzoBasedTx
getConwayEraGovDict :: forall (proxy :: * -> *).
proxy (AlonzoEra c) -> Maybe (ConwayEraGovDict (AlonzoEra c))
getConwayEraGovDict = proxy (AlonzoEra c) -> Maybe (ConwayEraGovDict (AlonzoEra c))
forall (proxy :: * -> *) era.
proxy era -> Maybe (ConwayEraGovDict era)
defaultGetConwayEraGovDict
instance (Praos.PraosCrypto c) => ShelleyBasedEra (BabbageEra c) where
applyShelleyBasedTx :: Globals
-> LedgerEnv (BabbageEra c)
-> LedgerState (BabbageEra c)
-> WhetherToIntervene
-> Tx (BabbageEra c)
-> Except
(ApplyTxError (BabbageEra c))
(LedgerState (BabbageEra c), Validated (Tx (BabbageEra c)))
applyShelleyBasedTx = Globals
-> LedgerEnv (BabbageEra c)
-> LedgerState (BabbageEra c)
-> WhetherToIntervene
-> Tx (BabbageEra c)
-> Except
(ApplyTxError (BabbageEra c))
(LedgerState (BabbageEra c), Validated (Tx (BabbageEra c)))
Globals
-> LedgerEnv (BabbageEra c)
-> LedgerState (BabbageEra c)
-> WhetherToIntervene
-> AlonzoTx (BabbageEra c)
-> Except
(ApplyTxError (BabbageEra c))
(LedgerState (BabbageEra c), Validated (AlonzoTx (BabbageEra c)))
forall era.
(ShelleyBasedEra era, SupportsTwoPhaseValidation era,
Tx era ~ AlonzoTx era) =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> AlonzoTx era
-> Except
(ApplyTxError era) (LedgerState era, Validated (AlonzoTx era))
applyAlonzoBasedTx
getConwayEraGovDict :: forall (proxy :: * -> *).
proxy (BabbageEra c) -> Maybe (ConwayEraGovDict (BabbageEra c))
getConwayEraGovDict = proxy (BabbageEra c) -> Maybe (ConwayEraGovDict (BabbageEra c))
forall (proxy :: * -> *) era.
proxy era -> Maybe (ConwayEraGovDict era)
defaultGetConwayEraGovDict
instance (Praos.PraosCrypto c) => ShelleyBasedEra (ConwayEra c) where
applyShelleyBasedTx :: Globals
-> LedgerEnv (ConwayEra c)
-> LedgerState (ConwayEra c)
-> WhetherToIntervene
-> Tx (ConwayEra c)
-> Except
(ApplyTxError (ConwayEra c))
(LedgerState (ConwayEra c), Validated (Tx (ConwayEra c)))
applyShelleyBasedTx = Globals
-> LedgerEnv (ConwayEra c)
-> LedgerState (ConwayEra c)
-> WhetherToIntervene
-> Tx (ConwayEra c)
-> Except
(ApplyTxError (ConwayEra c))
(LedgerState (ConwayEra c), Validated (Tx (ConwayEra c)))
Globals
-> LedgerEnv (ConwayEra c)
-> LedgerState (ConwayEra c)
-> WhetherToIntervene
-> AlonzoTx (ConwayEra c)
-> Except
(ApplyTxError (ConwayEra c))
(LedgerState (ConwayEra c), Validated (AlonzoTx (ConwayEra c)))
forall era.
(ShelleyBasedEra era, SupportsTwoPhaseValidation era,
Tx era ~ AlonzoTx era) =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> AlonzoTx era
-> Except
(ApplyTxError era) (LedgerState era, Validated (AlonzoTx era))
applyAlonzoBasedTx
getConwayEraGovDict :: forall (proxy :: * -> *).
proxy (ConwayEra c) -> Maybe (ConwayEraGovDict (ConwayEra c))
getConwayEraGovDict proxy (ConwayEra c)
_ = ConwayEraGovDict (ConwayEra c)
-> Maybe (ConwayEraGovDict (ConwayEra c))
forall a. a -> Maybe a
Just ConwayEraGovDict (ConwayEra c)
forall era. ConwayEraGov era => ConwayEraGovDict era
ConwayEraGovDict
applyAlonzoBasedTx :: forall era.
( ShelleyBasedEra era,
SupportsTwoPhaseValidation era,
Core.Tx era ~ Alonzo.AlonzoTx era
) =>
Globals ->
SL.LedgerEnv era ->
SL.LedgerState era ->
WhetherToIntervene ->
Alonzo.AlonzoTx era ->
Except
(SL.ApplyTxError era)
( SL.LedgerState era,
SL.Validated (Alonzo.AlonzoTx era)
)
applyAlonzoBasedTx :: forall era.
(ShelleyBasedEra era, SupportsTwoPhaseValidation era,
Tx era ~ AlonzoTx era) =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> AlonzoTx era
-> Except
(ApplyTxError era) (LedgerState era, Validated (AlonzoTx era))
applyAlonzoBasedTx Globals
globals LedgerEnv era
ledgerEnv LedgerState era
mempoolState WhetherToIntervene
wti AlonzoTx era
tx = do
(LedgerState era
mempoolState', Validated (AlonzoTx era)
vtx) <-
(ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
-> (ApplyTxError era
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era)))
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
forall a.
ExceptT (ApplyTxError era) Identity a
-> (ApplyTxError era -> ExceptT (ApplyTxError era) Identity a)
-> ExceptT (ApplyTxError era) Identity a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ApplyTxError era
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
handler)
(ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era)))
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
forall a b. (a -> b) -> a -> b
$ Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx era))
defaultApplyShelleyBasedTx
Globals
globals
LedgerEnv era
ledgerEnv
LedgerState era
mempoolState
WhetherToIntervene
wti
Tx era
AlonzoTx era
intervenedTx
(LedgerState era, Validated (AlonzoTx era))
-> Except
(ApplyTxError era) (LedgerState era, Validated (AlonzoTx era))
forall a. a -> ExceptT (ApplyTxError era) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerState era
mempoolState', Validated (AlonzoTx era)
vtx)
where
intervenedTx :: AlonzoTx era
intervenedTx = case WhetherToIntervene
wti of
WhetherToIntervene
DoNotIntervene -> AlonzoTx era
tx { Alonzo.isValid = Alonzo.IsValid True }
WhetherToIntervene
Intervene -> AlonzoTx era
tx
handler :: ApplyTxError era
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
handler ApplyTxError era
e = case (WhetherToIntervene
wti, ApplyTxError era
e) of
(WhetherToIntervene
DoNotIntervene, SL.ApplyTxError (PredicateFailure (EraRule "LEDGER" era)
err :| []))
| Proxy era -> PredicateFailure (EraRule "LEDGER" era) -> Bool
forall era (proxy :: * -> *).
SupportsTwoPhaseValidation era =>
proxy era -> PredicateFailure (EraRule "LEDGER" era) -> Bool
forall (proxy :: * -> *).
proxy era -> PredicateFailure (EraRule "LEDGER" era) -> Bool
isIncorrectClaimedFlag (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @era) PredicateFailure (EraRule "LEDGER" era)
err
->
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> ExceptT
(ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx era))
defaultApplyShelleyBasedTx
Globals
globals
LedgerEnv era
ledgerEnv
LedgerState era
mempoolState
WhetherToIntervene
wti
AlonzoTx era
tx{Alonzo.isValid = Alonzo.IsValid False}
(WhetherToIntervene, ApplyTxError era)
_ -> ApplyTxError era
-> Except
(ApplyTxError era) (LedgerState era, Validated (AlonzoTx era))
forall a. ApplyTxError era -> ExceptT (ApplyTxError era) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ApplyTxError era
e
class SupportsTwoPhaseValidation era where
isIncorrectClaimedFlag :: proxy era -> SL.PredicateFailure (Core.EraRule "LEDGER" era) -> Bool
instance SupportsTwoPhaseValidation (AlonzoEra c) where
isIncorrectClaimedFlag :: forall (proxy :: * -> *).
proxy (AlonzoEra c)
-> PredicateFailure (EraRule "LEDGER" (AlonzoEra c)) -> Bool
isIncorrectClaimedFlag proxy (AlonzoEra c)
_ = \case
SL.UtxowFailure
( Alonzo.ShelleyInAlonzoUtxowPredFailure
( SL.UtxoFailure
( Alonzo.UtxosFailure
( Alonzo.ValidationTagMismatch
(Alonzo.IsValid Bool
_claimedFlag)
TagMismatchDescription
_validationErrs
)
)
)
) ->
Bool
True
PredicateFailure (EraRule "LEDGER" (AlonzoEra c))
_ -> Bool
False
instance SupportsTwoPhaseValidation (BabbageEra c) where
isIncorrectClaimedFlag :: forall (proxy :: * -> *).
proxy (BabbageEra c)
-> PredicateFailure (EraRule "LEDGER" (BabbageEra c)) -> Bool
isIncorrectClaimedFlag proxy (BabbageEra c)
_ = \case
SL.UtxowFailure
( Babbage.AlonzoInBabbageUtxowPredFailure
( Alonzo.ShelleyInAlonzoUtxowPredFailure
( SL.UtxoFailure
( Babbage.AlonzoInBabbageUtxoPredFailure
( Alonzo.UtxosFailure
( Alonzo.ValidationTagMismatch
(Alonzo.IsValid Bool
_claimedFlag)
TagMismatchDescription
_validationErrs
)
)
)
)
)
) -> Bool
True
SL.UtxowFailure
( Babbage.UtxoFailure
( Babbage.AlonzoInBabbageUtxoPredFailure
( Alonzo.UtxosFailure
( Alonzo.ValidationTagMismatch
(Alonzo.IsValid Bool
_claimedFlag)
TagMismatchDescription
_validationErrs
)
)
)
) -> Bool
True
PredicateFailure (EraRule "LEDGER" (BabbageEra c))
_ -> Bool
False
instance SupportsTwoPhaseValidation (ConwayEra c) where
isIncorrectClaimedFlag :: forall (proxy :: * -> *).
proxy (ConwayEra c)
-> PredicateFailure (EraRule "LEDGER" (ConwayEra c)) -> Bool
isIncorrectClaimedFlag proxy (ConwayEra c)
_ = \case
SL.ConwayUtxowFailure
( Conway.UtxoFailure
( Conway.UtxosFailure
( Conway.ValidationTagMismatch
(Alonzo.IsValid Bool
_claimedFlag)
TagMismatchDescription
_validationErrs
)
)
) -> Bool
True
PredicateFailure (EraRule "LEDGER" (ConwayEra c))
_ -> Bool
False
newtype WrapTx era = WrapTx {forall era. WrapTx era -> Tx era
unwrapTx :: Core.Tx era}
instance ShelleyBasedEra (AllegraEra c) => Core.TranslateEra (AllegraEra c) WrapTx where
type TranslationError (AllegraEra c) WrapTx = Core.TranslationError (AllegraEra c) SL.ShelleyTx
translateEra :: TranslationContext (AllegraEra c)
-> WrapTx (PreviousEra (AllegraEra c))
-> Except
(TranslationError (AllegraEra c) WrapTx) (WrapTx (AllegraEra c))
translateEra TranslationContext (AllegraEra c)
ctxt = (ShelleyTx (AllegraEra c) -> WrapTx (AllegraEra c))
-> ExceptT DecoderError Identity (ShelleyTx (AllegraEra c))
-> ExceptT DecoderError Identity (WrapTx (AllegraEra c))
forall a b.
(a -> b)
-> ExceptT DecoderError Identity a
-> ExceptT DecoderError Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx (AllegraEra c) -> WrapTx (AllegraEra c)
ShelleyTx (AllegraEra c) -> WrapTx (AllegraEra c)
forall era. Tx era -> WrapTx era
WrapTx (ExceptT DecoderError Identity (ShelleyTx (AllegraEra c))
-> ExceptT DecoderError Identity (WrapTx (AllegraEra c)))
-> (WrapTx (ShelleyEra c)
-> ExceptT DecoderError Identity (ShelleyTx (AllegraEra c)))
-> WrapTx (ShelleyEra c)
-> ExceptT DecoderError Identity (WrapTx (AllegraEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext (AllegraEra c)
-> ShelleyTx (PreviousEra (AllegraEra c))
-> Except
(TranslationError (AllegraEra c) ShelleyTx)
(ShelleyTx (AllegraEra c))
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
Core.translateEra TranslationContext (AllegraEra c)
ctxt (ShelleyTx (ShelleyEra c)
-> ExceptT DecoderError Identity (ShelleyTx (AllegraEra c)))
-> (WrapTx (ShelleyEra c) -> ShelleyTx (ShelleyEra c))
-> WrapTx (ShelleyEra c)
-> ExceptT DecoderError Identity (ShelleyTx (AllegraEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapTx (ShelleyEra c) -> Tx (ShelleyEra c)
WrapTx (ShelleyEra c) -> ShelleyTx (ShelleyEra c)
forall era. WrapTx era -> Tx era
unwrapTx
instance ShelleyBasedEra (MaryEra c) => Core.TranslateEra (MaryEra c) WrapTx where
type TranslationError (MaryEra c) WrapTx = Core.TranslationError (MaryEra c) SL.ShelleyTx
translateEra :: TranslationContext (MaryEra c)
-> WrapTx (PreviousEra (MaryEra c))
-> Except
(TranslationError (MaryEra c) WrapTx) (WrapTx (MaryEra c))
translateEra TranslationContext (MaryEra c)
ctxt = (ShelleyTx (MaryEra c) -> WrapTx (MaryEra c))
-> ExceptT DecoderError Identity (ShelleyTx (MaryEra c))
-> ExceptT DecoderError Identity (WrapTx (MaryEra c))
forall a b.
(a -> b)
-> ExceptT DecoderError Identity a
-> ExceptT DecoderError Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx (MaryEra c) -> WrapTx (MaryEra c)
ShelleyTx (MaryEra c) -> WrapTx (MaryEra c)
forall era. Tx era -> WrapTx era
WrapTx (ExceptT DecoderError Identity (ShelleyTx (MaryEra c))
-> ExceptT DecoderError Identity (WrapTx (MaryEra c)))
-> (WrapTx (AllegraEra c)
-> ExceptT DecoderError Identity (ShelleyTx (MaryEra c)))
-> WrapTx (AllegraEra c)
-> ExceptT DecoderError Identity (WrapTx (MaryEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslationContext (MaryEra c)
-> ShelleyTx (PreviousEra (MaryEra c))
-> Except
(TranslationError (MaryEra c) ShelleyTx) (ShelleyTx (MaryEra c))
forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
Core.translateEra TranslationContext (MaryEra c)
ctxt (ShelleyTx (AllegraEra c)
-> ExceptT DecoderError Identity (ShelleyTx (MaryEra c)))
-> (WrapTx (AllegraEra c) -> ShelleyTx (AllegraEra c))
-> WrapTx (AllegraEra c)
-> ExceptT DecoderError Identity (ShelleyTx (MaryEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapTx (AllegraEra c) -> Tx (AllegraEra c)
WrapTx (AllegraEra c) -> ShelleyTx (AllegraEra c)
forall era. WrapTx era -> Tx era
unwrapTx
instance ShelleyBasedEra (AlonzoEra c) => Core.TranslateEra (AlonzoEra c) WrapTx where
type TranslationError (AlonzoEra c) WrapTx = Core.TranslationError (AlonzoEra c) Alonzo.Tx
translateEra :: TranslationContext (AlonzoEra c)
-> WrapTx (PreviousEra (AlonzoEra c))
-> Except
(TranslationError (AlonzoEra c) WrapTx) (WrapTx (AlonzoEra c))
translateEra TranslationContext (AlonzoEra c)
ctxt =
(Tx (AlonzoEra c) -> WrapTx (AlonzoEra c))
-> ExceptT DecoderError Identity (Tx (AlonzoEra c))
-> ExceptT DecoderError Identity (WrapTx (AlonzoEra c))
forall a b.
(a -> b)
-> ExceptT DecoderError Identity a
-> ExceptT DecoderError Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tx (AlonzoEra c) -> WrapTx (AlonzoEra c)
AlonzoTx (AlonzoEra c) -> WrapTx (AlonzoEra c)
forall era. Tx era -> WrapTx era
WrapTx (AlonzoTx (AlonzoEra c) -> WrapTx (AlonzoEra c))
-> (Tx (AlonzoEra c) -> AlonzoTx (AlonzoEra c))
-> Tx (AlonzoEra c)
-> WrapTx (AlonzoEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (AlonzoEra c) -> Tx (AlonzoEra c)
Tx (AlonzoEra c) -> AlonzoTx (AlonzoEra c)
forall era. Tx era -> Tx era
Alonzo.unTx)
(ExceptT DecoderError Identity (Tx (AlonzoEra c))
-> ExceptT DecoderError Identity (WrapTx (AlonzoEra c)))
-> (WrapTx (MaryEra c)
-> ExceptT DecoderError Identity (Tx (AlonzoEra c)))
-> WrapTx (MaryEra c)
-> ExceptT DecoderError Identity (WrapTx (AlonzoEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
Core.translateEra @(AlonzoEra c) TranslationContext (AlonzoEra c)
ctxt
(Tx (MaryEra c)
-> ExceptT DecoderError Identity (Tx (AlonzoEra c)))
-> (WrapTx (MaryEra c) -> Tx (MaryEra c))
-> WrapTx (MaryEra c)
-> ExceptT DecoderError Identity (Tx (AlonzoEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (MaryEra c) -> Tx (MaryEra c)
ShelleyTx (MaryEra c) -> Tx (MaryEra c)
forall era. Tx era -> Tx era
Alonzo.Tx (ShelleyTx (MaryEra c) -> Tx (MaryEra c))
-> (WrapTx (MaryEra c) -> ShelleyTx (MaryEra c))
-> WrapTx (MaryEra c)
-> Tx (MaryEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapTx (MaryEra c) -> Tx (MaryEra c)
WrapTx (MaryEra c) -> ShelleyTx (MaryEra c)
forall era. WrapTx era -> Tx era
unwrapTx
instance ShelleyBasedEra (BabbageEra c) => Core.TranslateEra (BabbageEra c) WrapTx where
type TranslationError (BabbageEra c) WrapTx = Core.TranslationError (BabbageEra c) Babbage.Tx
translateEra :: TranslationContext (BabbageEra c)
-> WrapTx (PreviousEra (BabbageEra c))
-> Except
(TranslationError (BabbageEra c) WrapTx) (WrapTx (BabbageEra c))
translateEra TranslationContext (BabbageEra c)
ctxt =
(Tx (BabbageEra c) -> WrapTx (BabbageEra c))
-> ExceptT DecoderError Identity (Tx (BabbageEra c))
-> ExceptT DecoderError Identity (WrapTx (BabbageEra c))
forall a b.
(a -> b)
-> ExceptT DecoderError Identity a
-> ExceptT DecoderError Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tx (BabbageEra c) -> WrapTx (BabbageEra c)
AlonzoTx (BabbageEra c) -> WrapTx (BabbageEra c)
forall era. Tx era -> WrapTx era
WrapTx (AlonzoTx (BabbageEra c) -> WrapTx (BabbageEra c))
-> (Tx (BabbageEra c) -> AlonzoTx (BabbageEra c))
-> Tx (BabbageEra c)
-> WrapTx (BabbageEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (BabbageEra c) -> Tx (BabbageEra c)
Tx (BabbageEra c) -> AlonzoTx (BabbageEra c)
forall era. Tx era -> Tx era
Babbage.unTx)
(ExceptT DecoderError Identity (Tx (BabbageEra c))
-> ExceptT DecoderError Identity (WrapTx (BabbageEra c)))
-> (WrapTx (AlonzoEra c)
-> ExceptT DecoderError Identity (Tx (BabbageEra c)))
-> WrapTx (AlonzoEra c)
-> ExceptT DecoderError Identity (WrapTx (BabbageEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
Core.translateEra @(BabbageEra c) TranslationContext (BabbageEra c)
ctxt
(Tx (AlonzoEra c)
-> ExceptT DecoderError Identity (Tx (BabbageEra c)))
-> (WrapTx (AlonzoEra c) -> Tx (AlonzoEra c))
-> WrapTx (AlonzoEra c)
-> ExceptT DecoderError Identity (Tx (BabbageEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (AlonzoEra c) -> Tx (AlonzoEra c)
AlonzoTx (AlonzoEra c) -> Tx (AlonzoEra c)
forall era. Tx era -> Tx era
Babbage.Tx (AlonzoTx (AlonzoEra c) -> Tx (AlonzoEra c))
-> (WrapTx (AlonzoEra c) -> AlonzoTx (AlonzoEra c))
-> WrapTx (AlonzoEra c)
-> Tx (AlonzoEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapTx (AlonzoEra c) -> Tx (AlonzoEra c)
WrapTx (AlonzoEra c) -> AlonzoTx (AlonzoEra c)
forall era. WrapTx era -> Tx era
unwrapTx
instance ShelleyBasedEra (ConwayEra c) => Core.TranslateEra (ConwayEra c) WrapTx where
type TranslationError (ConwayEra c) WrapTx = Core.TranslationError (ConwayEra c) Conway.Tx
translateEra :: TranslationContext (ConwayEra c)
-> WrapTx (PreviousEra (ConwayEra c))
-> Except
(TranslationError (ConwayEra c) WrapTx) (WrapTx (ConwayEra c))
translateEra TranslationContext (ConwayEra c)
ctxt =
(Tx (ConwayEra c) -> WrapTx (ConwayEra c))
-> ExceptT DecoderError Identity (Tx (ConwayEra c))
-> ExceptT DecoderError Identity (WrapTx (ConwayEra c))
forall a b.
(a -> b)
-> ExceptT DecoderError Identity a
-> ExceptT DecoderError Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tx (ConwayEra c) -> WrapTx (ConwayEra c)
AlonzoTx (ConwayEra c) -> WrapTx (ConwayEra c)
forall era. Tx era -> WrapTx era
WrapTx (AlonzoTx (ConwayEra c) -> WrapTx (ConwayEra c))
-> (Tx (ConwayEra c) -> AlonzoTx (ConwayEra c))
-> Tx (ConwayEra c)
-> WrapTx (ConwayEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (ConwayEra c) -> Tx (ConwayEra c)
Tx (ConwayEra c) -> AlonzoTx (ConwayEra c)
forall era. Tx era -> Tx era
Conway.unTx)
(ExceptT DecoderError Identity (Tx (ConwayEra c))
-> ExceptT DecoderError Identity (WrapTx (ConwayEra c)))
-> (WrapTx (BabbageEra c)
-> ExceptT DecoderError Identity (Tx (ConwayEra c)))
-> WrapTx (BabbageEra c)
-> ExceptT DecoderError Identity (WrapTx (ConwayEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (f :: * -> *).
TranslateEra era f =>
TranslationContext era
-> f (PreviousEra era) -> Except (TranslationError era f) (f era)
Core.translateEra @(ConwayEra c) TranslationContext (ConwayEra c)
ctxt
(Tx (BabbageEra c)
-> ExceptT DecoderError Identity (Tx (ConwayEra c)))
-> (WrapTx (BabbageEra c) -> Tx (BabbageEra c))
-> WrapTx (BabbageEra c)
-> ExceptT DecoderError Identity (Tx (ConwayEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (BabbageEra c) -> Tx (BabbageEra c)
AlonzoTx (BabbageEra c) -> Tx (BabbageEra c)
forall era. Tx era -> Tx era
Conway.Tx (AlonzoTx (BabbageEra c) -> Tx (BabbageEra c))
-> (WrapTx (BabbageEra c) -> AlonzoTx (BabbageEra c))
-> WrapTx (BabbageEra c)
-> Tx (BabbageEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapTx (BabbageEra c) -> Tx (BabbageEra c)
WrapTx (BabbageEra c) -> AlonzoTx (BabbageEra c)
forall era. WrapTx era -> Tx era
unwrapTx