Skip to content

Commit eb85a2b

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

File tree

10 files changed

+59
-38
lines changed

10 files changed

+59
-38
lines changed

‎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
@@ -98,7 +99,7 @@ instance ToKeyValuePairs (ConwayCertState era) where
9899

99100
conwayObligationCertState :: ConwayEraCertState era => CertState era -> Obligations
100101
conwayObligationCertState certState =
101-
let accum ans drepState = ans <> drepDeposit drepState
102+
let accum ans drepState = ans <> fromCompact (drepDeposit drepState)
102103
in (shelleyObligationCertState certState)
103104
{ oblDRep = F.foldl' accum (Coin 0) (certState ^. certVStateL . vsDRepsL)
104105
}

‎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/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})

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/Specs.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -229,16 +229,16 @@ vstateSpec univ epoch delegated = constrained $ \ [var|vstate|] ->
229229
, forAll dreps $ \ [var|pair|] ->
230230
match pair $ \ [var|drep|] [var|drepstate|] ->
231231
[ satisfies drep (witCredSpec univ)
232-
, match drepstate $ \ [var|expiry|] _anchor [var|drepDdeposit|] [var|delegs|] ->
232+
, match drepstate $ \ [var|expiry|] _anchor [var|drepDeposit'|] [var|delegs|] ->
233233
onJust (lookup_ drep delegated) $ \ [var|delegSet|] ->
234234
[ assertExplain (pure "all delegatees have delegated") $ delegs ==. delegSet
235235
, witness univ delegSet
236236
, assertExplain (pure "epoch of expiration must follow the current epoch") $ epoch <=. expiry
237-
, assertExplain (pure "no deposit is 0") $ lit (Coin 0) <=. drepDdeposit
237+
, assertExplain (pure "no deposit is 0") $ match drepDeposit' (lit 0 <=.)
238238
]
239239
]
240240
, assertExplain (pure "num dormant epochs should not be too large") $
241-
[epoch <=. numdormant, numdormant <=. epoch + (lit (EpochNo 10))]
241+
[epoch <=. numdormant, numdormant <=. epoch + lit (EpochNo 10)]
242242
, dependsOn numdormant epoch -- Solve epoch first.
243243
, match comstate $ \ [var|commap|] ->
244244
[witness univ (dom_ commap), satisfies commap (hasSize (rangeSize 1 4))]

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Utxo.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ import Cardano.Ledger.Babbage.TxOut
2222
import Cardano.Ledger.BaseTypes
2323
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
2424
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
25+
import Cardano.Ledger.Compactible (Compactible (..))
2526
import Cardano.Ledger.Conway (ConwayEra)
2627
import Cardano.Ledger.Conway.Core (
2728
Era (..),
@@ -216,6 +217,6 @@ depositsMap certState props =
216217
Map.unions
217218
[ Map.mapKeys CredentialDeposit $ depositMap (certState ^. certDStateL . dsUnifiedL)
218219
, Map.mapKeys PoolDeposit $ certState ^. certPStateL . psDepositsL
219-
, fmap drepDeposit . Map.mapKeys DRepDeposit $ certState ^. certVStateL . vsDRepsL
220+
, fmap (fromCompact . drepDeposit) . Map.mapKeys DRepDeposit $ certState ^. certVStateL . vsDRepsL
220221
, Map.fromList . fmap (bimap GovActionDeposit gasDeposit) $ OMap.assocList (props ^. pPropsL)
221222
]

0 commit comments

Comments
 (0)