{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage.Rules.Utxos (
  BabbageUTXOS,
  utxosTransition,
  expectScriptsToPass,
  babbageEvalScriptsTxInvalid,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext)
import Cardano.Ledger.Alonzo.Plutus.Evaluate (
  collectPlutusScriptsWithContext,
  evalPlutusScripts,
 )
import Cardano.Ledger.Alonzo.Rules (
  AlonzoUtxosEvent (..),
  AlonzoUtxosPredFailure (..),
  TagMismatchDescription (..),
  invalidBegin,
  invalidEnd,
  scriptFailureToFailureDescription,
  validBegin,
  validEnd,
  when2Phase,
 )
import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO (..),
  AlonzoScriptsNeeded,
 )
import Cardano.Ledger.Babbage.Collateral (
  collAdaBalance,
  collOuts,
 )
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.Era (BabbageEra, BabbageUTXOS)
import Cardano.Ledger.Babbage.Rules.Ppup ()
import Cardano.Ledger.Babbage.State
import Cardano.Ledger.Babbage.Tx
import Cardano.Ledger.BaseTypes (
  ShelleyBase,
  StrictMaybe,
  epochInfo,
  systemStart,
 )
import Cardano.Ledger.Binary (EncCBOR (..))
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
import Cardano.Ledger.Plutus.Evaluate (
  ScriptFailure (..),
  ScriptResult (..),
 )
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..))
import Cardano.Ledger.Shelley.PParams (Update)
import Cardano.Ledger.Shelley.Rules (
  PpupEnv (..),
  PpupEvent,
  ShelleyPPUP,
  ShelleyPpupPredFailure,
  UtxoEnv (..),
  updateUTxOState,
 )
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended
import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map.Strict as Map
import Data.MapExtras (extractKeys)
import qualified Debug.Trace as Debug
import Lens.Micro

type instance EraRuleFailure "UTXOS" BabbageEra = AlonzoUtxosPredFailure BabbageEra

type instance EraRuleEvent "UTXOS" BabbageEra = AlonzoUtxosEvent BabbageEra

instance InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure BabbageEra

instance InjectRuleEvent "UTXOS" AlonzoUtxosEvent BabbageEra

instance InjectRuleFailure "UTXOS" ShelleyPpupPredFailure BabbageEra where
  injectFailure :: ShelleyPpupPredFailure BabbageEra
-> EraRuleFailure "UTXOS" BabbageEra
injectFailure = EraRuleFailure "PPUP" BabbageEra
-> AlonzoUtxosPredFailure BabbageEra
ShelleyPpupPredFailure BabbageEra
-> EraRuleFailure "UTXOS" BabbageEra
forall era. EraRuleFailure "PPUP" era -> AlonzoUtxosPredFailure era
UpdateFailure

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

instance
  ( AlonzoEraTx era
  , AlonzoEraPParams era
  , ShelleyEraTxBody era
  , BabbageEraTxBody era
  , AlonzoEraUTxO era
  , EraPlutusContext era
  , EraStake era
  , EraCertState era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraGov era
  , GovState era ~ ShelleyGovState era
  , Embed (EraRule "PPUP" era) (BabbageUTXOS era)
  , Environment (EraRule "PPUP" era) ~ PpupEnv era
  , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era)
  , State (EraRule "PPUP" era) ~ ShelleyGovState era
  , Signal (BabbageUTXOS era) ~ Tx era
  , EncCBOR (EraRuleFailure "PPUP" era)
  , Eq (EraRuleFailure "PPUP" era)
  , Show (EraRuleFailure "PPUP" era)
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  , EraRule "UTXOS" era ~ BabbageUTXOS era
  ) =>
  STS (BabbageUTXOS era)
  where
  type BaseM (BabbageUTXOS era) = ShelleyBase
  type Environment (BabbageUTXOS era) = UtxoEnv era
  type State (BabbageUTXOS era) = UTxOState era
  type Signal (BabbageUTXOS era) = AlonzoTx era
  type PredicateFailure (BabbageUTXOS era) = AlonzoUtxosPredFailure era
  type Event (BabbageUTXOS era) = AlonzoUtxosEvent era
  transitionRules :: [TransitionRule (BabbageUTXOS era)]
