Skip to content

Commit 3532c31

Browse files
teodanciuteodanciu
committed
Update UTxOState and send events in UTXO rather than UTXOS in conway
1 parent b062a3d commit 3532c31

File tree

3 files changed

+74
-58
lines changed

3 files changed

+74
-58
lines changed

‎eras/conway/impl/CHANGELOG.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22

33
## 1.21.0.0
44

5+
* Change `STS` instance of `ConwayUTOXS`: use `PParams` as `Environment`
6+
* Remove `TotalDeposits` and `TxUTxODiff` data constructors from `ConwayUtxosEvent`
57
* Add `Generic` instance for `ApplyTxError`
68
* Change `ScriptsNotPaidUTxO` to use `NonEmptyMap TxIn (TxOut era)` instead of `UTxO era`
79
* Add `conwayLedgerTransitionTRC`

‎eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs‎

Lines changed: 55 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -26,18 +26,20 @@ module Cardano.Ledger.Conway.Rules.Utxo (
2626
import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure, shelleyToAllegraUtxoPredFailure)
2727
import qualified Cardano.Ledger.Allegra.Rules as Allegra (AllegraUtxoPredFailure (..))
2828
import Cardano.Ledger.Alonzo.Rules (
29-
AlonzoUtxoEvent,
29+
AlonzoUtxoEvent (..),
3030
AlonzoUtxoPredFailure,
3131
AlonzoUtxosPredFailure,
3232
)
3333
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo (
34-
AlonzoUtxoEvent (UtxosEvent),
3534
AlonzoUtxoPredFailure (..),
3635
)
37-
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure)
36+
import Cardano.Ledger.Babbage.Rules (
37+
BabbageUtxoPredFailure,
38+
babbageUtxoValidation,
39+
updateUTxOStateByTxValidity,
40+
)
3841
import qualified Cardano.Ledger.Babbage.Rules as Babbage (
3942
BabbageUtxoPredFailure (..),
40-
utxoTransition,
4143
)
4244
import Cardano.Ledger.BaseTypes (
4345
Mismatch (..),
@@ -65,13 +67,16 @@ import Cardano.Ledger.Conway.Rules.Utxos (
6567
ConwayUtxosPredFailure (..),
6668
)
6769
import Cardano.Ledger.Plutus (ExUnits)
68-
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley (UTxOState)
69-
import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure, UtxoEnv (..))
70-
import qualified Cardano.Ledger.Shelley.Rules as Shelley (UtxoEnv, validSizeComputationCheck)
71-
import Cardano.Ledger.State (EraCertState (..), EraUTxO)
70+
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..))
71+
import Cardano.Ledger.Shelley.Rules (
72+
ShelleyUtxoPredFailure,
73+
UtxoEnv (..),
74+
validSizeComputationCheck,
75+
)
76+
import Cardano.Ledger.State (EraCertState (..), EraStake, EraUTxO)
7277
import Cardano.Ledger.TxIn (TxIn)
7378
import Control.DeepSeq (NFData)
74-
import Control.State.Transition.Extended (Embed (..), STS (..))
79+
import Control.State.Transition.Extended
7580
import Data.List.NonEmpty (NonEmpty)
7681
import Data.Map.NonEmpty (NonEmptyMap)
7782
import Data.Set.NonEmpty (NonEmptySet)
@@ -174,7 +179,7 @@ instance InjectRuleFailure "UTXO" ShelleyUtxoPredFailure ConwayEra where
174179
allegraToConwayUtxoPredFailure
175180
. shelleyToAllegraUtxoPredFailure
176181

177-
instance InjectRuleFailure "UTXO" Allegra.AllegraUtxoPredFailure ConwayEra where
182+
instance InjectRuleFailure "UTXO" AllegraUtxoPredFailure ConwayEra where
178183
injectFailure = allegraToConwayUtxoPredFailure
179184

180185
instance InjectRuleFailure "UTXO" AlonzoUtxosPredFailure ConwayEra where
@@ -216,6 +221,36 @@ instance
216221
) =>
217222
NFData (ConwayUtxoPredFailure era)
218223

