{-# 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 (
  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.Alonzo.Tx (AlonzoTx (..))
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 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 Integer)
  | 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" 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

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
  , Tx era ~ AlonzoTx 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 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) = AlonzoTx 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,
 Tx era ~ AlonzoTx 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) ~ AlonzoTx 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 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 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 Integer
mm -> (Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era)
-> Word
-> Encode
     'Open (Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
forall era. Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Word
3 Encode
  'Open (Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelLTEQ Integer)
-> Encode 'Open (ConwayUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Mismatch 'RelLTEQ Integer
-> Encode ('Closed 'Dense) (Mismatch 'RelLTEQ Integer)
forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelLTEQ Integer
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 Any) (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 Any) (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 Any) (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 Any) (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 Any) 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 Any) ValidityInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (SlotNo -> ConwayUtxoPredFailure era)
-> Decode ('Closed Any) 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 Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era)
-> Decode
     'Open (Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
forall era. Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Decode
  'Open (Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelLTEQ Integer)
-> 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 Any) (Mismatch 'RelLTEQ Integer)
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 Any) (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 Any) (Coin, Coin)
-> Decode ('Closed Any) (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 Any) (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 Any) (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 Any) (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 Any) 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 Any) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Set Addr -> ConwayUtxoPredFailure era)
-> Decode ('Closed Any) (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 Any) (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 Any) 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 Any) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Set RewardAccount -> ConwayUtxoPredFailure era)
-> Decode ('Closed Any) (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 Any) (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 Any) [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 Any) [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 Any) [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 Any) [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 Any) [(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 Any) [(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 Any) 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 Any) DeltaCoin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Coin -> ConwayUtxoPredFailure era)
-> Decode ('Closed Any) 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 Any) 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 Any) (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 Any) (ExUnits, ExUnits)
-> Decode ('Closed Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (Network, Network)
-> Decode ('Closed Any) (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 Any) (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 Any) 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 Any) 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 Any) (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 Any) (Natural, Natural)
-> Decode ('Closed Any) (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 Any) (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 Any) 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 Any) DeltaCoin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Coin -> ConwayUtxoPredFailure era)
-> Decode ('Closed Any) 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 Any) 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 Any) [(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 Any) [(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 Any) (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 Any) (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 Integer
m -> Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
forall era. Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Mismatch 'RelLTEQ Integer
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
  AlonzoUtxoPredFailure era
Alonzo.TriesToForgeADA ->
    String -> ConwayUtxoPredFailure era
forall a. HasCallStack => String -> a
error
      String
"Impossible case, soon to be removed. See: https://github.com/IntersectMBO/cardano-ledger/issues/4085"
  Alonzo.OutputTooBigUTxO [(Integer, Integer, TxOut era)]
xs ->
    let
      -- TODO: Remove this once the other eras will make the switch from Integer to Int
      -- as per #4015.
      -- https://github.com/IntersectMBO/cardano-ledger/issues/4085
      toRestricted :: (Integer, Integer, TxOut era) -> (Int, Int, TxOut era)
      toRestricted :: (Integer, Integer, TxOut era) -> (Int, Int, TxOut era)
toRestricted (Integer
sz, Integer
mv, TxOut era
out) = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sz, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
mv, TxOut era
out)
     in
      [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
forall era. [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
OutputTooBigUTxO ([(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era)
-> [(Int, Int, TxOut era)] -> ConwayUtxoPredFailure era
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer, TxOut era) -> (Int, Int, TxOut era))
-> [(Integer, Integer, TxOut era)] -> [(Int, Int, TxOut era)]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Integer, TxOut era) -> (Int, Int, TxOut era)
toRestricted [(Integer, Integer, 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 Integer
m -> Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
forall era. Mismatch 'RelLTEQ Integer -> ConwayUtxoPredFailure era
MaxTxSizeUTxO Mismatch 'RelLTEQ Integer
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 VoidEraRule "PPUP" era
EraRuleFailure "PPUP" era
x
  Allegra.OutputBootAddrAttrsTooBig [TxOut era]
xs -> [TxOut era] -> ConwayUtxoPredFailure era
forall era. [TxOut era] -> ConwayUtxoPredFailure era
OutputBootAddrAttrsTooBig [TxOut era]
xs
  AllegraUtxoPredFailure era
Allegra.TriesToForgeADA ->
    String -> ConwayUtxoPredFailure era
forall a. HasCallStack => String -> a
error
      String
"Impossible case, soon to be removed. See: https://github.com/IntersectMBO/cardano-ledger/issues/4085"
  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)