{-# 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 (ShelleyBase)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin)
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 Cardano.Ledger.Shelley.Rules (UtxoEnv (..), updateUTxOState)
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 [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
  = TotalDeposits (SafeHash EraIndependentTxBody) Coin
  | SuccessfulPlutusScriptsEvent (NonEmpty PlutusWithContext)
  | FailedPlutusScriptsEvent (NonEmpty PlutusWithContext)
  | -- | The UTxOs consumed and created by a signal tx
    TxUTxODiff
      -- | UTxO consumed
      (UTxO era)
      -- | UTxO created
      (UTxO era)
  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 (Era era, Eq (TxOut era)) => Eq (ConwayUtxosEvent era)

instance (Era era, NFData (TxOut era)) => 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 [CollectError era]
x -> [CollectError era] -> ConwayUtxosPredFailure era
forall era. [CollectError era] -> ConwayUtxosPredFailure era
CollectErrors [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.TotalDeposits SafeHash EraIndependentTxBody
h Coin
c -> SafeHash EraIndependentTxBody -> Coin -> ConwayUtxosEvent era
forall era.
SafeHash EraIndependentTxBody -> Coin -> ConwayUtxosEvent era
TotalDeposits SafeHash EraIndependentTxBody
h Coin
c
  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
  Alonzo.TxUTxODiff UTxO era
x UTxO era
y -> UTxO era -> UTxO era -> ConwayUtxosEvent era
forall era. UTxO era -> UTxO era -> ConwayUtxosEvent era
TxUTxODiff UTxO era
x UTxO era
y

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 [CollectError era]
cs -> ([CollectError era] -> ConwayUtxosPredFailure era)
-> Word
-> Encode Open ([CollectError era] -> ConwayUtxosPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. [CollectError era] -> ConwayUtxosPredFailure era
CollectErrors @era) Word
1 Encode Open ([CollectError era] -> ConwayUtxosPredFailure era)
-> Encode (Closed Dense) [CollectError era]
-> Encode Open (ConwayUtxosPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> [CollectError era] -> Encode (Closed Dense) [CollectError era]
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To [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 = ([CollectError era] -> ConwayUtxosPredFailure era)
-> Decode Open ([CollectError era] -> ConwayUtxosPredFailure era)
forall t. t -> Decode Open t
SumD (forall era. [CollectError era] -> ConwayUtxosPredFailure era
CollectErrors @era) Decode Open ([CollectError era] -> ConwayUtxosPredFailure era)
-> Decode (Closed (ZonkAny 2)) [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)) [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) = UtxoEnv 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, EraStake era, EraCertState era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era,
 STS (EraRule "UTXOS" era),
 Environment (EraRule "UTXOS" era) ~ UtxoEnv era,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era,
 InjectRuleEvent "UTXOS" ConwayUtxosEvent 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
  , EraStake era
  , EraCertState era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (EraRule "UTXOS" era) ~ Tx TopTx era
  , STS (EraRule "UTXOS" era)
  , Environment (EraRule "UTXOS" era) ~ UtxoEnv era
  , State (EraRule "UTXOS" era) ~ UTxOState era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , BaseM (EraRule "UTXOS" era) ~ ShelleyBase
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  , InjectRuleEvent "UTXOS" ConwayUtxosEvent era
  ) =>
  TransitionRule (EraRule "UTXOS" era)
utxosTransition :: forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, EraStake era, EraCertState era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era,
 STS (EraRule "UTXOS" era),
 Environment (EraRule "UTXOS" era) ~ UtxoEnv era,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era,
 InjectRuleEvent "UTXOS" ConwayUtxosEvent 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)
_, State (EraRule "UTXOS" era)
_, 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, EraStake era, EraCertState 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) ~ UtxoEnv era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era,
 InjectRuleEvent "UTXOS" ConwayUtxosEvent era) =>
TransitionRule (EraRule "UTXOS" era)
conwayEvalScriptsTxValid
      IsValid Bool
False -> F (Clause (EraRule "UTXOS" era) 'Transition)
  (State (EraRule "UTXOS" era))
F (Clause (EraRule "UTXOS" era) 'Transition) (UTxOState era)
forall era.
(EraStake era, AlonzoEraTx era, BabbageEraTxBody era,
 EraPlutusContext era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 STS (EraRule "UTXOS" era),
 Environment (EraRule "UTXOS" era) ~ UtxoEnv era,
 Signal (EraRule "UTXOS" era) ~ Tx TopTx era,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (EraRule "UTXOS" era)
babbageEvalScriptsTxInvalid

conwayEvalScriptsTxValid ::
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ConwayEraTxBody era
  , EraPlutusContext era
  , EraStake era
  , EraCertState 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) ~ UtxoEnv era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , BaseM (EraRule "UTXOS" era) ~ ShelleyBase
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  , InjectRuleEvent "UTXOS" ConwayUtxosEvent era
  ) =>
  TransitionRule (EraRule "UTXOS" era)
conwayEvalScriptsTxValid :: forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, EraStake era, EraCertState 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) ~ UtxoEnv era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era,
 InjectRuleEvent "UTXOS" ConwayUtxosEvent era) =>
TransitionRule (EraRule "UTXOS" era)
conwayEvalScriptsTxValid = do
  TRC (UtxoEnv _ pp certState, utxos@(UTxOState utxo _ _ govState _ _), 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 utxo
  () <- pure $! Debug.traceEvent validEnd ()

  utxos' <-
    updateUTxOState
      pp
      utxos
      txBody
      certState
      govState
      (tellEvent . injectEvent . TotalDeposits (hashAnnotated txBody))
      (\UTxO era
a UTxO era
b -> EraRuleEvent "UTXOS" era
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
Event (EraRule "UTXOS" era)
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (EraRuleEvent "UTXOS" era
 -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> (ConwayUtxosEvent era -> EraRuleEvent "UTXOS" era)
-> ConwayUtxosEvent era
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayUtxosEvent era -> EraRuleEvent "UTXOS" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent (ConwayUtxosEvent era
 -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> ConwayUtxosEvent era
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ UTxO era -> UTxO era -> ConwayUtxosEvent era
forall era. UTxO era -> UTxO era -> ConwayUtxosEvent era
TxUTxODiff UTxO era
a UTxO era
b)
  pure $! utxos' & utxosDonationL <>~ txBody ^. treasuryDonationTxBodyL