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

module Cardano.Ledger.Conway.Rules.Utxow (
  alonzoToConwayUtxowPredFailure,
  babbageToConwayUtxowPredFailure,
  ConwayUTXOW,
  ConwayUtxowPredFailure (..),
  shelleyToConwayUtxowPredFailure,
)
where

import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
import Cardano.Ledger.Alonzo.Rules (
  AlonzoUtxoEvent,
  AlonzoUtxoPredFailure,
  AlonzoUtxosPredFailure,
  AlonzoUtxowEvent (WrappedShelleyEraEvent),
  AlonzoUtxowPredFailure,
 )
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo (AlonzoUtxowPredFailure (..))
import Cardano.Ledger.Alonzo.UTxO (AlonzoEraUTxO, AlonzoScriptsNeeded)
import Cardano.Ledger.Babbage.Rules (
  BabbageUtxoPredFailure,
  BabbageUtxowPredFailure,
  babbageUtxowTransition,
 )
import qualified Cardano.Ledger.Babbage.Rules as Babbage (BabbageUtxowPredFailure (..))
import Cardano.Ledger.BaseTypes (Mismatch (..), Relation (..), ShelleyBase)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayUTXO, ConwayUTXOW)
import Cardano.Ledger.Conway.Rules.Utxo (ConwayUtxoPredFailure)
import Cardano.Ledger.Conway.Rules.Utxos (ConwayUtxosPredFailure)
import Cardano.Ledger.Keys (VKey)
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley (UTxOState)
import Cardano.Ledger.Shelley.Rules (
  ShelleyUtxoPredFailure,
  ShelleyUtxowEvent (UtxoEvent),
  ShelleyUtxowPredFailure,
 )
import qualified Cardano.Ledger.Shelley.Rules as Shelley (
  ShelleyUtxowPredFailure (..),
  UtxoEnv,
 )
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Ledger.UTxO (EraUTxO (..))
import Control.DeepSeq (NFData)
import Control.State.Transition.Extended (Embed (..), STS (..))
import Data.Maybe.Strict (StrictMaybe)
import Data.Set (Set)
import GHC.Generics (Generic)
import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))

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

