{-# 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 (..),
) 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.TxInfo ()
import Cardano.Ledger.Plutus (PlutusWithContext)
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..), utxosDonationL)
import Cardano.Ledger.Shelley.Rules (UtxoEnv (..), updateUTxOState)
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO)
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 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
$cto :: forall era x.
Rep (ConwayUtxosPredFailure era) x -> ConwayUtxosPredFailure era
$cfrom :: forall era x.
ConwayUtxosPredFailure era -> Rep (ConwayUtxosPredFailure era) x
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 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
$cto :: forall era x. Rep (ConwayUtxosEvent era) x -> ConwayUtxosEvent era
$cfrom :: forall era x. ConwayUtxosEvent era -> Rep (ConwayUtxosEvent era) x
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 = 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 = 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 -> forall era.
IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
ValidationTagMismatch IsValid
t TagMismatchDescription
x
  Alonzo.CollectErrors [CollectError era]
x -> 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
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
x
  Alonzo.TotalDeposits SafeHash EraIndependentTxBody
h Coin
c -> forall era.
SafeHash EraIndependentTxBody -> Coin -> ConwayUtxosEvent era
TotalDeposits SafeHash EraIndependentTxBody
h Coin
c
  Alonzo.SuccessfulPlutusScriptsEvent NonEmpty PlutusWithContext
l -> forall era. NonEmpty PlutusWithContext -> ConwayUtxosEvent era
SuccessfulPlutusScriptsEvent NonEmpty PlutusWithContext
l
  Alonzo.FailedPlutusScriptsEvent NonEmpty PlutusWithContext
l -> forall era. NonEmpty PlutusWithContext -> ConwayUtxosEvent era
FailedPlutusScriptsEvent NonEmpty PlutusWithContext
l
  Alonzo.TxUTxODiff UTxO era
x UTxO era
y -> 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 =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ValidationTagMismatch IsValid
v TagMismatchDescription
descr -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
ValidationTagMismatch Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To IsValid
v forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TagMismatchDescription
descr
      CollectErrors [CollectError era]
cs -> forall t. t -> Word -> Encode 'Open t
Sum (forall era. [CollectError era] -> ConwayUtxosPredFailure era
CollectErrors @era) Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [CollectError era]
cs

instance
  ( EraTxCert era
  , ConwayEraScript era
  , DecCBOR (ContextError era)
  ) =>
  DecCBOR (ConwayUtxosPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayUtxosPredFailure era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (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 = forall t. t -> Decode 'Open t
SumD forall era.
IsValid -> TagMismatchDescription -> ConwayUtxosPredFailure era
ValidationTagMismatch forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
1 = forall t. t -> Decode 'Open t
SumD (forall era. [CollectError era] -> ConwayUtxosPredFailure era
CollectErrors @era) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
n = 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
  , EraPlutusContext era
  , GovState era ~ ConwayGovState era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (ConwayUTXOS era) ~ Tx 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) = AlonzoTx era
  type PredicateFailure (ConwayUTXOS era) = ConwayUtxosPredFailure era
  type Event (ConwayUTXOS era) = ConwayUtxosEvent era

  transitionRules :: [TransitionRule (ConwayUTXOS era)]
transitionRules = [forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx 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
  , EraPlutusContext era
  , GovState era ~ ConwayGovState era
  , PredicateFailure (EraRule "UTXOS" era) ~ ConwayUtxosPredFailure era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (ConwayUTXOS era) ~ Tx 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 = forall era. AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era
AlonzoInBabbageUtxoPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "UTXOS" era) -> AlonzoUtxoPredFailure era
UtxosFailure
  wrapEvent :: Event (ConwayUTXOS era) -> Event (BabbageUTXO era)
wrapEvent = 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 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, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx 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 sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext 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 Signal (EraRule "UTXOS" era)
tx forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL of
      IsValid Bool
True -> forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ConwayEraTxBody era,
 EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx 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 -> forall 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 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
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (EraRule "UTXOS" era) ~ Tx 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, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 Signal (EraRule "UTXOS" era) ~ Tx 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 SlotNo
_ PParams era
pp CertState era
certState, utxos :: State (EraRule "UTXOS" era)
utxos@(UTxOState UTxO era
utxo Coin
_ Coin
_ GovState era
govState IncrementalStake
_ Coin
_), Signal (EraRule "UTXOS" era)
tx) <-
    forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let txBody :: TxBody era
txBody = Signal (EraRule "UTXOS" era)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL

  () <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. String -> a -> a
Debug.traceEvent String
validBegin ()
  forall era.
(AlonzoEraTx era, EraPlutusContext era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 STS (EraRule "UTXOS" era),
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
PParams era
-> Tx era -> UTxO era -> Rule (EraRule "UTXOS" era) 'Transition ()
expectScriptsToPass PParams era
pp Signal (EraRule "UTXOS" era)
tx UTxO era
utxo
  () <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. String -> a -> a
Debug.traceEvent String
validEnd ()

  UTxOState era
utxos' <-
    forall era (m :: * -> *).
(EraTxBody era, Monad m) =>
PParams era
-> UTxOState era
-> TxBody era
-> CertState era
-> GovState era
-> (Coin -> m ())
-> (UTxO era -> UTxO era -> m ())
-> m (UTxOState era)
updateUTxOState
      PParams era
pp
      State (EraRule "UTXOS" era)
utxos
      TxBody era
txBody
      CertState era
certState
      GovState era
govState
      (forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
SafeHash EraIndependentTxBody -> Coin -> ConwayUtxosEvent era
TotalDeposits (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
txBody))
      (\UTxO era
a UTxO era
b -> forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent forall a b. (a -> b) -> a -> b
$ forall era. UTxO era -> UTxO era -> ConwayUtxosEvent era
TxUTxODiff UTxO era
a UTxO era
b)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! UTxOState era
utxos' forall a b. a -> (a -> b) -> b
& forall era. Lens' (UTxOState era) Coin
utxosDonationL forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
treasuryDonationTxBodyL