Change the type of dRepDeposits to CompactForm Coin

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## 1.20.0.0
 
+* Change the type of `cppDRepDeposit` to `CompactForm Coin`
+* Add `ppDRepDepositCompactL` and `ppuDRepDepositCompactL`
+* Replace `hkdDRepDepositL` with `hkdDRepDepositCompactL`
 * Delete `Tx` newtype wrapper
 * Hide `Cardano.Ledger.Conway.Translation` module and remove its re-exports: `addrPtrNormalize` and `translateDatum`
 * Removed:

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

@@ -30,6 +30,7 @@ module Cardano.Ledger.Conway.PParams (
   ppCommitteeMinSize,
   ppDRepActivity,
   ppDRepDeposit,
+  ppDRepDepositCompactL,
   ppDRepVotingThresholds,
   ppGovActionDeposit,
   ppGovActionLifetime,
@@ -87,6 +88,7 @@ module Cardano.Ledger.Conway.PParams (
   asNaturalHKD,
   asBoundedIntegralHKD,
   ppGroup,
+  asCompactCoinHKD,
 ) where
 
 import Cardano.Ledger.Alonzo.PParams
@@ -119,7 +121,8 @@ import Cardano.Ledger.Binary (
   encodeListLen,
  )
 import Cardano.Ledger.Binary.Coders
-import Cardano.Ledger.Coin (Coin (Coin), CompactForm (..))
+import Cardano.Ledger.Coin (Coin (Coin), CompactForm (..), compactCoinOrError, partialCompactCoinL)
+import Cardano.Ledger.Compactible (partialCompactFL)
 import Cardano.Ledger.Conway.Era (ConwayEra, hardforkConwayBootstrapPhase)
 import Cardano.Ledger.Core (EraPParams (..))
 import Cardano.Ledger.HKD (
@@ -180,7 +183,7 @@ class BabbageEraPParams era => ConwayEraPParams era where
   hkdCommitteeMaxTermLengthL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochInterval)
   hkdGovActionLifetimeL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochInterval)
   hkdGovActionDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin)
-  hkdDRepDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin)
+  hkdDRepDepositCompactL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f (CompactForm Coin))
   hkdDRepActivityL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochInterval)
   hkdMinFeeRefScriptCostPerByteL ::
     HKDFunctor f => Lens' (PParamsHKD f era) (HKD f NonNegativeInterval)
@@ -233,8 +236,11 @@ ppGovActionLifetimeL = ppLensHKD . hkdGovActionLifetimeL @era @Identity
 ppGovActionDepositL :: forall era. ConwayEraPParams era => Lens' (PParams era) Coin
 ppGovActionDepositL = ppLensHKD . hkdGovActionDepositL @era @Identity
 
-ppDRepDepositL :: forall era. ConwayEraPParams era => Lens' (PParams era) Coin
-ppDRepDepositL = ppLensHKD . hkdDRepDepositL @era @Identity
+ppDRepDepositCompactL :: forall era. ConwayEraPParams era => Lens' (PParams era) (CompactForm Coin)
+ppDRepDepositCompactL = ppLensHKD . hkdDRepDepositCompactL @era @Identity
+
+ppDRepDepositL :: ConwayEraPParams era => Lens' (PParams era) Coin
+ppDRepDepositL = ppDRepDepositCompactL . partialCompactCoinL
 
 ppDRepActivityL :: forall era. ConwayEraPParams era => Lens' (PParams era) EpochInterval
 ppDRepActivityL = ppLensHKD . hkdDRepActivityL @era @Identity
@@ -267,9 +273,13 @@ ppuGovActionDepositL ::
   forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Coin)
 ppuGovActionDepositL = ppuLensHKD . hkdGovActionDepositL @era @StrictMaybe
 
+ppuDRepDepositCompactL ::
+  forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe (CompactForm Coin))
+ppuDRepDepositCompactL = ppuLensHKD . hkdDRepDepositCompactL @era @StrictMaybe
+
 ppuDRepDepositL ::
   forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Coin)
