{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.Utxo (
  ConwayUTXO,
  allegraToConwayUtxoPredFailure,
  babbageToConwayUtxoPredFailure,
  alonzoToConwayUtxoPredFailure,
  ConwayUtxoPredFailure (..),
) where

import Cardano.Ledger.Address (Addr, RewardAccount)
import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure, shelleyToAllegraUtxoPredFailure)
import qualified Cardano.Ledger.Allegra.Rules as Allegra (AllegraUtxoPredFailure (..))
import Cardano.Ledger.Alonzo.Rules (
  AlonzoUtxoEvent,
  AlonzoUtxoPredFailure,
  AlonzoUtxosPredFailure,
 )
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo (
  AlonzoUtxoEvent (UtxosEvent),
  AlonzoUtxoPredFailure (..),
 )
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure)
import qualified Cardano.Ledger.Babbage.Rules as Babbage (
  BabbageUtxoPredFailure (..),
  utxoTransition,
 )
import Cardano.Ledger.BaseTypes (
  Mismatch (..),
  Network,
  Relation (..),
  ShelleyBase,
  SlotNo,
  swapMismatch,
  unswapMismatch,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  mapCoder,
  (!>),
  (<!),
 )
import Cardano.Ledger.Coin (Coin, DeltaCoin)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayUTXO, ConwayUTXOS)
import Cardano.Ledger.Conway.Rules.Utxos (
  ConwayUtxosPredFailure (..),
 )
import Cardano.Ledger.Plutus (ExUnits)
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley (UTxOState)
import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure)
import qualified Cardano.Ledger.Shelley.Rules as Shelley (UtxoEnv, validSizeComputationCheck)
import Cardano.Ledger.State (EraCertState (..), EraUTxO, UTxO (..))
import Cardano.Ledger.TxIn (TxIn)
import Control.DeepSeq (NFData)
import Control.State.Transition.Extended (Embed (..), STS (..))
import Data.List.NonEmpty (NonEmpty)
import Data.Set (Set)
import Data.Word (Word32)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))

-- ======================================================

-- | Predicate failure for the Conway Era
data ConwayUtxoPredFailure era
  = -- | Subtransition Failures
    UtxosFailure (PredicateFailure (EraRule "UTXOS" era))
  | -- | The bad transaction inputs
    BadInputsUTxO
      (Set TxIn)
  | OutsideValidityIntervalUTxO
      -- | transaction's validity interval
      ValidityInterval
      -- | current slot
      SlotNo
  | MaxTxSizeUTxO (Mismatch RelLTEQ Word32)
  | InputSetEmptyUTxO
  | FeeTooSmallUTxO
      (Mismatch RelGTEQ Coin) -- The values are serialised in reverse order
  | ValueNotConservedUTxO
      (Mismatch RelEQ (Value era)) -- Serialise consumed first, then produced
  | -- | the set of addresses with incorrect network IDs
    WrongNetwork
      -- | the expected network id
      Network
      -- | the set of addresses with incorrect network IDs
      (Set Addr)
  | WrongNetworkWithdrawal
      -- | the expected network id
      Network
      -- | the set of reward addresses with incorrect network IDs
      (Set RewardAccount)
  | -- | list of supplied transaction outputs that are too small
    OutputTooSmallUTxO
      [TxOut era]
  | -- | list of supplied bad transaction outputs
    OutputBootAddrAttrsTooBig
      [TxOut era]
  | -- | list of supplied bad transaction output triples (actualSize,PParameterMaxValue,TxOut)
    OutputTooBigUTxO
      [(Int, Int, TxOut era)]
  | InsufficientCollateral
      -- | balance computed
      DeltaCoin
      -- | the required collateral for the given fee
      Coin
  | -- | The UTxO entries which have the wrong kind of script
    ScriptsNotPaidUTxO
      (UTxO era)
  | ExUnitsTooBigUTxO
      (Mismatch RelLTEQ ExUnits) -- The values are serialised in reverse order
  | -- | The inputs marked for use as fees contain non-ADA tokens
    CollateralContainsNonADA (Value era)
  | -- | Wrong Network ID in body
    WrongNetworkInTxBody
      (Mismatch RelEQ Network) -- The values are serialised in reverse order
  | -- | slot number outside consensus forecast range
    OutsideForecast
      SlotNo
  | -- | There are too many collateral inputs
    TooManyCollateralInputs
      (Mismatch RelLTEQ Natural) -- The values are serialised in reverse order
  | NoCollateralInputs
  | -- | The collateral is not equivalent to the total collateral asserted by the transaction
    IncorrectTotalCollateralField
      -- | collateral provided
      DeltaCoin
      -- | collateral amount declared in transaction body
      Coin
  | -- | list of supplied transaction outputs that are too small,
    -- together with the minimum value for the given output.
    BabbageOutputTooSmallUTxO
      [(TxOut era, Coin)]
  | -- | TxIns that appear in both inputs and reference inputs
    BabbageNonDisjointRefInputs
      (NonEmpty TxIn)
  deriving ((forall x.
 ConwayUtxoPredFailure era -> Rep (ConwayUtxoPredFailure era) x)
-> (forall x.
    Rep (ConwayUtxoPredFailure era) x -> ConwayUtxoPredFailure era)
-> Generic (ConwayUtxoPredFailure era)
forall x.
Rep (ConwayUtxoPredFailure era) x -> ConwayUtxoPredFailure era
forall x.
ConwayUtxoPredFailure era -> Rep (ConwayUtxoPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayUtxoPredFailure era) x -> ConwayUtxoPredFailure era
forall era x.
ConwayUtxoPredFailure era -> Rep (ConwayUtxoPredFailure era) x
$cfrom :: forall era x.
ConwayUtxoPredFailure era -> Rep (ConwayUtxoPredFailure era) x
from :: forall x.
ConwayUtxoPredFailure era -> Rep (ConwayUtxoPredFailure era) x
$cto :: forall era x.
Rep (ConwayUtxoPredFailure era) x -> ConwayUtxoPredFailure era
to :: forall x.
Rep (ConwayUtxoPredFailure era) x -> ConwayUtxoPredFailure era
Generic)

type instance EraRuleFailure "UTXO" ConwayEra = ConwayUtxoPredFailure ConwayEra

type instance EraRuleEvent "UTXO" ConwayEra = AlonzoUtxoEvent ConwayEra

