{-# 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.State
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 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 VoidEraRule "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 VoidEraRule "PPUP" era
EraRuleEvent "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 Any) 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 Any) IsValid
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (TagMismatchDescription -> ConwayUtxosPredFailure era)
-> Decode ('Closed Any) 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 Any) 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 Any) [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 Any) [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 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 = [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 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 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 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 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 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 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 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 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 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 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 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
  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

  () <- () -> 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
validBegin ()
  PParams era
-> Tx era
-> UTxO era
-> F (Clause (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 (EraRule "UTXOS" era)
tx UTxO era
utxo
  () <- () -> 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
validEnd ()

  UTxOState era
utxos' <-
    PParams era
-> UTxOState era
-> TxBody era
-> CertState era
-> GovState era
-> (Coin -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> (UTxO era
    -> UTxO era -> F (Clause (EraRule "UTXOS" era) 'Transition) ())
-> F (Clause (EraRule "UTXOS" 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 (EraRule "UTXOS" era)
UTxOState era
utxos
      TxBody era
txBody
      CertState era
certState
      GovState era
govState
      (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) ())
-> (Coin -> Event (EraRule "UTXOS" era))
-> Coin
-> F (Clause (EraRule "UTXOS" era) 'Transition) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayUtxosEvent era -> EraRuleEvent "UTXOS" era
ConwayUtxosEvent era -> Event (EraRule "UTXOS" era)
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent (ConwayUtxosEvent era -> Event (EraRule "UTXOS" era))
-> (Coin -> ConwayUtxosEvent era)
-> Coin
-> Event (EraRule "UTXOS" era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash EraIndependentTxBody -> Coin -> ConwayUtxosEvent era
forall era.
SafeHash EraIndependentTxBody -> Coin -> ConwayUtxosEvent 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 (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) ())
-> (ConwayUtxosEvent era -> Event (EraRule "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
ConwayUtxosEvent era -> Event (EraRule "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)
  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
$! UTxOState era
utxos' UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDonationL ((Coin -> Identity Coin)
 -> UTxOState era -> Identity (UTxOState era))
-> Coin -> UTxOState era -> UTxOState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ TxBody era
txBody TxBody era -> Getting Coin (TxBody era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody era) Coin
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
treasuryDonationTxBodyL