-ppuDRepDepositL = ppuLensHKD . hkdDRepDepositL @era @StrictMaybe
+ppuDRepDepositL = ppuDRepDepositCompactL . partialCompactFL
 
 ppuDRepActivityL ::
   forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
@@ -678,7 +688,7 @@ data ConwayPParams f era = ConwayPParams
   -- ^ Gov action lifetime in number of Epochs
   , cppGovActionDeposit :: !(THKD ('PPGroups 'GovGroup 'SecurityGroup) f Coin)
   -- ^ The amount of the Gov Action deposit
-  , cppDRepDeposit :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f Coin)
+  , cppDRepDeposit :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f (CompactForm Coin))
   -- ^ The amount of a DRep registration deposit
   , cppDRepActivity :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f EpochInterval)
   -- ^ The number of Epochs that a DRep can perform no activity without losing their @Active@ status.
@@ -945,7 +955,7 @@ instance ConwayEraPParams ConwayEra where
     lens (unTHKD . cppGovActionLifetime) $ \pp x -> pp {cppGovActionLifetime = THKD x}
   hkdGovActionDepositL =
     lens (unTHKD . cppGovActionDeposit) $ \pp x -> pp {cppGovActionDeposit = THKD x}
-  hkdDRepDepositL =
+  hkdDRepDepositCompactL =
     lens (unTHKD . cppDRepDeposit) $ \pp x -> pp {cppDRepDeposit = THKD x}
   hkdDRepActivityL =
     lens (unTHKD . cppDRepActivity) $ \pp x -> pp {cppDRepActivity = THKD x}
@@ -989,7 +999,7 @@ emptyConwayPParams =
     , cppCommitteeMaxTermLength = THKD (EpochInterval 0)
     , cppGovActionLifetime = THKD (EpochInterval 0)
     , cppGovActionDeposit = THKD (Coin 0)
-    , cppDRepDeposit = THKD (Coin 0)
+    , cppDRepDeposit = THKD (CompactCoin 0)
     , cppDRepActivity = THKD (EpochInterval 0)
     , cppMinFeeRefScriptCostPerByte = THKD minBound
     }
@@ -1121,7 +1131,7 @@ upgradeConwayPParams UpgradeConwayPParams {..} BabbagePParams {..} =
     , cppCommitteeMaxTermLength = THKD ucppCommitteeMaxTermLength
     , cppGovActionLifetime = THKD ucppGovActionLifetime
     , cppGovActionDeposit = THKD ucppGovActionDeposit
-    , cppDRepDeposit = THKD ucppDRepDeposit
+    , cppDRepDeposit = THKD $ asCompactCoinHKD @f ucppDRepDeposit
     , cppDRepActivity = THKD ucppDRepActivity
     , cppMinFeeRefScriptCostPerByte = THKD ucppMinFeeRefScriptCostPerByte
     }
@@ -1235,6 +1245,9 @@ instance CollectModifiedPPGroups (K1 i (NoUpdate a) p) where
 instance CollectModifiedPPGroups (a u) => CollectModifiedPPGroups (M1 i c a u) where
   collectModifiedPPGroups (M1 x) = collectModifiedPPGroups x
 
+asCompactCoinHKD :: forall f. HKDFunctor f => HKD f Coin -> HKD f (CompactForm Coin)
+asCompactCoinHKD = hkdMap (Proxy @f) compactCoinOrError
+
 -- | Care should be taken to not apply this function to signed values, otherwise it will result in
 -- an `ArithmeticUnderflow` exception for negative numbers.
 asNaturalHKD :: forall f i. (HKDFunctor f, Integral i) => HKD f i -> HKD f Natural

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

@@ -37,6 +37,7 @@ import Cardano.Ledger.Binary (
  )
 import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Coin (Coin)
