Skip to content

Commit fdda3a1

Browse files
lehinslehins
committed
Add Can[Get|Set]ChainAccountState
Also add `treasuryL` and `reservesL`
1 parent f169fbf commit fdda3a1

File tree

16 files changed

+86
-56
lines changed

16 files changed

+86
-56
lines changed

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -218,7 +218,6 @@ import Cardano.Ledger.Shelley.LedgerState (
218218
NewEpochState (..),
219219
epochStateGovStateL,
220220
epochStatePoolParamsL,
221-
epochStateTreasuryL,
222221
esLStateL,
223222
lsCertState,
224223
lsCertStateL,
@@ -504,7 +503,7 @@ setFreshDRepPulsingState epochNo stakePoolDistr epochState = do
504503
, dpCommitteeState = vsCommitteeState vState
505504
, dpEnactState =
506505
mkEnactState govState
507-
& ensTreasuryL .~ epochState ^. epochStateTreasuryL
506+
& ensTreasuryL .~ epochState ^. treasuryL
508507
, dpProposals = proposalsActions props
509508
, dpProposalDeposits = proposalsDeposits props
510509
, dpGlobals = globals

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

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -68,8 +68,6 @@ import Cardano.Ledger.Shelley.LedgerState (
6868
LedgerState (..),
6969
UTxOState (..),
7070
curPParamsEpochStateL,
71-
esChainAccountState,
72-
esChainAccountStateL,
7371
esLStateL,
7472
esSnapshotsL,
7573
lsCertStateL,
@@ -290,14 +288,14 @@ epochTransition = do
290288
TRC
291289
( ()
292290
, epochState0@EpochState
293-
{ esChainAccountState = chainAccountState0
294-
, esSnapshots = snapshots0
291+
{ esSnapshots = snapshots0
295292
, esLState = ledgerState0
296293
}
297294
, eNo
298295
) <-
299296
judgmentContext
300-
let govState0 = utxosGovState utxoState0
297+
let chainAccountState0 = epochState0 ^. chainAccountStateL
298+
govState0 = utxosGovState utxoState0
301299
curPParams = govState0 ^. curPParamsGovStateL
302300
utxoState0 = lsUTxOState ledgerState0
303301
certState0 = ledgerState0 ^. lsCertStateL
@@ -390,7 +388,7 @@ epochTransition = do
390388
& lsUTxOStateL .~ utxoState2
391389
epochState1 =
392390
epochState0
393-
& esChainAccountStateL .~ chainAccountState3
391+
& chainAccountStateL .~ chainAccountState3
394392
& esSnapshotsL .~ snapshots1
395393
& esLStateL .~ ledgerState1
396394
tellEvent $ EpochBoundaryRatifyState ratifyState

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import Cardano.Ledger.Conway.Rules (
2121
maxRefScriptSizePerBlock,
2222
maxRefScriptSizePerTx,
2323
)
24+
import Cardano.Ledger.Conway.State
2425
import Cardano.Ledger.Plutus (SLanguage (..))
2526
import Cardano.Ledger.Shelley.LedgerState
2627
import Cardano.Ledger.Shelley.Rules (
@@ -77,7 +78,6 @@ spec = describe "BBODY" $ do
7778
nes <- use impNESL
7879
let ls = nes ^. nesEsL . esLStateL
7980
pp = nes ^. nesEsL . curPParamsEpochStateL
80-
account = nes ^. nesEsL . esChainAccountStateL
8181
kh <- freshKeyHash
8282
slotNo <- use impLastTickG
8383
let bhView =
@@ -90,7 +90,7 @@ spec = describe "BBODY" $ do
9090
}
9191
Left predFailures <-
9292
tryRunImpRule @"BBODY"
93-
(BbodyEnv pp account)
93+
(BbodyEnv pp (nes ^. chainAccountStateL))
9494
(BbodyState ls (BlocksMade Map.empty))
9595
(Block bhView txSeq)
9696
predFailures

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

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,7 @@ treasuryWithdrawalsSpec =
123123
disableTreasuryExpansion
124124
committeeCs <- registerInitialCommittee
125125
(drepC, _, _) <- setupSingleDRep 1_000_000
126-
initialTreasury <- getTreasury
126+
initialTreasury <- getsNES treasuryL
127127
numWithdrawals <- choose (1, 10)
128128
withdrawals <- genWithdrawalsExceeding initialTreasury numWithdrawals
129129

@@ -138,14 +138,14 @@ treasuryWithdrawalsSpec =
138138
& bodyTxL . treasuryDonationTxBodyL .~ (sumRequested <-> initialTreasury)
139139
submitTx_ tx
140140
passNEpochs 2
141-
getTreasury `shouldReturn` zero
141+
getsNES treasuryL `shouldReturn` zero
142142
sumRewardAccounts withdrawals `shouldReturn` sumRequested
143143

144144
it "Withdrawals exceeding maxBound Word64 submitted in a single proposal" $ whenPostBootstrap $ do
145145
disableTreasuryExpansion
146146
committeeCs <- registerInitialCommittee
147147
(drepC, _, _) <- setupSingleDRep 1_000_000
148-
initialTreasury <- getTreasury
148+
initialTreasury <- getsNES treasuryL
149149
numWithdrawals <- choose (1, 10)
150150
withdrawals <- genWithdrawalsExceeding (Coin (fromIntegral (maxBound :: Word64))) numWithdrawals
151151
void $ enactTreasuryWithdrawals withdrawals drepC committeeCs
@@ -157,7 +157,7 @@ treasuryWithdrawalsSpec =
157157
committeeCs <- registerInitialCommittee
158158
(drepC, _, _) <- setupSingleDRep 1_000_000
159159
donateToTreasury $ Coin 5_000_000
160-
initialTreasury <- getTreasury
160+
initialTreasury <- getsNES treasuryL
161161
numWithdrawals <- choose (1, 10)
162162
withdrawals <- genWithdrawalsExceeding initialTreasury numWithdrawals
163163

@@ -181,17 +181,16 @@ treasuryWithdrawalsSpec =
181181
initialTreasury
182182
withdrawals
183183

184-
getTreasury `shouldReturn` expectedTreasury
184+
getsNES treasuryL `shouldReturn` expectedTreasury
185185
-- check that the sum of the rewards matches what was spent from the treasury
186186
sumRewardAccounts withdrawals `shouldReturn` (initialTreasury <-> expectedTreasury)
187187
where
188-
getTreasury = getsNES (nesEsL . esChainAccountStateL . casTreasuryL)
189188
sumRewardAccounts withdrawals = mconcat <$> traverse (getRewardAccountAmount . fst) withdrawals
190189
genWithdrawalsExceeding (Coin val) n = do
191190
vals <- genValuesExceeding val n
192191
forM (Coin <$> vals) $ \coin -> (,coin) <$> registerRewardAccount
193192
checkNoWithdrawal initialTreasury withdrawals = do
194-
getTreasury `shouldReturn` initialTreasury
193+
getsNES treasuryL `shouldReturn` initialTreasury
195194
sumRewardAccounts withdrawals `shouldReturn` zero
196195
genValuesExceeding val n = do
197196
pcts <- replicateM (n - 1) $ choose (1, 100)

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -422,7 +422,7 @@ treasuryWithdrawalExpectation extraWithdrawals = do
422422
donateToTreasury withdrawalAmount
423423
committeeHotCreds <- registerInitialCommittee
424424
(dRepCred, _, _) <- setupSingleDRep 1_000_000
425-
treasuryStart <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
425+
treasuryStart <- getsNES treasuryL
426426
treasuryStart `shouldBe` withdrawalAmount
427427
rewardAccount <- registerRewardAccount
428428
govPolicy <- getGovPolicy
@@ -437,7 +437,7 @@ treasuryWithdrawalExpectation extraWithdrawals = do
437437
getReward (raCredential rewardAccount) `shouldReturn` mempty
438438
passEpoch -- 2nd epoch crossing enacts all the ratified actions
439439
expectMissingGovActionId govActionId
440-
treasuryEnd <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
440+
treasuryEnd <- getsNES treasuryL
441441
impAnn "Withdrawal deducted from treasury" $
442442
treasuryStart <-> treasuryEnd `shouldBe` withdrawalAmount
443443
impAnn "Withdrawal received by reward account" $
@@ -446,7 +446,7 @@ treasuryWithdrawalExpectation extraWithdrawals = do
446446
depositMovesToTreasuryWhenStakingAddressUnregisters :: ConwayEraImp era => ImpTestM era ()
447447
depositMovesToTreasuryWhenStakingAddressUnregisters = do
448448
disableTreasuryExpansion
449-
initialTreasury <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
449+
initialTreasury <- getsNES treasuryL
450450
modifyPParams $ \pp ->
451451
pp
452452
& ppGovActionLifetimeL .~ EpochInterval 8

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

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -476,14 +476,14 @@ committeeMinSizeAffectsInFlightProposalsSpec =
476476
& ppuCommitteeMinSizeL .~ SJust 3
477477
submitYesVoteCCs_ hotCommitteeCs gaiPC
478478
submitYesVote_ (DRepVoter drepC) gaiPC
479-
treasury <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
479+
treasury <- getsNES treasuryL
480480
passNEpochs 2
481481
-- The ParameterChange prevents the TreasuryWithdrawal from being enacted,
482482
-- because it has higher priority.
483483
getLastEnactedParameterChange `shouldReturn` SJust (GovPurposeId gaiPC)
484484
isCommitteeAccepted gaiTW `shouldReturn` False
485485
currentProposalsShouldContain gaiTW
486-
getsNES (nesEsL . esChainAccountStateL . casTreasuryL) `shouldReturn` treasury
486+
getsNES treasuryL `shouldReturn` treasury
487487
it "TreasuryWithdrawal ratifies due to a decrease in CommitteeMinSize" $ whenPostBootstrap $ do
488488
disableTreasuryExpansion
489489
(drepC, hotCommitteeC, _) <- electBasicCommittee
@@ -492,14 +492,14 @@ committeeMinSizeAffectsInFlightProposalsSpec =
492492
-- Ensure sufficient amount in the treasury
493493
submitTx_ $ mkBasicTx (mkBasicTxBody & treasuryDonationTxBodyL .~ amount)
494494
passEpoch
495-
treasury <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
495+
treasury <- getsNES treasuryL
496496
gaiTW <- submitTreasuryWithdrawal amount
497497
submitYesVote_ (CommitteeVoter hotCommitteeC) gaiTW
498498
submitYesVote_ (DRepVoter drepC) gaiTW
499499
setCommitteeMinSize 2
500500
isCommitteeAccepted gaiTW `shouldReturn` False
501501
passNEpochs 2
502-
getsNES (nesEsL . esChainAccountStateL . casTreasuryL) `shouldReturn` treasury
502+
getsNES treasuryL `shouldReturn` treasury
503503
-- We do not enact the ParameterChange here because that does not pass
504504
-- ratification as the CC size is smaller than MinSize.
505505
-- We instead just add another Committee member to reach the CommitteeMinSize.
@@ -511,7 +511,7 @@ committeeMinSizeAffectsInFlightProposalsSpec =
511511
_hotCommitteeC' <- registerCommitteeHotKey coldCommitteeCred
512512
isCommitteeAccepted gaiTW `shouldReturn` True
513513
passNEpochs 2
514-
getsNES (nesEsL . esChainAccountStateL . casTreasuryL) `shouldReturn` (treasury <-> amount)
514+
getsNES treasuryL `shouldReturn` (treasury <-> amount)
515515

516516
spoVotesForHardForkInitiation ::
517517
forall era.
@@ -854,7 +854,7 @@ votingSpec =
854854
passEpoch
855855
getCommitteeMembers `shouldReturn` mempty
856856
it "AlwaysAbstain" $ whenPostBootstrap $ do
857-
let getTreasury = getsNES (nesEsL . esChainAccountStateL . casTreasuryL)
857+
let getTreasury = getsNES treasuryL
858858

859859
disableTreasuryExpansion
860860
donateToTreasury $ Coin 5_000_000

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

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -187,7 +187,6 @@ import Cardano.Ledger.Shelley.LedgerState (
187187
curPParamsEpochStateL,
188188
epochStateGovStateL,
189189
epochStatePoolParamsL,
190-
esChainAccountStateL,
191190
esLStateL,
192191
lsCertStateL,
193192
lsUTxOStateL,
@@ -1170,7 +1169,7 @@ logRatificationChecks gaId = do
11701169
committee <- getsNES $ nesEsL . epochStateGovStateL . committeeGovStateL
11711170
ratEnv@RatifyEnv {reCurrentEpoch} <- getRatifyEnv
11721171
let ratSt = RatifyState ens mempty mempty False
1173-
curTreasury <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
1172+
curTreasury <- getsNES treasuryL
11741173
currentEpoch <- getsNES nesELL
11751174
pv <- getProtVer
11761175
let
@@ -1670,13 +1669,13 @@ expectCommitteeMemberAbsence cc = do
16701669
donateToTreasury :: ConwayEraImp era => Coin -> ImpTestM era ()
16711670
donateToTreasury amount =
16721671
impAnn ("Donation to treasury in the amount of: " ++ show amount) $ do
1673-
treasuryStart <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
1672+
treasuryStart <- getsNES treasuryL
16741673
submitTx_ $ mkBasicTx (mkBasicTxBody & treasuryDonationTxBodyL .~ amount)
1675-
treasuryEndEpoch0 <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
1674+
treasuryEndEpoch0 <- getsNES treasuryL
16761675
-- Actual donation happens on the epoch boundary
16771676
treasuryStart `shouldBe` treasuryEndEpoch0
16781677
passEpoch
1679-
treasuryEndEpoch1 <- getsNES $ nesEsL . esChainAccountStateL . casTreasuryL
1678+
treasuryEndEpoch1 <- getsNES treasuryL
16801679
treasuryEndEpoch1 <-> treasuryStart `shouldBe` amount
16811680

16821681
expectMembers ::

‎eras/shelley/impl/CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
## 1.17.0.0
44

5+
* Deprecate `esAccountStateL`, `epochStateTreasuryL`, `asTreasuryL` and `asReservesL`
56
* Rename `esAccountState` to `esChainAccountState`
67
* Replaced `prDState` and `prPState` with `prCertState` in `ShelleyPoolreapState`
78
* Removed `ShelleyPoolreapEnv` (became obsolete)

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -88,7 +88,7 @@ module Cardano.Ledger.Shelley.LedgerState (
8888
nesRuL,
8989
nesStashedAVVMAddressesL,
9090
nesEpochStateL,
91-
esChainAccountStateL,
91+
esAccountStateL,
9292
esSnapshotsL,
9393
esLStateL,
9494
esNonMyopicL,

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

Lines changed: 21 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
22
{-# LANGUAGE ConstraintKinds #-}
33
{-# LANGUAGE DataKinds #-}
4-
{-# LANGUAGE DeriveAnyClass #-}
54
{-# LANGUAGE DeriveGeneric #-}
65
{-# LANGUAGE DerivingVia #-}
76
{-# LANGUAGE FlexibleContexts #-}
@@ -83,14 +82,19 @@ data EpochState era = EpochState
8382

8483
instance CanGetUTxO EpochState
8584
instance CanSetUTxO EpochState where
86-
utxoL = (lens esLState $ \s ls -> s {esLState = ls}) . utxoL
85+
utxoL = lens esLState (\es ls -> es {esLState = ls}) . utxoL
8786
{-# INLINE utxoL #-}
8887

8988
instance CanGetInstantStake EpochState
9089
instance CanSetInstantStake EpochState where
91-
instantStakeL = (lens esLState $ \s ls -> s {esLState = ls}) . instantStakeL
90+
instantStakeL = lens esLState (\es ls -> es {esLState = ls}) . instantStakeL
9291
{-# INLINE instantStakeL #-}
9392

93+
instance CanGetChainAccountState EpochState
94+
instance CanSetChainAccountState EpochState where
95+
chainAccountStateL = lens esChainAccountState $ \es cas -> es {esChainAccountState = cas}
96+
{-# INLINE chainAccountStateL #-}
97+
9498
deriving stock instance
9599
( EraTxOut era
96100
, Show (GovState era)
@@ -334,14 +338,19 @@ data NewEpochState era = NewEpochState
334338

335339
instance CanGetUTxO NewEpochState
336340
instance CanSetUTxO NewEpochState where
337-
utxoL = (lens nesEs $ \s es -> s {nesEs = es}) . utxoL
341+
utxoL = lens nesEs (\s es -> s {nesEs = es}) . utxoL
338342
{-# INLINE utxoL #-}
339343

340344
instance CanGetInstantStake NewEpochState
341345
instance CanSetInstantStake NewEpochState where
342-
instantStakeL = (lens nesEs $ \s es -> s {nesEs = es}) . instantStakeL
346+
instantStakeL = lens nesEs (\s es -> s {nesEs = es}) . instantStakeL
343347
{-# INLINE instantStakeL #-}
344348

349+
instance CanGetChainAccountState NewEpochState
350+
instance CanSetChainAccountState NewEpochState where
351+
chainAccountStateL = lens nesEs (\s es -> s {nesEs = es}) . chainAccountStateL
352+
{-# INLINE chainAccountStateL #-}
353+
345354
type family StashedAVVMAddresses era where
346355
StashedAVVMAddresses ShelleyEra = UTxO ShelleyEra
347356
StashedAVVMAddresses _ = ()
@@ -441,12 +450,12 @@ data LedgerState era = LedgerState
441450

442451
instance CanGetUTxO LedgerState
443452
instance CanSetUTxO LedgerState where
444-
utxoL = (lens lsUTxOState $ \s us -> s {lsUTxOState = us}) . utxoL
453+
utxoL = lens lsUTxOState (\s us -> s {lsUTxOState = us}) . utxoL
445454
{-# INLINE utxoL #-}
446455

447456
instance CanGetInstantStake LedgerState
448457
instance CanSetInstantStake LedgerState where
449-
instantStakeL = (lens lsUTxOState $ \s us -> s {lsUTxOState = us}) . instantStakeL
458+
instantStakeL = lens lsUTxOState (\s us -> s {lsUTxOState = us}) . instantStakeL
450459
{-# INLINE instantStakeL #-}
451460

452461
deriving stock instance
@@ -589,8 +598,9 @@ nesEpochStateL = lens nesEs $ \x y -> x {nesEs = y}
589598
-- ===================================================
590599
-- EpochState
591600

592-
esChainAccountStateL :: Lens' (EpochState era) ChainAccountState
593-
esChainAccountStateL = lens esChainAccountState (\x y -> x {esChainAccountState = y})
601+
esAccountStateL :: Lens' (EpochState era) ChainAccountState
602+
esAccountStateL = lens esChainAccountState (\x y -> x {esChainAccountState = y})
603+
{-# DEPRECATED esAccountStateL "In favor of `chainAccountStateL`" #-}
594604

595605
esSnapshotsL :: Lens' (EpochState era) SnapShots
596606
esSnapshotsL = lens esSnapshots (\x y -> x {esSnapshots = y})
@@ -660,7 +670,8 @@ epochStateDonationL :: Lens' (EpochState era) Coin
660670
epochStateDonationL = esLStateL . lsUTxOStateL . utxosDonationL
661671

662672
epochStateTreasuryL :: Lens' (EpochState era) Coin
663-
epochStateTreasuryL = esChainAccountStateL . asTreasuryL
673+
epochStateTreasuryL = treasuryL
674+
{-# DEPRECATED epochStateTreasuryL "In favor of `treasuryL`" #-}
664675

665676
epochStatePoolParamsL ::
666677
EraCertState era => Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)

0 commit comments

Comments
 (0)