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

module Cardano.Ledger.Alonzo.Rules.Utxow (
  AlonzoUTXOW,
  AlonzoUtxowEvent (WrappedShelleyEraEvent),
  AlonzoUtxowPredFailure (..),
  hasExactSetOfRedeemers,
  missingRequiredDatums,
  checkScriptIntegrityHash,
) where

import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Era (AlonzoEra, AlonzoUTXOW)
import Cardano.Ledger.Alonzo.Rules.Utxo (
  AlonzoUTXO,
  AlonzoUtxoEvent,
  AlonzoUtxoPredFailure (..),
 )
import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure)
import Cardano.Ledger.Alonzo.Scripts (toAsItem, toAsIx)
import Cardano.Ledger.Alonzo.Tx (ScriptIntegrity (..), hashScriptIntegrity, mkScriptIntegrity)
import Cardano.Ledger.Alonzo.TxWits (
  unRedeemersL,
  unTxDatsL,
 )
import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO (..),
  AlonzoScriptsNeeded (..),
  getInputDataHashesTxBody,
 )
import Cardano.Ledger.BaseTypes (
  Mismatch (..),
  ProtVer (..),
  Relation (..),
  ShelleyBase,
  StrictMaybe (..),
  quorum,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), natVersion)
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Rules.ValidationMode (Test, runTest, runTestOnSignal)
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..))
import Cardano.Ledger.Shelley.Rules (
  ShelleyPpupPredFailure,
  ShelleyUtxoPredFailure,
  ShelleyUtxowEvent (UtxoEvent),
  ShelleyUtxowPredFailure (..),
  UtxoEnv (..),
  validateNeededWitnesses,
 )
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.Shelley.UTxO (ShelleyScriptsNeeded (..))
import Cardano.Ledger.State (
  EraCertState (..),
  EraUTxO (..),
  ScriptsProvided (..),
  UTxO (..),
  dsGenDelegsL,
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended
import Data.ByteString (ByteString)
import Data.Foldable (sequenceA_)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class
import Validation

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

-- | The Predicate failure type in the Alonzo Era. It embeds the Predicate
--   failure type of the Shelley Era, as they share some failure modes.
data AlonzoUtxowPredFailure era
  = ShelleyInAlonzoUtxowPredFailure (ShelleyUtxowPredFailure era)
  | -- | List of scripts for which no redeemers were supplied
    MissingRedeemers
      (NonEmpty (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
      (NonEmpty (PlutusPurpose AsIx era))
  | -- | The computed script integrity hash does not match the provided script integrity hash
    ScriptIntegrityHashMismatch
      (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
      (StrictMaybe ByteString)
  deriving ((forall x.
 AlonzoUtxowPredFailure era -> Rep (AlonzoUtxowPredFailure era) x)
-> (forall x.
    Rep (AlonzoUtxowPredFailure era) x -> AlonzoUtxowPredFailure era)
-> Generic (AlonzoUtxowPredFailure era)
forall x.
Rep (AlonzoUtxowPredFailure era) x -> AlonzoUtxowPredFailure era
forall x.
AlonzoUtxowPredFailure era -> Rep (AlonzoUtxowPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (AlonzoUtxowPredFailure era) x -> AlonzoUtxowPredFailure era
forall era x.
AlonzoUtxowPredFailure era -> Rep (AlonzoUtxowPredFailure era) x
$cfrom :: forall era x.
AlonzoUtxowPredFailure era -> Rep (AlonzoUtxowPredFailure era) x
from :: forall x.
AlonzoUtxowPredFailure era -> Rep (AlonzoUtxowPredFailure era) x
$cto :: forall era x.
Rep (AlonzoUtxowPredFailure era) x -> AlonzoUtxowPredFailure era
to :: forall x.
Rep (AlonzoUtxowPredFailure era) x -> AlonzoUtxowPredFailure era
Generic)

type instance EraRuleFailure "UTXOW" AlonzoEra = AlonzoUtxowPredFailure AlonzoEra

instance InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure AlonzoEra

instance InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure AlonzoEra where
  injectFailure :: ShelleyUtxowPredFailure AlonzoEra
-> EraRuleFailure "UTXOW" AlonzoEra
injectFailure = ShelleyUtxowPredFailure AlonzoEra
-> EraRuleFailure "UTXOW" AlonzoEra
ShelleyUtxowPredFailure AlonzoEra
-> AlonzoUtxowPredFailure AlonzoEra
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
ShelleyInAlonzoUtxowPredFailure

instance InjectRuleFailure "UTXOW" AlonzoUtxoPredFailure AlonzoEra where
  injectFailure :: AlonzoUtxoPredFailure AlonzoEra -> EraRuleFailure "UTXOW" AlonzoEra
injectFailure = ShelleyUtxowPredFailure AlonzoEra
-> AlonzoUtxowPredFailure AlonzoEra
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
ShelleyInAlonzoUtxowPredFailure (ShelleyUtxowPredFailure AlonzoEra
 -> AlonzoUtxowPredFailure AlonzoEra)
-> (AlonzoUtxoPredFailure AlonzoEra
    -> ShelleyUtxowPredFailure AlonzoEra)
-> AlonzoUtxoPredFailure AlonzoEra
-> AlonzoUtxowPredFailure AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "UTXO" AlonzoEra)
-> ShelleyUtxowPredFailure AlonzoEra
AlonzoUtxoPredFailure AlonzoEra
-> ShelleyUtxowPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure

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

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

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

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

deriving instance
  ( AlonzoEraScript era
  , Show (TxCert era)
  , Show (PredicateFailure (EraRule "UTXO" era))
  ) =>
  Show (AlonzoUtxowPredFailure era)

deriving instance
  ( AlonzoEraScript era
  , Eq (TxCert era)
  , Eq (PredicateFailure (EraRule "UTXO" era))
  ) =>
  Eq (AlonzoUtxowPredFailure era)

instance
  ( AlonzoEraScript era
  , NoThunks (TxCert era)
  , NoThunks (PredicateFailure (EraRule "UTXO" era))
  ) =>
  NoThunks (AlonzoUtxowPredFailure era)

instance
  ( AlonzoEraScript era
  , NFData (TxCert era)
  , NFData (PredicateFailure (EraRule "UTXO" era))
  ) =>
  NFData (AlonzoUtxowPredFailure era)

instance
  ( AlonzoEraScript era
  , EncCBOR (PredicateFailure (EraRule "UTXO" era))
  ) =>
  EncCBOR (AlonzoUtxowPredFailure era)
  where
  encCBOR :: AlonzoUtxowPredFailure era -> Encoding
encCBOR =
    Encode Open (AlonzoUtxowPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (AlonzoUtxowPredFailure era) -> Encoding)
-> (AlonzoUtxowPredFailure era
    -> Encode Open (AlonzoUtxowPredFailure era))
-> AlonzoUtxowPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ShelleyInAlonzoUtxowPredFailure ShelleyUtxowPredFailure era
x -> (ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open (ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
ShelleyInAlonzoUtxowPredFailure Word
0 Encode
  Open (ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (ShelleyUtxowPredFailure era)
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ShelleyUtxowPredFailure era
-> Encode (Closed Dense) (ShelleyUtxowPredFailure era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ShelleyUtxowPredFailure era
x
      MissingRedeemers NonEmpty (PlutusPurpose AsItem era, ScriptHash)
x -> (NonEmpty (PlutusPurpose AsItem era, ScriptHash)
 -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open
     (NonEmpty (PlutusPurpose AsItem era, ScriptHash)
      -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty (PlutusPurpose AsItem era, ScriptHash)
-> AlonzoUtxowPredFailure era
forall era.
NonEmpty (PlutusPurpose AsItem era, ScriptHash)
-> AlonzoUtxowPredFailure era
MissingRedeemers Word
1 Encode
  Open
  (NonEmpty (PlutusPurpose AsItem era, ScriptHash)
   -> AlonzoUtxowPredFailure era)
-> Encode
     (Closed Dense) (NonEmpty (PlutusPurpose AsItem era, ScriptHash))
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty (PlutusPurpose AsItem era, ScriptHash)
-> Encode
     (Closed Dense) (NonEmpty (PlutusPurpose AsItem era, ScriptHash))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty (PlutusPurpose AsItem era, ScriptHash)
x
      MissingRequiredDatums Set DataHash
x Set DataHash
y -> (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums Word
2 Encode
  Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (Set DataHash)
-> Encode Open (Set DataHash -> AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set DataHash -> Encode (Closed Dense) (Set DataHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set DataHash
x Encode Open (Set DataHash -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (Set DataHash)
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set DataHash -> Encode (Closed Dense) (Set DataHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set DataHash
y
      NotAllowedSupplementalDatums Set DataHash
x Set DataHash
y -> (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums Word
3 Encode
  Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (Set DataHash)
-> Encode Open (Set DataHash -> AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set DataHash -> Encode (Closed Dense) (Set DataHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set DataHash
x Encode Open (Set DataHash -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (Set DataHash)
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set DataHash -> Encode (Closed Dense) (Set DataHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set DataHash
y
      PPViewHashesDontMatch Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
m -> (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
 -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open
     (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
      -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> AlonzoUtxowPredFailure era
forall era.
Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> AlonzoUtxowPredFailure era
PPViewHashesDontMatch Word
4 Encode
  Open
  (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
   -> AlonzoUtxowPredFailure era)
-> Encode
     (Closed Dense) (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> Encode
     (Closed Dense) (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
m
      UnspendableUTxONoDatumHash Set TxIn
x -> (Set TxIn -> AlonzoUtxowPredFailure era)
-> Word -> Encode Open (Set TxIn -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Set TxIn -> AlonzoUtxowPredFailure era
forall era. Set TxIn -> AlonzoUtxowPredFailure era
UnspendableUTxONoDatumHash Word
6 Encode Open (Set TxIn -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (Set TxIn)
-> Encode Open (AlonzoUtxowPredFailure 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
x
      ExtraRedeemers NonEmpty (PlutusPurpose AsIx era)
x -> (NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open
     (NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era
forall era.
NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era
ExtraRedeemers Word
7 Encode
  Open
  (NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (NonEmpty (PlutusPurpose AsIx era))
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty (PlutusPurpose AsIx era)
-> Encode (Closed Dense) (NonEmpty (PlutusPurpose AsIx era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty (PlutusPurpose AsIx era)
x
      ScriptIntegrityHashMismatch Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
x StrictMaybe ByteString
y -> (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
 -> StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open
     (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
      -> StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ByteString -> AlonzoUtxowPredFailure era
forall era.
Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ByteString -> AlonzoUtxowPredFailure era
ScriptIntegrityHashMismatch Word
8 Encode
  Open
  (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
   -> StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
-> Encode
     (Closed Dense) (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
-> Encode
     Open (StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> Encode
     (Closed Dense) (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
x Encode Open (StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (StrictMaybe ByteString)
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe ByteString
-> Encode (Closed Dense) (StrictMaybe ByteString)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe ByteString
y

newtype AlonzoUtxowEvent era
  = WrappedShelleyEraEvent (ShelleyUtxowEvent era)
  deriving ((forall x. AlonzoUtxowEvent era -> Rep (AlonzoUtxowEvent era) x)
-> (forall x. Rep (AlonzoUtxowEvent era) x -> AlonzoUtxowEvent era)
-> Generic (AlonzoUtxowEvent era)
forall x. Rep (AlonzoUtxowEvent era) x -> AlonzoUtxowEvent era
forall x. AlonzoUtxowEvent era -> Rep (AlonzoUtxowEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoUtxowEvent era) x -> AlonzoUtxowEvent era
forall era x. AlonzoUtxowEvent era -> Rep (AlonzoUtxowEvent era) x
$cfrom :: forall era x. AlonzoUtxowEvent era -> Rep (AlonzoUtxowEvent era) x
from :: forall x. AlonzoUtxowEvent era -> Rep (AlonzoUtxowEvent era) x
$cto :: forall era x. Rep (AlonzoUtxowEvent era) x -> AlonzoUtxowEvent era
to :: forall x. Rep (AlonzoUtxowEvent era) x -> AlonzoUtxowEvent era
Generic)

deriving instance Eq (Event (EraRule "UTXO" era)) => Eq (AlonzoUtxowEvent era)

instance NFData (Event (EraRule "UTXO" era)) => NFData (AlonzoUtxowEvent era)

instance
  ( AlonzoEraScript era
  , DecCBOR (TxCert era)
  , DecCBOR (PredicateFailure (EraRule "UTXO" era))
  , Typeable (TxAuxData era)
  ) =>
  DecCBOR (AlonzoUtxowPredFailure era)
  where
  decCBOR :: forall s. Decoder s (AlonzoUtxowPredFailure era)
decCBOR =
    Decode (Closed Dense) (AlonzoUtxowPredFailure era)
-> Decoder s (AlonzoUtxowPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (AlonzoUtxowPredFailure era)
 -> Decoder s (AlonzoUtxowPredFailure era))
-> Decode (Closed Dense) (AlonzoUtxowPredFailure era)
-> Decoder s (AlonzoUtxowPredFailure era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode Open (AlonzoUtxowPredFailure era))
-> Decode (Closed Dense) (AlonzoUtxowPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"UtxowPredicateFail" ((Word -> Decode Open (AlonzoUtxowPredFailure era))
 -> Decode (Closed Dense) (AlonzoUtxowPredFailure era))
-> (Word -> Decode Open (AlonzoUtxowPredFailure era))
-> Decode (Closed Dense) (AlonzoUtxowPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
      Word
0 -> (ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era)
-> Decode
     Open (ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
ShelleyInAlonzoUtxowPredFailure Decode
  Open (ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 0)) (ShelleyUtxowPredFailure era)
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 0)) (ShelleyUtxowPredFailure era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
1 -> (NonEmpty (PlutusPurpose AsItem era, ScriptHash)
 -> AlonzoUtxowPredFailure era)
-> Decode
     Open
     (NonEmpty (PlutusPurpose AsItem era, ScriptHash)
      -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty (PlutusPurpose AsItem era, ScriptHash)
-> AlonzoUtxowPredFailure era
forall era.
NonEmpty (PlutusPurpose AsItem era, ScriptHash)
-> AlonzoUtxowPredFailure era
MissingRedeemers Decode
  Open
  (NonEmpty (PlutusPurpose AsItem era, ScriptHash)
   -> AlonzoUtxowPredFailure era)
-> Decode
     (Closed (ZonkAny 1))
     (NonEmpty (PlutusPurpose AsItem era, ScriptHash))
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 1))
  (NonEmpty (PlutusPurpose AsItem era, ScriptHash))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
2 -> (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode
     Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums Decode
  Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 3)) (Set DataHash)
-> Decode Open (Set DataHash -> AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) (Set DataHash)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 2)) (Set DataHash)
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) (Set DataHash)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
3 -> (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode
     Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums Decode
  Open (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 5)) (Set DataHash)
-> Decode Open (Set DataHash -> AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 5)) (Set DataHash)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 4)) (Set DataHash)
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 4)) (Set DataHash)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
4 -> (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
 -> AlonzoUtxowPredFailure era)
-> Decode
     Open
     (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
      -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> AlonzoUtxowPredFailure era
forall era.
Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> AlonzoUtxowPredFailure era
PPViewHashesDontMatch Decode
  Open
  (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
   -> AlonzoUtxowPredFailure era)
-> Decode
     (Closed (ZonkAny 6))
     (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 6))
  (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
6 -> (Set TxIn -> AlonzoUtxowPredFailure era)
-> Decode Open (Set TxIn -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD Set TxIn -> AlonzoUtxowPredFailure era
forall era. Set TxIn -> AlonzoUtxowPredFailure era
UnspendableUTxONoDatumHash Decode Open (Set TxIn -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 7)) (Set TxIn)
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 7)) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
7 -> (NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era)
-> Decode
     Open
     (NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era
forall era.
NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era
ExtraRedeemers Decode
  Open
  (NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 8)) (NonEmpty (PlutusPurpose AsIx era))
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 8)) (NonEmpty (PlutusPurpose AsIx era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
8 -> (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
 -> StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
-> Decode
     Open
     (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
      -> StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ByteString -> AlonzoUtxowPredFailure era
forall era.
Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ByteString -> AlonzoUtxowPredFailure era
ScriptIntegrityHashMismatch Decode
  Open
  (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
   -> StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
-> Decode
     (Closed (ZonkAny 10))
     (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
-> Decode
     Open (StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 10))
  (Mismatch RelEQ (StrictMaybe ScriptIntegrityHash))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (StrictMaybe ByteString -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 9)) (StrictMaybe ByteString)
-> Decode Open (AlonzoUtxowPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 9)) (StrictMaybe ByteString)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
n -> Word -> Decode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

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

{- { h | (_ → (a,_,h)) ∈ txins tx ◁ utxo, isTwoPhaseScriptAddress tx a} ⊆ dom(txdats txw)   -}
{- dom(txdats txw) ⊆ inputHashes ∪ {h | ( , , h, ) ∈ txouts tx ∪ utxo (refInputs tx) } -}
missingRequiredDatums ::
  forall era l.
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  ) =>
  UTxO era ->
  Tx l era ->
  Test (AlonzoUtxowPredFailure era)
missingRequiredDatums :: forall era (l :: TxLevel).
(AlonzoEraTx era, AlonzoEraUTxO era) =>
UTxO era -> Tx l era -> Test (AlonzoUtxowPredFailure era)
missingRequiredDatums UTxO era
utxo Tx l era
tx = do
  let txBody :: TxBody l era
txBody = Tx l era
tx Tx l era
-> Getting (TxBody l era) (Tx l era) (TxBody l era) -> TxBody l era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody l era) (Tx l era) (TxBody l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
      scriptsProvided :: ScriptsProvided era
scriptsProvided = UTxO era -> Tx l era -> ScriptsProvided era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> Tx t era -> ScriptsProvided era
forall (t :: TxLevel). UTxO era -> Tx t era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx l era
tx
      (Set DataHash
inputHashes, Set TxIn
txInsNoDataHash) = UTxO era
-> TxBody l era -> ScriptsProvided era -> (Set DataHash, Set TxIn)
forall era (l :: TxLevel).
(EraTxBody era, AlonzoEraTxOut era, AlonzoEraScript era) =>
UTxO era
-> TxBody l era -> ScriptsProvided era -> (Set DataHash, Set TxIn)
getInputDataHashesTxBody UTxO era
utxo TxBody l era
txBody ScriptsProvided era
scriptsProvided
      txHashes :: Set DataHash
txHashes = Map DataHash (Data era) -> Set DataHash
forall k a. Map k a -> Set k
Map.keysSet (Tx l era
tx Tx l era
-> Getting
     (Map DataHash (Data era)) (Tx l era) (Map DataHash (Data era))
-> Map DataHash (Data era)
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
-> Tx l era -> Const (Map DataHash (Data era)) (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
 -> Tx l era -> Const (Map DataHash (Data era)) (Tx l era))
-> ((Map DataHash (Data era)
     -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
    -> TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
-> Getting
     (Map DataHash (Data era)) (Tx l era) (Map DataHash (Data era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
-> TxWits era -> Const (Map DataHash (Data era)) (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
 -> TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
-> ((Map DataHash (Data era)
     -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
    -> TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
-> (Map DataHash (Data era)
    -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
-> TxWits era
-> Const (Map DataHash (Data era)) (TxWits era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map DataHash (Data era)
 -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
-> TxDats era -> Const (Map DataHash (Data era)) (TxDats era)
forall era. Era era => Lens' (TxDats era) (Map DataHash (Data era))
Lens' (TxDats era) (Map DataHash (Data era))
unTxDatsL)
      unmatchedDatumHashes :: Set DataHash
unmatchedDatumHashes = Set DataHash -> Set DataHash -> Set DataHash
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set DataHash
inputHashes Set DataHash
txHashes
      allowedSupplementalDataHashes :: Set DataHash
allowedSupplementalDataHashes = UTxO era -> TxBody l era -> Set DataHash
forall era (l :: TxLevel).
AlonzoEraUTxO era =>
UTxO era -> TxBody l era -> Set DataHash
forall (l :: TxLevel). UTxO era -> TxBody l era -> Set DataHash
getSupplementalDataHashes UTxO era
utxo TxBody l era
txBody
      supplimentalDatumHashes :: Set DataHash
supplimentalDatumHashes = Set DataHash -> Set DataHash -> Set DataHash
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set DataHash
txHashes Set DataHash
inputHashes
      (Set DataHash
okSupplimentalDHs, Set DataHash
notOkSupplimentalDHs) =
        (DataHash -> Bool) -> Set DataHash -> (Set DataHash, Set DataHash)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition (DataHash -> Set DataHash -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set DataHash
allowedSupplementalDataHashes) Set DataHash
supplimentalDatumHashes
  [Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()]
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_
    [ Bool
-> AlonzoUtxowPredFailure era
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless
        (Set TxIn -> Bool
forall a. Set a -> Bool
Set.null Set TxIn
txInsNoDataHash)
        (Set TxIn -> AlonzoUtxowPredFailure era
forall era. Set TxIn -> AlonzoUtxowPredFailure era
UnspendableUTxONoDatumHash Set TxIn
txInsNoDataHash)
    , Bool
-> AlonzoUtxowPredFailure era
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless
        (Set DataHash -> Bool
forall a. Set a -> Bool
Set.null Set DataHash
unmatchedDatumHashes)
        (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums Set DataHash
unmatchedDatumHashes Set DataHash
txHashes)
    , Bool
-> AlonzoUtxowPredFailure era
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless
        (Set DataHash -> Bool
forall a. Set a -> Bool
Set.null Set DataHash
notOkSupplimentalDHs)
        (Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums Set DataHash
notOkSupplimentalDHs Set DataHash
okSupplimentalDHs)
    ]

-- ==================
{-  dom (txrdmrs tx) = { rdptr txb sp | (sp, h) ∈ scriptsNeeded utxo tx,
                           h ↦ s ∈ txscripts txw, s ∈ Scriptph2}     -}
hasExactSetOfRedeemers ::
  forall era l.
  AlonzoEraTx era =>
  Tx l era ->
  ScriptsProvided era ->
  AlonzoScriptsNeeded era ->
  Test (AlonzoUtxowPredFailure era)
hasExactSetOfRedeemers :: forall era (l :: TxLevel).
AlonzoEraTx era =>
Tx l era
-> ScriptsProvided era
-> AlonzoScriptsNeeded era
-> Test (AlonzoUtxowPredFailure era)
hasExactSetOfRedeemers Tx l era
tx (ScriptsProvided Map ScriptHash (Script era)
scriptsProvided) (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash)]
scriptsNeeded) = do
  let redeemersNeeded :: [(PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))]
redeemersNeeded =
        [ ((forall ix it. AsIxItem ix it -> AsIx ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsIx era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsIx ix it
forall ix it. AsIxItem ix it -> AsIx ix it
toAsIx PlutusPurpose AsIxItem era
sp, ((forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsItem era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem PlutusPurpose AsIxItem era
sp, ScriptHash
sh))
        | (PlutusPurpose AsIxItem era
sp, ScriptHash
sh) <- [(PlutusPurpose AsIxItem era, ScriptHash)]
scriptsNeeded
        , Just Script era
script <- [ScriptHash -> Map ScriptHash (Script era) -> Maybe (Script era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
sh Map ScriptHash (Script era)
scriptsProvided]
        , Bool -> Bool
not (Script era -> Bool
forall era. EraScript era => Script era -> Bool
isNativeScript Script era
script)
        ]
      ([PlutusPurpose AsIx era]
extraRdmrs, [(PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))]
missingRdmrs) =
        [PlutusPurpose AsIx era]
-> (PlutusPurpose AsIx era -> PlutusPurpose AsIx era)
-> [(PlutusPurpose AsIx era,
     (PlutusPurpose AsItem era, ScriptHash))]
-> ((PlutusPurpose AsIx era,
     (PlutusPurpose AsItem era, ScriptHash))
    -> PlutusPurpose AsIx era)
-> ([PlutusPurpose AsIx era],
    [(PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))])
forall k a b.
Ord k =>
[a] -> (a -> k) -> [b] -> (b -> k) -> ([a], [b])
extSymmetricDifference
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> [PlutusPurpose AsIx era]
forall k a. Map k a -> [k]
Map.keys (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> [PlutusPurpose AsIx era])
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> [PlutusPurpose AsIx era]
forall a b. (a -> b) -> a -> b
$ Tx l era
tx Tx l era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx l era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall s a. s -> Getting a s a -> a
^. (TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Tx l era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
 -> Tx l era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx l era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> TxWits era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx l era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
 -> TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> Redeemers era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> Redeemers era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era)
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
unRedeemersL)
          PlutusPurpose AsIx era -> PlutusPurpose AsIx era
forall a. a -> a
id
          [(PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))]
redeemersNeeded
          (PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))
-> PlutusPurpose AsIx era
forall a b. (a, b) -> a
fst
  [Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()]
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_
    [ [PlutusPurpose AsIx era]
-> (NonEmpty (PlutusPurpose AsIx era)
    -> AlonzoUtxowPredFailure era)
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall (f :: * -> *) a e.
Foldable f =>
f a -> (NonEmpty a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmpty [PlutusPurpose AsIx era]
extraRdmrs NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era
forall era.
NonEmpty (PlutusPurpose AsIx era) -> AlonzoUtxowPredFailure era
ExtraRedeemers
    , [(PlutusPurpose AsItem era, ScriptHash)]
-> (NonEmpty (PlutusPurpose AsItem era, ScriptHash)
    -> AlonzoUtxowPredFailure era)
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall (f :: * -> *) a e.
Foldable f =>
f a -> (NonEmpty a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmpty (((PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))
 -> (PlutusPurpose AsItem era, ScriptHash))
-> [(PlutusPurpose AsIx era,
     (PlutusPurpose AsItem era, ScriptHash))]
-> [(PlutusPurpose AsItem era, ScriptHash)]
forall a b. (a -> b) -> [a] -> [b]
map (PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))
-> (PlutusPurpose AsItem era, ScriptHash)
forall a b. (a, b) -> b
snd [(PlutusPurpose AsIx era, (PlutusPurpose AsItem era, ScriptHash))]
missingRdmrs) NonEmpty (PlutusPurpose AsItem era, ScriptHash)
-> AlonzoUtxowPredFailure era
forall era.
NonEmpty (PlutusPurpose AsItem era, ScriptHash)
-> AlonzoUtxowPredFailure era
MissingRedeemers
    ]

-- =======================
{-  scriptIntegrityHash txb = hashScriptIntegrity pp (languages txw) (txrdmrs txw)  -}
checkScriptIntegrityHash ::
  forall era l.
  AlonzoEraTx era =>
  Tx l era ->
  PParams era ->
  StrictMaybe (ScriptIntegrity era) ->
  Test (AlonzoUtxowPredFailure era)
checkScriptIntegrityHash :: forall era (l :: TxLevel).
AlonzoEraTx era =>
Tx l era
-> PParams era
-> StrictMaybe (ScriptIntegrity era)
-> Test (AlonzoUtxowPredFailure era)
checkScriptIntegrityHash Tx l era
tx PParams era
pp StrictMaybe (ScriptIntegrity era)
scriptIntegrity = do
  let computedScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
computedScriptIntegrityHash = ScriptIntegrity era -> ScriptIntegrityHash
forall era. Era era => ScriptIntegrity era -> ScriptIntegrityHash
hashScriptIntegrity (ScriptIntegrity era -> ScriptIntegrityHash)
-> StrictMaybe (ScriptIntegrity era)
-> StrictMaybe ScriptIntegrityHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (ScriptIntegrity era)
scriptIntegrity
      suppliedScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
suppliedScriptIntegrityHash = Tx l era
tx Tx l era
-> Getting
     (StrictMaybe ScriptIntegrityHash)
     (Tx l era)
     (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ScriptIntegrityHash
forall s a. s -> Getting a s a -> a
^. (TxBody l era
 -> Const (StrictMaybe ScriptIntegrityHash) (TxBody l era))
-> Tx l era -> Const (StrictMaybe ScriptIntegrityHash) (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody l era
  -> Const (StrictMaybe ScriptIntegrityHash) (TxBody l era))
 -> Tx l era -> Const (StrictMaybe ScriptIntegrityHash) (Tx l era))
-> ((StrictMaybe ScriptIntegrityHash
     -> Const
          (StrictMaybe ScriptIntegrityHash)
          (StrictMaybe ScriptIntegrityHash))
    -> TxBody l era
    -> Const (StrictMaybe ScriptIntegrityHash) (TxBody l era))
-> Getting
     (StrictMaybe ScriptIntegrityHash)
     (Tx l era)
     (StrictMaybe ScriptIntegrityHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe ScriptIntegrityHash
 -> Const
      (StrictMaybe ScriptIntegrityHash)
      (StrictMaybe ScriptIntegrityHash))
-> TxBody l era
-> Const (StrictMaybe ScriptIntegrityHash) (TxBody l era)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
      expectedScriptIntegrity :: StrictMaybe ByteString
expectedScriptIntegrity = ScriptIntegrity era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (ScriptIntegrity era -> ByteString)
-> StrictMaybe (ScriptIntegrity era) -> StrictMaybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (ScriptIntegrity era)
scriptIntegrity
      mismatch :: Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
mismatch =
        Mismatch
          { mismatchSupplied :: StrictMaybe ScriptIntegrityHash
mismatchSupplied = StrictMaybe ScriptIntegrityHash
suppliedScriptIntegrityHash
          , mismatchExpected :: StrictMaybe ScriptIntegrityHash
mismatchExpected = StrictMaybe ScriptIntegrityHash
computedScriptIntegrityHash
          }
  Bool
-> AlonzoUtxowPredFailure era
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless
    (StrictMaybe ScriptIntegrityHash
suppliedScriptIntegrityHash StrictMaybe ScriptIntegrityHash
-> StrictMaybe ScriptIntegrityHash -> Bool
forall a. Eq a => a -> a -> Bool
== StrictMaybe ScriptIntegrityHash
computedScriptIntegrityHash)
    (AlonzoUtxowPredFailure era
 -> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ())
-> AlonzoUtxowPredFailure era
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall a b. (a -> b) -> a -> b
$ if ProtVer -> Version
pvMajor (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL) Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @11
      then Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> AlonzoUtxowPredFailure era
forall era.
Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> AlonzoUtxowPredFailure era
PPViewHashesDontMatch Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
mismatch
      else Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ByteString -> AlonzoUtxowPredFailure era
forall era.
Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ByteString -> AlonzoUtxowPredFailure era
ScriptIntegrityHashMismatch Mismatch RelEQ (StrictMaybe ScriptIntegrityHash)
mismatch StrictMaybe ByteString
expectedScriptIntegrity

-- ==============================================================
-- Here we define the transtion function, using reusable tests.
-- The tests are very generic and reusabe, but the transition
-- function is very specific to the Alonzo Era.

-- | A very specialized transitionRule function for the Alonzo Era.
alonzoStyleWitness ::
  forall era.
  ( AlonzoEraTx era
  , ShelleyEraTxBody era
  , AlonzoEraUTxO era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraRule "UTXOW" era ~ AlonzoUTXOW era
  , InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era
  , -- Allow UTXOW to call UTXO
    Embed (EraRule "UTXO" era) (AlonzoUTXOW era)
  , Environment (EraRule "UTXO" era) ~ UtxoEnv era
  , State (EraRule "UTXO" era) ~ UTxOState era
  , Signal (EraRule "UTXO" era) ~ Tx TopTx era
  , EraCertState era
  ) =>
  TransitionRule (EraRule "UTXOW" era)
alonzoStyleWitness :: forall era.
(AlonzoEraTx era, ShelleyEraTxBody era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraRule "UTXOW" era ~ AlonzoUTXOW era,
 InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era,
 Embed (EraRule "UTXO" era) (AlonzoUTXOW era),
 Environment (EraRule "UTXO" era) ~ UtxoEnv era,
 State (EraRule "UTXO" era) ~ UTxOState era,
 Signal (EraRule "UTXO" era) ~ Tx TopTx era, EraCertState era) =>
TransitionRule (EraRule "UTXOW" era)
alonzoStyleWitness = do
  TRC (utxoEnv@(UtxoEnv _ pp certState), u, tx) <- Rule
  (AlonzoUTXOW era)
  'Transition
  (RuleContext 'Transition (AlonzoUTXOW era))
F (Clause (AlonzoUTXOW era) 'Transition) (TRC (AlonzoUTXOW era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext

  {-  (utxo,_,_,_ ) := utxoSt  -}
  {-  txb := txbody tx  -}
  {-  txw := txwits tx  -}
  {-  witsKeyHashes := { hashKey vk | vk ∈ dom(txwitsVKey txw) }  -}
  let utxo = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo State (AlonzoUTXOW era)
UTxOState era
u
      txBody = Tx TopTx era
Signal (AlonzoUTXOW era)
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
      witsKeyHashes = TxWits era -> Set (KeyHash Witness)
forall era. EraTxWits era => TxWits era -> Set (KeyHash Witness)
keyHashWitnessesTxWits (Tx TopTx era
Signal (AlonzoUTXOW era)
tx Tx TopTx era
-> Getting (TxWits era) (Tx TopTx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx TopTx era) (TxWits era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL)
      scriptsProvided = UTxO era -> Tx TopTx era -> ScriptsProvided era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> Tx t era -> ScriptsProvided era
forall (t :: TxLevel). UTxO era -> Tx t era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx TopTx era
Signal (AlonzoUTXOW era)
tx

  -- check scripts
  {-  ∀ s ∈ range(txscripts txw) ∩ Scriptnative), runNativeScript s tx   -}
  runTestOnSignal $ Shelley.validateFailedNativeScripts scriptsProvided tx

  {-  { h | (_,h) ∈ scriptsNeeded utxo tx} = dom(txscripts txw)          -}
  let scriptsNeeded = UTxO era -> TxBody TopTx era -> ScriptsNeeded era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
forall (t :: TxLevel).
UTxO era -> TxBody t era -> ScriptsNeeded era
getScriptsNeeded UTxO era
utxo TxBody TopTx era
txBody
      scriptsHashesNeeded = ScriptsNeeded era -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded ScriptsNeeded era
scriptsNeeded
      shelleyScriptsNeeded = Set ScriptHash -> ShelleyScriptsNeeded era
forall era. Set ScriptHash -> ShelleyScriptsNeeded era
ShelleyScriptsNeeded Set ScriptHash
scriptsHashesNeeded
  runTest $ Shelley.validateMissingScripts shelleyScriptsNeeded scriptsProvided

  {- inputHashes := { h | (_ → (a,_,h)) ∈ txins tx ◁ utxo, isTwoPhaseScriptAddress tx a} -}
  {-  inputHashes ⊆ dom(txdats txw)  -}
  runTest $ missingRequiredDatums utxo tx

  {- dom(txdats txw) ⊆ inputHashes ∪ {h | ( , , h) ∈ txouts tx -}
  -- This is incorporated into missingRequiredDatums, see the
  -- (failure . UnspendableUTxONoDatumHash) path.

  {-  dom (txrdmrs tx) = { rdptr txb sp | (sp, h) ∈ scriptsNeeded utxo tx,
                           h ↦ s ∈ txscripts txw, s ∈ Scriptph2}     -}
  runTest $ hasExactSetOfRedeemers tx scriptsProvided scriptsNeeded

  -- check VKey witnesses
  {-  ∀ (vk ↦ σ) ∈ (txwitsVKey txw), V_vk⟦ txBodyHash ⟧_σ                -}
  runTestOnSignal $ Shelley.validateVerifiedWits tx

  {-  witsVKeyNeeded utxo tx genDelegs ⊆ witsKeyHashes                   -}
  runTest $ validateNeededWitnesses witsKeyHashes certState utxo txBody

  -- check genesis keys signatures for instantaneous rewards certificates
  {-  genSig := { hashKey gkey | gkey ∈ dom(genDelegs)} ∩ witsKeyHashes  -}
  {-  { c ∈ txcerts txb ∩ TxCert_mir} ≠ ∅  ⇒ (|genSig| ≥ Quorum) ∧ (d pp > 0)  -}
  let genDelegs = CertState era
certState CertState era
-> Getting GenDelegs (CertState era) GenDelegs -> GenDelegs
forall s a. s -> Getting a s a -> a
^. (DState era -> Const GenDelegs (DState era))
-> CertState era -> Const GenDelegs (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const GenDelegs (DState era))
 -> CertState era -> Const GenDelegs (CertState era))
-> ((GenDelegs -> Const GenDelegs GenDelegs)
    -> DState era -> Const GenDelegs (DState era))
-> Getting GenDelegs (CertState era) GenDelegs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenDelegs -> Const GenDelegs GenDelegs)
-> DState era -> Const GenDelegs (DState era)
forall era (f :: * -> *).
Functor f =>
(GenDelegs -> f GenDelegs) -> DState era -> f (DState era)
dsGenDelegsL
  coreNodeQuorum <- liftSTS $ asks quorum
  runTest $
    Shelley.validateMIRInsufficientGenesisSigs genDelegs coreNodeQuorum witsKeyHashes tx

  -- check metadata hash
  {-   adh := txADhash txb;  ad := auxiliaryData tx                      -}
  {-  ((adh = ◇) ∧ (ad= ◇)) ∨ (adh = hashAD ad)                          -}
  runTestOnSignal $ Shelley.validateMetadata pp tx

  {- languages txw ⊆ dom(costmdls pp)  -}
  -- This check is checked when building the TxInfo using collectTwoPhaseScriptInputs, if it fails
  -- It raises 'NoCostModel' a constructor of the predicate failure 'CollectError'.

  let scriptIntegrity = PParams era
-> Tx TopTx era
-> ScriptsProvided era
-> Set ScriptHash
-> StrictMaybe (ScriptIntegrity era)
forall era (l :: TxLevel).
(AlonzoEraPParams era, AlonzoEraTxWits era, EraUTxO era) =>
PParams era
-> Tx l era
-> ScriptsProvided era
-> Set ScriptHash
-> StrictMaybe (ScriptIntegrity era)
mkScriptIntegrity PParams era
pp Tx TopTx era
Signal (AlonzoUTXOW era)
tx ScriptsProvided era
scriptsProvided Set ScriptHash
scriptsHashesNeeded
  {-  scriptIntegrityHash txb = hashScriptIntegrity pp (languages txw) (txrdmrs txw)  -}
  runTest $ checkScriptIntegrityHash tx pp scriptIntegrity

  trans @(EraRule "UTXO" era) $ TRC (utxoEnv, u, tx)

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

extSymmetricDifference :: Ord k => [a] -> (a -> k) -> [b] -> (b -> k) -> ([a], [b])
extSymmetricDifference :: forall k a b.
Ord k =>
[a] -> (a -> k) -> [b] -> (b -> k) -> ([a], [b])
extSymmetricDifference [a]
as a -> k
fa [b]
bs b -> k
fb = ([a]
extraA, [b]
extraB)
  where
    intersection :: Set k
intersection = [k] -> Set k
forall a. Ord a => [a] -> Set a
Set.fromList ((a -> k) -> [a] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map a -> k
fa [a]
as) Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` [k] -> Set k
forall a. Ord a => [a] -> Set a
Set.fromList ((b -> k) -> [b] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map b -> k
fb [b]
bs)
    extraA :: [a]
extraA = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> k
fa a
x k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set k
intersection) [a]
as
    extraB :: [b]
extraB = (b -> Bool) -> [b] -> [b]
forall a. (a -> Bool) -> [a] -> [a]
filter (\b
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ b -> k
fb b
x k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set k
intersection) [b]
bs

-- ====================================
-- Make the STS instance

instance
  forall era.
  ( AlonzoEraTx era
  , EraTxAuxData era
  , AlonzoEraUTxO era
  , ShelleyEraTxBody era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraRule "UTXOW" era ~ AlonzoUTXOW era
  , InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era
  , -- Allow UTXOW to call UTXO
    Embed (EraRule "UTXO" era) (AlonzoUTXOW era)
  , Environment (EraRule "UTXO" era) ~ UtxoEnv era
  , State (EraRule "UTXO" era) ~ UTxOState era
  , Signal (EraRule "UTXO" era) ~ Tx TopTx era
  , EraCertState era
  ) =>
  STS (AlonzoUTXOW era)
  where
  type State (AlonzoUTXOW era) = UTxOState era
  type Signal (AlonzoUTXOW era) = Tx TopTx era
  type Environment (AlonzoUTXOW era) = UtxoEnv era
  type BaseM (AlonzoUTXOW era) = ShelleyBase
  type PredicateFailure (AlonzoUTXOW era) = AlonzoUtxowPredFailure era
  type Event (AlonzoUTXOW era) = AlonzoUtxowEvent era
  transitionRules :: [TransitionRule (AlonzoUTXOW era)]
transitionRules = [forall era.
(AlonzoEraTx era, ShelleyEraTxBody era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraRule "UTXOW" era ~ AlonzoUTXOW era,
 InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era,
 Embed (EraRule "UTXO" era) (AlonzoUTXOW era),
 Environment (EraRule "UTXO" era) ~ UtxoEnv era,
 State (EraRule "UTXO" era) ~ UTxOState era,
 Signal (EraRule "UTXO" era) ~ Tx TopTx era, EraCertState era) =>
TransitionRule (EraRule "UTXOW" era)
alonzoStyleWitness @era]
  initialRules :: [InitialRule (AlonzoUTXOW era)]
initialRules = []

instance
  ( Era era
  , STS (AlonzoUTXO era)
  , PredicateFailure (EraRule "UTXO" era) ~ AlonzoUtxoPredFailure era
  , Event (EraRule "UTXO" era) ~ AlonzoUtxoEvent era
  , BaseM (AlonzoUTXOW era) ~ ShelleyBase
  , PredicateFailure (AlonzoUTXOW era) ~ AlonzoUtxowPredFailure era
  , Event (AlonzoUTXOW era) ~ AlonzoUtxowEvent era
  ) =>
  Embed (AlonzoUTXO era) (AlonzoUTXOW era)
  where
  wrapFailed :: PredicateFailure (AlonzoUTXO era)
-> PredicateFailure (AlonzoUTXOW era)
wrapFailed = ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
ShelleyInAlonzoUtxowPredFailure (ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era)
-> (AlonzoUtxoPredFailure era -> ShelleyUtxowPredFailure era)
-> AlonzoUtxoPredFailure era
-> AlonzoUtxowPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
AlonzoUtxoPredFailure era -> ShelleyUtxowPredFailure era
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure
  wrapEvent :: Event (AlonzoUTXO era) -> Event (AlonzoUTXOW era)
wrapEvent = ShelleyUtxowEvent era -> AlonzoUtxowEvent era
forall era. ShelleyUtxowEvent era -> AlonzoUtxowEvent era
WrappedShelleyEraEvent (ShelleyUtxowEvent era -> AlonzoUtxowEvent era)
-> (AlonzoUtxoEvent era -> ShelleyUtxowEvent era)
-> AlonzoUtxoEvent era
-> AlonzoUtxowEvent era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (EraRule "UTXO" era) -> ShelleyUtxowEvent era
AlonzoUtxoEvent era -> ShelleyUtxowEvent era
forall era. Event (EraRule "UTXO" era) -> ShelleyUtxowEvent era
UtxoEvent