+import Cardano.Ledger.Compactible (Compactible (..))
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOVCERT, hardforkConwayBootstrapPhase)
 import Cardano.Ledger.Conway.Governance (
@@ -47,6 +48,7 @@ import Cardano.Ledger.Conway.Governance (
   GovPurposeId,
   ProposalProcedure (..),
  )
+import Cardano.Ledger.Conway.PParams (ppDRepDepositCompactL)
 import Cardano.Ledger.Conway.State
 import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..))
 import Cardano.Ledger.Credential (Credential)
@@ -178,7 +180,8 @@ conwayGovCertTransition = do
       , cert
       ) <-
     judgmentContext
-  let ppDRepDeposit = cgcePParams ^. ppDRepDepositL
+  let ppDRepDepositCompact = cgcePParams ^. ppDRepDepositCompactL
+      ppDRepDeposit = fromCompact ppDRepDepositCompact
       ppDRepActivity = cgcePParams ^. ppDRepActivityL
       checkAndOverwriteCommitteeMemberState coldCred newMemberState = do
         let VState {vsCommitteeState = CommitteeState csCommitteeCreds} = certState ^. certVStateL
@@ -217,7 +220,7 @@ conwayGovCertTransition = do
                     cgceCurrentEpoch
                     (certState ^. certVStateL . vsNumDormantEpochsL)
               , drepAnchor = mAnchor
-              , drepDeposit = ppDRepDeposit
+              , drepDeposit = ppDRepDepositCompact
               , drepDelegs = mempty
               }
       pure $
@@ -250,18 +253,17 @@ conwayGovCertTransition = do
       pure $
         certState
           & certVStateL . vsDRepsL
-            %~ ( Map.adjust
-                   ( \drepState ->
-                       drepState
-                         & drepExpiryL
-                           .~ computeDRepExpiry
-                             ppDRepActivity
-                             cgceCurrentEpoch
-                             (certState ^. certVStateL . vsNumDormantEpochsL)
-                         & drepAnchorL .~ mAnchor
-                   )
-                   cred
-               )
+            %~ Map.adjust
+              ( \drepState ->
+                  drepState
+                    & drepExpiryL
+                      .~ computeDRepExpiry
+                        ppDRepActivity
+                        cgceCurrentEpoch
+                        (certState ^. certVStateL . vsNumDormantEpochsL)
+                    & drepAnchorL .~ mAnchor
+              )
+              cred
     ConwayAuthCommitteeHotKey coldCred hotCred ->
       checkAndOverwriteCommitteeMemberState coldCred $ CommitteeHotCredential hotCred
     ConwayResignCommitteeColdKey coldCred anchor ->

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

@@ -36,6 +36,7 @@ import Cardano.Ledger.Binary (
   encodeListLen,
  )
 import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Compactible (Compactible (..))
 import Cardano.Ledger.Conway.Era (ConwayEra)
 import Cardano.Ledger.Conway.State.Account (ConwayEraAccounts)
 import Cardano.Ledger.Conway.State.VState
@@ -112,7 +113,7 @@ conwayObligationCertState :: ConwayEraCertState era => CertState era -> Obligati
 conwayObligationCertState certState =
   let accum ans drepState = ans <> drepDeposit drepState
    in (shelleyObligationCertState certState)
