Skip to content

Commit 09dc377

Browse files
lehinslehins
authored
Merge pull request #4867 from IntersectMBO/lehins/initial-attempt-at-approach-of-using-lenses-for-managing-ledger-state
Add `CanGetUTxO` and `CanSetUTxO` type classes
2 parents 3dd7401 + b6c46be commit 09dc377

File tree

21 files changed

+72
-35
lines changed

21 files changed

+72
-35
lines changed

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -81,10 +81,8 @@ import Cardano.Ledger.Plutus (
8181
)
8282
import Cardano.Ledger.Shelley.LedgerState (
8383
curPParamsEpochStateL,
84-
esLStateL,
85-
lsUTxOStateL,
8684
nesEsL,
87-
utxosUtxoL,
85+
utxoL,
8886
)
8987
import Cardano.Ledger.Shelley.UTxO (EraUTxO (..), ScriptsProvided (..), UTxO (..), txouts)
9088
import Cardano.Ledger.TxIn (TxIn)
@@ -162,7 +160,7 @@ impGetPlutusContexts ::
162160
ImpTestM era [(PlutusPurpose AsIxItem era, ScriptHash, ScriptTestContext)]
163161
impGetPlutusContexts tx = do
164162
let txBody = tx ^. bodyTxL
165-
utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
163+
utxo <- getsNES utxoL
166164
let AlonzoScriptsNeeded asn = getScriptsNeeded utxo txBody
167165
mbyContexts <- forM asn $ \(prp, sh) -> do
168166
pure $ (prp,sh,) <$> impGetScriptContextMaybe @era sh
@@ -529,15 +527,15 @@ expectTxSuccess ::
529527
Tx era -> ImpTestM era ()
530528
expectTxSuccess tx
531529
| tx ^. isValidTxL == IsValid True = do
532-
utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
530+
utxo <- getsNES utxoL
533531
let inputs = Set.toList $ tx ^. bodyTxL . inputsTxBodyL
534532
outputs = Map.toList . unUTxO . txouts $ tx ^. bodyTxL
535533
impAnn "Inputs should be gone from UTxO" $
536534
expectUTxOContent utxo [(txIn, isNothing) | txIn <- inputs]
537535
impAnn "Outputs should be in UTxO" $
538536
expectUTxOContent utxo [(txIn, (== Just txOut)) | (txIn, txOut) <- outputs]
539537
| otherwise = do
540-
utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
538+
utxo <- getsNES utxoL
541539
let inputs = tx ^. bodyTxL . inputsTxBodyL
542540
collaterals = tx ^. bodyTxL . collateralInputsTxBodyL
543541
outputs = Map.toList . unUTxO . txouts $ tx ^. bodyTxL

‎eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/ChainTrace.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,6 @@ import Cardano.Ledger.Plutus.Evaluate (PlutusWithContext (..), ScriptResult (..)
2727
import Cardano.Ledger.Plutus.Language (plutusFromRunnable)
2828
import Cardano.Ledger.Shelley.LedgerState hiding (circulation)
2929
import Cardano.Ledger.Slot (EpochSize (..))
30-
import Cardano.Ledger.UTxO (UTxO (..))
3130
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
3231
import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
3332
import Control.State.Transition

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -94,8 +94,8 @@ import Cardano.Ledger.Shelley.LedgerState (
9494
LedgerState (..),
9595
UTxOState (..),
9696
asTreasuryL,
97+
utxoL,
9798
utxosGovStateL,
98-
utxosUtxoL,
9999
)
100100
import Cardano.Ledger.Shelley.Rules (
101101
LedgerEnv (..),
@@ -407,7 +407,7 @@ ledgerTransition = do
407407
}
408408
)
409409

410-
let totalRefScriptSize = txNonDistinctRefScriptsSize (utxoState ^. utxosUtxoL) tx
410+
let totalRefScriptSize = txNonDistinctRefScriptsSize (utxoState ^. utxoL) tx
411411
totalRefScriptSize
412412
<= maxRefScriptSizePerTx
413413
?! ConwayTxRefScriptsSizeTooBig

‎eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -209,9 +209,9 @@ import Cardano.Ledger.Shelley.LedgerState (
209209
newEpochStateGovStateL,
210210
produced,
211211
unifiedL,
212+
utxoL,
212213
utxosGovStateL,
213214
utxosStakeDistrL,
214-
utxosUtxoL,
215215
vsCommitteeStateL,
216216
vsDRepsL,
217217
)
@@ -1761,7 +1761,7 @@ logConwayTxBalance ::
17611761
logConwayTxBalance tx = do
17621762
pp <- getsPParams id
17631763
certState <- getsNES $ nesEsL . esLStateL . lsCertStateL
1764-
utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
1764+
utxo <- getsNES utxoL
17651765
logString $ showConwayTxBalance pp certState utxo tx
17661766

17671767
submitBootstrapAwareFailingVote ::

