Skip to content

Commit 7e91599

Browse files
SoupstrawSoupstraw
committed
Changed dRepDeposits to CompactCoin
1 parent 2ca5475 commit 7e91599

File tree

13 files changed

+64
-39
lines changed

13 files changed

+64
-39
lines changed

‎eras/conway/impl/CHANGELOG.md‎

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

33
## 1.20.0.0
44

5+
* Change the type of `cppDRepDeposit` to `CompactForm Coin`
6+
* Add `ppDRepDepositCompactL` and `ppuDRepDepositCompactL`
7+
* Replace `hkdDRepDepositL` with `hkdDRepDepositCompactL`
58
* Add `AlonzoEraTx` constraint to `STS` instance for `ConwayBBODY`
69
* Add `totalRefScriptSizeInBlock`
710
* Move some hard-fork triggers and export them from `Cardano.Ledger.Conway` module.

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

Lines changed: 22 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ module Cardano.Ledger.Conway.PParams (
2727
ppCommitteeMinSize,
2828
ppDRepActivity,
2929
ppDRepDeposit,
30+
ppDRepDepositCompactL,
3031
ppDRepVotingThresholds,
3132
ppGovActionDeposit,
3233
ppGovActionLifetime,
@@ -85,6 +86,7 @@ module Cardano.Ledger.Conway.PParams (
8586
emptyConwayPParamsUpdate,
8687
asNaturalHKD,
8788
asBoundedIntegralHKD,
89+
asCompactCoinHKD,
8890
) where
8991

9092
import Cardano.Ledger.Alonzo.PParams
@@ -113,7 +115,8 @@ import Cardano.Ledger.Binary (
113115
encodeListLen,
114116
)
115117
import Cardano.Ledger.Binary.Coders
116-
import Cardano.Ledger.Coin (Coin (Coin), CompactForm (..))
118+
import Cardano.Ledger.Coin (Coin (Coin), CompactForm (..), compactCoinOrError, partialCompactCoinL)
119+
import Cardano.Ledger.Compactible (partialCompactFL)
117120
import Cardano.Ledger.Conway.Era (ConwayEra, hardforkConwayBootstrapPhase)
118121
import Cardano.Ledger.Core (EraPParams (..))
119122
import Cardano.Ledger.HKD (
@@ -165,7 +168,7 @@ class BabbageEraPParams era => ConwayEraPParams era where
165168
hkdCommitteeMaxTermLengthL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochInterval)
166169
hkdGovActionLifetimeL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochInterval)
167170
hkdGovActionDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin)
168-
hkdDRepDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin)
171+
hkdDRepDepositCompactL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f (CompactForm Coin))
169172
hkdDRepActivityL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochInterval)
170173
hkdMinFeeRefScriptCostPerByteL ::
171174
HKDFunctor f => Lens' (PParamsHKD f era) (HKD f NonNegativeInterval)
@@ -214,8 +217,11 @@ ppGovActionLifetimeL = ppLensHKD . hkdGovActionLifetimeL @era @Identity
214217
ppGovActionDepositL :: forall era. ConwayEraPParams era => Lens' (PParams era) Coin
215218
ppGovActionDepositL = ppLensHKD . hkdGovActionDepositL @era @Identity
216219

217-
ppDRepDepositL :: forall era. ConwayEraPParams era => Lens' (PParams era) Coin
218-
ppDRepDepositL = ppLensHKD . hkdDRepDepositL @era @Identity
220+
ppDRepDepositCompactL :: forall era. ConwayEraPParams era => Lens' (PParams era) (CompactForm Coin)
221+
ppDRepDepositCompactL = ppLensHKD . hkdDRepDepositCompactL @era @Identity
222+
223+
ppDRepDepositL :: ConwayEraPParams era => Lens' (PParams era) Coin
224+
ppDRepDepositL = ppDRepDepositCompactL . partialCompactCoinL
219225

220226
ppDRepActivityL :: forall era. ConwayEraPParams era => Lens' (PParams era) EpochInterval
221227
ppDRepActivityL = ppLensHKD . hkdDRepActivityL @era @Identity
@@ -248,9 +254,13 @@ ppuGovActionDepositL ::
248254
forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Coin)
249255
ppuGovActionDepositL = ppuLensHKD . hkdGovActionDepositL @era @StrictMaybe
250256

257+
ppuDRepDepositCompactL ::
258+
forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe (CompactForm Coin))
259+
ppuDRepDepositCompactL = ppuLensHKD . hkdDRepDepositCompactL @era @StrictMaybe
260+
251261
ppuDRepDepositL ::
252262
forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Coin)
253-
ppuDRepDepositL = ppuLensHKD . hkdDRepDepositL @era @StrictMaybe
263+
ppuDRepDepositL = ppuDRepDepositCompactL . partialCompactFL
254264

