{-# 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.Set.NonEmpty (NonEmptySet)
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
      -- | Set of missing data hashes
      (NonEmptySet DataHash)
      -- | Set of received data hashes
      (Set DataHash)
  | NotAllowedSupplementalDatums
      -- | Set of unallowed data hashes
      (NonEmptySet 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
      (NonEmptySet 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 NonEmptySet DataHash
x Set DataHash
y -> (NonEmptySet DataHash
 -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open
     (NonEmptySet DataHash
      -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums Word
2 Encode
  Open
  (NonEmptySet DataHash
   -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (NonEmptySet 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
!> NonEmptySet DataHash
-> Encode (Closed Dense) (NonEmptySet DataHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmptySet 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 NonEmptySet DataHash
x Set DataHash
y -> (NonEmptySet DataHash
 -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Word
-> Encode
     Open
     (NonEmptySet DataHash
      -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums Word
3 Encode
  Open
  (NonEmptySet DataHash
   -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (NonEmptySet 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
!> NonEmptySet DataHash
-> Encode (Closed Dense) (NonEmptySet DataHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmptySet 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 NonEmptySet TxIn
x -> (NonEmptySet TxIn -> AlonzoUtxowPredFailure era)
-> Word
-> Encode Open (NonEmptySet TxIn -> AlonzoUtxowPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmptySet TxIn -> AlonzoUtxowPredFailure era
forall era. NonEmptySet TxIn -> AlonzoUtxowPredFailure era
UnspendableUTxONoDatumHash Word
6 Encode Open (NonEmptySet TxIn -> AlonzoUtxowPredFailure era)
-> Encode (Closed Dense) (NonEmptySet TxIn)
-> Encode Open (AlonzoUtxowPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmptySet TxIn -> Encode (Closed Dense) (NonEmptySet TxIn)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmptySet 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 -> (NonEmptySet DataHash
 -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode
     Open
     (NonEmptySet DataHash
      -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums Decode
  Open
  (NonEmptySet DataHash
   -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 3)) (NonEmptySet 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)) (NonEmptySet 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 -> (NonEmptySet DataHash
 -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode
     Open
     (NonEmptySet DataHash
      -> Set DataHash -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums Decode
  Open
  (NonEmptySet DataHash
   -> Set DataHash -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 5)) (NonEmptySet 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)) (NonEmptySet 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 -> (NonEmptySet TxIn -> AlonzoUtxowPredFailure era)
-> Decode Open (NonEmptySet TxIn -> AlonzoUtxowPredFailure era)
forall t. t -> Decode Open t
SumD NonEmptySet TxIn -> AlonzoUtxowPredFailure era
forall era. NonEmptySet TxIn -> AlonzoUtxowPredFailure era
UnspendableUTxONoDatumHash Decode Open (NonEmptySet TxIn -> AlonzoUtxowPredFailure era)
-> Decode (Closed (ZonkAny 7)) (NonEmptySet 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)) (NonEmptySet 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_
    [ Set TxIn
-> (NonEmptySet TxIn -> AlonzoUtxowPredFailure era)
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall (f :: * -> *) a e.
(Foldable f, Ord a) =>
f a -> (NonEmptySet a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmptySet Set TxIn
txInsNoDataHash NonEmptySet TxIn -> AlonzoUtxowPredFailure era
forall era. NonEmptySet TxIn -> AlonzoUtxowPredFailure era
UnspendableUTxONoDatumHash
    , Set DataHash
-> (NonEmptySet DataHash -> AlonzoUtxowPredFailure era)
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall (f :: * -> *) a e.
(Foldable f, Ord a) =>
f a -> (NonEmptySet a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmptySet Set DataHash
unmatchedDatumHashes (\NonEmptySet DataHash
unmatched -> NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums NonEmptySet DataHash
unmatched Set DataHash
txHashes)
    , Set DataHash
-> (NonEmptySet DataHash -> AlonzoUtxowPredFailure era)
-> Validation (NonEmpty (AlonzoUtxowPredFailure era)) ()
forall (f :: * -> *) a e.
(Foldable f, Ord a) =>
f a -> (NonEmptySet a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmptySet
        Set DataHash
notOkSupplimentalDHs
        (\NonEmptySet DataHash
notOk -> NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
NonEmptySet DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums NonEmptySet DataHash
notOk 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