Change the type of psDeposits to CompactForm Coin

Author: Soupstraw

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs

@@ -86,7 +86,7 @@ import Cardano.Ledger.Binary (
   encodePreEncoded,
   serialize',
  )
-import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
 import Cardano.Ledger.Core (EraPParams (..))
 import Cardano.Ledger.HKD (HKDFunctor (..))
 import Cardano.Ledger.Mary.Core
@@ -237,7 +237,7 @@ data AlonzoPParams f era = AlonzoPParams
   -- ^ Maximal block header size
   , appKeyDeposit :: !(HKD f Coin)
   -- ^ The amount of a key registration deposit
-  , appPoolDeposit :: !(HKD f Coin)
+  , appPoolDeposit :: !(HKD f (CompactForm Coin))
   -- ^ The amount of a pool registration deposit
   , appEMax :: !(HKD f EpochInterval)
   -- ^ Maximum number of epochs in the future a pool retirement is allowed to
@@ -465,7 +465,7 @@ emptyAlonzoPParams =
     , appMaxTxSize = 2048
     , appMaxBHSize = 0
     , appKeyDeposit = Coin 0
-    , appPoolDeposit = Coin 0
+    , appPoolDeposit = CompactCoin 0
     , appEMax = EpochInterval 0
     , appNOpt = 100
     , appA0 = minBound

eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs

@@ -60,7 +60,7 @@ import Cardano.Ledger.Binary (
   DecCBOR (..),
   EncCBOR (..),
  )
-import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
 import Cardano.Ledger.Core (EraPParams (..))
 import Cardano.Ledger.HKD (HKDFunctor (..))
 import Cardano.Ledger.Orphans ()
@@ -113,7 +113,7 @@ data BabbagePParams f era = BabbagePParams
   -- ^ Maximal block header size
   , bppKeyDeposit :: !(HKD f Coin)
   -- ^ The amount of a key registration deposit
-  , bppPoolDeposit :: !(HKD f Coin)
+  , bppPoolDeposit :: !(HKD f (CompactForm Coin))
   -- ^ The amount of a pool registration deposit
   , bppEMax :: !(HKD f EpochInterval)
   -- ^ Maximum number of epochs in the future a pool retirement is allowed to
@@ -274,7 +274,7 @@ emptyBabbagePParams =
     , bppMaxTxSize = 2048
     , bppMaxBHSize = 0
     , bppKeyDeposit = Coin 0
-    , bppPoolDeposit = Coin 0
+    , bppPoolDeposit = CompactCoin 0
     , bppEMax = EpochInterval 0
     , bppNOpt = 100
     , bppA0 = minBound

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

@@ -113,7 +113,7 @@ import Cardano.Ledger.Binary (
   encodeListLen,
  )
 import Cardano.Ledger.Binary.Coders
-import Cardano.Ledger.Coin (Coin (Coin))
+import Cardano.Ledger.Coin (Coin (Coin), CompactForm (..))
 import Cardano.Ledger.Conway.Era (ConwayEra, hardforkConwayBootstrapPhase)
 import Cardano.Ledger.Core (EraPParams (..))
 import Cardano.Ledger.HKD (
@@ -612,7 +612,7 @@ data ConwayPParams f era = ConwayPParams
   -- ^ Maximal block header size
   , cppKeyDeposit :: !(THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f Coin)
   -- ^ The amount of a key registration deposit
-  , cppPoolDeposit :: !(THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f Coin)
+  , cppPoolDeposit :: !(THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f (CompactForm Coin))
   -- ^ The amount of a pool registration deposit
   , cppEMax :: !(THKD ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) f EpochInterval)
   -- ^ Maximum number of epochs in the future a pool retirement is allowed to
@@ -883,7 +883,7 @@ instance ConwayEraPParams ConwayEra where
       , isValid (/= EpochInterval 0) ppuCommitteeMaxTermLengthL
       , isValid (/= EpochInterval 0) ppuGovActionLifetimeL
       , -- Coins
-        isValid (/= zero) ppuPoolDepositL
+        isValid (/= CompactCoin 0) ppuPoolDepositCompactL
       , isValid (/= zero) ppuGovActionDepositL
       , isValid (/= zero) ppuDRepDepositL
       , hardforkConwayBootstrapPhase pv
@@ -929,7 +929,7 @@ emptyConwayPParams =
     , cppMaxTxSize = THKD 2048
     , cppMaxBHSize = THKD 0
     , cppKeyDeposit = THKD (Coin 0)
-    , cppPoolDeposit = THKD (Coin 0)
+    , cppPoolDeposit = THKD (CompactCoin 0)
     , cppEMax = THKD (EpochInterval 0)
     , cppNOpt = THKD 100
     , cppA0 = THKD minBound

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

@@ -13,7 +13,7 @@ module Test.Cardano.Ledger.Conway.Imp.GovSpec (spec) where
 
 import Cardano.Ledger.Address (RewardAccount (..))
 import Cardano.Ledger.BaseTypes