224+
conwayUtxoTransition ::
225+
forall era.
226+
( EraUTxO era
227+
, EraCertState era
228+
, BabbageEraTxBody era
229+
, AlonzoEraTx era
230+
, EraStake era
231+
, InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era
232+
, InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
233+
, InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era
234+
, InjectRuleFailure "UTXO" BabbageUtxoPredFailure era
235+
, Environment (EraRule "UTXO" era) ~ UtxoEnv era
236+
, State (EraRule "UTXO" era) ~ UTxOState era
237+
, Signal (EraRule "UTXO" era) ~ Tx TopTx era
238+
, BaseM (EraRule "UTXO" era) ~ ShelleyBase
239+
, STS (EraRule "UTXO" era)
240+
, Event (EraRule "UTXO" era) ~ AlonzoUtxoEvent era
241+
, -- In this function we we call the UTXOS rule, so we need some assumptions
242+
Environment (EraRule "UTXOS" era) ~ PParams era
243+
, State (EraRule "UTXOS" era) ~ UTxOState era
244+
, Signal (EraRule "UTXOS" era) ~ Tx TopTx era
245+
, Embed (EraRule "UTXOS" era) (EraRule "UTXO" era)
246+
) =>
247+
TransitionRule (EraRule "UTXO" era)
248+
conwayUtxoTransition = do
249+
TRC (UtxoEnv _ pp certState, utxos, tx) <- judgmentContext
250+
babbageUtxoValidation
251+
updatedUtxos <- trans @(EraRule "UTXOS" era) $ TRC (pp, utxos, tx)
252+
updateUTxOStateByTxValidity pp certState (utxosGovState utxos) tx updatedUtxos
253+
219254
--------------------------------------------------------------------------------
220255
-- ConwayUTXO STS
221256
--------------------------------------------------------------------------------
@@ -225,35 +260,36 @@ instance
225260
( EraTx era
226261
, EraUTxO era
227262
, ConwayEraTxBody era
228-
, AlonzoEraTxWits era
263+
, AlonzoEraTx era
264+
, EraStake era
229265
, EraRule "UTXO" era ~ ConwayUTXO era
230266
, InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era
231267
, InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
232268
, InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era
233269
, InjectRuleFailure "UTXO" BabbageUtxoPredFailure era
234270
, InjectRuleFailure "UTXO" ConwayUtxoPredFailure era
235271
, Embed (EraRule "UTXOS" era) (ConwayUTXO era)
236-
, Environment (EraRule "UTXOS" era) ~ Shelley.UtxoEnv era
237-
, State (EraRule "UTXOS" era) ~ Shelley.UTxOState era
272+
, Environment (EraRule "UTXOS" era) ~ PParams era
273+
, State (EraRule "UTXOS" era) ~ UTxOState era
238274
, Signal (EraRule "UTXOS" era) ~ Tx TopTx era
239275
, PredicateFailure (EraRule "UTXO" era) ~ ConwayUtxoPredFailure era
240276
, EraCertState era
241277
, SafeToHash (TxWits era)
242278
) =>
243279
STS (ConwayUTXO era)
244280
where
245-
type State (ConwayUTXO era) = Shelley.UTxOState era
281+
type State (ConwayUTXO era) = UTxOState era
246282
type Signal (ConwayUTXO era) = Tx TopTx era
247-
type Environment (ConwayUTXO era) = Shelley.UtxoEnv era
283+
type Environment (ConwayUTXO era) = UtxoEnv era
248284
type BaseM (ConwayUTXO era) = ShelleyBase
249285
type PredicateFailure (ConwayUTXO era) = ConwayUtxoPredFailure era
250286
type Event (ConwayUTXO era) = AlonzoUtxoEvent era
251287

252288
initialRules = []
253289

254-
transitionRules = [Babbage.utxoTransition @era]
290+
transitionRules = [conwayUtxoTransition]
255291

256-
assertions = [Shelley.validSizeComputationCheck]
292+
assertions = [validSizeComputationCheck]
257293