-        { oblDRep = F.foldl' accum (Coin 0) (certState ^. certVStateL . vsDRepsL)
+        { oblDRep = fromCompact $ F.foldl' accum mempty (certState ^. certVStateL . vsDRepsL)
         }
 
 conwayCertsTotalDepositsTxBody ::

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

@@ -32,6 +32,7 @@ import Cardano.Ledger.Binary (
  )
 import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
 import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Compactible (Compactible (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.Shelley.State
@@ -64,7 +65,7 @@ data VState era = VState
 
 -- | Function that looks up the deposit for currently registered DRep
 lookupDepositVState :: VState era -> Credential 'DRepRole -> Maybe Coin
-lookupDepositVState vstate = fmap drepDeposit . flip Map.lookup (vstate ^. vsDRepsL)
+lookupDepositVState vstate = fmap (fromCompact . drepDeposit) . flip Map.lookup (vstate ^. vsDRepsL)
 
 instance Default (VState era) where
   def = VState def def (EpochNo 0)

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

@@ -8,7 +8,7 @@
 module Test.Cardano.Ledger.Conway.Genesis (expectedConwayGenesis) where
 
 import Cardano.Ledger.BaseTypes (EpochInterval (..), textToUrl)
-import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
 import Cardano.Ledger.Conway
 import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
 import Cardano.Ledger.Conway.Governance (Anchor (..), Committee (..))
@@ -62,7 +62,7 @@ expectedConwayGenesis =
             , DRepState
                 { drepExpiry = EpochNo 1000
                 , drepAnchor = SNothing
-                , drepDeposit = Coin 5000
+                , drepDeposit = CompactCoin 5000
                 , drepDelegs = mempty
                 }
             )
@@ -77,7 +77,7 @@ expectedConwayGenesis =
                         { anchorUrl = fromJust $ textToUrl 99 "example.com"
                         , anchorDataHash = def
                         }
-                , drepDeposit = Coin 6000
+                , drepDeposit = CompactCoin 6000
                 , drepDelegs = mempty
                 }
             )

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

@@ -363,7 +363,7 @@ unRegisterDRep ::
   ImpTestM era ()
 unRegisterDRep drep = do
   drepState <- getDRepState drep
-  let refund = drepDeposit drepState
+  let refund = fromCompact $ drepDeposit drepState
   submitTxAnn_ "UnRegister DRep" $
     mkBasicTx mkBasicTxBody
       & bodyTxL . certsTxBodyL

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

@@ -135,7 +135,7 @@ data DijkstraPParams f era = DijkstraPParams
   -- ^ Gov action lifetime in number of Epochs
   , dppGovActionDeposit :: !(THKD ('PPGroups 'GovGroup 'SecurityGroup) f Coin)
   -- ^ The amount of the Gov Action deposit
-  , dppDRepDeposit :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f Coin)
+  , dppDRepDeposit :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f (CompactForm Coin))
   -- ^ The amount of a DRep registration deposit
   , dppDRepActivity :: !(THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f EpochInterval)
   -- ^ The number of Epochs that a DRep can perform no activity without losing their @Active@ status.
@@ -558,7 +558,7 @@ instance ConwayEraPParams DijkstraEra where
     lens (unTHKD . dppGovActionLifetime) $ \pp x -> pp {dppGovActionLifetime = THKD x}
   hkdGovActionDepositL =
     lens (unTHKD . dppGovActionDeposit) $ \pp x -> pp {dppGovActionDeposit = THKD x}
-  hkdDRepDepositL =
+  hkdDRepDepositCompactL =
     lens (unTHKD . dppDRepDeposit) $ \pp x -> pp {dppDRepDeposit = THKD x}
   hkdDRepActivityL =
     lens (unTHKD . dppDRepActivity) $ \pp x -> pp {dppDRepActivity = THKD x}
@@ -601,7 +601,7 @@ emptyDijkstraPParams =
     , dppCommitteeMaxTermLength = THKD (EpochInterval 0)
     , dppGovActionLifetime = THKD (EpochInterval 0)
     , dppGovActionDeposit = THKD (Coin 0)
-    , dppDRepDeposit = THKD (Coin 0)
+    , dppDRepDeposit = THKD (CompactCoin 0)
     , dppDRepActivity = THKD (EpochInterval 0)
     , dppMinFeeRefScriptCostPerByte = THKD minBound
     , dppMaxRefScriptSizePerBlock = THKD 0

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.18.0.0
 
+* Add `drepDepositCompactL`
+* Change the type of `drepDeposit` to `CompactForm Coin`
 * Remove `AccountState` type synonym for `ChainAccountState`
 * Remove `rewards`, `delegations`, `ptrsMap` and `dsUnifiedL`
 * Replace `dsUnified` with `dsAccounts` in `DState`

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