255265
ppuDRepActivityL ::
256266
forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
@@ -659,7 +669,7 @@ data ConwayPParams f era = ConwayPParams
659669
-- ^ Gov action lifetime in number of Epochs
660670
, cppGovActionDeposit :: !(THKD ('PPGroups 'GovGroup 'SecurityGroup) f Coin)
661671
-- ^ The amount of the Gov Action deposit
662-
, cppDRepDeposit :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f Coin)
672+
, cppDRepDeposit :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f (CompactForm Coin))
663673
-- ^ The amount of a DRep registration deposit
664674
, cppDRepActivity :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f EpochInterval)
665675
-- ^ The number of Epochs that a DRep can perform no activity without losing their @Active@ status.
@@ -912,7 +922,7 @@ instance ConwayEraPParams ConwayEra where
912922
lens (unTHKD . cppGovActionLifetime) $ \pp x -> pp {cppGovActionLifetime = THKD x}
913923
hkdGovActionDepositL =
914924
lens (unTHKD . cppGovActionDeposit) $ \pp x -> pp {cppGovActionDeposit = THKD x}
915-
hkdDRepDepositL =
925+
hkdDRepDepositCompactL =
916926
lens (unTHKD . cppDRepDeposit) $ \pp x -> pp {cppDRepDeposit = THKD x}
917927
hkdDRepActivityL =
918928
lens (unTHKD . cppDRepActivity) $ \pp x -> pp {cppDRepActivity = THKD x}
@@ -952,7 +962,7 @@ emptyConwayPParams =
952962
, cppCommitteeMaxTermLength = THKD (EpochInterval 0)
953963
, cppGovActionLifetime = THKD (EpochInterval 0)
954964
, cppGovActionDeposit = THKD (Coin 0)
955-
, cppDRepDeposit = THKD (Coin 0)
965+
, cppDRepDeposit = THKD (CompactCoin 0)
956966
, cppDRepActivity = THKD (EpochInterval 0)
957967
, cppMinFeeRefScriptCostPerByte = THKD minBound
958968
}
@@ -1084,7 +1094,7 @@ upgradeConwayPParams UpgradeConwayPParams {..} BabbagePParams {..} =
10841094
, cppCommitteeMaxTermLength = THKD ucppCommitteeMaxTermLength
10851095
, cppGovActionLifetime = THKD ucppGovActionLifetime
10861096
, cppGovActionDeposit = THKD ucppGovActionDeposit
1087-
, cppDRepDeposit = THKD ucppDRepDeposit
1097+
, cppDRepDeposit = THKD $ asCompactCoinHKD @f ucppDRepDeposit
10881098
, cppDRepActivity = THKD ucppDRepActivity
10891099
, cppMinFeeRefScriptCostPerByte = THKD ucppMinFeeRefScriptCostPerByte
10901100
}
@@ -1241,6 +1251,9 @@ conwayModifiedPPGroups
12411251
, ppGroup p31
12421252
]
12431253

1254+
asCompactCoinHKD :: forall f. HKDFunctor f => HKD f Coin -> HKD f (CompactForm Coin)
1255+
asCompactCoinHKD = hkdMap (Proxy @f) compactCoinOrError
1256+
12441257
-- | Care should be taken to not apply this function to signed values, otherwise it will result in
12451258
-- an `ArithmeticUnderflow` exception for negative numbers.
12461259
asNaturalHKD :: forall f i. (HKDFunctor f, Integral i) => HKD f i -> HKD f Natural

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