258294
instance
259295
( Era era
@@ -264,7 +300,7 @@ instance
264300
Embed (ConwayUTXOS era) (ConwayUTXO era)
265301
where
266302
wrapFailed = UtxosFailure
267-
wrapEvent = Alonzo.UtxosEvent
303+
wrapEvent = UtxosEvent
268304

269305
--------------------------------------------------------------------------------
270306
-- Serialisation
@@ -381,7 +417,7 @@ alonzoToConwayUtxoPredFailure = \case
381417
allegraToConwayUtxoPredFailure ::
382418
forall era.
383419
EraRuleFailure "PPUP" era ~ VoidEraRule "PPUP" era =>
384-
Allegra.AllegraUtxoPredFailure era ->
420+
AllegraUtxoPredFailure era ->
385421
ConwayUtxoPredFailure era
386422
allegraToConwayUtxoPredFailure = \case
387423
Allegra.BadInputsUTxO x -> BadInputsUTxO x

‎eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs‎

Lines changed: 17 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -49,21 +49,20 @@ import Cardano.Ledger.Babbage.Rules (
4949
expectScriptsToPass,
5050
)
5151
import Cardano.Ledger.Babbage.Tx
52-
import Cardano.Ledger.BaseTypes (ShelleyBase)
52+
import Cardano.Ledger.BaseTypes
5353
import Cardano.Ledger.Binary (
5454
DecCBOR (..),
5555
EncCBOR (..),
5656
)
5757
import Cardano.Ledger.Binary.Coders
58-
import Cardano.Ledger.Coin (Coin)
5958
import Cardano.Ledger.Conway.Core
6059
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayUTXOS)
6160
import Cardano.Ledger.Conway.Governance (ConwayGovState)
6261
import Cardano.Ledger.Conway.State
6362
import Cardano.Ledger.Plutus (PlutusWithContext)
6463
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..), utxosDonationL)
65-
import Cardano.Ledger.Shelley.Rules (UtxoEnv (..), updateUTxOState)
6664
import Control.DeepSeq (NFData)
65+
import Control.Monad.Trans.Reader (asks)
6766
import Control.State.Transition.Extended
6867
import Data.List.NonEmpty (NonEmpty)
6968
import qualified Debug.Trace as Debug
@@ -86,20 +85,13 @@ data ConwayUtxosPredFailure era
8685
(Generic)
8786

8887
data ConwayUtxosEvent era
89-
= TotalDeposits (SafeHash EraIndependentTxBody) Coin
90-
| SuccessfulPlutusScriptsEvent (NonEmpty PlutusWithContext)
88+
= SuccessfulPlutusScriptsEvent (NonEmpty PlutusWithContext)
9189
| FailedPlutusScriptsEvent (NonEmpty PlutusWithContext)
92-
| -- | The UTxOs consumed and created by a signal tx
93-
TxUTxODiff
94-
-- | UTxO consumed
95-
(UTxO era)
96-
-- | UTxO created
97-
(UTxO era)
9890
deriving (Generic)
9991

100-
deriving instance (Era era, Eq (TxOut era)) => Eq (ConwayUtxosEvent era)
92+
deriving instance Eq (ConwayUtxosEvent era)
10193

102-
instance (Era era, NFData (TxOut era)) => NFData (ConwayUtxosEvent era)
94+
instance NFData (ConwayUtxosEvent era)
10395

10496
type instance EraRuleFailure "UTXOS" ConwayEra = ConwayUtxosPredFailure ConwayEra
10597

@@ -132,10 +124,8 @@ alonzoToConwayUtxosEvent ::
132124
ConwayUtxosEvent era
133125
alonzoToConwayUtxosEvent = \case
134126
Alonzo.AlonzoPpupToUtxosEvent x -> absurdEraRule @"PPUP" @era x
135-
Alonzo.TotalDeposits h c -> TotalDeposits h c
136127
Alonzo.SuccessfulPlutusScriptsEvent l -> SuccessfulPlutusScriptsEvent l
137128
Alonzo.FailedPlutusScriptsEvent l -> FailedPlutusScriptsEvent l
138-
Alonzo.TxUTxODiff x y -> TxUTxODiff x y
139129