‎eras/shelley/impl/CHANGELOG.md‎

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

33
## 1.16.0.0
44

5+
* Deprecated `utxosUtxoL`
6+
* Added `CanGetUTxO` and `CanSetUTxO` instances for `EpochState`, `UTxOState`, `NewEpochState`, `LedgerState`
57
* Made the fields of predicate failures and environments lazy
68
* Changed the type of `sgSecurityParam` to `NonZero Word64`
79
* Following functions now expect a `NonZero Word64` security parameter:

‎eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,12 @@
1010
-- as state transformations on a ledger state ('LedgerState'),
1111
-- as specified in /A Simplified Formal Specification of a UTxO Ledger/.
1212
module Cardano.Ledger.Shelley.LedgerState (
13+
-- * UTxO
14+
UTxO (..),
15+
CanGetUTxO (..),
16+
CanSetUTxO (..),
17+
18+
-- * Others to organize
1319
AccountState (..),
1420
CertState (..),
1521
DState (..),
@@ -159,3 +165,4 @@ import Cardano.Ledger.Shelley.PParams (pvCanFollow)
159165
import Cardano.Ledger.Shelley.RewardUpdate
160166
import Cardano.Ledger.Shelley.Rules.Ppup (ShelleyGovState (..))
161167
import Cardano.Ledger.Shelley.UTxO (consumed, produced)
168+
import Cardano.Ledger.UTxO (CanGetUTxO (..), CanSetUTxO (..), UTxO (..))

‎eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/Types.hs‎

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ import Cardano.Ledger.Shelley.Era (ShelleyEra)
6868
import Cardano.Ledger.Shelley.PoolRank (NonMyopic (..))
6969
import Cardano.Ledger.Shelley.RewardUpdate (PulsingRewUpdate (..))
7070
import Cardano.Ledger.UMap (UMap (..))
71-
import Cardano.Ledger.UTxO (UTxO (..))
71+
import Cardano.Ledger.UTxO (CanGetUTxO (..), CanSetUTxO (..), UTxO (..))
7272
import Control.DeepSeq (NFData)
7373
import Control.Monad.State.Strict (evalStateT)
7474
import Control.Monad.Trans (MonadTrans (lift))
@@ -130,6 +130,11 @@ data EpochState era = EpochState
130130
}
131131
deriving (Generic)
132132