instance InjectRuleFailure "UTXO" ConwayUtxoPredFailure ConwayEra

instance InjectRuleFailure "UTXO" BabbageUtxoPredFailure ConwayEra where
  injectFailure :: BabbageUtxoPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
injectFailure = BabbageUtxoPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
BabbageUtxoPredFailure ConwayEra -> ConwayUtxoPredFailure ConwayEra
forall era. BabbageUtxoPredFailure era -> ConwayUtxoPredFailure era
babbageToConwayUtxoPredFailure

instance InjectRuleFailure "UTXO" AlonzoUtxoPredFailure ConwayEra where
  injectFailure :: AlonzoUtxoPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
injectFailure = AlonzoUtxoPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
AlonzoUtxoPredFailure ConwayEra -> ConwayUtxoPredFailure ConwayEra
forall era. AlonzoUtxoPredFailure era -> ConwayUtxoPredFailure era
alonzoToConwayUtxoPredFailure

instance InjectRuleFailure "UTXO" ShelleyUtxoPredFailure ConwayEra where
  injectFailure :: ShelleyUtxoPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
injectFailure =
    AllegraUtxoPredFailure ConwayEra -> ConwayUtxoPredFailure ConwayEra
forall era.
(EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era) =>
AllegraUtxoPredFailure era -> ConwayUtxoPredFailure era
allegraToConwayUtxoPredFailure
      (AllegraUtxoPredFailure ConwayEra
 -> ConwayUtxoPredFailure ConwayEra)
-> (ShelleyUtxoPredFailure ConwayEra
    -> AllegraUtxoPredFailure ConwayEra)
-> ShelleyUtxoPredFailure ConwayEra
-> ConwayUtxoPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyUtxoPredFailure ConwayEra
-> AllegraUtxoPredFailure ConwayEra
forall era.
ShelleyUtxoPredFailure era -> AllegraUtxoPredFailure era
shelleyToAllegraUtxoPredFailure

instance InjectRuleFailure "UTXO" Allegra.AllegraUtxoPredFailure ConwayEra where
  injectFailure :: AllegraUtxoPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
injectFailure = AllegraUtxoPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
AllegraUtxoPredFailure ConwayEra -> ConwayUtxoPredFailure ConwayEra
forall era.
(EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era) =>
AllegraUtxoPredFailure era -> ConwayUtxoPredFailure era
allegraToConwayUtxoPredFailure

instance InjectRuleFailure "UTXO" AlonzoUtxosPredFailure ConwayEra where
  injectFailure :: AlonzoUtxosPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
injectFailure =
    AlonzoUtxoPredFailure ConwayEra -> ConwayUtxoPredFailure ConwayEra
forall era. AlonzoUtxoPredFailure era -> ConwayUtxoPredFailure era
alonzoToConwayUtxoPredFailure
      (AlonzoUtxoPredFailure ConwayEra
 -> ConwayUtxoPredFailure ConwayEra)
-> (AlonzoUtxosPredFailure ConwayEra
    -> AlonzoUtxoPredFailure ConwayEra)
-> AlonzoUtxosPredFailure ConwayEra
-> ConwayUtxoPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "UTXOS" ConwayEra)
-> AlonzoUtxoPredFailure ConwayEra
ConwayUtxosPredFailure ConwayEra -> AlonzoUtxoPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "UTXOS" era) -> AlonzoUtxoPredFailure era
Alonzo.UtxosFailure
      (ConwayUtxosPredFailure ConwayEra
 -> AlonzoUtxoPredFailure ConwayEra)
-> (AlonzoUtxosPredFailure ConwayEra
    -> ConwayUtxosPredFailure ConwayEra)
-> AlonzoUtxosPredFailure ConwayEra
-> AlonzoUtxoPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoUtxosPredFailure ConwayEra
-> EraRuleFailure "UTXOS" ConwayEra
AlonzoUtxosPredFailure ConwayEra
-> ConwayUtxosPredFailure ConwayEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

deriving instance
  ( Era era
  , Show (Value era)
  , Show (PredicateFailure (EraRule "UTXOS" era))
  , Show (TxOut era)
  , Show (Script era)
  , Show TxIn
  ) =>
  Show (ConwayUtxoPredFailure era)

deriving instance
  ( Era era
  , Eq (Value era)
  , Eq (PredicateFailure (EraRule "UTXOS" era))
  , Eq (TxOut era)
  , Eq (Script era)
  , Eq TxIn
  ) =>
  Eq (ConwayUtxoPredFailure era)

deriving via
  InspectHeapNamed "ConwayUtxoPred" (ConwayUtxoPredFailure era)
  instance
    NoThunks (ConwayUtxoPredFailure era)

instance
  ( Era era
  , NFData (Value era)
  , NFData (TxOut era)
  , NFData (PredicateFailure (EraRule "UTXOS" era))
  ) =>
  NFData (ConwayUtxoPredFailure era)

--------------------------------------------------------------------------------
-- ConwayUTXO STS
--------------------------------------------------------------------------------

instance
  forall era.
  ( EraTx era
  , EraUTxO era
  , ConwayEraTxBody era
  , AlonzoEraTxWits era
  , EraRule "UTXO" era ~ ConwayUTXO era
  , InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era
  , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
  , InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era
  , InjectRuleFailure "UTXO" BabbageUtxoPredFailure era
  , InjectRuleFailure "UTXO" ConwayUtxoPredFailure era
  , Embed (EraRule "UTXOS" era) (ConwayUTXO era)
  , Environment (EraRule "UTXOS" era) ~ Shelley.UtxoEnv era
  , State (EraRule "UTXOS" era) ~ Shelley.UTxOState era
  , Signal (EraRule "UTXOS" era) ~ Tx TopTx era
  , PredicateFailure (EraRule "UTXO" era) ~ ConwayUtxoPredFailure era
  , EraCertState era
  , SafeToHash (TxWits era)
  ) =>
  STS (ConwayUTXO era)
  where
  type State (ConwayUTXO era) = Shelley.UTxOState era
  type Signal (ConwayUTXO era) = Tx TopTx era
  type Environment (ConwayUTXO era) = Shelley.UtxoEnv era
  type BaseM (ConwayUTXO era) = ShelleyBase
  type PredicateFailure (ConwayUTXO era) = ConwayUtxoPredFailure era
  type Event (ConwayUTXO era) = AlonzoUtxoEvent era

  initialRules :: [InitialRule (ConwayUTXO era)]