140130
instance
141131
( EraTxCert era
@@ -214,7 +204,7 @@ instance
214204
STS (ConwayUTXOS era)
215205
where
216206
type BaseM (ConwayUTXOS era) = Cardano.Ledger.BaseTypes.ShelleyBase
217-
type Environment (ConwayUTXOS era) = UtxoEnv era
207+
type Environment (ConwayUTXOS era) = PParams era
218208
type State (ConwayUTXOS era) = UTxOState era
219209
type Signal (ConwayUTXOS era) = Tx TopTx era
220210
type PredicateFailure (ConwayUTXOS era) = ConwayUtxosPredFailure era
@@ -251,60 +241,48 @@ utxosTransition ::
251241
, AlonzoEraUTxO era
252242
, ConwayEraTxBody era
253243
, EraPlutusContext era
254-
, EraStake era
255-
, EraCertState era
256244
, ScriptsNeeded era ~ AlonzoScriptsNeeded era
257245
, Signal (EraRule "UTXOS" era) ~ Tx TopTx era
258246
, STS (EraRule "UTXOS" era)
259-
, Environment (EraRule "UTXOS" era) ~ UtxoEnv era
247+
, Environment (EraRule "UTXOS" era) ~ PParams era
260248
, State (EraRule "UTXOS" era) ~ UTxOState era
261249
, InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
262250
, BaseM (EraRule "UTXOS" era) ~ ShelleyBase
263251
, InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
264-
, InjectRuleEvent "UTXOS" ConwayUtxosEvent era
265252
) =>
266253
TransitionRule (EraRule "UTXOS" era)
267254
utxosTransition =
268-
judgmentContext >>= \(TRC (_, _, tx)) -> do
255+
judgmentContext >>= \(TRC (pp, utxos, tx)) -> do
269256
case tx ^. isValidTxL of
270257
IsValid True -> conwayEvalScriptsTxValid
271-
IsValid False -> babbageEvalScriptsTxInvalid
258+
IsValid False -> do
259+
sysSt <- liftSTS $ asks systemStart
260+
ei <- liftSTS $ asks epochInfo
261+
babbageEvalScriptsTxInvalid @era ei sysSt pp tx (utxosUtxo utxos)
262+
pure utxos
272263

273264
conwayEvalScriptsTxValid ::
274265
forall era.
275266
( AlonzoEraTx era
276267
, AlonzoEraUTxO era
277268
, ConwayEraTxBody era
278269
, EraPlutusContext era
279-
, EraStake era
280-
, EraCertState era
281270
, ScriptsNeeded era ~ AlonzoScriptsNeeded era
282271
, Signal (EraRule "UTXOS" era) ~ Tx TopTx era
283272
, STS (EraRule "UTXOS" era)
284273
, State (EraRule "UTXOS" era) ~ UTxOState era
285-
, Environment (EraRule "UTXOS" era) ~ UtxoEnv era
274+
, Environment (EraRule "UTXOS" era) ~ PParams era
286275
, InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era
287276
, BaseM (EraRule "UTXOS" era) ~ ShelleyBase
288277
, InjectRuleEvent "UTXOS" AlonzoUtxosEvent era
289-
, InjectRuleEvent "UTXOS" ConwayUtxosEvent era
290278
) =>
291279
TransitionRule (EraRule "UTXOS" era)
292280
conwayEvalScriptsTxValid = do
293-
TRC (UtxoEnv _ pp certState, utxos@(UTxOState utxo _ _ govState _ _), tx) <-
294-
judgmentContext
281+
TRC (pp, utxos, tx) <- judgmentContext
295282
let txBody = tx ^. bodyTxL
296283

297284
() <- pure $! Debug.traceEvent validBegin ()
298-
expectScriptsToPass pp tx utxo
285+
expectScriptsToPass pp tx (utxosUtxo utxos)
299286
() <- pure $! Debug.traceEvent validEnd ()
300287

301-
utxos' <-
302-
updateUTxOState
303-
pp
304-
utxos
305-
txBody
306-
certState
307-
govState
308-
(tellEvent . injectEvent . TotalDeposits (hashAnnotated txBody))
309-
(\a b -> tellEvent . injectEvent $ TxUTxODiff a b)
310-
pure $! utxos' & utxosDonationL <>~ txBody ^. treasuryDonationTxBodyL
288+
pure $! utxos & utxosDonationL <>~ txBody ^. treasuryDonationTxBodyL

0 commit comments

Comments
 (0)