-- | Predicate failure type for the Conway Era
data ConwayUtxowPredFailure era
  = UtxoFailure (PredicateFailure (EraRule "UTXO" era))
  | InvalidWitnessesUTXOW
      ![VKey 'Witness]
  | -- | witnesses which failed in verifiedWits function
    MissingVKeyWitnessesUTXOW
      -- | witnesses which were needed and not supplied
      !(Set (KeyHash 'Witness))
  | -- | missing scripts
    MissingScriptWitnessesUTXOW
      !(Set ScriptHash)
  | -- | failed scripts
    ScriptWitnessNotValidatingUTXOW
      !(Set ScriptHash)
  | -- | hash of the full metadata
    MissingTxBodyMetadataHash
      !TxAuxDataHash
  | -- | hash of the metadata included in the transaction body
    MissingTxMetadata
      !TxAuxDataHash
  | ConflictingMetadataHash
      !(Mismatch 'RelEQ TxAuxDataHash)
  | -- | Contains out of range values (string`s too long)
    InvalidMetadata
  | -- | extraneous scripts
    ExtraneousScriptWitnessesUTXOW
      !(Set ScriptHash)
  | MissingRedeemers
      ![(PlutusPurpose AsItem era, ScriptHash)]
  | MissingRequiredDatums
      -- TODO: Make this NonEmpty #4066

      -- | Set of missing data hashes
      !(Set DataHash)
      -- | Set of received data hashes
      !(Set DataHash)
  | NotAllowedSupplementalDatums
      -- TODO: Make this NonEmpty #4066

      -- | Set of unallowed data hashes.
      !(Set DataHash)
      -- | Set of acceptable supplemental data hashes
      !(Set DataHash)
  | PPViewHashesDontMatch
      !(Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash))
  | -- | Set of transaction inputs that are TwoPhase scripts, and should have a DataHash but don't
    UnspendableUTxONoDatumHash
      -- TODO: Make this NonEmpty #4066
      (Set TxIn)
  | -- | List of redeemers not needed
    ExtraRedeemers ![PlutusPurpose AsIx era]
  | -- | Embed UTXO rule failures
    MalformedScriptWitnesses
      !(Set ScriptHash)
  | -- | the set of malformed script witnesses
    MalformedReferenceScripts
      !(Set ScriptHash)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayUtxowPredFailure era) x -> ConwayUtxowPredFailure era
forall era x.
ConwayUtxowPredFailure era -> Rep (ConwayUtxowPredFailure era) x
$cto :: forall era x.
Rep (ConwayUtxowPredFailure era) x -> ConwayUtxowPredFailure era
$cfrom :: forall era x.
ConwayUtxowPredFailure era -> Rep (ConwayUtxowPredFailure era) x
Generic)

type instance EraRuleFailure "UTXOW" ConwayEra = ConwayUtxowPredFailure ConwayEra

type instance EraRuleEvent "UTXOW" ConwayEra = AlonzoUtxowEvent ConwayEra

instance InjectRuleFailure "UTXOW" ConwayUtxowPredFailure ConwayEra

instance InjectRuleFailure "UTXOW" BabbageUtxowPredFailure ConwayEra where
  injectFailure :: BabbageUtxowPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
BabbageUtxowPredFailure era -> ConwayUtxowPredFailure era
babbageToConwayUtxowPredFailure

instance InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure ConwayEra where
  injectFailure :: AlonzoUtxowPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
AlonzoUtxowPredFailure era -> ConwayUtxowPredFailure era
alonzoToConwayUtxowPredFailure

instance InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure ConwayEra where
  injectFailure :: ShelleyUtxowPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
ShelleyUtxowPredFailure era -> ConwayUtxowPredFailure era
shelleyToConwayUtxowPredFailure

instance InjectRuleFailure "UTXOW" ConwayUtxoPredFailure ConwayEra where
  injectFailure :: ConwayUtxoPredFailure ConwayEra -> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "UTXOW" BabbageUtxoPredFailure ConwayEra where
  injectFailure :: BabbageUtxoPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "UTXOW" AlonzoUtxoPredFailure ConwayEra where
  injectFailure :: AlonzoUtxoPredFailure ConwayEra -> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure ConwayEra where
  injectFailure :: AlonzoUtxosPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "UTXOW" ConwayUtxosPredFailure ConwayEra where
  injectFailure :: ConwayUtxosPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "UTXOW" ShelleyUtxoPredFailure ConwayEra where
  injectFailure :: ShelleyUtxoPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "UTXOW" AllegraUtxoPredFailure ConwayEra where
  injectFailure :: AllegraUtxoPredFailure ConwayEra
-> EraRuleFailure "UTXOW" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

deriving instance
  ( ConwayEraScript era
  , Show (PredicateFailure (EraRule "UTXO" era))
  ) =>
  Show (ConwayUtxowPredFailure era)

deriving instance
  ( ConwayEraScript era
  , Eq (PredicateFailure (EraRule "UTXO" era))
  ) =>
  Eq (ConwayUtxowPredFailure era)

deriving via
  InspectHeapNamed "ConwayUtxowPred" (ConwayUtxowPredFailure era)
  instance
    NoThunks (ConwayUtxowPredFailure era)

instance
  ( ConwayEraScript era
  , NFData (TxCert era)
  , NFData (PredicateFailure (EraRule "UTXO" era))
  ) =>
  NFData (ConwayUtxowPredFailure era)

--------------------------------------------------------------------------------
-- ConwayUTXOW STS
--------------------------------------------------------------------------------

instance
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , ConwayEraTxBody era
  , EraRule "UTXOW" era ~ ConwayUTXOW era
  , InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era
  , InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era
  , -- Allow UTXOW to call UTXO
    Embed (EraRule "UTXO" era) (ConwayUTXOW era)
  , Environment (EraRule "UTXO" era) ~ Shelley.UtxoEnv era
  , State (EraRule "UTXO" era) ~ Shelley.UTxOState era
  , Signal (EraRule "UTXO" era) ~ Tx era
  , Eq (PredicateFailure (EraRule "UTXOS" era))
  , Show (PredicateFailure (EraRule "UTXOS" era))
  ) =>
  STS (ConwayUTXOW era)
  where
  type State (ConwayUTXOW era) = Shelley.UTxOState era
  type Signal (ConwayUTXOW era) = Tx era
  type Environment (ConwayUTXOW era) = Shelley.UtxoEnv era
  type BaseM (ConwayUTXOW era) = ShelleyBase
  type PredicateFailure (ConwayUTXOW era) = ConwayUtxowPredFailure era
  type Event (ConwayUTXOW era) = AlonzoUtxowEvent era
  transitionRules :: [TransitionRule (ConwayUTXOW era)]
transitionRules = [forall era.
(AlonzoEraTx era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era, BabbageEraTxBody era,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Signal (EraRule "UTXOW" era) ~ Tx era,
 State (EraRule "UTXOW" era) ~ UTxOState era,
 InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 Embed (EraRule "UTXO" era) (EraRule "UTXOW" era),
 Environment (EraRule "UTXO" era) ~ UtxoEnv era,
 Signal (EraRule "UTXO" era) ~ Tx era,
 State (EraRule "UTXO" era) ~ UTxOState era) =>
TransitionRule (EraRule "UTXOW" era)
babbageUtxowTransition @era]
  initialRules :: [InitialRule (ConwayUTXOW era)]
initialRules = []

instance
  ( Era era
  , STS (ConwayUTXO era)
  , PredicateFailure (EraRule "UTXO" era) ~ ConwayUtxoPredFailure era
  , Event (EraRule "UTXO" era) ~ AlonzoUtxoEvent era
  , BaseM (ConwayUTXOW era) ~ ShelleyBase
  , PredicateFailure (ConwayUTXOW era) ~ ConwayUtxowPredFailure era
  , Event (ConwayUTXOW era) ~ AlonzoUtxowEvent era
  ) =>
  Embed (ConwayUTXO era) (ConwayUTXOW era)
  where
  wrapFailed :: PredicateFailure (ConwayUTXO era)
-> PredicateFailure (ConwayUTXOW era)
wrapFailed = forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure
  wrapEvent :: Event (ConwayUTXO era) -> Event (ConwayUTXOW era)
wrapEvent = forall era. ShelleyUtxowEvent era -> AlonzoUtxowEvent era
WrappedShelleyEraEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Event (EraRule "UTXO" era) -> ShelleyUtxowEvent era
UtxoEvent

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

instance
  ( ConwayEraScript era
  , EncCBOR (PredicateFailure (EraRule "UTXO" era))
  ) =>
  EncCBOR (ConwayUtxowPredFailure era)
  where
  encCBOR :: ConwayUtxowPredFailure era -> Encoding
encCBOR =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      UtxoFailure PredicateFailure (EraRule "UTXO" era)
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "UTXO" era)
x
      InvalidWitnessesUTXOW [VKey 'Witness]
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era. [VKey 'Witness] -> ConwayUtxowPredFailure era
InvalidWitnessesUTXOW Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [VKey 'Witness]
xs
      MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Set (KeyHash 'Witness) -> ConwayUtxowPredFailure era
MissingVKeyWitnessesUTXOW Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (KeyHash 'Witness)
xs
      MissingScriptWitnessesUTXOW Set ScriptHash
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MissingScriptWitnessesUTXOW Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set ScriptHash
xs
      ScriptWitnessNotValidatingUTXOW Set ScriptHash
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Set ScriptHash -> ConwayUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW Word
4 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set ScriptHash
xs
      MissingTxBodyMetadataHash TxAuxDataHash
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era. TxAuxDataHash -> ConwayUtxowPredFailure era
MissingTxBodyMetadataHash Word
5 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxAuxDataHash
xs
      MissingTxMetadata TxAuxDataHash
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era. TxAuxDataHash -> ConwayUtxowPredFailure era
MissingTxMetadata Word
6 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxAuxDataHash
xs
      ConflictingMetadataHash Mismatch 'RelEQ TxAuxDataHash
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Mismatch 'RelEQ TxAuxDataHash -> ConwayUtxowPredFailure era
ConflictingMetadataHash Word
7 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ TxAuxDataHash
mm
      ConwayUtxowPredFailure era
InvalidMetadata -> forall t. t -> Word -> Encode 'Open t
Sum forall era. ConwayUtxowPredFailure era
InvalidMetadata Word
8
      ExtraneousScriptWitnessesUTXOW Set ScriptHash
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Set ScriptHash -> ConwayUtxowPredFailure era
ExtraneousScriptWitnessesUTXOW Word
9 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set ScriptHash
xs
      MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash)]
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
[(PlutusPurpose AsItem era, ScriptHash)]
-> ConwayUtxowPredFailure era
MissingRedeemers Word
10 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [(PlutusPurpose AsItem era, ScriptHash)]
x
      MissingRequiredDatums Set DataHash
x Set DataHash
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set DataHash -> Set DataHash -> ConwayUtxowPredFailure era
MissingRequiredDatums Word
11 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set DataHash
x forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set DataHash
y
      NotAllowedSupplementalDatums Set DataHash
x Set DataHash
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set DataHash -> Set DataHash -> ConwayUtxowPredFailure era
NotAllowedSupplementalDatums Word
12 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set DataHash
x forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set DataHash
y
      PPViewHashesDontMatch Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
-> ConwayUtxowPredFailure era
PPViewHashesDontMatch Word
13 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
mm
      UnspendableUTxONoDatumHash Set TxIn
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Set TxIn -> ConwayUtxowPredFailure era
UnspendableUTxONoDatumHash Word
14 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set TxIn
x
      ExtraRedeemers [PlutusPurpose AsIx era]
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era. [PlutusPurpose AsIx era] -> ConwayUtxowPredFailure era
ExtraRedeemers Word
15 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [PlutusPurpose AsIx era]
x
      MalformedScriptWitnesses Set ScriptHash
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MalformedScriptWitnesses Word
16 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set ScriptHash
x
      MalformedReferenceScripts Set ScriptHash
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MalformedReferenceScripts Word
17 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set ScriptHash
x

instance
  ( ConwayEraScript era
  , DecCBOR (PredicateFailure (EraRule "UTXO" era))
  ) =>
  DecCBOR (ConwayUtxowPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayUtxowPredFailure era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayUtxowPred" forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> forall t. t -> Decode 'Open t
SumD forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> forall t. t -> Decode 'Open t
SumD forall era. [VKey 'Witness] -> ConwayUtxowPredFailure era
InvalidWitnessesUTXOW forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> forall t. t -> Decode 'Open t
SumD forall era. Set (KeyHash 'Witness) -> ConwayUtxowPredFailure era
MissingVKeyWitnessesUTXOW forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> forall t. t -> Decode 'Open t
SumD forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MissingScriptWitnessesUTXOW forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> forall t. t -> Decode 'Open t
SumD forall era. Set ScriptHash -> ConwayUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> forall t. t -> Decode 'Open t
SumD forall era. TxAuxDataHash -> ConwayUtxowPredFailure era
MissingTxBodyMetadataHash forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
6 -> forall t. t -> Decode 'Open t
SumD forall era. TxAuxDataHash -> ConwayUtxowPredFailure era
MissingTxMetadata forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
7 -> forall t. t -> Decode 'Open t
SumD forall era.
Mismatch 'RelEQ TxAuxDataHash -> ConwayUtxowPredFailure era
ConflictingMetadataHash forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
8 -> forall t. t -> Decode 'Open t
SumD forall era. ConwayUtxowPredFailure era
InvalidMetadata
    Word
9 -> forall t. t -> Decode 'Open t
SumD forall era. Set ScriptHash -> ConwayUtxowPredFailure era
ExtraneousScriptWitnessesUTXOW forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
10 -> forall t. t -> Decode 'Open t
SumD forall era.
[(PlutusPurpose AsItem era, ScriptHash)]
-> ConwayUtxowPredFailure era
MissingRedeemers forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
11 -> forall t. t -> Decode 'Open t
SumD forall era.
Set DataHash -> Set DataHash -> ConwayUtxowPredFailure era
MissingRequiredDatums forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
12 -> forall t. t -> Decode 'Open t
SumD forall era.
Set DataHash -> Set DataHash -> ConwayUtxowPredFailure era
NotAllowedSupplementalDatums forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
13 -> forall t. t -> Decode 'Open t
SumD forall era.
Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
-> ConwayUtxowPredFailure era
PPViewHashesDontMatch forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
14 -> forall t. t -> Decode 'Open t
SumD forall era. Set TxIn -> ConwayUtxowPredFailure era
UnspendableUTxONoDatumHash forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
15 -> forall t. t -> Decode 'Open t
SumD forall era. [PlutusPurpose AsIx era] -> ConwayUtxowPredFailure era
ExtraRedeemers forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
16 -> forall t. t -> Decode 'Open t
SumD forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MalformedScriptWitnesses forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
17 -> forall t. t -> Decode 'Open t
SumD forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MalformedReferenceScripts forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

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

babbageToConwayUtxowPredFailure ::
  forall era.
  BabbageUtxowPredFailure era ->
  ConwayUtxowPredFailure era
babbageToConwayUtxowPredFailure :: forall era.
BabbageUtxowPredFailure era -> ConwayUtxowPredFailure era
babbageToConwayUtxowPredFailure = \case
  Babbage.AlonzoInBabbageUtxowPredFailure AlonzoUtxowPredFailure era
x -> forall era.
AlonzoUtxowPredFailure era -> ConwayUtxowPredFailure era
alonzoToConwayUtxowPredFailure AlonzoUtxowPredFailure era
x
  Babbage.UtxoFailure PredicateFailure (EraRule "UTXO" era)
x -> forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure PredicateFailure (EraRule "UTXO" era)
x
  Babbage.MalformedScriptWitnesses Set ScriptHash
xs -> forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MalformedScriptWitnesses Set ScriptHash
xs
  Babbage.MalformedReferenceScripts Set ScriptHash
xs -> forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MalformedReferenceScripts Set ScriptHash
xs

alonzoToConwayUtxowPredFailure ::
  forall era.
  AlonzoUtxowPredFailure era ->
  ConwayUtxowPredFailure era
alonzoToConwayUtxowPredFailure :: forall era.
AlonzoUtxowPredFailure era -> ConwayUtxowPredFailure era
alonzoToConwayUtxowPredFailure = \case
  Alonzo.ShelleyInAlonzoUtxowPredFailure ShelleyUtxowPredFailure era
f -> forall era.
ShelleyUtxowPredFailure era -> ConwayUtxowPredFailure era
shelleyToConwayUtxowPredFailure ShelleyUtxowPredFailure era
f
  Alonzo.MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash)]
rs -> forall era.
[(PlutusPurpose AsItem era, ScriptHash)]
-> ConwayUtxowPredFailure era
MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash)]
rs
  Alonzo.MissingRequiredDatums Set DataHash
mds Set DataHash
rds -> forall era.
Set DataHash -> Set DataHash -> ConwayUtxowPredFailure era
MissingRequiredDatums Set DataHash
mds Set DataHash
rds
  Alonzo.NotAllowedSupplementalDatums Set DataHash
uds Set DataHash
ads -> forall era.
Set DataHash -> Set DataHash -> ConwayUtxowPredFailure era
NotAllowedSupplementalDatums Set DataHash
uds Set DataHash
ads
  Alonzo.PPViewHashesDontMatch Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
m -> forall era.
Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
-> ConwayUtxowPredFailure era
PPViewHashesDontMatch Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash)
m
  Alonzo.MissingRequiredSigners Set (KeyHash 'Witness)
_xs ->
    forall a. HasCallStack => String -> a
error String
"Impossible case. It will be removed once we are in Conway. See #3972"
  Alonzo.UnspendableUTxONoDatumHash Set TxIn
ins -> forall era. Set TxIn -> ConwayUtxowPredFailure era
UnspendableUTxONoDatumHash Set TxIn
ins
  Alonzo.ExtraRedeemers [PlutusPurpose AsIx era]
xs -> forall era. [PlutusPurpose AsIx era] -> ConwayUtxowPredFailure era
ExtraRedeemers [PlutusPurpose AsIx era]
xs

shelleyToConwayUtxowPredFailure :: ShelleyUtxowPredFailure era -> ConwayUtxowPredFailure era
shelleyToConwayUtxowPredFailure :: forall era.
ShelleyUtxowPredFailure era -> ConwayUtxowPredFailure era
shelleyToConwayUtxowPredFailure = \case
  Shelley.InvalidWitnessesUTXOW [VKey 'Witness]
xs -> forall era. [VKey 'Witness] -> ConwayUtxowPredFailure era
InvalidWitnessesUTXOW [VKey 'Witness]
xs
  Shelley.MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
xs -> forall era. Set (KeyHash 'Witness) -> ConwayUtxowPredFailure era
MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
xs
  Shelley.MissingScriptWitnessesUTXOW Set ScriptHash
xs -> forall era. Set ScriptHash -> ConwayUtxowPredFailure era
MissingScriptWitnessesUTXOW Set ScriptHash
xs
  Shelley.ScriptWitnessNotValidatingUTXOW Set ScriptHash
xs -> forall era. Set ScriptHash -> ConwayUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW Set ScriptHash
xs
  Shelley.UtxoFailure PredicateFailure (EraRule "UTXO" era)
x -> forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
UtxoFailure PredicateFailure (EraRule "UTXO" era)
x
  Shelley.MIRInsufficientGenesisSigsUTXOW Set (KeyHash 'Witness)
_xs ->
    forall a. HasCallStack => String -> a
error String
"Impossible: MIR has been removed in Conway"
  Shelley.MissingTxBodyMetadataHash TxAuxDataHash
x -> forall era. TxAuxDataHash -> ConwayUtxowPredFailure era
MissingTxBodyMetadataHash TxAuxDataHash
x
  Shelley.MissingTxMetadata TxAuxDataHash
x -> forall era. TxAuxDataHash -> ConwayUtxowPredFailure era
MissingTxMetadata TxAuxDataHash
x
  Shelley.ConflictingMetadataHash Mismatch 'RelEQ TxAuxDataHash
mm -> forall era.
Mismatch 'RelEQ TxAuxDataHash -> ConwayUtxowPredFailure era
ConflictingMetadataHash Mismatch 'RelEQ TxAuxDataHash
mm
  ShelleyUtxowPredFailure era
Shelley.InvalidMetadata -> forall era. ConwayUtxowPredFailure era
InvalidMetadata
  Shelley.ExtraneousScriptWitnessesUTXOW Set ScriptHash
xs -> forall era. Set ScriptHash -> ConwayUtxowPredFailure era
ExtraneousScriptWitnessesUTXOW Set ScriptHash
xs