{-# 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.Crypto.DSIGN.Class (DSIGNAlgorithm (..), Signable)
import Cardano.Crypto.Hash.Class (Hash)
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.AuxiliaryData (AuxiliaryDataHash)
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.Crypto (DSIGN, HASH)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..), 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 (EraCrypto era)]
  | -- | witnesses which failed in verifiedWits function
    MissingVKeyWitnessesUTXOW
      -- | witnesses which were needed and not supplied
      !(Set (KeyHash 'Witness (EraCrypto era)))
  | -- | missing scripts
    MissingScriptWitnessesUTXOW
      !(Set (ScriptHash (EraCrypto era)))
  | -- | failed scripts
    ScriptWitnessNotValidatingUTXOW
      !(Set (ScriptHash (EraCrypto era)))
  | -- | hash of the full metadata
    MissingTxBodyMetadataHash
      !(AuxiliaryDataHash (EraCrypto era))
  | -- | hash of the metadata included in the transaction body
    MissingTxMetadata
      !(AuxiliaryDataHash (EraCrypto era))
  | ConflictingMetadataHash
      !(Mismatch 'RelEQ (AuxiliaryDataHash (EraCrypto era)))
  | -- | Contains out of range values (string`s too long)
    InvalidMetadata
  | -- | extraneous scripts
    ExtraneousScriptWitnessesUTXOW
      !(Set (ScriptHash (EraCrypto era)))
  | MissingRedeemers
      ![(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
  | MissingRequiredDatums
      -- TODO: Make this NonEmpty #4066

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

      -- | Set of unallowed data hashes.
      !(Set (DataHash (EraCrypto era)))
      -- | Set of acceptable supplemental data hashes
      !(Set (DataHash (EraCrypto era)))
  | PPViewHashesDontMatch
      !(Mismatch 'RelEQ (StrictMaybe (ScriptIntegrityHash (EraCrypto era))))
  | -- | Set of transaction inputs that are TwoPhase scripts, and should have a DataHash but don't
    UnspendableUTxONoDatumHash
      -- TODO: Make this NonEmpty #4066
      (Set (TxIn (EraCrypto era)))
  | -- | List of redeemers not needed
    ExtraRedeemers ![PlutusPurpose AsIx era]
  | -- | Embed UTXO rule failures
    MalformedScriptWitnesses
      !(Set (ScriptHash (EraCrypto era)))
  | -- | the set of malformed script witnesses
    MalformedReferenceScripts
      !(Set (ScriptHash (EraCrypto era)))
  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 c) = ConwayUtxowPredFailure (ConwayEra c)

type instance EraRuleEvent "UTXOW" (ConwayEra c) = AlonzoUtxowEvent (ConwayEra c)

instance InjectRuleFailure "UTXOW" ConwayUtxowPredFailure (ConwayEra c)

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

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

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

instance InjectRuleFailure "UTXOW" ConwayUtxoPredFailure (ConwayEra c) where
  injectFailure :: ConwayUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "UTXOW" (ConwayEra c)
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 c) where
  injectFailure :: BabbageUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "UTXOW" (ConwayEra c)
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 c) where
  injectFailure :: AlonzoUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "UTXOW" (ConwayEra c)
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 c) where
  injectFailure :: AlonzoUtxosPredFailure (ConwayEra c)
-> EraRuleFailure "UTXOW" (ConwayEra c)
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 c) where
  injectFailure :: ConwayUtxosPredFailure (ConwayEra c)
-> EraRuleFailure "UTXOW" (ConwayEra c)
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 c) where
  injectFailure :: ShelleyUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "UTXOW" (ConwayEra c)
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 c) where
  injectFailure :: AllegraUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "UTXOW" (ConwayEra c)
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 (VerKeyDSIGN (DSIGN (EraCrypto era)))
  ) =>
  NFData (ConwayUtxowPredFailure era)

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

instance
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , ConwayEraTxBody era
  , Signable (DSIGN (EraCrypto era)) (Hash (HASH (EraCrypto era)) EraIndependentTxBody)
  , 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,
 Signable
   (DSIGN (EraCrypto era))
   (Hash (HASH (EraCrypto era)) EraIndependentTxBody),
 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 (EraCrypto era)]
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
[VKey 'Witness (EraCrypto era)] -> 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 (EraCrypto era)]
xs
      MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness (EraCrypto era))
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (KeyHash 'Witness (EraCrypto era))
-> 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 (EraCrypto era))
xs
      MissingScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (ScriptHash (EraCrypto era)) -> 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 (EraCrypto era))
xs
      ScriptWitnessNotValidatingUTXOW Set (ScriptHash (EraCrypto era))
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (ScriptHash (EraCrypto era)) -> 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 (EraCrypto era))
xs
      MissingTxBodyMetadataHash AuxiliaryDataHash (EraCrypto era)
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
AuxiliaryDataHash (EraCrypto era) -> 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 AuxiliaryDataHash (EraCrypto era)
xs
      MissingTxMetadata AuxiliaryDataHash (EraCrypto era)
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
AuxiliaryDataHash (EraCrypto era) -> 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 AuxiliaryDataHash (EraCrypto era)
xs
      ConflictingMetadataHash Mismatch 'RelEQ (AuxiliaryDataHash (EraCrypto era))
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Mismatch 'RelEQ (AuxiliaryDataHash (EraCrypto era))
-> 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 (AuxiliaryDataHash (EraCrypto era))
mm
      ConwayUtxowPredFailure era
InvalidMetadata -> forall t. t -> Word -> Encode 'Open t
Sum forall era. ConwayUtxowPredFailure era
InvalidMetadata Word
8
      ExtraneousScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
xs -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (ScriptHash (EraCrypto era)) -> 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 (EraCrypto era))
xs
      MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
[(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
-> 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 (EraCrypto era))]
x
      MissingRequiredDatums Set (DataHash (EraCrypto era))
x Set (DataHash (EraCrypto era))
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (DataHash (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> 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 (EraCrypto era))
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 (EraCrypto era))
y
      NotAllowedSupplementalDatums Set (DataHash (EraCrypto era))
x Set (DataHash (EraCrypto era))
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (DataHash (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> 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 (EraCrypto era))
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 (EraCrypto era))
y
      PPViewHashesDontMatch Mismatch 'RelEQ (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Mismatch 'RelEQ (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
-> 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 (EraCrypto era)))
mm
      UnspendableUTxONoDatumHash Set (TxIn (EraCrypto era))
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (TxIn (EraCrypto era)) -> 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 (EraCrypto era))
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 (EraCrypto era))
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (ScriptHash (EraCrypto era)) -> 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 (EraCrypto era))
x
      MalformedReferenceScripts Set (ScriptHash (EraCrypto era))
x -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (ScriptHash (EraCrypto era)) -> 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 (EraCrypto era))
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 (EraCrypto era)] -> 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 (EraCrypto era))
-> 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 (EraCrypto era)) -> 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 (EraCrypto era)) -> 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.
AuxiliaryDataHash (EraCrypto era) -> 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.
AuxiliaryDataHash (EraCrypto era) -> 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 (AuxiliaryDataHash (EraCrypto era))
-> 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 (EraCrypto era)) -> 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 (EraCrypto era))]
-> 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 (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> 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 (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> 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 (EraCrypto era)))
-> 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 (EraCrypto era)) -> 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 (EraCrypto era)) -> 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 (EraCrypto era)) -> 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 (EraCrypto era))
xs -> forall era.
Set (ScriptHash (EraCrypto era)) -> ConwayUtxowPredFailure era
MalformedScriptWitnesses Set (ScriptHash (EraCrypto era))
xs
  Babbage.MalformedReferenceScripts Set (ScriptHash (EraCrypto era))
xs -> forall era.
Set (ScriptHash (EraCrypto era)) -> ConwayUtxowPredFailure era
MalformedReferenceScripts Set (ScriptHash (EraCrypto era))
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 (EraCrypto era))]
rs -> forall era.
[(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
-> ConwayUtxowPredFailure era
MissingRedeemers [(PlutusPurpose AsItem era, ScriptHash (EraCrypto era))]
rs
  Alonzo.MissingRequiredDatums Set (DataHash (EraCrypto era))
mds Set (DataHash (EraCrypto era))
rds -> forall era.
Set (DataHash (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> ConwayUtxowPredFailure era
MissingRequiredDatums Set (DataHash (EraCrypto era))
mds Set (DataHash (EraCrypto era))
rds
  Alonzo.NotAllowedSupplementalDatums Set (DataHash (EraCrypto era))
uds Set (DataHash (EraCrypto era))
ads -> forall era.
Set (DataHash (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> ConwayUtxowPredFailure era
NotAllowedSupplementalDatums Set (DataHash (EraCrypto era))
uds Set (DataHash (EraCrypto era))
ads
  Alonzo.PPViewHashesDontMatch Mismatch 'RelEQ (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
m -> forall era.
Mismatch 'RelEQ (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
-> ConwayUtxowPredFailure era
PPViewHashesDontMatch Mismatch 'RelEQ (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
m
  Alonzo.MissingRequiredSigners Set (KeyHash 'Witness (EraCrypto era))
_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 (EraCrypto era))
ins -> forall era.
Set (TxIn (EraCrypto era)) -> ConwayUtxowPredFailure era
UnspendableUTxONoDatumHash Set (TxIn (EraCrypto era))
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 (EraCrypto era)]
xs -> forall era.
[VKey 'Witness (EraCrypto era)] -> ConwayUtxowPredFailure era
InvalidWitnessesUTXOW [VKey 'Witness (EraCrypto era)]
xs
  Shelley.MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness (EraCrypto era))
xs -> forall era.
Set (KeyHash 'Witness (EraCrypto era))
-> ConwayUtxowPredFailure era
MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness (EraCrypto era))
xs
  Shelley.MissingScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
xs -> forall era.
Set (ScriptHash (EraCrypto era)) -> ConwayUtxowPredFailure era
MissingScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
xs
  Shelley.ScriptWitnessNotValidatingUTXOW Set (ScriptHash (EraCrypto era))
xs -> forall era.
Set (ScriptHash (EraCrypto era)) -> ConwayUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW Set (ScriptHash (EraCrypto era))
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 (EraCrypto era))
_xs ->
    forall a. HasCallStack => String -> a
error String
"Impossible: MIR has been removed in Conway"
  Shelley.MissingTxBodyMetadataHash AuxiliaryDataHash (EraCrypto era)
x -> forall era.
AuxiliaryDataHash (EraCrypto era) -> ConwayUtxowPredFailure era
MissingTxBodyMetadataHash AuxiliaryDataHash (EraCrypto era)
x
  Shelley.MissingTxMetadata AuxiliaryDataHash (EraCrypto era)
x -> forall era.
AuxiliaryDataHash (EraCrypto era) -> ConwayUtxowPredFailure era
MissingTxMetadata AuxiliaryDataHash (EraCrypto era)
x
  Shelley.ConflictingMetadataHash Mismatch 'RelEQ (AuxiliaryDataHash (EraCrypto era))
mm -> forall era.
Mismatch 'RelEQ (AuxiliaryDataHash (EraCrypto era))
-> ConwayUtxowPredFailure era
ConflictingMetadataHash Mismatch 'RelEQ (AuxiliaryDataHash (EraCrypto era))
mm
  ShelleyUtxowPredFailure era
Shelley.InvalidMetadata -> forall era. ConwayUtxowPredFailure era
InvalidMetadata
  Shelley.ExtraneousScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
xs -> forall era.
Set (ScriptHash (EraCrypto era)) -> ConwayUtxowPredFailure era
ExtraneousScriptWitnessesUTXOW Set (ScriptHash (EraCrypto era))
xs