transitionRules = [TransitionRule (BabbageUTXOS era)
forall era.
(AlonzoEraTx era, ShelleyEraTxBody era, BabbageEraTxBody era,
 AlonzoEraUTxO era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraCertState era, EraStake era, EraGov era,
 GovState era ~ ShelleyGovState era,
 Environment (EraRule "PPUP" era) ~ PpupEnv era,
 Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era),
 Embed (EraRule "PPUP" era) (BabbageUTXOS era),
 State (EraRule "PPUP" era) ~ ShelleyGovState era,
 Signal (BabbageUTXOS era) ~ Tx era,
 EncCBOR (EraRuleFailure "PPUP" era),
 Eq (EraRuleFailure "PPUP" era), Show (EraRuleFailure "PPUP" era),
 EraPlutusContext era, EraRule "UTXOS" era ~ BabbageUTXOS era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (BabbageUTXOS era)
utxosTransition]

instance
  ( Era era
  , STS (ShelleyPPUP era)
  , EraRuleFailure "PPUP" era ~ ShelleyPpupPredFailure era
  , EraRuleEvent "PPUP" era ~ PpupEvent era
  ) =>
  Embed (ShelleyPPUP era) (BabbageUTXOS era)
  where
  wrapFailed :: PredicateFailure (ShelleyPPUP era)
-> PredicateFailure (BabbageUTXOS era)
wrapFailed = EraRuleFailure "PPUP" era -> AlonzoUtxosPredFailure era
PredicateFailure (ShelleyPPUP era)
-> PredicateFailure (BabbageUTXOS era)
forall era. EraRuleFailure "PPUP" era -> AlonzoUtxosPredFailure era
UpdateFailure
  wrapEvent :: Event (ShelleyPPUP era) -> Event (BabbageUTXOS era)
wrapEvent = EraRuleEvent "PPUP" era -> AlonzoUtxosEvent era
Event (ShelleyPPUP era) -> Event (BabbageUTXOS era)
forall era. EraRuleEvent "PPUP" era -> AlonzoUtxosEvent era
AlonzoPpupToUtxosEvent

utxosTransition ::
  forall era.
  ( AlonzoEraTx era
  , ShelleyEraTxBody era
  , BabbageEraTxBody era
  , AlonzoEraUTxO era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraCertState era
  , EraStake era
  , EraGov era
  , GovState era ~ ShelleyGovState era
  , Environment (EraRule "PPUP" era) ~ PpupEnv era
  , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era)
  , Embed (EraRule "PPUP" era) (BabbageUTXOS era)
  , State (EraRule "PPUP" era) ~ ShelleyGovState era
  , Signal (BabbageUTXOS era) ~ Tx era
  , EncCBOR (EraRuleFailure "PPUP" era)
  , Eq (EraRuleFailure "PPUP" era)
  , Show (EraRuleFailure "PPUP" era)
  , EraPlutusContext era
  , EraRule "UTXOS" era ~ BabbageUTXOS era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  ) =>
  TransitionRule (BabbageUTXOS era)
utxosTransition :: forall era.
(AlonzoEraTx era, ShelleyEraTxBody era, BabbageEraTxBody era,
 AlonzoEraUTxO era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraCertState era, EraStake era, EraGov era,
 GovState era ~ ShelleyGovState era,
 Environment (EraRule "PPUP" era) ~ PpupEnv era,
 Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era),
 Embed (EraRule "PPUP" era) (BabbageUTXOS era),
 State (EraRule "PPUP" era) ~ ShelleyGovState era,
 Signal (BabbageUTXOS era) ~ Tx era,
 EncCBOR (EraRuleFailure "PPUP" era),
 Eq (EraRuleFailure "PPUP" era), Show (EraRuleFailure "PPUP" era),
 EraPlutusContext era, EraRule "UTXOS" era ~ BabbageUTXOS era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (BabbageUTXOS era)
