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

module Cardano.Ledger.Conway.Rules.Utxos (
  ConwayUTXOS,
  ConwayUtxosPredFailure (..),
  ConwayUtxosEvent (..),
  alonzoToConwayUtxosPredFailure,
  alonzoToConwayUtxosEvent,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusContext)
import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..))
import Cardano.Ledger.Alonzo.Rules (
  AlonzoUtxoEvent (..),
  AlonzoUtxoPredFailure (..),
  AlonzoUtxosEvent,
  AlonzoUtxosPredFailure,
  TagMismatchDescription,
  validBegin,
  validEnd,
 )
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo (
  AlonzoUtxosEvent (..),
  AlonzoUtxosPredFailure (..),
 )
import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO,
  AlonzoScriptsNeeded,
 )
import Cardano.Ledger.Babbage.Rules (
  BabbageUTXO,
  BabbageUtxoPredFailure (..),
  babbageEvalScriptsTxInvalid,
  expectScriptsToPass,
 )
import Cardano.Ledger.Babbage.Tx
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayUTXOS)
import Cardano.Ledger.Conway.Governance (ConwayGovState)
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Plutus (PlutusWithContext)
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..), utxosDonationL)
import Control.DeepSeq (NFData)
import Control.State.Transition.Extended
import Data.List.NonEmpty (NonEmpty)
import qualified Debug.Trace as Debug
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)

data ConwayUtxosPredFailure era
  = -- | The 'isValid' tag on the transaction is incorrect. The tag given
    --   here is that provided on the transaction (whereas evaluation of the
    --   scripts gives the opposite.). The Text tries to explain why it failed.
    ValidationTagMismatch IsValid TagMismatchDescription
  | -- | We could not find all the necessary inputs for a Plutus Script.
    -- Previous PredicateFailure tests should make this impossible, but the
    -- consequences of not detecting this means scripts get dropped, so things
    -- might validate that shouldn't. So we double check in the function
    -- collectTwoPhaseScriptInputs, it should find data for every Script.
    CollectErrors (NonEmpty (CollectError era))
  deriving
    ((forall x.
 ConwayUtxosPredFailure era -> Rep (ConwayUtxosPredFailure era) x)
-> (forall x.
    Rep (ConwayUtxosPredFailure era) x -> ConwayUtxosPredFailure era)
-> Generic (ConwayUtxosPredFailure era)
forall x.
Rep (ConwayUtxosPredFailure era) x -> ConwayUtxosPredFailure era
forall x.
ConwayUtxosPredFailure era -> Rep (ConwayUtxosPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayUtxosPredFailure era) x -> ConwayUtxosPredFailure era
forall era x.
ConwayUtxosPredFailure era -> Rep (ConwayUtxosPredFailure era) x
$cfrom :: forall era x.
ConwayUtxosPredFailure era -> Rep (ConwayUtxosPredFailure era) x
from :: forall x.
ConwayUtxosPredFailure era -> Rep (ConwayUtxosPredFailure era) x
$cto :: forall era x.
Rep (ConwayUtxosPredFailure era) x -> ConwayUtxosPredFailure era
to :: forall x.
Rep (ConwayUtxosPredFailure era) x -> ConwayUtxosPredFailure era
Generic)

data ConwayUtxosEvent era
  = SuccessfulPlutusScriptsEvent (NonEmpty PlutusWithContext)
  | FailedPlutusScriptsEvent (NonEmpty PlutusWithContext)
  deriving ((forall x. ConwayUtxosEvent era -> Rep (ConwayUtxosEvent era) x)
-> (forall x. Rep (ConwayUtxosEvent era) x -> ConwayUtxosEvent era)
-> Generic (ConwayUtxosEvent era)
forall x. Rep (ConwayUtxosEvent era) x -> ConwayUtxosEvent era
forall x. ConwayUtxosEvent era -> Rep (ConwayUtxosEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayUtxosEvent era) x -> ConwayUtxosEvent era
forall era x. ConwayUtxosEvent era -> Rep (ConwayUtxosEvent era) x
$cfrom :: forall era x. ConwayUtxosEvent era -> Rep (ConwayUtxosEvent era) x
from :: forall x. ConwayUtxosEvent era -> Rep (ConwayUtxosEvent era) x
$cto :: forall era x. Rep (ConwayUtxosEvent era) x -> ConwayUtxosEvent era
to :: forall x. Rep (ConwayUtxosEvent era) x -> ConwayUtxosEvent era
Generic)