Lines changed: 16 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ import Cardano.Ledger.Binary (
3737
)
3838
import Cardano.Ledger.Binary.Coders
3939
import Cardano.Ledger.Coin (Coin)
40+
import Cardano.Ledger.Compactible (Compactible (..))
4041
import Cardano.Ledger.Conway.Core
4142
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOVCERT, hardforkConwayBootstrapPhase)
4243
import Cardano.Ledger.Conway.Governance (
@@ -47,6 +48,7 @@ import Cardano.Ledger.Conway.Governance (
4748
GovPurposeId,
4849
ProposalProcedure (..),
4950
)
51+
import Cardano.Ledger.Conway.PParams (ppDRepDepositCompactL)
5052
import Cardano.Ledger.Conway.State (
5153
ConwayEraCertState (..),
5254
VState (..),
@@ -192,7 +194,8 @@ conwayGovCertTransition = do
192194
, cert
193195
) <-
194196
judgmentContext
195-
let ppDRepDeposit = cgcePParams ^. ppDRepDepositL
197+
let ppDRepDepositCompact = cgcePParams ^. ppDRepDepositCompactL
198+
ppDRepDeposit = fromCompact ppDRepDepositCompact
196199
ppDRepActivity = cgcePParams ^. ppDRepActivityL
197200
checkAndOverwriteCommitteeMemberState coldCred newMemberState = do
198201
let VState {vsCommitteeState = CommitteeState csCommitteeCreds} = certState ^. certVStateL
@@ -231,7 +234,7 @@ conwayGovCertTransition = do
231234
cgceCurrentEpoch
232235
(certState ^. certVStateL . vsNumDormantEpochsL)
233236
, drepAnchor = mAnchor
234-
, drepDeposit = ppDRepDeposit
237+
, drepDeposit = ppDRepDepositCompact
235238
, drepDelegs = mempty
236239
}
237240
pure $
@@ -262,18 +265,17 @@ conwayGovCertTransition = do
262265
pure $
263266
certState
264267
& certVStateL . vsDRepsL
265-
%~ ( Map.adjust
266-
( \drepState ->
267-
drepState
268-
& drepExpiryL
269-
.~ computeDRepExpiry
270-
ppDRepActivity
271-
cgceCurrentEpoch
272-
(certState ^. certVStateL . vsNumDormantEpochsL)
273-
& drepAnchorL .~ mAnchor
274-
)
275-
cred
276-
)
268+
%~ Map.adjust
269+
( \drepState ->
270+
drepState
271+
& drepExpiryL
272+
.~ computeDRepExpiry
273+
ppDRepActivity
274+
cgceCurrentEpoch
275+
(certState ^. certVStateL . vsNumDormantEpochsL)
276+
& drepAnchorL .~ mAnchor
277+
)
278+
cred
277279
ConwayAuthCommitteeHotKey coldCred hotCred ->
278280
checkAndOverwriteCommitteeMemberState coldCred $ CommitteeHotCredential hotCred
279281
ConwayResignCommitteeColdKey coldCred anchor ->