utxosTransition =
  Rule
  (BabbageUTXOS era)
  'Transition
  (RuleContext 'Transition (BabbageUTXOS era))
F (Clause (BabbageUTXOS era) 'Transition) (TRC (BabbageUTXOS era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext F (Clause (BabbageUTXOS era) 'Transition) (TRC (BabbageUTXOS era))
-> (TRC (BabbageUTXOS era)
    -> F (Clause (BabbageUTXOS era) 'Transition) (UTxOState era))
-> F (Clause (BabbageUTXOS era) 'Transition) (UTxOState era)
forall a b.
F (Clause (BabbageUTXOS era) 'Transition) a
-> (a -> F (Clause (BabbageUTXOS era) 'Transition) b)
-> F (Clause (BabbageUTXOS era) 'Transition) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(TRC (Environment (BabbageUTXOS era)
_, State (BabbageUTXOS era)
_, Signal (BabbageUTXOS era)
tx)) -> do
    case AlonzoTx era
Signal (BabbageUTXOS era)
tx AlonzoTx era -> Getting IsValid (AlonzoTx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. (IsValid -> Const IsValid IsValid)
-> Tx era -> Const IsValid (Tx era)
Getting IsValid (AlonzoTx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL of
      IsValid Bool
True -> F (Clause (BabbageUTXOS era) 'Transition)
  (State (BabbageUTXOS era))
F (Clause (BabbageUTXOS era) 'Transition) (UTxOState era)
forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ShelleyEraTxBody era,
 EraStake era, EraCertState era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 STS (BabbageUTXOS era), Signal (BabbageUTXOS era) ~ Tx era,
 Environment (EraRule "PPUP" era) ~ PpupEnv era,
 Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era),
 Embed (EraRule "PPUP" era) (BabbageUTXOS era),
 GovState era ~ ShelleyGovState era,
 State (EraRule "PPUP" era) ~ ShelleyGovState era,
 EraPlutusContext era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 EraRule "UTXOS" era ~ BabbageUTXOS era,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (BabbageUTXOS era)
babbageEvalScriptsTxValid
      IsValid Bool
False -> TransitionRule (EraRule "UTXOS" era)
F (Clause (BabbageUTXOS 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 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

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

expectScriptsToPass ::
  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 :: 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 Tx era
tx UTxO era
utxo = do
  SystemStart
sysSt <- BaseM (EraRule "UTXOS" era) SystemStart
-> Rule (EraRule "UTXOS" era) 'Transition SystemStart
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (EraRule "UTXOS" era) SystemStart
 -> Rule (EraRule "UTXOS" era) 'Transition SystemStart)
-> BaseM (EraRule "UTXOS" era) SystemStart
-> Rule (EraRule "UTXOS" era) 'Transition SystemStart
forall a b. (a -> b) -> a -> b
$ (Globals -> SystemStart) -> ReaderT Globals Identity SystemStart
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> SystemStart
systemStart
  EpochInfo (Either Text)
ei <- BaseM (EraRule "UTXOS" era) (EpochInfo (Either Text))
-> Rule (EraRule "UTXOS" era) 'Transition (EpochInfo (Either Text))
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (EraRule "UTXOS" era) (EpochInfo (Either Text))
 -> Rule
      (EraRule "UTXOS" era) 'Transition (EpochInfo (Either Text)))
-> BaseM (EraRule "UTXOS" era) (EpochInfo (Either Text))
-> Rule (EraRule "UTXOS" era) 'Transition (EpochInfo (Either Text))
forall a b. (a -> b) -> a -> b
$ (Globals -> EpochInfo (Either Text))
-> ReaderT Globals Identity (EpochInfo (Either Text))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> EpochInfo (Either Text)
epochInfo
  {- sLst := collectTwoPhaseScriptInputs pp tx utxo -}
  case EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
forall era.
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraPlutusContext era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectPlutusScriptsWithContext EpochInfo (Either Text)
ei SystemStart
sysSt PParams era
pp Tx era
tx UTxO era
utxo of
    Right [PlutusWithContext]
sLst -> do
      {- isValid tx = evalScripts tx sLst = True -}
      Rule (EraRule "UTXOS" era) 'Transition ()
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall sts (rtype :: RuleType).
Rule sts rtype () -> Rule sts rtype ()
whenFailureFree (Rule (EraRule "UTXOS" era) 'Transition ()
 -> Rule (EraRule "UTXOS" era) 'Transition ())
-> Rule (EraRule "UTXOS" era) 'Transition ()
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$
        Rule (EraRule "UTXOS" era) 'Transition ()
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall sts (rtype :: RuleType).
Rule sts rtype () -> Rule sts rtype ()
when2Phase (Rule (EraRule "UTXOS" era) 'Transition ()
 -> Rule (EraRule "UTXOS" era) 'Transition ())
-> Rule (EraRule "UTXOS" era) 'Transition ()
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ case [PlutusWithContext] -> ScriptResult
evalPlutusScripts [PlutusWithContext]
sLst of
          Fails [PlutusWithContext]
_ NonEmpty ScriptFailure
fs ->
            PredicateFailure (EraRule "UTXOS" era)
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (PredicateFailure (EraRule "UTXOS" era)
 -> Rule (EraRule "UTXOS" era) 'Transition ())
-> PredicateFailure (EraRule "UTXOS" era)
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$
              AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era)
-> AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall a b. (a -> b) -> a -> b
$
                IsValid -> TagMismatchDescription -> AlonzoUtxosPredFailure era
forall era.
IsValid -> TagMismatchDescription -> AlonzoUtxosPredFailure era
ValidationTagMismatch
                  (Tx era
tx Tx era -> Getting IsValid (Tx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL)
                  (NonEmpty FailureDescription -> TagMismatchDescription
FailedUnexpectedly (ScriptFailure -> FailureDescription
scriptFailureToFailureDescription (ScriptFailure -> FailureDescription)
-> NonEmpty ScriptFailure -> NonEmpty FailureDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ScriptFailure
fs))
          Passes [PlutusWithContext]
ps -> (NonEmpty PlutusWithContext
 -> Rule (EraRule "UTXOS" era) 'Transition ())
-> Maybe (NonEmpty PlutusWithContext)
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event (EraRule "UTXOS" era)
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (EraRule "UTXOS" era)
 -> Rule (EraRule "UTXOS" era) 'Transition ())
-> (NonEmpty PlutusWithContext -> Event (EraRule "UTXOS" era))
-> NonEmpty PlutusWithContext
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoUtxosEvent era -> EraRuleEvent "UTXOS" era
AlonzoUtxosEvent era -> Event (EraRule "UTXOS" era)
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent (AlonzoUtxosEvent era -> Event (EraRule "UTXOS" era))
-> (NonEmpty PlutusWithContext -> AlonzoUtxosEvent era)
-> NonEmpty PlutusWithContext
-> Event (EraRule "UTXOS" era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PlutusWithContext -> AlonzoUtxosEvent era
forall era. NonEmpty PlutusWithContext -> AlonzoUtxosEvent era
SuccessfulPlutusScriptsEvent) ([PlutusWithContext] -> Maybe (NonEmpty PlutusWithContext)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [PlutusWithContext]
ps)
    Left [CollectError era]
info -> PredicateFailure (EraRule "UTXOS" era)
-> Rule (EraRule "UTXOS" era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era)
-> AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall a b. (a -> b) -> a -> b
$ [CollectError era] -> AlonzoUtxosPredFailure era
forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors [CollectError era]
info)

babbageEvalScriptsTxValid ::
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraUTxO era
  , ShelleyEraTxBody era
  , EraStake era
  , EraCertState era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , STS (BabbageUTXOS era)
  , Signal (BabbageUTXOS era) ~ Tx era
  , Environment (EraRule "PPUP" era) ~ PpupEnv era
  , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era)
  , Embed (EraRule "PPUP" era) (BabbageUTXOS era)
  , GovState era ~ ShelleyGovState era
  , State (EraRule "PPUP" era) ~ ShelleyGovState era
  , EraPlutusContext era
  , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
  , EraRule "UTXOS" era ~ BabbageUTXOS era
  , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
  ) =>
  TransitionRule (BabbageUTXOS era)
babbageEvalScriptsTxValid :: forall era.
(AlonzoEraTx era, AlonzoEraUTxO era, ShelleyEraTxBody era,
 EraStake era, EraCertState era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 STS (BabbageUTXOS era), Signal (BabbageUTXOS era) ~ Tx era,
 Environment (EraRule "PPUP" era) ~ PpupEnv era,
 Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era),
 Embed (EraRule "PPUP" era) (BabbageUTXOS era),
 GovState era ~ ShelleyGovState era,
 State (EraRule "PPUP" era) ~ ShelleyGovState era,
 EraPlutusContext era,
 InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era,
 EraRule "UTXOS" era ~ BabbageUTXOS era,
 InjectRuleEvent "UTXOS" AlonzoUtxosEvent era) =>
TransitionRule (BabbageUTXOS era)
babbageEvalScriptsTxValid = do
  TRC (UtxoEnv SlotNo
slot PParams era
pp CertState era
certState, utxos :: State (BabbageUTXOS era)
utxos@(UTxOState UTxO era
utxo Coin
_ Coin
_ GovState era
pup InstantStake era
_ Coin
_), Signal (BabbageUTXOS era)
tx) <-
    Rule
  (BabbageUTXOS era)
  'Transition
  (RuleContext 'Transition (BabbageUTXOS era))
F (Clause (BabbageUTXOS era) 'Transition) (TRC (BabbageUTXOS era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let txBody :: TxBody era
txBody = AlonzoTx era
Signal (BabbageUTXOS era)
tx AlonzoTx era
-> Getting (TxBody era) (AlonzoTx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (TxBody era) (TxBody era))
-> Tx era -> Const (TxBody era) (Tx era)
Getting (TxBody era) (AlonzoTx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
      genDelegs :: GenDelegs
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

  -- We intentionally run the PPUP rule before evaluating any Plutus scripts.
  -- We do not want to waste computation running plutus scripts if the
  -- transaction will fail due to `PPUP`
  ShelleyGovState era
ppup' <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "PPUP" era) (RuleContext 'Transition (EraRule "PPUP" era)
 -> Rule
      (BabbageUTXOS era) 'Transition (State (EraRule "PPUP" era)))
-> RuleContext 'Transition (EraRule "PPUP" era)
-> Rule (BabbageUTXOS era) 'Transition (State (EraRule "PPUP" era))
forall a b. (a -> b) -> a -> b
$
      (Environment (EraRule "PPUP" era), State (EraRule "PPUP" era),
 Signal (EraRule "PPUP" era))
-> TRC (EraRule "PPUP" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo -> PParams era -> GenDelegs -> PpupEnv era
forall era. SlotNo -> PParams era -> GenDelegs -> PpupEnv era
PPUPEnv SlotNo
slot PParams era
pp GenDelegs
genDelegs, GovState era
State (EraRule "PPUP" era)
pup, TxBody era
txBody TxBody era
-> Getting
     (StrictMaybe (Update era)) (TxBody era) (StrictMaybe (Update era))
-> StrictMaybe (Update era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Update era)) (TxBody era) (StrictMaybe (Update era))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL)

  () <- () -> F (Clause (BabbageUTXOS era) 'Transition) ()
forall a. a -> F (Clause (BabbageUTXOS era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> F (Clause (BabbageUTXOS era) 'Transition) ())
-> () -> F (Clause (BabbageUTXOS era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$! String -> () -> ()
forall a. String -> a -> a
Debug.traceEvent String
validBegin ()
  PParams era
-> Tx era -> UTxO era -> Rule (EraRule "UTXOS" era) 'Transition ()
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 Tx era
Signal (BabbageUTXOS era)
tx UTxO era
utxo
  () <- () -> F (Clause (BabbageUTXOS era) 'Transition) ()
forall a. a -> F (Clause (BabbageUTXOS era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> F (Clause (BabbageUTXOS era) 'Transition) ())
-> () -> F (Clause (BabbageUTXOS era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$! String -> () -> ()
forall a. String -> a -> a
Debug.traceEvent String
validEnd ()

  PParams era
-> UTxOState era
-> TxBody era
-> CertState era
-> GovState era
-> (Coin -> F (Clause (BabbageUTXOS era) 'Transition) ())
-> (UTxO era
    -> UTxO era -> F (Clause (BabbageUTXOS era) 'Transition) ())
-> F (Clause (BabbageUTXOS era) 'Transition) (UTxOState era)
forall era (m :: * -> *).
(EraTxBody era, EraStake era, EraCertState 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 (BabbageUTXOS era)
UTxOState era
utxos
    TxBody era
txBody
    CertState era
certState
    GovState era
ShelleyGovState era
ppup'
    (AlonzoUtxosEvent era
-> F (Clause (BabbageUTXOS era) 'Transition) ()
Event (BabbageUTXOS era)
-> F (Clause (BabbageUTXOS era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (AlonzoUtxosEvent era
 -> F (Clause (BabbageUTXOS era) 'Transition) ())
-> (Coin -> AlonzoUtxosEvent era)
-> Coin
-> F (Clause (BabbageUTXOS era) 'Transition) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash EraIndependentTxBody -> Coin -> AlonzoUtxosEvent era
forall era.
SafeHash EraIndependentTxBody -> Coin -> AlonzoUtxosEvent era
TotalDeposits (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
txBody))
    (\UTxO era
a UTxO era
b -> Event (BabbageUTXOS era)
-> F (Clause (BabbageUTXOS era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (BabbageUTXOS era)
 -> F (Clause (BabbageUTXOS era) 'Transition) ())
-> Event (BabbageUTXOS era)
-> F (Clause (BabbageUTXOS era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ UTxO era -> UTxO era -> AlonzoUtxosEvent era
forall era. UTxO era -> UTxO era -> AlonzoUtxosEvent era
TxUTxODiff UTxO era
a UTxO era
b)

babbageEvalScriptsTxInvalid ::
  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 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 :: 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 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 = do
  TRC (UtxoEnv SlotNo
_ PParams era
pp CertState era
_, utxos :: State (EraRule "UTXOS" era)
utxos@(UTxOState UTxO era
utxo Coin
_ Coin
fees GovState era
_ InstantStake era
_ Coin
_), Signal (EraRule "UTXOS" era)
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
  {- txb := txbody tx -}
  let txBody :: TxBody era
txBody = Tx era
Signal (EraRule "UTXOS" era)
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
  SystemStart
sysSt <- BaseM (EraRule "UTXOS" era) SystemStart
-> Rule (EraRule "UTXOS" era) 'Transition SystemStart
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (EraRule "UTXOS" era) SystemStart
 -> Rule (EraRule "UTXOS" era) 'Transition SystemStart)
-> BaseM (EraRule "UTXOS" era) SystemStart
-> Rule (EraRule "UTXOS" era) 'Transition SystemStart
forall a b. (a -> b) -> a -> b
$ (Globals -> SystemStart) -> ReaderT Globals Identity SystemStart
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> SystemStart
systemStart
  EpochInfo (Either Text)
ei <- BaseM (EraRule "UTXOS" era) (EpochInfo (Either Text))
-> Rule (EraRule "UTXOS" era) 'Transition (EpochInfo (Either Text))
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (EraRule "UTXOS" era) (EpochInfo (Either Text))
 -> Rule
      (EraRule "UTXOS" era) 'Transition (EpochInfo (Either Text)))
-> BaseM (EraRule "UTXOS" era) (EpochInfo (Either Text))
-> Rule (EraRule "UTXOS" era) 'Transition (EpochInfo (Either Text))
forall a b. (a -> b) -> a -> b
$ (Globals -> EpochInfo (Either Text))
-> ReaderT Globals Identity (EpochInfo (Either Text))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> EpochInfo (Either Text)
epochInfo

  () <- () -> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a. a -> F (Clause (EraRule "UTXOS" era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> () -> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$! String -> () -> ()
forall a. String -> a -> a
Debug.traceEvent String
invalidBegin ()

  case EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
forall era.
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraPlutusContext era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectPlutusScriptsWithContext EpochInfo (Either Text)
ei SystemStart
sysSt PParams era
pp Tx era
Signal (EraRule "UTXOS" era)
tx UTxO era
utxo of
    Right [PlutusWithContext]
sLst ->
      {- sLst := collectTwoPhaseScriptInputs pp tx utxo -}
      {- isValid tx = evalScripts tx sLst = False -}
      F (Clause (EraRule "UTXOS" era) 'Transition) ()
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall sts (rtype :: RuleType).
Rule sts rtype () -> Rule sts rtype ()
whenFailureFree (F (Clause (EraRule "UTXOS" era) 'Transition) ()
 -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$
        F (Clause (EraRule "UTXOS" era) 'Transition) ()
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall sts (rtype :: RuleType).
Rule sts rtype () -> Rule sts rtype ()
when2Phase (F (Clause (EraRule "UTXOS" era) 'Transition) ()
 -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ case [PlutusWithContext] -> ScriptResult
evalPlutusScripts [PlutusWithContext]
sLst of
          Passes [PlutusWithContext]
_ ->
            PredicateFailure (EraRule "UTXOS" era)
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (PredicateFailure (EraRule "UTXOS" era)
 -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> PredicateFailure (EraRule "UTXOS" era)
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$
              AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era)
-> AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall a b. (a -> b) -> a -> b
$
                IsValid -> TagMismatchDescription -> AlonzoUtxosPredFailure era
forall era.
IsValid -> TagMismatchDescription -> AlonzoUtxosPredFailure era
ValidationTagMismatch (Tx era
Signal (EraRule "UTXOS" era)
tx Tx era -> Getting IsValid (Tx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL) TagMismatchDescription
PassedUnexpectedly
          Fails [PlutusWithContext]
ps NonEmpty ScriptFailure
fs -> do
            (NonEmpty PlutusWithContext
 -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> Maybe (NonEmpty PlutusWithContext)
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event (EraRule "UTXOS" era)
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (EraRule "UTXOS" era)
 -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> (NonEmpty PlutusWithContext -> Event (EraRule "UTXOS" era))
-> NonEmpty PlutusWithContext
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
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 @"UTXOS" (AlonzoUtxosEvent era -> Event (EraRule "UTXOS" era))
-> (NonEmpty PlutusWithContext -> AlonzoUtxosEvent era)
-> NonEmpty PlutusWithContext
-> Event (EraRule "UTXOS" era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. NonEmpty PlutusWithContext -> AlonzoUtxosEvent era
SuccessfulPlutusScriptsEvent @era) ([PlutusWithContext] -> Maybe (NonEmpty PlutusWithContext)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [PlutusWithContext]
ps)
            Event (EraRule "UTXOS" era)
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (AlonzoUtxosEvent era -> EraRuleEvent "UTXOS" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent (AlonzoUtxosEvent era -> EraRuleEvent "UTXOS" era)
-> AlonzoUtxosEvent era -> EraRuleEvent "UTXOS" era
forall a b. (a -> b) -> a -> b
$ NonEmpty PlutusWithContext -> AlonzoUtxosEvent era
forall era. NonEmpty PlutusWithContext -> AlonzoUtxosEvent era
FailedPlutusScriptsEvent (ScriptFailure -> PlutusWithContext
scriptFailurePlutus (ScriptFailure -> PlutusWithContext)
-> NonEmpty ScriptFailure -> NonEmpty PlutusWithContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ScriptFailure
fs))
    Left [CollectError era]
info -> PredicateFailure (EraRule "UTXOS" era)
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era)
-> AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOS" era
forall a b. (a -> b) -> a -> b
$ [CollectError era] -> AlonzoUtxosPredFailure era
forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors [CollectError era]
info)

  () <- () -> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a. a -> F (Clause (EraRule "UTXOS" era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> () -> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$! String -> () -> ()
forall a. String -> a -> a
Debug.traceEvent String
invalidEnd ()

  {- utxoKeep = txBody ^. collateralInputsTxBodyL ⋪ utxo -}
  {- utxoDel  = txBody ^. collateralInputsTxBodyL ◁ utxo -}
  let !(Map TxIn (TxOut era)
utxoKeep, Map TxIn (TxOut era)
utxoDel) = Map TxIn (TxOut era)
-> Set TxIn -> (Map TxIn (TxOut era), Map TxIn (TxOut era))
forall k a. Ord k => Map k a -> Set k -> (Map k a, Map k a)
extractKeys (UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO era
utxo) (TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL)
      UTxO Map TxIn (TxOut era)
collouts = TxBody era -> UTxO era
forall era. BabbageEraTxBody era => TxBody era -> UTxO era
collOuts TxBody era
txBody
      DeltaCoin Integer
collateralFees = TxBody era -> Map TxIn (TxOut era) -> DeltaCoin
forall era.
BabbageEraTxBody era =>
TxBody era -> Map TxIn (TxOut era) -> DeltaCoin
collAdaBalance TxBody era
txBody Map TxIn (TxOut era)
utxoDel -- NEW to Babbage
  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 (UTxOState era
 -> F (Clause (EraRule "UTXOS" era) 'Transition) (UTxOState era))
-> UTxOState era
-> F (Clause (EraRule "UTXOS" era) 'Transition) (UTxOState era)
forall a b. (a -> b) -> a -> b
$!
    State (EraRule "UTXOS" era)
utxos {- (collInputs txb ⋪ utxo) ∪ collouts tx -}
      { utxosUtxo = UTxO (Map.union utxoKeep collouts) -- NEW to Babbage
      {- fees + collateralFees -}
      , utxosFees = fees <> Coin collateralFees -- NEW to Babbage
      , utxosInstantStake =
          deleteInstantStake (UTxO utxoDel) (addInstantStake (UTxO collouts) (utxos ^. instantStakeL))
      }