deriving instance Eq (ConwayUtxosEvent era)

instance NFData (ConwayUtxosEvent era)

type instance EraRuleFailure "UTXOS" ConwayEra = ConwayUtxosPredFailure ConwayEra

type instance EraRuleEvent "UTXOS" ConwayEra = ConwayUtxosEvent ConwayEra

instance InjectRuleFailure "UTXOS" ConwayUtxosPredFailure ConwayEra

instance InjectRuleEvent "UTXOS" ConwayUtxosEvent ConwayEra

instance InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure ConwayEra where
  injectFailure :: AlonzoUtxosPredFailure ConwayEra
-> EraRuleFailure "UTXOS" ConwayEra
injectFailure = AlonzoUtxosPredFailure ConwayEra
-> EraRuleFailure "UTXOS" ConwayEra
AlonzoUtxosPredFailure ConwayEra
-> ConwayUtxosPredFailure ConwayEra
forall era.
(EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era) =>
AlonzoUtxosPredFailure era -> ConwayUtxosPredFailure era
alonzoToConwayUtxosPredFailure

instance InjectRuleEvent "UTXOS" AlonzoUtxosEvent ConwayEra where
  injectEvent :: AlonzoUtxosEvent ConwayEra -> EraRuleEvent "UTXOS" ConwayEra
injectEvent = AlonzoUtxosEvent ConwayEra -> EraRuleEvent "UTXOS" ConwayEra
AlonzoUtxosEvent ConwayEra -> ConwayUtxosEvent ConwayEra
forall era.
(EraRuleEvent "PPUP" era ~ VoidEraRule "PPUP" era) =>
AlonzoUtxosEvent era -> ConwayUtxosEvent era
alonzoToConwayUtxosEvent

alonzoToConwayUtxosPredFailure ::
  forall era.
  EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era =>
  Alonzo.AlonzoUtxosPredFailure era ->
  ConwayUtxosPredFailure era
alonzoToConwayUtxosPredFailure :: forall era.
(EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era) =>
AlonzoUtxosPredFailure era -> ConwayUtxosPredFailure era
alonzoToConwayUtxosPredFailure = \case
  Alonzo.ValidationTagMismatch IsValid
t TagMismatchDescription
x -> IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
forall era.
IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
ValidationTagMismatch IsValid
t TagMismatchDescription
x
  Alonzo.CollectErrors NonEmpty (CollectError era)
x -> NonEmpty (CollectError era) -> ConwayUtxosPredFailure era
forall era.
NonEmpty (CollectError era) -> ConwayUtxosPredFailure era
CollectErrors NonEmpty (CollectError era)
x
  Alonzo.UpdateFailure EraRuleFailure "PPUP" era
x -> forall (rule :: Symbol) era a. VoidEraRule rule era -> a
absurdEraRule @"PPUP" @era EraRuleFailure "PPUP" era
VoidEraRule "PPUP" era
x

alonzoToConwayUtxosEvent ::
  forall era.
  EraRuleEvent "PPUP" era ~ VoidEraRule "PPUP" era =>
  Alonzo.AlonzoUtxosEvent era ->
  ConwayUtxosEvent era
alonzoToConwayUtxosEvent :: forall era.
(EraRuleEvent "PPUP" era ~ VoidEraRule "PPUP" era) =>
AlonzoUtxosEvent era -> ConwayUtxosEvent era
alonzoToConwayUtxosEvent = \case
  Alonzo.AlonzoPpupToUtxosEvent EraRuleEvent "PPUP" era
x -> forall (rule :: Symbol) era a. VoidEraRule rule era -> a
absurdEraRule @"PPUP" @era EraRuleEvent "PPUP" era
VoidEraRule "PPUP" era
x
  Alonzo.SuccessfulPlutusScriptsEvent NonEmpty PlutusWithContext
l -> NonEmpty PlutusWithContext -> ConwayUtxosEvent era
forall era. NonEmpty PlutusWithContext -> ConwayUtxosEvent era
SuccessfulPlutusScriptsEvent NonEmpty PlutusWithContext
l
  Alonzo.FailedPlutusScriptsEvent NonEmpty PlutusWithContext