@@ -28,7 +28,7 @@ import Cardano.Ledger.Binary (
   internsFromSet,
  )
 import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
-import Cardano.Ledger.Coin (Coin)
+import Cardano.Ledger.Coin (Coin, CompactForm, partialCompactCoinL)
 import Cardano.Ledger.Credential (Credential (..), credToText, parseCredential)
 import Cardano.Ledger.Hashes (ScriptHash)
 import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
@@ -147,7 +147,7 @@ pattern DRepCredential c <- (dRepToCred -> Just c)
 data DRepState = DRepState
   { drepExpiry :: !EpochNo
   , drepAnchor :: !(StrictMaybe Anchor)
-  , drepDeposit :: !Coin
+  , drepDeposit :: !(CompactForm Coin)
   , drepDelegs :: !(Set (Credential 'Staking))
   }
   deriving (Show, Eq, Ord, Generic)
@@ -208,7 +208,10 @@ drepAnchorL :: Lens' DRepState (StrictMaybe Anchor)
 drepAnchorL = lens drepAnchor (\x y -> x {drepAnchor = y})
 
 drepDepositL :: Lens' DRepState Coin
-drepDepositL = lens drepDeposit (\x y -> x {drepDeposit = y})
+drepDepositL = drepDepositCompactL . partialCompactCoinL
+
+drepDepositCompactL :: Lens' DRepState (CompactForm Coin)
+drepDepositCompactL = lens drepDeposit (\x y -> x {drepDeposit = y})
 
 drepDelegsL :: Lens' DRepState (Set (Credential 'Staking))
 drepDelegsL = lens drepDelegs (\x y -> x {drepDelegs = y})

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

@@ -251,16 +251,16 @@ vStateSpec univ epoch whoDelegated = constrained $ \ [var|vstate|] ->
     , forAll dreps $ \ [var|pair|] ->
         match pair $ \ [var|drep|] [var|drepstate|] ->
           [ satisfies drep (witCredSpec univ)
-          , match drepstate $ \ [var|expiry|] _anchor [var|drepDdeposit|] [var|delegs|] ->
+          , match drepstate $ \ [var|expiry|] _anchor [var|drepDeposit'|] [var|delegs|] ->
               onJust (lookup_ drep (lit whoDelegated)) $ \ [var|delegSet|] ->
                 [ assertExplain (pure "all delegatees have delegated") $ delegs ==. delegSet
                 , witness univ delegSet
                 , assertExplain (pure "epoch of expiration must follow the current epoch") $ epoch <=. expiry
-                , assertExplain (pure "no deposit is 0") $ lit (Coin 0) <=. drepDdeposit
+                , assertExplain (pure "no deposit is 0") $ match drepDeposit' (lit 0 <=.)
                 ]
           ]
     , assertExplain (pure "num dormant epochs should not be too large") $
-        [epoch <=. numdormant, numdormant <=. epoch + (lit (EpochNo 10))]
+        [epoch <=. numdormant, numdormant <=. epoch + lit (EpochNo 10)]
     , dependsOn numdormant epoch -- Solve epoch first.
     , match committeestate $ \ [var|committeemap|] ->
         [witness univ (dom_ committeemap), satisfies committeemap (hasSize (rangeSize 1 4))]

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

@@ -219,6 +219,6 @@ depositsMap certState props =
           (fromCompact . (^. depositAccountStateL))
           (certState ^. certDStateL . accountsL . accountsMapL)
     , Map.mapKeys PoolDeposit $ certState ^. certPStateL . psDepositsL
-    , fmap drepDeposit . Map.mapKeys DRepDeposit $ certState ^. certVStateL . vsDRepsL
+    , fmap (fromCompact . drepDeposit) . Map.mapKeys DRepDeposit $ certState ^. certVStateL . vsDRepsL
     , Map.fromList . fmap (bimap GovActionDeposit gasDeposit) $ OMap.assocList (props ^. pPropsL)
     ]