133+
instance CanGetUTxO EpochState
134+
instance CanSetUTxO EpochState where
135+
utxoL = (lens esLState $ \s ls -> s {esLState = ls}) . utxoL
136+
{-# INLINE utxoL #-}
137+
133138
deriving stock instance
134139
( EraTxOut era
135140
, Show (GovState era)
@@ -285,6 +290,11 @@ data UTxOState era = UTxOState
285290
}
286291
deriving (Generic)
287292

293+
instance CanGetUTxO UTxOState
294+
instance CanSetUTxO UTxOState where
295+
utxoL = lens utxosUtxo $ \s u -> s {utxosUtxo = u}
296+
{-# INLINE utxoL #-}
297+
288298
instance
289299
( EraTxOut era
290300
, NFData (GovState era)
@@ -403,6 +413,11 @@ data NewEpochState era = NewEpochState
403413
}
404414
deriving (Generic)
405415

416+
instance CanGetUTxO NewEpochState
417+
instance CanSetUTxO NewEpochState where
418+
utxoL = (lens nesEs $ \s es -> s {nesEs = es}) . utxoL
419+
{-# INLINE utxoL #-}
420+
406421
type family StashedAVVMAddresses era where
407422
StashedAVVMAddresses ShelleyEra = UTxO ShelleyEra
408423
StashedAVVMAddresses _ = ()
@@ -490,6 +505,11 @@ data LedgerState era = LedgerState
490505
}
491506
deriving (Generic)
492507

508+
instance CanGetUTxO LedgerState
509+
instance CanSetUTxO LedgerState where
510+
utxoL = (lens lsUTxOState $ \s us -> s {lsUTxOState = us}) . utxoL
511+
{-# INLINE utxoL #-}
512+
493513
deriving stock instance
494514
( EraTxOut era
495515
, Show (GovState era)
@@ -664,6 +684,7 @@ lsCertStateL = lens lsCertState (\x y -> x {lsCertState = y})
664684

665685
utxosUtxoL :: Lens' (UTxOState era) (UTxO era)
666686
utxosUtxoL = lens utxosUtxo (\x y -> x {utxosUtxo = y})
687+
{-# DEPRECATED utxosUtxoL "In favor of `utxoL`" #-}
667688

668689
utxosDepositedL :: Lens' (UTxOState era) Coin
669690
utxosDepositedL = lens utxosDeposited (\x y -> x {utxosDeposited = y})

‎eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -80,7 +80,7 @@ import Cardano.Ledger.Shelley.TxBody (RewardAccount)
8080
import Cardano.Ledger.Shelley.UTxO (consumed, produced)
8181
import Cardano.Ledger.Slot (SlotNo)
8282
import Cardano.Ledger.TxIn (TxIn)
83-
import Cardano.Ledger.UTxO (EraUTxO (getMinFeeTxUtxo), UTxO (..), balance, txouts)
83+
import Cardano.Ledger.UTxO (CanSetUTxO (..), EraUTxO (getMinFeeTxUtxo), UTxO (..), balance, txouts)
8484
import Cardano.Ledger.Val ((<->))
8585
import qualified Cardano.Ledger.Val as Val
8686
import Control.DeepSeq
@@ -360,7 +360,8 @@ utxoInductive ::
360360
TransitionRule (EraRule "UTXO" era)
361361
utxoInductive = do
362362
TRC (UtxoEnv slot pp certState, utxos, tx) <- judgmentContext
363-
let UTxOState utxo _ _ ppup _ _ = utxos
363+
let utxo = utxos ^. utxoL
364+
UTxOState _ _ _ ppup _ _ = utxos
364365
txBody = tx ^. bodyTxL
365366
outputs = txBody ^. outputsTxBodyL
366367
genDelegs = dsGenDelegs (certDState certState)

‎eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -169,6 +169,7 @@ import Cardano.Ledger.Shelley.Genesis (
169169
validateGenesis,
170170
)
171171
import Cardano.Ledger.Shelley.LedgerState (
172+
CanSetUTxO (..),
172173
LedgerState (..),
173174
NewEpochState (..),
174175
StashedAVVMAddresses,
@@ -186,7 +187,6 @@ import Cardano.Ledger.Shelley.LedgerState (
186187
prevPParamsEpochStateL,
187188
produced,
188189
utxosDonationL,
189-
utxosUtxoL,
190190
)
191191
import Cardano.Ledger.Shelley.Rules (
192192
BbodyEnv (..),
@@ -584,8 +584,7 @@ defaultInitImpTestState nes = do
584584
rootCoin = Coin (toInteger (sgMaxLovelaceSupply shelleyGenesis))
585585
rootTxIn :: TxIn
586586
rootTxIn = TxIn (mkTxId 0) minBound
587-
nesWithRoot =
588-
nes & nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL <>~ UTxO (Map.singleton rootTxIn rootTxOut)
587+
nesWithRoot = nes & utxoL <>~ UTxO (Map.singleton rootTxIn rootTxOut)
589588
prepState <- get
590589
let epochInfoE =
591590
fixedEpochInfo
@@ -779,7 +778,7 @@ impWitsVKeyNeeded txBody = do
779778
bootAddrs = Set.fromList $ mapMaybe toBootAddr $ Set.toList (txBody ^. spendableInputsTxBodyF)
780779
bootKeyHashes = Set.map (coerceKeyRole . bootstrapKeyHash) bootAddrs
781780
allKeyHashes =
782-
getWitsVKeyNeeded (ls ^. lsCertStateL) (ls ^. lsUTxOStateL . utxosUtxoL) txBody
781+
getWitsVKeyNeeded (ls ^. lsCertStateL) (ls ^. utxoL) txBody
783782
pure (bootAddrs, allKeyHashes Set.\\ bootKeyHashes)
784783

785784
data ImpTestEnv era = ImpTestEnv
@@ -1046,7 +1045,7 @@ shelleyFixupTx =
10461045
logFeeMismatch :: (EraGov era, EraUTxO era, HasCallStack) => Tx era -> ImpTestM era ()
10471046
logFeeMismatch tx = do
10481047
pp <- getsNES $ nesEsL . curPParamsEpochStateL
1049-
utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
1048+
utxo <- getsNES utxoL
10501049
let Coin feeUsed = tx ^. bodyTxL . feeTxBodyL
10511050
Coin feeMin = getMinFeeTxUtxo pp tx utxo
10521051
when (feeUsed /= feeMin) $ do
@@ -1442,7 +1441,7 @@ getsNES :: SimpleGetter (NewEpochState era) a -> ImpTestM era a
14421441
getsNES l = gets . view $ impNESL . l
14431442

14441443
getUTxO :: ImpTestM era (UTxO era)
1445-
getUTxO = getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
1444+
getUTxO = getsNES utxoL
14461445

14471446
getProtVer :: EraGov era => ImpTestM era ProtVer
14481447
getProtVer = getsNES $ nesEsL . curPParamsEpochStateL . ppProtocolVersionL

‎eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/EmptyBlock.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,6 @@ import Cardano.Ledger.Block (Block)
1515
import Cardano.Ledger.Shelley.Core
1616
import Cardano.Ledger.Shelley.LedgerState
1717
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
18-
import Cardano.Ledger.UTxO (UTxO (..))
1918
import Cardano.Protocol.TPraos.BHeader (BHeader)
2019
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
2120
import Data.Default

0 commit comments

Comments
 (0)