initialRules = []

  transitionRules :: [TransitionRule (ConwayUTXO era)]
transitionRules = [forall era.
(EraUTxO era, BabbageEraTxBody era, AlonzoEraTxWits era,
 InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era,
 InjectRuleFailure "UTXO" AllegraUtxoPredFailure era,
 InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era,
 InjectRuleFailure "UTXO" BabbageUtxoPredFailure era,
 Environment (EraRule "UTXO" era) ~ UtxoEnv era,
 State (EraRule "UTXO" era) ~ UTxOState era,
 Signal (EraRule "UTXO" era) ~ Tx TopTx era,
 BaseM (EraRule "UTXO" era) ~ ShelleyBase, STS (EraRule "UTXO" era),
 Embed (EraRule "UTXOS" era) (EraRule "UTXO" era),
 Environment (EraRule "UTXOS" era) ~ UtxoEnv era,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era, EraCertState era) =>
TransitionRule (EraRule "UTXO" era)
Babbage.utxoTransition @era]

  assertions :: [Assertion (ConwayUTXO era)]
assertions = [Assertion (ConwayUTXO era)
forall era (rule :: * -> *).
(EraTx era, SafeToHash (TxWits era),
 Signal (rule era) ~ Tx TopTx era) =>
Assertion (rule era)
Shelley.validSizeComputationCheck]

instance
  ( Era era
  , STS (ConwayUTXOS era)
  , PredicateFailure (EraRule "UTXOS" era) ~ ConwayUtxosPredFailure era
  , Event (EraRule "UTXOS" era) ~ Event (ConwayUTXOS era)
  ) =>
  Embed (ConwayUTXOS era) (ConwayUTXO era)
  where
  wrapFailed :: PredicateFailure (ConwayUTXOS era)
-> PredicateFailure (ConwayUTXO era)
wrapFailed = PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
PredicateFailure (ConwayUTXOS era)
-> PredicateFailure (ConwayUTXO era)
forall era.
PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
UtxosFailure
  wrapEvent :: Event (ConwayUTXOS era) -> Event (ConwayUTXO era)
wrapEvent = Event (EraRule "UTXOS" era) -> AlonzoUtxoEvent era
Event (ConwayUTXOS era) -> Event (ConwayUTXO era)
forall era. Event (EraRule "UTXOS" era) -> AlonzoUtxoEvent era
Alonzo.UtxosEvent

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

instance
  ( Era era
  , EncCBOR (TxOut era)
  , EncCBOR (Value era)
  , EncCBOR (PredicateFailure (EraRule "UTXOS" era))
  ) =>
  EncCBOR (ConwayUtxoPredFailure era)
  where
  encCBOR :: ConwayUtxoPredFailure era -> Encoding
encCBOR =
    Encode Open (ConwayUtxoPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayUtxoPredFailure era) -> Encoding)
-> (ConwayUtxoPredFailure era
    -> Encode Open (ConwayUtxoPredFailure era))
-> ConwayUtxoPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      UtxosFailure PredicateFailure (EraRule "UTXOS" era)
a -> (PredicateFailure (EraRule "UTXOS" era)
 -> ConwayUtxoPredFailure era)