l -> NonEmpty PlutusWithContext -> ConwayUtxosEvent era
forall era. NonEmpty PlutusWithContext -> ConwayUtxosEvent era
FailedPlutusScriptsEvent NonEmpty PlutusWithContext
l

instance
  ( EraTxCert era
  , ConwayEraScript era
  , EncCBOR (ContextError era)
  ) =>
  EncCBOR (ConwayUtxosPredFailure era)
  where
  encCBOR :: ConwayUtxosPredFailure era -> Encoding
encCBOR =
    Encode Open (ConwayUtxosPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayUtxosPredFailure era) -> Encoding)
-> (ConwayUtxosPredFailure era
    -> Encode Open (ConwayUtxosPredFailure era))
-> ConwayUtxosPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ValidationTagMismatch IsValid
v TagMismatchDescription
descr -> (IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era)
-> Word
-> Encode
     Open
     (IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era)
forall t. t -> Word -> Encode Open t
Sum IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
forall era.
IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
ValidationTagMismatch Word
0 Encode
  Open
  (IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era)
-> Encode (Closed Dense) IsValid
-> Encode
     Open (TagMismatchDescription -> ConwayUtxosPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> IsValid -> Encode (Closed Dense) IsValid
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To IsValid
v Encode Open (TagMismatchDescription -> ConwayUtxosPredFailure era)
-> Encode (Closed Dense) TagMismatchDescription
-> Encode Open (ConwayUtxosPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> TagMismatchDescription
-> Encode (Closed Dense) TagMismatchDescription
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To TagMismatchDescription
descr
      CollectErrors NonEmpty (CollectError era)
cs -> (NonEmpty (CollectError era) -> ConwayUtxosPredFailure era)
-> Word
-> Encode
     Open (NonEmpty (CollectError era) -> ConwayUtxosPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
NonEmpty (CollectError era) -> ConwayUtxosPredFailure era
CollectErrors @era) Word
1 Encode
  Open (NonEmpty (CollectError era) -> ConwayUtxosPredFailure era)
-> Encode (Closed Dense) (NonEmpty (CollectError era))
-> Encode Open (ConwayUtxosPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty (CollectError era)
-> Encode (Closed Dense) (NonEmpty (CollectError era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty (CollectError era)
cs

instance
  ( EraTxCert era
  , ConwayEraScript era
  , DecCBOR (ContextError era)
  ) =>
  DecCBOR (ConwayUtxosPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayUtxosPredFailure era)
decCBOR = Decode (Closed Dense) (ConwayUtxosPredFailure era)
-> Decoder s (ConwayUtxosPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Text
-> (Word -> Decode Open (ConwayUtxosPredFailure era))
-> Decode (Closed Dense) (ConwayUtxosPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"ConwayUtxosPredicateFailure" Word -> Decode Open (ConwayUtxosPredFailure era)
dec)
    where
      dec :: Word -> Decode Open (ConwayUtxosPredFailure era)
dec Word
0 = (IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era)
-> Decode
     Open
     (IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era)
forall t. t -> Decode Open t
SumD IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
forall era.
IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
ValidationTagMismatch Decode
  Open
  (IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era)
-> Decode (Closed (ZonkAny 1)) IsValid
-> Decode
     Open (TagMismatchDescription -> ConwayUtxosPredFailure 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)) IsValid
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (TagMismatchDescription -> ConwayUtxosPredFailure era)
-> Decode (Closed (ZonkAny 0)) TagMismatchDescription
-> Decode Open (ConwayUtxosPredFailure 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)) TagMismatchDescription
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
1 = (NonEmpty (CollectError era) -> ConwayUtxosPredFailure era)
-> Decode
     Open (NonEmpty (CollectError era) -> ConwayUtxosPredFailure era)
forall t. t -> Decode Open t
SumD (forall era.
NonEmpty (CollectError era) -> ConwayUtxosPredFailure era
CollectErrors @era) Decode
  Open (NonEmpty (CollectError era) -> ConwayUtxosPredFailure era)
-> Decode (Closed (ZonkAny 2)) (NonEmpty (CollectError era))
-> Decode Open (ConwayUtxosPredFailure 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)) (NonEmpty (CollectError era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
n = Word -> Decode Open (ConwayUtxosPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

deriving stock instance
  ( ConwayEraScript era
  , Show (TxCert era)
  , Show (ContextError era)
  , Show (UTxOState era)
  ) =>
  Show (ConwayUtxosPredFailure era)

deriving stock instance
  ( ConwayEraScript era
  , Eq (TxCert era)
  , Eq (ContextError era)
  , Eq (UTxOState era)
  ) =>
  Eq (ConwayUtxosPredFailure era)

instance
  ( ConwayEraScript era
  , NoThunks (TxCert era)
  , NoThunks (ContextError era)
  , NoThunks (UTxOState era)
  ) =>
  NoThunks (ConwayUtxosPredFailure era)

instance
  ( ConwayEraScript era
  , NFData (TxCert era)
  , NFData (ContextError era)
  , NFData (UTxOState era)
  ) =>
  NFData (ConwayUtxosPredFailure era)

instance
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ConwayEraTxBody era
  , ConwayEraPParams era
  , EraGov era
  , EraStake era
  , EraCertState era
  , EraPlutusContext era
  , GovState era ~ ConwayGovState era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (ConwayUTXOS era) ~ Tx TopTx era
  , EraRule "UTXOS" era ~ ConwayUTXOS era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  , InjectRuleEvent "UTXOS" ConwayUtxosEvent era
  ) =>
  STS (ConwayUTXOS era)
  where
  type BaseM (ConwayUTXOS era) = Cardano.Ledger.BaseTypes.ShelleyBase
  type Environment (ConwayUTXOS era) = PParams era
  type State (ConwayUTXOS era) = UTxOState era
  type Signal (ConwayUTXOS era) = Tx TopTx era
  type PredicateFailure (ConwayUTXOS era) = ConwayUtxosPredFailure era
  type Event (ConwayUTXOS era) = ConwayUtxosEvent era

  transitionRules :: [TransitionRule (ConwayUTXOS era)]
transitionRules = [TransitionRule (EraRule "UTXOS" era)
TransitionRule (ConwayUTXOS era)
forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era,
 STS (EraRule "UTXOS" era),
 Environment (EraRule "UTXOS" era) ~ PParams era,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (EraRule "UTXOS" era)
utxosTransition]

instance
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ConwayEraTxBody era
  , ConwayEraPParams era
  , EraGov era
  , EraStake era
  , EraCertState era
  , EraPlutusContext era
  , GovState era ~ ConwayGovState era
  , PredicateFailure (EraRule "UTXOS" era) ~ ConwayUtxosPredFailure era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (ConwayUTXOS era) ~ Tx TopTx era
  , EraRule "UTXOS" era ~ ConwayUTXOS era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  , InjectRuleEvent "UTXOS" ConwayUtxosEvent era
  ) =>
  Embed (ConwayUTXOS era) (BabbageUTXO era)
  where
  wrapFailed :: PredicateFailure (ConwayUTXOS era)
-> PredicateFailure (BabbageUTXO era)
wrapFailed = AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era
forall era. AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era
AlonzoInBabbageUtxoPredFailure (AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era)
-> (ConwayUtxosPredFailure era -> AlonzoUtxoPredFailure era)
-> ConwayUtxosPredFailure era
-> BabbageUtxoPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "UTXOS" era) -> AlonzoUtxoPredFailure era
ConwayUtxosPredFailure era -> AlonzoUtxoPredFailure era
forall era.
PredicateFailure (EraRule "UTXOS" era) -> AlonzoUtxoPredFailure era
UtxosFailure
  wrapEvent :: Event (ConwayUTXOS era) -> Event (BabbageUTXO era)
wrapEvent = Event (EraRule "UTXOS" era) -> AlonzoUtxoEvent era
Event (ConwayUTXOS era) -> Event (BabbageUTXO era)
forall era. Event (EraRule "UTXOS" era) -> AlonzoUtxoEvent era
UtxosEvent

utxosTransition ::
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ConwayEraTxBody era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (EraRule "UTXOS" era) ~ Tx TopTx era
  , STS (EraRule "UTXOS" era)
  , Environment (EraRule "UTXOS" era) ~ PParams era
  , State (EraRule "UTXOS" era) ~ UTxOState era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , BaseM (EraRule "UTXOS" era) ~ ShelleyBase
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  ) =>
  TransitionRule (EraRule "UTXOS" era)
utxosTransition :: forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era,
 STS (EraRule "UTXOS" era),
 Environment (EraRule "UTXOS" era) ~ PParams era,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (EraRule "UTXOS" era)
utxosTransition =
  Rule
  (EraRule "UTXOS" era)
  'Transition
  (RuleContext 'Transition (EraRule "UTXOS" era))
F (Clause (EraRule "UTXOS" era) 'Transition)
  (TRC (EraRule "UTXOS" era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext F (Clause (EraRule "UTXOS" era) 'Transition)
  (TRC (EraRule "UTXOS" era))
-> (TRC (EraRule "UTXOS" era)
    -> F (Clause (EraRule "UTXOS" era) 'Transition) (UTxOState era))
-> F (Clause (EraRule "UTXOS" era) 'Transition) (UTxOState era)
forall a b.
F (Clause (EraRule "UTXOS" era) 'Transition) a
-> (a -> F (Clause (EraRule "UTXOS" era) 'Transition) b)
-> F (Clause (EraRule "UTXOS" era) 'Transition) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(TRC (Environment (EraRule "UTXOS" era)
pp, State (EraRule "UTXOS" era)
utxos, Signal (EraRule "UTXOS" era)
tx)) -> do
    case Tx TopTx era
Signal (EraRule "UTXOS" era)
tx Tx TopTx era -> Getting IsValid (Tx TopTx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx TopTx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx era) IsValid
isValidTxL of
      IsValid Bool
True -> F (Clause (EraRule "UTXOS" era) 'Transition)
  (State (EraRule "UTXOS" era))
F (Clause (EraRule "UTXOS" era) 'Transition) (UTxOState era)
forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era,
 STS (EraRule "UTXOS" era),
 State (EraRule "UTXOS" era) ~ UTxOState era,
 Environment (EraRule "UTXOS" era) ~ PParams era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (EraRule "UTXOS" era)
conwayEvalScriptsTxValid
      IsValid Bool
False -> do
        forall era.
(AlonzoEraTx era, EraPlutusContext era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 STS (EraRule "UTXOS" era)) =>
PParams era
-> Tx TopTx era
-> UTxO era
-> Rule (EraRule "UTXOS" era) 'Transition ()
babbageEvalScriptsTxInvalid @era PParams era
Environment (EraRule "UTXOS" era)
pp Tx TopTx era
Signal (EraRule "UTXOS" era)
tx (UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo State (EraRule "UTXOS" era)
UTxOState era
utxos)
        UTxOState era
-> F (Clause (EraRule "UTXOS" era) 'Transition) (UTxOState era)
forall a. a -> F (Clause (EraRule "UTXOS" era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure State (EraRule "UTXOS" era)
UTxOState era
utxos

conwayEvalScriptsTxValid ::
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ConwayEraTxBody era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (EraRule "UTXOS" era) ~ Tx TopTx era
  , STS (EraRule "UTXOS" era)
  , State (EraRule "UTXOS" era) ~ UTxOState era
  , Environment (EraRule "UTXOS" era) ~ PParams era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , BaseM (EraRule "UTXOS" era) ~ ShelleyBase
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  ) =>
  TransitionRule (EraRule "UTXOS" era)
conwayEvalScriptsTxValid :: forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era,
 STS (EraRule "UTXOS" era),
 State (EraRule "UTXOS" era) ~ UTxOState era,
 Environment (EraRule "UTXOS" era) ~ PParams era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (EraRule "UTXOS" era)
conwayEvalScriptsTxValid = do
  TRC (pp, utxos, tx) <- Rule
  (EraRule "UTXOS" era)
  'Transition
  (RuleContext 'Transition (EraRule "UTXOS" era))
F (Clause (EraRule "UTXOS" era) 'Transition)
  (TRC (EraRule "UTXOS" era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let txBody = Tx TopTx era
Signal (EraRule "UTXOS" 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

  () <- pure $! Debug.traceEvent validBegin ()
  expectScriptsToPass pp tx (utxosUtxo utxos)
  () <- pure $! Debug.traceEvent validEnd ()

  pure $! utxos & utxosDonationL <>~ txBody ^. treasuryDonationTxBodyL