-import Cardano.Ledger.Coin (Coin (Coin))
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway (hardforkConwayDisallowUnelectedCommitteeFromVoting)
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Governance
@@ -223,7 +223,7 @@ pparamUpdateSpec =
       testMalformedProposal
         "ppuPoolDepositL cannot be 0"
         ppuPoolDepositL
-        zero
+        $ Coin 0
       testMalformedProposal
         "ppuGovActionDepositL cannot be 0"
         ppuGovActionDepositL

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

@@ -139,7 +139,7 @@ instance ConwayEraPParams DijkstraEra where
       , isValid (/= EpochInterval 0) ppuCommitteeMaxTermLengthL
       , isValid (/= EpochInterval 0) ppuGovActionLifetimeL
       , -- Coins
-        isValid (/= zero) ppuPoolDepositL
+        isValid (/= mempty) ppuPoolDepositL
       , isValid (/= zero) ppuGovActionDepositL
       , isValid (/= zero) ppuDRepDepositL
       , isValid ((/= zero) . unCoinPerByte) ppuCoinsPerUTxOByteL

eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs

@@ -67,7 +67,8 @@ import Cardano.Ledger.Binary (
   encodeListLen,
  )
 import Cardano.Ledger.Binary.Coders (Decode (From, RecD), decode, (<!))
-import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
+import Cardano.Ledger.Compactible (Compactible (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.HKD (HKD)
 import Cardano.Ledger.Hashes (GenDelegs)
@@ -103,7 +104,7 @@ data ShelleyPParams f era = ShelleyPParams
   -- ^ Maximal block header size
   , sppKeyDeposit :: !(HKD f Coin)
   -- ^ The amount of a key registration deposit
-  , sppPoolDeposit :: !(HKD f Coin)
+  , sppPoolDeposit :: !(HKD f (CompactForm Coin))
   -- ^ The amount of a pool registration deposit
   , sppEMax :: !(HKD f EpochInterval)
   -- ^ epoch bound on pool retirement
@@ -194,7 +195,7 @@ emptyShelleyPParams =
     , sppMaxTxSize = 2048
     , sppMaxBHSize = 0
     , sppKeyDeposit = Coin 0
-    , sppPoolDeposit = Coin 0
+    , sppPoolDeposit = CompactCoin 0
     , sppEMax = EpochInterval 0
     , sppNOpt = 100
     , sppA0 = minBound

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/PoolReap.hs

@@ -22,7 +22,7 @@ module Cardano.Ledger.Shelley.Rules.PoolReap (
 
 import Cardano.Ledger.Address (RewardAccount, raCredential)
 import Cardano.Ledger.BaseTypes (ShelleyBase)
-import Cardano.Ledger.Coin (Coin)
+import Cardano.Ledger.Coin (Coin, CompactForm)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.PoolParams (ppRewardAccount)
@@ -35,7 +35,7 @@ import Cardano.Ledger.Shelley.LedgerState (
 import Cardano.Ledger.Shelley.LedgerState.Types (potEqualsObligation)
 import Cardano.Ledger.Slot (EpochNo (..))
 import Cardano.Ledger.State
-import Cardano.Ledger.UMap (UView (RewDepUView, SPoolUView), compactCoinOrError)
+import Cardano.Ledger.UMap (UView (RewDepUView, SPoolUView), compactCoinOrError, fromCompact)
 import qualified Cardano.Ledger.UMap as UM
 import Cardano.Ledger.Val ((<+>), (<->))
 import Control.DeepSeq (NFData)
@@ -49,6 +49,7 @@ import Control.State.Transition (
   judgmentContext,
   tellEvent,
  )
+import Data.Bifunctor (Bifunctor (..))
 import Data.Default (Default, def)
 import Data.Foldable (fold)
 import qualified Data.Map.Strict as Map
@@ -74,9 +75,9 @@ instance NFData (ShelleyPoolreapPredFailure era)
 
 data ShelleyPoolreapEvent era = RetiredPools
   { refundPools ::
-      Map.Map (Credential 'Staking) (Map.Map (KeyHash 'StakePool) Coin)
+      Map.Map (Credential 'Staking) (Map.Map (KeyHash 'StakePool) (CompactForm Coin))
   , unclaimedPools ::
-      Map.Map (Credential 'Staking) (Map.Map (KeyHash 'StakePool) Coin)
+      Map.Map (Credential 'Staking) (Map.Map (KeyHash 'StakePool) (CompactForm Coin))
   , epochNo :: EpochNo
   }
   deriving (Generic)