-> Word
-> Encode
     Open
     (PredicateFailure (EraRule "UTXOS" era)
      -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
UtxosFailure @era) Word
0 Encode
  Open
  (PredicateFailure (EraRule "UTXOS" era)
   -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "UTXOS" era))
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PredicateFailure (EraRule "UTXOS" era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "UTXOS" era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PredicateFailure (EraRule "UTXOS" era)
a
      BadInputsUTxO Set TxIn
ins -> (Set TxIn -> ConwayUtxoPredFailure era)
-> Word -> Encode Open (Set TxIn -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Set TxIn -> ConwayUtxoPredFailure era
BadInputsUTxO @era) Word
1 Encode Open (Set TxIn -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Set TxIn)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set TxIn -> Encode (Closed Dense) (Set TxIn)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set TxIn
ins
      OutsideValidityIntervalUTxO ValidityInterval
a SlotNo
b -> (ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era)
-> Word
-> Encode
     Open (ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
forall era. ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
OutsideValidityIntervalUTxO Word
2 Encode
  Open (ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) ValidityInterval
-> Encode Open (SlotNo -> ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ValidityInterval -> Encode (Closed Dense) ValidityInterval
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ValidityInterval
a Encode Open (SlotNo -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) SlotNo
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> SlotNo -> Encode (Closed Dense) SlotNo
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To SlotNo
b
      MaxTxSizeUTxO Mismatch RelLTEQ Word32
mm -> (Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era)
-> Word
-> Encode
     Open (Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Word
3 Encode Open (Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Mismatch RelLTEQ Word32)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Mismatch RelLTEQ Word32
-> Encode (Closed Dense) (Mismatch RelLTEQ Word32)
forall t. EncCBORGroup t => t -> Encode (Closed Dense) t
ToGroup Mismatch RelLTEQ Word32
mm
      ConwayUtxoPredFailure era
InputSetEmptyUTxO -> ConwayUtxoPredFailure era
-> Word -> Encode Open (ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum ConwayUtxoPredFailure era
forall era. ConwayUtxoPredFailure era
InputSetEmptyUTxO Word
4
      FeeTooSmallUTxO Mismatch RelGTEQ Coin
mm -> ((Coin, Coin) -> ConwayUtxoPredFailure era)
-> Word -> Encode Open ((Coin, Coin) -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
forall era. Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
FeeTooSmallUTxO (Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era)
-> ((Coin, Coin) -> Mismatch RelGTEQ Coin)
-> (Coin, Coin)
-> ConwayUtxoPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin, Coin) -> Mismatch RelGTEQ Coin
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch) Word
5 Encode Open ((Coin, Coin) -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Coin, Coin)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> (Coin, Coin) -> Encode (Closed Dense) (Coin, Coin)
forall t. EncCBORGroup t => t -> Encode (Closed Dense) t
ToGroup (Mismatch RelGTEQ Coin -> (Coin, Coin)
forall (r :: Relation) a. Mismatch r a -> (a, a)
swapMismatch Mismatch RelGTEQ Coin
mm)
      ValueNotConservedUTxO Mismatch RelEQ (Value era)
mm -> (Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era)
-> Word
-> Encode
     Open (Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era
ValueNotConservedUTxO @era) Word
6 Encode
  Open (Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Mismatch RelEQ (Value era))
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Mismatch RelEQ (Value era)
-> Encode (Closed Dense) (Mismatch RelEQ (Value era))
forall t. EncCBORGroup t => t -> Encode (Closed Dense) t
ToGroup Mismatch RelEQ (Value era)
mm
      WrongNetwork Network
right Set Addr
wrongs -> (Network -> Set Addr -> ConwayUtxoPredFailure era)
-> Word
-> Encode Open (Network -> Set Addr -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Network -> Set Addr -> ConwayUtxoPredFailure era
WrongNetwork @era) Word
7 Encode Open (Network -> Set Addr -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) Network
-> Encode Open (Set Addr -> ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Network -> Encode (Closed Dense) Network
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Network
right Encode Open (Set Addr -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Set Addr)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set Addr -> Encode (Closed Dense) (Set Addr)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set Addr
wrongs
      WrongNetworkWithdrawal Network
right Set RewardAccount
wrongs -> (Network -> Set RewardAccount -> ConwayUtxoPredFailure era)
-> Word
-> Encode
     Open (Network -> Set RewardAccount -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
Network -> Set RewardAccount -> ConwayUtxoPredFailure era
WrongNetworkWithdrawal @era) Word
8 Encode
  Open (Network -> Set RewardAccount -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) Network
-> Encode Open (Set RewardAccount -> ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Network -> Encode (Closed Dense) Network
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Network
right Encode Open (Set RewardAccount -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Set RewardAccount)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set RewardAccount -> Encode (Closed Dense) (Set RewardAccount)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set RewardAccount
wrongs
      OutputTooSmallUTxO [TxOut era]
outs -> ([TxOut era] -> ConwayUtxoPredFailure era)
-> Word -> Encode Open ([TxOut era] -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputTooSmallUTxO @era) Word
9 Encode Open ([TxOut era] -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) [TxOut era]
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> [TxOut era] -> Encode (Closed Dense) [TxOut era]
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To [TxOut era]
outs
      OutputBootAddrAttrsTooBig [TxOut era]
outs -> ([TxOut era] -> ConwayUtxoPredFailure era)
-> Word -> Encode Open ([TxOut era] -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputBootAddrAttrsTooBig @era) Word
10 Encode Open ([TxOut era] -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) [TxOut era]
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> [TxOut era] -> Encode (Closed Dense) [TxOut era]
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To [TxOut era]
outs
      OutputTooBigUTxO [(Int, Int, TxOut era)]
outs -> ([(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era)
-> Word
-> Encode
     Open ([(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
OutputTooBigUTxO @era) Word
11 Encode Open ([(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) [(Int, Int, TxOut era)]
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> [(Int, Int, TxOut era)]
-> Encode (Closed Dense) [(Int, Int, TxOut era)]
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To [(Int, Int, TxOut era)]
outs
      InsufficientCollateral DeltaCoin
a Coin
b -> (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Word
-> Encode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum DeltaCoin -> Coin -> ConwayUtxoPredFailure era
forall era. DeltaCoin -> Coin -> ConwayUtxoPredFailure era
InsufficientCollateral Word
12 Encode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) DeltaCoin
-> Encode Open (Coin -> ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> DeltaCoin -> Encode (Closed Dense) DeltaCoin
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To DeltaCoin
a Encode Open (Coin -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) Coin
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Coin -> Encode (Closed Dense) Coin
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Coin
b
      ScriptsNotPaidUTxO UTxO era
a -> (UTxO era -> ConwayUtxoPredFailure era)
-> Word -> Encode Open (UTxO era -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum UTxO era -> ConwayUtxoPredFailure era
forall era. UTxO era -> ConwayUtxoPredFailure era
ScriptsNotPaidUTxO Word
13 Encode Open (UTxO era -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (UTxO era)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> UTxO era -> Encode (Closed Dense) (UTxO era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To UTxO era
a
      ExUnitsTooBigUTxO Mismatch RelLTEQ ExUnits
mm -> ((ExUnits, ExUnits) -> ConwayUtxoPredFailure era)
-> Word
-> Encode Open ((ExUnits, ExUnits) -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era
ExUnitsTooBigUTxO (Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era)
-> ((ExUnits, ExUnits) -> Mismatch RelLTEQ ExUnits)
-> (ExUnits, ExUnits)
-> ConwayUtxoPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExUnits, ExUnits) -> Mismatch RelLTEQ ExUnits
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch) Word
14 Encode Open ((ExUnits, ExUnits) -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (ExUnits, ExUnits)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> (ExUnits, ExUnits) -> Encode (Closed Dense) (ExUnits, ExUnits)
forall t. EncCBORGroup t => t -> Encode (Closed Dense) t
ToGroup (Mismatch RelLTEQ ExUnits -> (ExUnits, ExUnits)
forall (r :: Relation) a. Mismatch r a -> (a, a)
swapMismatch Mismatch RelLTEQ ExUnits
mm)
      CollateralContainsNonADA Value era
a -> (Value era -> ConwayUtxoPredFailure era)
-> Word -> Encode Open (Value era -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Value era -> ConwayUtxoPredFailure era
forall era. Value era -> ConwayUtxoPredFailure era
CollateralContainsNonADA Word
15 Encode Open (Value era -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Value era)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Value era -> Encode (Closed Dense) (Value era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Value era
a
      WrongNetworkInTxBody Mismatch RelEQ Network
mm -> ((Network, Network) -> ConwayUtxoPredFailure era)
-> Word
-> Encode Open ((Network, Network) -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (Mismatch RelEQ Network -> ConwayUtxoPredFailure era
forall era. Mismatch RelEQ Network -> ConwayUtxoPredFailure era
WrongNetworkInTxBody (Mismatch RelEQ Network -> ConwayUtxoPredFailure era)
-> ((Network, Network) -> Mismatch RelEQ Network)
-> (Network, Network)
-> ConwayUtxoPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Network, Network) -> Mismatch RelEQ Network
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch) Word
16 Encode Open ((Network, Network) -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Network, Network)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> (Network, Network) -> Encode (Closed Dense) (Network, Network)
forall t. EncCBORGroup t => t -> Encode (Closed Dense) t
ToGroup (Mismatch RelEQ Network -> (Network, Network)
forall (r :: Relation) a. Mismatch r a -> (a, a)
swapMismatch Mismatch RelEQ Network
mm)
      OutsideForecast SlotNo
a -> (SlotNo -> ConwayUtxoPredFailure era)
-> Word -> Encode Open (SlotNo -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum SlotNo -> ConwayUtxoPredFailure era
forall era. SlotNo -> ConwayUtxoPredFailure era
OutsideForecast Word
17 Encode Open (SlotNo -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) SlotNo
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> SlotNo -> Encode (Closed Dense) SlotNo
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To SlotNo
a
      TooManyCollateralInputs Mismatch RelLTEQ Natural
mm -> ((Natural, Natural) -> ConwayUtxoPredFailure era)
-> Word
-> Encode Open ((Natural, Natural) -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era
TooManyCollateralInputs (Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era)
-> ((Natural, Natural) -> Mismatch RelLTEQ Natural)
-> (Natural, Natural)
-> ConwayUtxoPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural, Natural) -> Mismatch RelLTEQ Natural
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch) Word
18 Encode Open ((Natural, Natural) -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (Natural, Natural)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> (Natural, Natural) -> Encode (Closed Dense) (Natural, Natural)
forall t. EncCBORGroup t => t -> Encode (Closed Dense) t
ToGroup (Mismatch RelLTEQ Natural -> (Natural, Natural)
forall (r :: Relation) a. Mismatch r a -> (a, a)
swapMismatch Mismatch RelLTEQ Natural
mm)
      ConwayUtxoPredFailure era
NoCollateralInputs -> ConwayUtxoPredFailure era
-> Word -> Encode Open (ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum ConwayUtxoPredFailure era
forall era. ConwayUtxoPredFailure era
NoCollateralInputs Word
19
      IncorrectTotalCollateralField DeltaCoin
c1 Coin
c2 -> (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Word
-> Encode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum DeltaCoin -> Coin -> ConwayUtxoPredFailure era
forall era. DeltaCoin -> Coin -> ConwayUtxoPredFailure era
IncorrectTotalCollateralField Word
20 Encode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) DeltaCoin
-> Encode Open (Coin -> ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> DeltaCoin -> Encode (Closed Dense) DeltaCoin
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To DeltaCoin
c1 Encode Open (Coin -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) Coin
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Coin -> Encode (Closed Dense) Coin
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Coin
c2
      BabbageOutputTooSmallUTxO [(TxOut era, Coin)]
x -> ([(TxOut era, Coin)] -> ConwayUtxoPredFailure era)
-> Word
-> Encode Open ([(TxOut era, Coin)] -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum [(TxOut era, Coin)] -> ConwayUtxoPredFailure era
forall era. [(TxOut era, Coin)] -> ConwayUtxoPredFailure era
BabbageOutputTooSmallUTxO Word
21 Encode Open ([(TxOut era, Coin)] -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) [(TxOut era, Coin)]
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> [(TxOut era, Coin)] -> Encode (Closed Dense) [(TxOut era, Coin)]
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To [(TxOut era, Coin)]
x
      BabbageNonDisjointRefInputs NonEmpty TxIn
x -> (NonEmpty TxIn -> ConwayUtxoPredFailure era)
-> Word -> Encode Open (NonEmpty TxIn -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty TxIn -> ConwayUtxoPredFailure era
forall era. NonEmpty TxIn -> ConwayUtxoPredFailure era
BabbageNonDisjointRefInputs Word
22 Encode Open (NonEmpty TxIn -> ConwayUtxoPredFailure era)
-> Encode (Closed Dense) (NonEmpty TxIn)
-> Encode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty TxIn -> Encode (Closed Dense) (NonEmpty TxIn)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty TxIn
x

instance
  ( Era era
  , DecCBOR (TxOut era)
  , EncCBOR (Value era)
  , DecCBOR (Value era)
  , DecCBOR (PredicateFailure (EraRule "UTXOS" era))
  ) =>
  DecCBOR (ConwayUtxoPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayUtxoPredFailure era)
decCBOR = Decode (Closed Dense) (ConwayUtxoPredFailure era)
-> Decoder s (ConwayUtxoPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (ConwayUtxoPredFailure era)
 -> Decoder s (ConwayUtxoPredFailure era))
-> ((Word -> Decode Open (ConwayUtxoPredFailure era))
    -> Decode (Closed Dense) (ConwayUtxoPredFailure era))
-> (Word -> Decode Open (ConwayUtxoPredFailure era))
-> Decoder s (ConwayUtxoPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Word -> Decode Open (ConwayUtxoPredFailure era))
-> Decode (Closed Dense) (ConwayUtxoPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"ConwayUtxoPredFailure" ((Word -> Decode Open (ConwayUtxoPredFailure era))
 -> Decoder s (ConwayUtxoPredFailure era))
-> (Word -> Decode Open (ConwayUtxoPredFailure era))
-> Decoder s (ConwayUtxoPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (PredicateFailure (EraRule "UTXOS" era)
 -> ConwayUtxoPredFailure era)
-> Decode
     Open
     (PredicateFailure (EraRule "UTXOS" era)
      -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
forall era.
PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
UtxosFailure Decode
  Open
  (PredicateFailure (EraRule "UTXOS" era)
   -> ConwayUtxoPredFailure era)
-> Decode
     (Closed (ZonkAny 0)) (PredicateFailure (EraRule "UTXOS" era))
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 0)) (PredicateFailure (EraRule "UTXOS" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (Set TxIn -> ConwayUtxoPredFailure era)
-> Decode Open (Set TxIn -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Set TxIn -> ConwayUtxoPredFailure era
forall era. Set TxIn -> ConwayUtxoPredFailure era
BadInputsUTxO Decode Open (Set TxIn -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 1)) (Set TxIn)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era)
-> Decode
     Open (ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
forall era. ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
OutsideValidityIntervalUTxO Decode
  Open (ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 3)) ValidityInterval
-> Decode Open (SlotNo -> ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) ValidityInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (SlotNo -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 2)) SlotNo
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era)
-> Decode
     Open (Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Decode Open (Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 4)) (Mismatch RelLTEQ Word32)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 4)) (Mismatch RelLTEQ Word32)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
4 -> ConwayUtxoPredFailure era
-> Decode Open (ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD ConwayUtxoPredFailure era
forall era. ConwayUtxoPredFailure era
InputSetEmptyUTxO
    Word
5 -> (Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era)
-> Decode Open (Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
forall era. Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
FeeTooSmallUTxO Decode Open (Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 5)) (Mismatch RelGTEQ Coin)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! ((Coin, Coin) -> Mismatch RelGTEQ Coin)
-> Decode (Closed (ZonkAny 5)) (Coin, Coin)
-> Decode (Closed (ZonkAny 5)) (Mismatch RelGTEQ Coin)
forall a b (w :: Wrapped).
Typeable a =>
(a -> b) -> Decode w a -> Decode w b
mapCoder (Coin, Coin) -> Mismatch RelGTEQ Coin
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch Decode (Closed (ZonkAny 5)) (Coin, Coin)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
6 -> (Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era)
-> Decode
     Open (Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era
forall era. Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era
ValueNotConservedUTxO Decode
  Open (Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 6)) (Mismatch RelEQ (Value era))
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 6)) (Mismatch RelEQ (Value era))
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
7 -> (Network -> Set Addr -> ConwayUtxoPredFailure era)
-> Decode Open (Network -> Set Addr -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Network -> Set Addr -> ConwayUtxoPredFailure era
forall era. Network -> Set Addr -> ConwayUtxoPredFailure era
WrongNetwork Decode Open (Network -> Set Addr -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 8)) Network
-> Decode Open (Set Addr -> ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 8)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Set Addr -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 7)) (Set Addr)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 7)) (Set Addr)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
8 -> (Network -> Set RewardAccount -> ConwayUtxoPredFailure era)
-> Decode
     Open (Network -> Set RewardAccount -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Network -> Set RewardAccount -> ConwayUtxoPredFailure era
forall era.
Network -> Set RewardAccount -> ConwayUtxoPredFailure era
WrongNetworkWithdrawal Decode
  Open (Network -> Set RewardAccount -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 10)) Network
-> Decode Open (Set RewardAccount -> ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 10)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Set RewardAccount -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 9)) (Set RewardAccount)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 9)) (Set RewardAccount)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
9 -> ([TxOut era] -> ConwayUtxoPredFailure era)
-> Decode Open ([TxOut era] -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD [TxOut era] -> ConwayUtxoPredFailure era
forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputTooSmallUTxO Decode Open ([TxOut era] -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 11)) [TxOut era]
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 11)) [TxOut era]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
10 -> ([TxOut era] -> ConwayUtxoPredFailure era)
-> Decode Open ([TxOut era] -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD [TxOut era] -> ConwayUtxoPredFailure era
forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputBootAddrAttrsTooBig Decode Open ([TxOut era] -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 12)) [TxOut era]
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 12)) [TxOut era]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
11 -> ([(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era)
-> Decode
     Open ([(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
forall era. [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
OutputTooBigUTxO Decode Open ([(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 13)) [(Int, Int, TxOut era)]
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 13)) [(Int, Int, TxOut era)]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
12 -> (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Decode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD DeltaCoin -> Coin -> ConwayUtxoPredFailure era
forall era. DeltaCoin -> Coin -> ConwayUtxoPredFailure era
InsufficientCollateral Decode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 15)) DeltaCoin
-> Decode Open (Coin -> ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 15)) DeltaCoin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Coin -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 14)) Coin
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 14)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
13 -> (UTxO era -> ConwayUtxoPredFailure era)
-> Decode Open (UTxO era -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD UTxO era -> ConwayUtxoPredFailure era
forall era. UTxO era -> ConwayUtxoPredFailure era
ScriptsNotPaidUTxO Decode Open (UTxO era -> ConwayUtxoPredFailure era)
-> Decode (Closed Dense) (UTxO era)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! (forall s. Decoder s (UTxO era))
-> Decode (Closed Dense) (UTxO era)
forall t. (forall s. Decoder s t) -> Decode (Closed Dense) t
D (Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Decoder s (Map TxIn (TxOut era)) -> Decoder s (UTxO era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map TxIn (TxOut era))
forall s. Decoder s (Map TxIn (TxOut era))
forall a s. DecCBOR a => Decoder s a
decCBOR)
    Word
14 -> (Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era)
-> Decode
     Open (Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era
ExUnitsTooBigUTxO Decode Open (Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 16)) (Mismatch RelLTEQ ExUnits)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! ((ExUnits, ExUnits) -> Mismatch RelLTEQ ExUnits)
-> Decode (Closed (ZonkAny 16)) (ExUnits, ExUnits)
-> Decode (Closed (ZonkAny 16)) (Mismatch RelLTEQ ExUnits)
forall a b (w :: Wrapped).
Typeable a =>
(a -> b) -> Decode w a -> Decode w b
mapCoder (ExUnits, ExUnits) -> Mismatch RelLTEQ ExUnits
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch Decode (Closed (ZonkAny 16)) (ExUnits, ExUnits)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
15 -> (Value era -> ConwayUtxoPredFailure era)
-> Decode Open (Value era -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Value era -> ConwayUtxoPredFailure era
forall era. Value era -> ConwayUtxoPredFailure era
CollateralContainsNonADA Decode Open (Value era -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 17)) (Value era)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 17)) (Value era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
16 -> (Mismatch RelEQ Network -> ConwayUtxoPredFailure era)
-> Decode
     Open (Mismatch RelEQ Network -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelEQ Network -> ConwayUtxoPredFailure era
forall era. Mismatch RelEQ Network -> ConwayUtxoPredFailure era
WrongNetworkInTxBody Decode Open (Mismatch RelEQ Network -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 18)) (Mismatch RelEQ Network)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! ((Network, Network) -> Mismatch RelEQ Network)
-> Decode (Closed (ZonkAny 18)) (Network, Network)
-> Decode (Closed (ZonkAny 18)) (Mismatch RelEQ Network)
forall a b (w :: Wrapped).
Typeable a =>
(a -> b) -> Decode w a -> Decode w b
mapCoder (Network, Network) -> Mismatch RelEQ Network
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch Decode (Closed (ZonkAny 18)) (Network, Network)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
17 -> (SlotNo -> ConwayUtxoPredFailure era)
-> Decode Open (SlotNo -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD SlotNo -> ConwayUtxoPredFailure era
forall era. SlotNo -> ConwayUtxoPredFailure era
OutsideForecast Decode Open (SlotNo -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 19)) SlotNo
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 19)) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
18 -> (Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era)
-> Decode
     Open (Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era
TooManyCollateralInputs Decode Open (Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 20)) (Mismatch RelLTEQ Natural)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! ((Natural, Natural) -> Mismatch RelLTEQ Natural)
-> Decode (Closed (ZonkAny 20)) (Natural, Natural)
-> Decode (Closed (ZonkAny 20)) (Mismatch RelLTEQ Natural)
forall a b (w :: Wrapped).
Typeable a =>
(a -> b) -> Decode w a -> Decode w b
mapCoder (Natural, Natural) -> Mismatch RelLTEQ Natural
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch Decode (Closed (ZonkAny 20)) (Natural, Natural)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
19 -> ConwayUtxoPredFailure era
-> Decode Open (ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD ConwayUtxoPredFailure era
forall era. ConwayUtxoPredFailure era
NoCollateralInputs
    Word
20 -> (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Decode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD DeltaCoin -> Coin -> ConwayUtxoPredFailure era
forall era. DeltaCoin -> Coin -> ConwayUtxoPredFailure era
IncorrectTotalCollateralField Decode Open (DeltaCoin -> Coin -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 22)) DeltaCoin
-> Decode Open (Coin -> ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 22)) DeltaCoin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Coin -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 21)) Coin
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 21)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
21 -> ([(TxOut era, Coin)] -> ConwayUtxoPredFailure era)
-> Decode Open ([(TxOut era, Coin)] -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD [(TxOut era, Coin)] -> ConwayUtxoPredFailure era
forall era. [(TxOut era, Coin)] -> ConwayUtxoPredFailure era
BabbageOutputTooSmallUTxO Decode Open ([(TxOut era, Coin)] -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 23)) [(TxOut era, Coin)]
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 23)) [(TxOut era, Coin)]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
22 -> (NonEmpty TxIn -> ConwayUtxoPredFailure era)
-> Decode Open (NonEmpty TxIn -> ConwayUtxoPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty TxIn -> ConwayUtxoPredFailure era
forall era. NonEmpty TxIn -> ConwayUtxoPredFailure era
BabbageNonDisjointRefInputs Decode Open (NonEmpty TxIn -> ConwayUtxoPredFailure era)
-> Decode (Closed (ZonkAny 24)) (NonEmpty TxIn)
-> Decode Open (ConwayUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 24)) (NonEmpty TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

-- =====================================================
-- Injecting from one PredicateFailure to another

babbageToConwayUtxoPredFailure ::
  forall era.
  BabbageUtxoPredFailure era ->
  ConwayUtxoPredFailure era
babbageToConwayUtxoPredFailure :: forall era. BabbageUtxoPredFailure era -> ConwayUtxoPredFailure era
babbageToConwayUtxoPredFailure = \case
  Babbage.AlonzoInBabbageUtxoPredFailure AlonzoUtxoPredFailure era
a -> AlonzoUtxoPredFailure era -> ConwayUtxoPredFailure era
forall era. AlonzoUtxoPredFailure era -> ConwayUtxoPredFailure era
alonzoToConwayUtxoPredFailure AlonzoUtxoPredFailure era
a
  Babbage.IncorrectTotalCollateralField DeltaCoin
c1 Coin
c2 -> DeltaCoin -> Coin -> ConwayUtxoPredFailure era
forall era. DeltaCoin -> Coin -> ConwayUtxoPredFailure era
IncorrectTotalCollateralField DeltaCoin
c1 Coin
c2
  Babbage.BabbageOutputTooSmallUTxO [(TxOut era, Coin)]
ts -> [(TxOut era, Coin)] -> ConwayUtxoPredFailure era
forall era. [(TxOut era, Coin)] -> ConwayUtxoPredFailure era
BabbageOutputTooSmallUTxO [(TxOut era, Coin)]
ts
  Babbage.BabbageNonDisjointRefInputs NonEmpty TxIn
ts -> NonEmpty TxIn -> ConwayUtxoPredFailure era
forall era. NonEmpty TxIn -> ConwayUtxoPredFailure era
BabbageNonDisjointRefInputs NonEmpty TxIn
ts

alonzoToConwayUtxoPredFailure ::
  forall era.
  AlonzoUtxoPredFailure era ->
  ConwayUtxoPredFailure era
alonzoToConwayUtxoPredFailure :: forall era. AlonzoUtxoPredFailure era -> ConwayUtxoPredFailure era
alonzoToConwayUtxoPredFailure = \case
  Alonzo.BadInputsUTxO Set TxIn
x -> Set TxIn -> ConwayUtxoPredFailure era
forall era. Set TxIn -> ConwayUtxoPredFailure era
BadInputsUTxO Set TxIn
x
  Alonzo.OutsideValidityIntervalUTxO ValidityInterval
vi SlotNo
slotNo -> ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
forall era. ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
OutsideValidityIntervalUTxO ValidityInterval
vi SlotNo
slotNo
  Alonzo.MaxTxSizeUTxO Mismatch RelLTEQ Word32
m -> Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Mismatch RelLTEQ Word32
m
  AlonzoUtxoPredFailure era
Alonzo.InputSetEmptyUTxO -> ConwayUtxoPredFailure era
forall era. ConwayUtxoPredFailure era
InputSetEmptyUTxO
  Alonzo.FeeTooSmallUTxO Mismatch RelGTEQ Coin
m -> Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
forall era. Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
FeeTooSmallUTxO Mismatch RelGTEQ Coin
m
  Alonzo.ValueNotConservedUTxO Mismatch RelEQ (Value era)
m -> Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era
forall era. Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era
ValueNotConservedUTxO Mismatch RelEQ (Value era)
m
  Alonzo.WrongNetwork Network
x Set Addr
y -> Network -> Set Addr -> ConwayUtxoPredFailure era
forall era. Network -> Set Addr -> ConwayUtxoPredFailure era
WrongNetwork Network
x Set Addr
y
  Alonzo.WrongNetworkWithdrawal Network
x Set RewardAccount
y -> Network -> Set RewardAccount -> ConwayUtxoPredFailure era
forall era.
Network -> Set RewardAccount -> ConwayUtxoPredFailure era
WrongNetworkWithdrawal Network
x Set RewardAccount
y
  Alonzo.OutputTooSmallUTxO [TxOut era]
x -> [TxOut era] -> ConwayUtxoPredFailure era
forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputTooSmallUTxO [TxOut era]
x
  Alonzo.UtxosFailure PredicateFailure (EraRule "UTXOS" era)
x -> PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
forall era.
PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
UtxosFailure PredicateFailure (EraRule "UTXOS" era)
x
  Alonzo.OutputBootAddrAttrsTooBig [TxOut era]
xs -> [TxOut era] -> ConwayUtxoPredFailure era
forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputBootAddrAttrsTooBig [TxOut era]
xs
  Alonzo.OutputTooBigUTxO [(Int, Int, TxOut era)]
xs -> [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
forall era. [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
OutputTooBigUTxO [(Int, Int, TxOut era)]
xs
  Alonzo.InsufficientCollateral DeltaCoin
c1 Coin
c2 -> DeltaCoin -> Coin -> ConwayUtxoPredFailure era
forall era. DeltaCoin -> Coin -> ConwayUtxoPredFailure era
InsufficientCollateral DeltaCoin
c1 Coin
c2
  Alonzo.ScriptsNotPaidUTxO UTxO era
u -> UTxO era -> ConwayUtxoPredFailure era
forall era. UTxO era -> ConwayUtxoPredFailure era
ScriptsNotPaidUTxO UTxO era
u
  Alonzo.ExUnitsTooBigUTxO Mismatch RelLTEQ ExUnits
m -> Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era
ExUnitsTooBigUTxO Mismatch RelLTEQ ExUnits
m
  Alonzo.CollateralContainsNonADA Value era
v -> Value era -> ConwayUtxoPredFailure era
forall era. Value era -> ConwayUtxoPredFailure era
CollateralContainsNonADA Value era
v
  Alonzo.WrongNetworkInTxBody Mismatch RelEQ Network
m -> Mismatch RelEQ Network -> ConwayUtxoPredFailure era
forall era. Mismatch RelEQ Network -> ConwayUtxoPredFailure era
WrongNetworkInTxBody Mismatch RelEQ Network
m
  Alonzo.OutsideForecast SlotNo
sno -> SlotNo -> ConwayUtxoPredFailure era
forall era. SlotNo -> ConwayUtxoPredFailure era
OutsideForecast SlotNo
sno
  Alonzo.TooManyCollateralInputs Mismatch RelLTEQ Natural
m -> Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ Natural -> ConwayUtxoPredFailure era
TooManyCollateralInputs Mismatch RelLTEQ Natural
m
  AlonzoUtxoPredFailure era
Alonzo.NoCollateralInputs -> ConwayUtxoPredFailure era
forall era. ConwayUtxoPredFailure era
NoCollateralInputs

allegraToConwayUtxoPredFailure ::
  forall era.
  EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era =>
  Allegra.AllegraUtxoPredFailure era ->
  ConwayUtxoPredFailure era
allegraToConwayUtxoPredFailure :: forall era.
(EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era) =>
AllegraUtxoPredFailure era -> ConwayUtxoPredFailure era
allegraToConwayUtxoPredFailure = \case
  Allegra.BadInputsUTxO Set TxIn
x -> Set TxIn -> ConwayUtxoPredFailure era
forall era. Set TxIn -> ConwayUtxoPredFailure era
BadInputsUTxO Set TxIn
x
  Allegra.OutsideValidityIntervalUTxO ValidityInterval
vi SlotNo
slotNo -> ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
forall era. ValidityInterval -> SlotNo -> ConwayUtxoPredFailure era
OutsideValidityIntervalUTxO ValidityInterval
vi SlotNo
slotNo
  Allegra.MaxTxSizeUTxO Mismatch RelLTEQ Word32
m -> Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
forall era. Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Mismatch RelLTEQ Word32
m
  AllegraUtxoPredFailure era
Allegra.InputSetEmptyUTxO -> ConwayUtxoPredFailure era
forall era. ConwayUtxoPredFailure era
InputSetEmptyUTxO
  Allegra.FeeTooSmallUTxO Mismatch RelGTEQ Coin
m -> Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
forall era. Mismatch RelGTEQ Coin -> ConwayUtxoPredFailure era
FeeTooSmallUTxO Mismatch RelGTEQ Coin
m
  Allegra.ValueNotConservedUTxO Mismatch RelEQ (Value era)
m -> Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era
forall era. Mismatch RelEQ (Value era) -> ConwayUtxoPredFailure era
ValueNotConservedUTxO Mismatch RelEQ (Value era)
m
  Allegra.WrongNetwork Network
x Set Addr
y -> Network -> Set Addr -> ConwayUtxoPredFailure era
forall era. Network -> Set Addr -> ConwayUtxoPredFailure era
WrongNetwork Network
x Set Addr
y
  Allegra.WrongNetworkWithdrawal Network
x Set RewardAccount
y -> Network -> Set RewardAccount -> ConwayUtxoPredFailure era
forall era.
Network -> Set RewardAccount -> ConwayUtxoPredFailure era
WrongNetworkWithdrawal Network
x Set RewardAccount
y
  Allegra.OutputTooSmallUTxO [TxOut era]
x -> [TxOut era] -> ConwayUtxoPredFailure era
forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputTooSmallUTxO [TxOut era]
x
  Allegra.UpdateFailure EraRuleFailure "PPUP" era
x -> forall (rule :: Symbol) era a. VoidEraRule rule era -> a
absurdEraRule @"PPUP" @era EraRuleFailure "PPUP" era
VoidEraRule "PPUP" era
x
  Allegra.OutputBootAddrAttrsTooBig [TxOut era]
xs -> [TxOut era] -> ConwayUtxoPredFailure era
forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputBootAddrAttrsTooBig [TxOut era]
xs
  Allegra.OutputTooBigUTxO [TxOut era]
xs -> [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
forall era. [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
OutputTooBigUTxO ((TxOut era -> (Int, Int, TxOut era))
-> [TxOut era] -> [(Int, Int, TxOut era)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
0,Int
0,) [TxOut era]
xs)

instance InjectRuleFailure "UTXO" ConwayUtxosPredFailure ConwayEra where
  injectFailure :: ConwayUtxosPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
injectFailure = PredicateFailure (EraRule "UTXOS" ConwayEra)
-> ConwayUtxoPredFailure ConwayEra
ConwayUtxosPredFailure ConwayEra -> EraRuleFailure "UTXO" ConwayEra
forall era.
PredicateFailure (EraRule "UTXOS" era) -> ConwayUtxoPredFailure era
UtxosFailure