‎eras/conway/impl/src/Cardano/Ledger/Conway/State/CertState.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ import Cardano.Ledger.Binary (
3333
encodeListLen,
3434
)
3535
import Cardano.Ledger.Coin (Coin (..))
36+
import Cardano.Ledger.Compactible (Compactible (..))
3637
import Cardano.Ledger.Conway.Era (ConwayEra)
3738
import Cardano.Ledger.Conway.State.VState
3839
import Cardano.Ledger.Core
@@ -100,7 +101,7 @@ conwayObligationCertState :: ConwayEraCertState era => CertState era -> Obligati
100101
conwayObligationCertState certState =
101102
let accum ans drepState = ans <> drepDeposit drepState
102103
in (shelleyObligationCertState certState)
103-
{ oblDRep = F.foldl' accum (Coin 0) (certState ^. certVStateL . vsDRepsL)
104+
{ oblDRep = fromCompact $ F.foldl' accum mempty (certState ^. certVStateL . vsDRepsL)
104105
}
105106

106107
conwayCertsTotalDepositsTxBody ::

‎eras/conway/impl/src/Cardano/Ledger/Conway/State/VState.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import Cardano.Ledger.Binary (
3232
)
3333
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
3434
import Cardano.Ledger.Coin (Coin (..))
35+
import Cardano.Ledger.Compactible (Compactible (..))
3536
import Cardano.Ledger.Core
3637
import Cardano.Ledger.Credential (Credential (..))
3738
import Cardano.Ledger.Shelley.State
@@ -64,7 +65,7 @@ data VState era = VState
6465

6566
-- | Function that looks up the deposit for currently registered DRep
6667
lookupDepositVState :: VState era -> Credential 'DRepRole -> Maybe Coin
67-
lookupDepositVState vstate = fmap drepDeposit . flip Map.lookup (vstate ^. vsDRepsL)
68+
lookupDepositVState vstate = fmap (fromCompact . drepDeposit) . flip Map.lookup (vstate ^. vsDRepsL)
6869

6970
instance Default (VState era) where
7071
def = VState def def (EpochNo 0)

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
module Test.Cardano.Ledger.Conway.Genesis (expectedConwayGenesis) where
99

1010
import Cardano.Ledger.BaseTypes (EpochInterval (..), textToUrl)
11-
import Cardano.Ledger.Coin (Coin (..))
11+
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
1212
import Cardano.Ledger.Conway
1313
import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
1414
import Cardano.Ledger.Conway.Governance (Anchor (..), Committee (..))
@@ -62,7 +62,7 @@ expectedConwayGenesis =
6262
, DRepState
6363
{ drepExpiry = EpochNo 1000
6464
, drepAnchor = SNothing
65-
, drepDeposit = Coin 5000
65+
, drepDeposit = CompactCoin 5000
6666
, drepDelegs = mempty
6767
}
6868
)
@@ -77,7 +77,7 @@ expectedConwayGenesis =
7777
{ anchorUrl = fromJust $ textToUrl 99 "example.com"
7878
, anchorDataHash = def
7979
}
80-
, drepDeposit = Coin 6000
80+
, drepDeposit = CompactCoin 6000
8181
, drepDelegs = mempty
8282
}
8383
)

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -195,7 +195,7 @@ import Cardano.Ledger.Shelley.LedgerState (
195195
import Cardano.Ledger.Shelley.Rules (ShelleyDelegPredFailure)
196196
import qualified Cardano.Ledger.Shelley.Rules as Shelley
197197
import Cardano.Ledger.TxIn (TxId (..))
198-
import Cardano.Ledger.UMap (dRepMap)
198+
import Cardano.Ledger.UMap (dRepMap, fromCompact)
199199
import qualified Cardano.Ledger.UMap as UMap
200200
import Cardano.Ledger.Val (Val (..), (<->))
201201
import Control.Monad (forM)
@@ -365,7 +365,7 @@ unRegisterDRep ::
365365
ImpTestM era ()
366366
unRegisterDRep drep = do
367367
drepState <- getDRepState drep
368-
let refund = drepDeposit drepState
368+
let refund = fromCompact $ drepDeposit drepState
369369
submitTxAnn_ "UnRegister DRep" $
370370
mkBasicTx mkBasicTxBody
371371
& bodyTxL . certsTxBodyL

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/PParams.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,7 @@ instance ConwayEraPParams DijkstraEra where
167167
lens (unTHKD . cppGovActionLifetime) $ \pp x -> pp {cppGovActionLifetime = THKD x}
168168
hkdGovActionDepositL =
169169
lens (unTHKD . cppGovActionDeposit) $ \pp x -> pp {cppGovActionDeposit = THKD x}
170-
hkdDRepDepositL =
170+
hkdDRepDepositCompactL =
171171
lens (unTHKD . cppDRepDeposit) $ \pp x -> pp {cppDRepDeposit = THKD x}
172172
hkdDRepActivityL =
173173
lens (unTHKD . cppDRepActivity) $ \pp x -> pp {cppDRepActivity = THKD x}

‎libs/cardano-ledger-core/CHANGELOG.md‎

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

33
## 1.18.0.0
44

5+
* Add `drepDepositCompactL`
6+
* Change the type of `drepDeposit` to `CompactForm Coin`
57
* Replaced `hkdPoolDepositL` method with `hkdPoolDepositCompactL`
68
* Add `ppPoolDepositCompactL` and `ppuPoolDepositCompactL`
79
* Add `standardHashSize` and `standardAddrHashSize`

‎libs/cardano-ledger-core/src/Cardano/Ledger/DRep.hs‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ import Cardano.Ledger.Binary (
2828
internsFromSet,
2929
)
3030
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
31-
import Cardano.Ledger.Coin (Coin)
31+
import Cardano.Ledger.Coin (Coin, CompactForm, partialCompactCoinL)
3232
import Cardano.Ledger.Credential (Credential (..), credToText, parseCredential)
3333
import Cardano.Ledger.Hashes (ScriptHash)
3434
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
@@ -147,7 +147,7 @@ pattern DRepCredential c <- (dRepToCred -> Just c)
147147
data DRepState = DRepState
148148
{ drepExpiry :: !EpochNo
149149
, drepAnchor :: !(StrictMaybe Anchor)
150-
, drepDeposit :: !Coin
150+
, drepDeposit :: !(CompactForm Coin)
151151
, drepDelegs :: !(Set (Credential 'Staking))
152152
}
153153
deriving (Show, Eq, Ord, Generic)
@@ -208,7 +208,10 @@ drepAnchorL :: Lens' DRepState (StrictMaybe Anchor)
208208
drepAnchorL = lens drepAnchor (\x y -> x {drepAnchor = y})
209209

210210
drepDepositL :: Lens' DRepState Coin
211-
drepDepositL = lens drepDeposit (\x y -> x {drepDeposit = y})
211+
drepDepositL = drepDepositCompactL . partialCompactCoinL
212+
213+
drepDepositCompactL :: Lens' DRepState (CompactForm Coin)
214+
drepDepositCompactL = lens drepDeposit (\x y -> x {drepDeposit = y})
212215

213216
drepDelegsL :: Lens' DRepState (Set (Credential 'Staking))
214217
drepDelegsL = lens drepDelegs (\x y -> x {drepDelegs = y})

0 commit comments

Comments
 (0)