@@ -136,18 +137,19 @@ poolReapTransition = do
     retired :: Set (KeyHash 'StakePool)
     retired = eval (dom (psRetiring ps ▷ setSingleton e))
     -- The Map of pools (retiring this epoch) to their deposits
-    retiringDeposits, remainingDeposits :: Map.Map (KeyHash 'StakePool) Coin
+    retiringDeposits, remainingDeposits :: Map.Map (KeyHash 'StakePool) (CompactForm Coin)
     (retiringDeposits, remainingDeposits) =
       Map.partitionWithKey (\k _ -> Set.member k retired) (psDeposits ps)
     rewardAccounts :: Map.Map (KeyHash 'StakePool) RewardAccount
     rewardAccounts = Map.map ppRewardAccount $ eval (retired ◁ psStakePoolParams ps)
     rewardAccounts_ ::
-      Map.Map (KeyHash 'StakePool) (RewardAccount, Coin)
+      Map.Map (KeyHash 'StakePool) (RewardAccount, CompactForm Coin)
     rewardAccounts_ = Map.intersectionWith (,) rewardAccounts retiringDeposits
     rewardAccounts' :: Map.Map RewardAccount Coin
     rewardAccounts' =
       Map.fromListWith (<+>)
         . Map.elems
+        . fmap (second fromCompact)
         $ rewardAccounts_
     refunds :: Map.Map (Credential 'Staking) Coin
     mRefunds :: Map.Map (Credential 'Staking) Coin
@@ -187,7 +189,7 @@ poolReapTransition = do
           & certPStateL . psStakePoolParamsL %~ (eval . (retired ⋪))
           & certPStateL . psFutureStakePoolParamsL %~ (eval . (retired ⋪))
           & certPStateL . psRetiringL %~ (eval . (retired ⋪))
-          & certPStateL . psDepositsL .~ remainingDeposits
+          & certPStateL . psDepositsCompactL .~ remainingDeposits
       )
 
 renderPoolReapViolation ::

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs

@@ -151,7 +151,7 @@ adaPreservationProps =
       , map feesNonDecreasing noEpochBoundarySsts
       ]
 
-infoRetire :: Map (KeyHash 'StakePool) Coin -> KeyHash 'StakePool -> String
+infoRetire :: Show a => Map (KeyHash 'StakePool) a -> KeyHash 'StakePool -> String
 infoRetire deposits keyhash = showKeyHash keyhash ++ extra
   where
     extra = case Map.lookup keyhash deposits of

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deposits.hs

@@ -21,7 +21,7 @@ import Cardano.Ledger.Shelley.LedgerState (
  )
 import Cardano.Ledger.Shelley.Rules.Reports (synopsisCoinMap)
 import Cardano.Ledger.Shelley.State
-import Cardano.Ledger.UMap (depositMap)
+import Cardano.Ledger.UMap (depositMap, fromCompact)
 import qualified Cardano.Ledger.UMap as UM
 import Cardano.Ledger.Val ((<+>))
 import qualified Data.Map.Strict as Map
@@ -87,14 +87,14 @@ depositInvariant SourceSignalTarget {source = chainSt} =
       allDeposits = utxosDeposited utxost
       sumCoin = Map.foldl' (<+>) (Coin 0)
       keyDeposits = (UM.fromCompact . UM.sumDepositUView . UM.RewDepUView . dsUnified) dstate
-      poolDeposits = sumCoin (psDeposits pstate)
+      poolDeposits = sumCoin (fromCompact <$> psDeposits pstate)
    in counterexample
         ( ansiDocToString . Pretty.vsep $
             [ "Deposit invariant fails:"
             , Pretty.indent 2 . Pretty.vsep . map Pretty.pretty $
                 [ "All deposits = " ++ show allDeposits
                 , "Key deposits = " ++ synopsisCoinMap (Just (depositMap (dsUnified dstate)))
-                , "Pool deposits = " ++ synopsisCoinMap (Just (psDeposits pstate))
+                , "Pool deposits = " ++ synopsisCoinMap (Just (fromCompact <$> psDeposits pstate))
                 ]
             ]
         )

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

@@ -191,10 +191,10 @@ feesAndDeposits ppEx newFees stakes pools cs = cs {chainNes = nes'}
     accum n x = if Map.member (ppId x) (psDeposits pstate) then (n :: Integer) else n + 1
     newDeposits =
       Map.fromList (map (\cred -> (cred, compactCoinOrError (ppEx ^. ppKeyDepositL))) stakes)
-    newPools = Map.fromList (map (\p -> (ppId p, ppEx ^. ppPoolDepositL)) pools)
+    newPools = Map.fromList (map (\p -> (ppId p, ppEx ^. ppPoolDepositCompactL)) pools)
     dpstate' =
       mkShelleyCertState
-        (pstate & psDepositsL %~ Map.unionWith (\old _new -> old) newPools)
+        (pstate & psDepositsCompactL %~ Map.unionWith (\old _new -> old) newPools)
         (dstate & dsUnifiedL .~ UM.unionKeyDeposits (RewDepUView (dstate ^. dsUnifiedL)) newDeposits)
     es' = es {esLState = ls'}
     nes' = nes {nesEs = es'}
@@ -473,7 +473,7 @@ reapPool pool cs = cs {chainNes = nes'}
         Just (UM.RDPair ccoin dep) ->
           ( UM.insert'
               rewardAddr
-              (UM.RDPair (addCompactCoin ccoin (compactCoinOrError (pp ^. ppPoolDepositL))) dep)
+              (UM.RDPair (addCompactCoin ccoin (pp ^. ppPoolDepositCompactL)) dep)
               (rewards ds)
           , Coin 0
           )