diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index a84b3a05c4a..b33b8ee5aee 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs @@ -98,7 +98,7 @@ import Cardano.Ledger.Binary.Coders ( invalidField, (!>), ) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Core (EraPParams (..)) import Cardano.Ledger.HKD (HKD, HKDFunctor (..)) import Cardano.Ledger.Mary.Core @@ -260,7 +260,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 @@ -563,7 +563,7 @@ emptyAlonzoPParams = , appMaxTxSize = 2048 , appMaxBHSize = 0 , appKeyDeposit = Coin 0 - , appPoolDeposit = Coin 0 + , appPoolDeposit = CompactCoin 0 , appEMax = EpochInterval 0 , appNOpt = 100 , appA0 = minBound diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs index 0aee8930913..6f1b10904bd 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs @@ -88,7 +88,7 @@ import Cardano.Ledger.Binary.Coders ( invalidField, (!>), ) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Core (EraPParams (..)) import Cardano.Ledger.HKD (HKD, HKDFunctor (..)) import Cardano.Ledger.Orphans () @@ -148,7 +148,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 @@ -385,7 +385,7 @@ emptyBabbagePParams = , bppMaxTxSize = 2048 , bppMaxBHSize = 0 , bppKeyDeposit = Coin 0 - , bppPoolDeposit = Coin 0 + , bppPoolDeposit = CompactCoin 0 , bppEMax = EpochInterval 0 , bppNOpt = 100 , bppA0 = minBound diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs index f92dcb20910..316b58b5f29 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs @@ -100,7 +100,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) import Cardano.Ledger.Core (EraPParams (..)) import Cardano.Ledger.HKD ( @@ -569,7 +569,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 @@ -806,7 +806,7 @@ instance ConwayEraPParams ConwayEra where , isValid (/= EpochInterval 0) ppuCommitteeMaxTermLengthL , isValid (/= EpochInterval 0) ppuGovActionLifetimeL , -- Coins - isValid (/= zero) ppuPoolDepositL + isValid (/= CompactCoin 0) ppuPoolDepositL , isValid (/= zero) ppuGovActionDepositL , isValid (/= zero) ppuDRepDepositL , bootstrapPhase pv @@ -982,7 +982,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 diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs index fe74d89cf20..3476ec2cc57 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs @@ -14,7 +14,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 (Coin), CompactForm (..)) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.Rules (ConwayGovPredFailure (..)) @@ -223,7 +223,7 @@ pparamUpdateSpec = testMalformedProposal "ppuPoolDepositL cannot be 0" ppuPoolDepositL - zero + $ CompactCoin 0 testMalformedProposal "ppuGovActionDepositL cannot be 0" ppuGovActionDepositL diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs index 61a793f221e..8d0f13e1e5d 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs @@ -31,6 +31,7 @@ import Test.Cardano.Ledger.Conway.ImpTest import Test.Cardano.Ledger.Core.KeyPair import Test.Cardano.Ledger.Core.Rational ((%!)) import Test.Cardano.Ledger.Imp.Common +import Cardano.Ledger.Compactible (Compactible(..)) spec :: forall era. @@ -661,7 +662,7 @@ votingSpec = it "Rewards contribute to active voting stake even in the absence of StakeDistr" $ whenPostBootstrap $ do let govActionLifetime = 5 govActionDeposit = Coin 1_000_000 - poolDeposit = Coin 858_000 + poolDeposit = CompactCoin 858_000 -- Only modify the applicable thresholds modifyPParams $ \pp -> pp @@ -695,7 +696,7 @@ votingSpec = -- Increase the rewards of the delegator to this DRep -- to barely make the threshold (65 %! 100) registerAndRetirePoolToMakeReward $ KeyHashObj stakingKH1 - getReward (KeyHashObj stakingKH1) `shouldReturn` poolDeposit <> govActionDeposit + getReward (KeyHashObj stakingKH1) `shouldReturn` fromCompact poolDeposit <> govActionDeposit isDRepAccepted addCCGaid `shouldReturn` True -- The same vote should now successfully ratify the proposal passEpoch @@ -972,7 +973,7 @@ votingSpec = whenPostBootstrap $ do let govActionLifetime = 5 govActionDeposit = Coin 1_000_000 - poolDeposit = Coin 200_000 + poolDeposit = CompactCoin 200_000 -- Only modify the applicable thresholds modifyPParams $ \pp -> pp @@ -1017,7 +1018,7 @@ votingSpec = -- Add to the rewards of the delegator to this SPO -- to barely make the threshold (51 %! 100) registerAndRetirePoolToMakeReward delegatorCStaking1 - getReward delegatorCStaking1 `shouldReturn` poolDeposit <> govActionDeposit + getReward delegatorCStaking1 `shouldReturn` fromCompact poolDeposit <> govActionDeposit -- The same vote should now successfully ratify the proposal -- NOTE: It takes 2 epochs for SPO votes as opposed to 1 epoch -- for DRep votes to ratify a proposal. diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs index 4c87657f49d..1d0d0292025 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs @@ -61,7 +61,7 @@ import Cardano.Ledger.Binary ( encodeWord, ) import Cardano.Ledger.Binary.Coders (Decode (From, RecD), decode, (), (<->)) import Control.DeepSeq (NFData) @@ -58,6 +58,7 @@ import qualified Data.Set as Set (member) import GHC.Generics (Generic) import Lens.Micro import NoThunks.Class (NoThunks (..)) +import Data.Bifunctor (Bifunctor(..)) data ShelleyPoolreapState era = PoolreapState { prUTxOSt :: UTxOState era @@ -75,9 +76,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) @@ -137,18 +138,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 diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/CertState.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/CertState.hs index 8fe94ff3b81..78d702bc761 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/CertState.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/CertState.hs @@ -25,6 +25,7 @@ import Cardano.Ledger.Binary ( encodeListLen, ) import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Compactible (Compactible (..)) import Cardano.Ledger.Core import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Shelley.Era (ShelleyEra) @@ -71,7 +72,7 @@ shelleyObligationCertState certState = Obligations { oblStake = UM.fromCompact (UM.sumDepositUView (UM.RewDepUView (certState ^. certDStateL . dsUnifiedL))) - , oblPool = F.foldl' (<>) (Coin 0) (certState ^. certPStateL . psDepositsL) + , oblPool = F.foldl' (<>) (Coin 0) (fmap fromCompact $ certState ^. certPStateL . psDepositsL) , oblDRep = Coin 0 , oblProposal = Coin 0 } diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs index 316d63f0b04..660d43e943e 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs @@ -113,6 +113,7 @@ import qualified Data.Set as Set import GHC.Generics (Generic) import Lens.Micro import NoThunks.Class (NoThunks (..)) +import Cardano.Ledger.Compactible (Compactible(..)) instance EraTxCert ShelleyEra where type TxCert ShelleyEra = ShelleyTxCert ShelleyEra @@ -565,7 +566,7 @@ shelleyTotalDepositsTxCerts pp isRegPoolRegistered certs = numKeys <×> (pp ^. ppKeyDepositL) <+> numNewRegPoolCerts - <×> (pp ^. ppPoolDepositL) + <×> fromCompact (pp ^. ppPoolDepositL) where numKeys = getSum @Int $ foldMap' (\x -> if isRegStakeTxCert x then 1 else 0) certs numNewRegPoolCerts = Set.size (F.foldl' addNewPoolIds Set.empty certs) diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 9f4623534ce..5abd3f89790 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -14,7 +14,6 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} @@ -675,7 +674,7 @@ instance & ppMaxBBSizeL .~ 65536 & ppMaxTxSizeL .~ 16384 & ppKeyDepositL .~ Coin 2_000_000 - & ppPoolDepositL .~ Coin 500_000_000 + & ppPoolDepositL .~ CompactCoin 500_000_000 & ppEMaxL .~ EpochInterval 18 & ppNOptL .~ 150 & ppA0L .~ (3 %! 10) diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs index 90b14be58c7..0d81f909b09 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs @@ -33,7 +33,7 @@ import Cardano.Ledger.BaseTypes ( inject, mkTxIxPartial, ) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Keys (asWitness) import Cardano.Ledger.PoolParams ( @@ -135,7 +135,7 @@ ppsBench = & ppMinFeeAL .~ Coin 0 & ppMinFeeBL .~ Coin 0 & ppMinUTxOValueL .~ Coin 10 - & ppPoolDepositL .~ Coin 0 + & ppPoolDepositL .~ CompactCoin 0 & ppRhoL .~ unsafeBoundRational 0.0021 & ppTauL .~ unsafeBoundRational 0.2 diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs index 116f03cdeea..ba4fc03a00c 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs @@ -37,7 +37,7 @@ import Cardano.Ledger.BaseTypes ( succVersion, unsafeNonZero, ) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Core import Cardano.Ledger.Keys ( GenDelegPair (..), @@ -162,11 +162,11 @@ hi = 200000 -- NOTE: we need to keep these deposits small, otherwise -- when we generate sequences of transactions we will bleed too -- much funds into the deposit pool (i.e. funds not available as utxo) -genPoolDeposit :: HasCallStack => Gen Coin +genPoolDeposit :: HasCallStack => Gen (CompactForm Coin) genPoolDeposit = increasingProbabilityAt - (Coin <$> genInteger 0 100) - (Coin 0, Coin 100) + (CompactCoin <$> genWord64 0 100) + (CompactCoin 0, CompactCoin 100) -- Generates a Neutral or actual Nonces with equal frequency genExtraEntropy :: HasCallStack => Gen Nonce diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs index 240e8f52b7e..d734e71fc85 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs +++ b/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 diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deposits.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deposits.hs index 0a9a7923b7a..370e4eacab6 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deposits.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deposits.hs @@ -22,7 +22,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 @@ -89,14 +89,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)) ] ] ) diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs index e4910497796..a9bbc30bb7a 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs @@ -182,7 +182,7 @@ feesAndDeposits ppEx newFees stakes pools cs = cs {chainNes = nes'} { utxosDeposited = utxosDeposited utxoSt <+> (length stakes <×> ppEx ^. ppKeyDepositL) - <+> (newcount <×> ppEx ^. ppPoolDepositL) + <+> (newcount <×> fromCompact (ppEx ^. ppPoolDepositL)) , utxosFees = utxosFees utxoSt <+> newFees } ls' = ls {lsUTxOState = utxoSt', lsCertState = dpstate'} @@ -474,18 +474,18 @@ 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 ^. ppPoolDepositL)) dep) (rewards ds) - , Coin 0 + , CompactCoin 0 ) -- FIXME shouldn't we look up the pooldeposit here? umap1 = unUView rewards' umap2 = UM.SPoolUView umap1 UM.⋫ Set.singleton kh ds' = ds {dsUnified = umap2} chainAccountState = esChainAccountState es - chainAccountState' = chainAccountState {casTreasury = casTreasury chainAccountState <+> unclaimed} + chainAccountState' = chainAccountState {casTreasury = casTreasury chainAccountState <+> fromCompact unclaimed} utxoSt = lsUTxOState ls - utxoSt' = utxoSt {utxosDeposited = utxosDeposited utxoSt <-> (pp ^. ppPoolDepositL)} + utxoSt' = utxoSt {utxosDeposited = utxosDeposited utxoSt <-> fromCompact (pp ^. ppPoolDepositL)} dps' = dps & certPStateL .~ ps' diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs index 3b06358eccc..5d82f23e1b5 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs @@ -19,7 +19,7 @@ module Test.Cardano.Ledger.Shelley.Examples.Init ( where import Cardano.Ledger.BaseTypes (EpochInterval (..), Nonce (..)) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses) import Cardano.Ledger.Shelley.State @@ -54,7 +54,7 @@ ppEx = & ppMaxTxSizeL .~ 10000 & ppEMaxL .~ EpochInterval 10000 & ppKeyDepositL .~ Coin 7 - & ppPoolDepositL .~ Coin 250 + & ppPoolDepositL .~ CompactCoin 250 & ppDL .~ unsafeBoundRational 0.5 & ppTauL .~ unsafeBoundRational 0.2 & ppRhoL .~ unsafeBoundRational 0.0021 diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs index 7fe71b96a38..f20d3f26a6e 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs @@ -23,7 +23,7 @@ import Cardano.Ledger.BaseTypes ( (⭒), ) import Cardano.Ledger.Block (Block, bheader) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Keys (asWitness) import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.Core @@ -103,7 +103,7 @@ initStUpdates = initSt initUTxO ppVoteA :: PParamsUpdate ShelleyEra ppVoteA = emptyPParamsUpdate - & ppuPoolDepositL .~ SJust (Coin 200) + & ppuPoolDepositL .~ SJust (CompactCoin 200) & ppuExtraEntropyL .~ SJust (mkNonceFromNumber 123) collectVotes :: @@ -357,7 +357,7 @@ blockEx4 = ppExUpdated :: PParams ShelleyEra ppExUpdated = ppEx - & ppPoolDepositL .~ Coin 200 + & ppPoolDepositL .~ CompactCoin 200 & ppExtraEntropyL .~ mkNonceFromNumber 123 expectedStEx4 :: ChainState ShelleyEra diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs index f0bff269b20..298188fed2b 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs @@ -59,7 +59,7 @@ import Cardano.Ledger.Binary.Crypto ( ) import qualified Cardano.Ledger.Binary.Plain as Plain import Cardano.Ledger.Block (Block (..)) -import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..)) +import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..), CompactForm (..)) import Cardano.Ledger.Credential (Credential (..), StakeReference (..)) import Cardano.Ledger.Keys ( DSIGN, @@ -620,7 +620,7 @@ tests = maxtxsize = 3 maxbhsize = 4 keydeposit = Coin 5 - pooldeposit = Coin 6 + pooldeposit = CompactCoin 6 emax = EpochInterval 7 nopt = 8 a0 = unsafeBoundRational $ 1 % 6 diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs index 0b35b7ceee6..e8904dcfa9d 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs @@ -140,7 +140,7 @@ pp = & ppMinFeeAL .~ Coin 1 & ppMinFeeBL .~ Coin 1 & ppKeyDepositL .~ Coin 100 - & ppPoolDepositL .~ Coin 250 + & ppPoolDepositL .~ CompactCoin 250 & ppMaxTxSizeL .~ 1024 & ppEMaxL .~ EpochInterval 10 & ppMinUTxOValueL .~ Coin 100 diff --git a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Body.hs b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Body.hs index 91ea1fdc37a..3ec591216d3 100644 --- a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Body.hs +++ b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Body.hs @@ -26,6 +26,7 @@ import Test.Cardano.Ledger.Babbage.Arbitrary () import Test.Cardano.Ledger.Common totalTxDeposits :: + forall era. (EraTxBody era, EraCertState era) => PParams era -> CertState era -> @@ -41,7 +42,7 @@ totalTxDeposits pp dpstate txb = -- We don't pay a deposit on a pool that is already registered if Map.member (ppId poolparam) pools then (pools, ans) - else (Map.insert (ppId poolparam) poolparam pools, ans <+> pp ^. ppPoolDepositL) + else (Map.insert (ppId poolparam) poolparam pools, ans <+> fromCompact (pp ^. ppPoolDepositL)) accum ans _ = ans keyTxRefunds :: diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs index e09b365749c..d166fe2d218 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Coin.hs @@ -67,6 +67,7 @@ import GHC.Stack import NoThunks.Class (NoThunks (..)) import Quiet import System.Random.Stateful (Uniform (..), UniformRange (..)) +import Data.Typeable (Typeable) -- | The amount of value held by a transaction output. newtype Coin = Coin {unCoin :: Integer} @@ -123,7 +124,7 @@ rationalToCoinViaCeiling = Coin . ceiling instance Compactible Coin where newtype CompactForm Coin = CompactCoin {unCompactCoin :: Word64} - deriving (Eq, Show, NoThunks, NFData, Prim, Ord, ToCBOR, ToJSON, FromJSON) + deriving (Eq, Show, NoThunks, NFData, Prim, Ord, ToCBOR, ToJSON, FromJSON, Generic, Typeable) deriving (Semigroup, Monoid, Group, Abelian) via Sum Word64 toCompact (Coin c) = CompactCoin <$> integerToWord64 c diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs index fc9ec2505c1..50bc6877582 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-} @@ -88,7 +87,7 @@ import Cardano.Ledger.BaseTypes ( UnitInterval, ) import Cardano.Ledger.Binary (DecCBOR, EncCBOR, FromCBOR, ToCBOR) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm) import Cardano.Ledger.Core.Era (Era (..), PreviousEra, ProtVerAtMost) import Cardano.Ledger.HKD (HKD, HKDApplicative, HKDFunctor (..), NoUpdate (..)) import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..)) @@ -315,7 +314,7 @@ class hkdKeyDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin) -- | The amount of a pool registration deposit - hkdPoolDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin) + hkdPoolDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f (CompactForm Coin)) -- | epoch bound on pool retirement hkdEMaxL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochInterval) @@ -400,7 +399,7 @@ ppKeyDepositL :: forall era. EraPParams era => Lens' (PParams era) Coin ppKeyDepositL = ppLens . hkdKeyDepositL @era @Identity -- | The amount of a pool registration deposit -ppPoolDepositL :: forall era. EraPParams era => Lens' (PParams era) Coin +ppPoolDepositL :: forall era. EraPParams era => Lens' (PParams era) (CompactForm Coin) ppPoolDepositL = ppLens . hkdPoolDepositL @era @Identity -- | epoch bound on pool retirement @@ -466,7 +465,7 @@ ppuKeyDepositL :: forall era. EraPParams era => Lens' (PParamsUpdate era) (Stric ppuKeyDepositL = ppuLens . hkdKeyDepositL @era @StrictMaybe -- | The amount of a pool registration deposit -ppuPoolDepositL :: forall era. EraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Coin) +ppuPoolDepositL :: forall era. EraPParams era => Lens' (PParamsUpdate era) (StrictMaybe (CompactForm Coin)) ppuPoolDepositL = ppuLens . hkdPoolDepositL @era @StrictMaybe -- | epoch bound on pool retirement diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ToPlutusData.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ToPlutusData.hs index 61e60880009..696b3b9b5a3 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ToPlutusData.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ToPlutusData.hs @@ -3,6 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleInstances #-} module Cardano.Ledger.Plutus.ToPlutusData where @@ -31,6 +32,7 @@ import Data.Word import GHC.Real (Ratio ((:%))) import Numeric.Natural (Natural) import PlutusLedgerApi.Common (Data (..)) +import Cardano.Ledger.Compactible (Compactible(..)) -- =============================================================== @@ -98,6 +100,9 @@ instance ToPlutusData Prices where deriving instance ToPlutusData Coin +instance ToPlutusData (CompactForm Coin) where + toPlutusData = toPlutusData . fromCompact + instance ToPlutusData Word32 where toPlutusData w32 = I (toInteger @Word32 w32) fromPlutusData (I n) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/State/CertState.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/State/CertState.hs index a2cfdfff1f5..79859034259 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/State/CertState.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/State/CertState.hs @@ -68,7 +68,7 @@ import Cardano.Ledger.Binary ( ) import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), ( PState era -> (Coin, PState era) +refundPoolDeposit :: KeyHash 'StakePool -> PState era -> (CompactForm Coin, PState era) refundPoolDeposit keyhash pstate = (coin, pstate {psDeposits = newpool}) where pool = psDeposits pstate @@ -501,5 +501,5 @@ psFutureStakePoolParamsL = lens psFutureStakePoolParams (\ds u -> ds {psFutureSt psRetiringL :: Lens' (PState era) (Map (KeyHash 'StakePool) EpochNo) psRetiringL = lens psRetiring (\ds u -> ds {psRetiring = u}) -psDepositsL :: Lens' (PState era) (Map (KeyHash 'StakePool) Coin) +psDepositsL :: Lens' (PState era) (Map (KeyHash 'StakePool) (CompactForm Coin)) psDepositsL = lens psDeposits (\ds u -> ds {psDeposits = u}) diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs index 064bdc950d4..4cc72ff8a02 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs @@ -10,6 +10,9 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Cardano.Ledger.Constrained.Classes where @@ -17,7 +20,7 @@ import Cardano.Ledger.Alonzo.Scripts (AsIx, AsIxItem, PlutusPurpose) import Cardano.Ledger.Alonzo.TxOut (AlonzoTxOut (..)) import Cardano.Ledger.Babbage.TxOut (BabbageTxOut (..)) import Cardano.Ledger.BaseTypes (EpochNo (..), ProtVer (..), SlotNo (..)) -import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..)) +import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..), CompactForm (..)) import Cardano.Ledger.Conway.Governance hiding (GovState) import Cardano.Ledger.Core import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..)) @@ -245,6 +248,8 @@ instance Adds ExUnits where | runOrdCondition GTE x y = y | otherwise = errorMess "ExUnits are incomparable, can't choose the 'smallerOf'" [show x, show y] +deriving newtype instance Adds (CompactForm Coin) + -- ================ instance Adds Word64 where zero = 0 diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Basic.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Basic.hs index 55b7fded48c..b0bc946ace1 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Basic.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Basic.hs @@ -252,7 +252,7 @@ data SimplePParams era = SimplePParams , maxTxSize :: Word32 , maxBHSize :: Word32 -- Need to be downsized inside reify to Word16 , keyDeposit :: Coin - , poolDeposit :: Coin + , poolDeposit :: CompactForm Coin , eMax :: EpochInterval , nOpt :: Word16 , a0 :: NonNegativeInterval @@ -289,6 +289,9 @@ data SimplePParams era = SimplePParams instance (EraSpecPParams era, EraGov era, EraTxOut era) => Show (SimplePParams era) where show x = show (subsetToPP @era x) +instance HasSimpleRep (CompactForm Coin) +instance HasSpec (CompactForm Coin) + -- | Use then generic HasSimpleRep and HasSpec instances for SimplePParams instance HasSimpleRep (SimplePParams era) diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/CertState.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/CertState.hs index 58ad92975b0..5124fa6eb8f 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/CertState.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/CertState.hs @@ -7,7 +7,7 @@ module Test.Cardano.Ledger.Constrained.Preds.CertState where import Cardano.Ledger.BaseTypes (EpochNo (..)) -import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..)) +import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..), CompactForm (..)) import Cardano.Ledger.Conway.State (ConwayEraCertState, EraCertState) import Cardano.Ledger.Core (Era) import Cardano.Ledger.DRep (drepAnchorL, drepDepositL, drepExpiryL) @@ -163,7 +163,7 @@ pstateCheckPreds :: EraCertState era => Proof era -> [Pred era] pstateCheckPreds _ = [ Subset (Dom retiring) (Dom regPools) -- Note regPools must be bigger than retiring , Dom regPools :=: Dom poolDeposits - , NotMember (Lit CoinR (Coin 0)) (Rng poolDeposits) + , NotMember (Lit CompactCoinR (CompactCoin 0)) (Rng poolDeposits) , Disjoint (Dom regPools) (Dom futureRegPools) ] diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/LedgerState.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/LedgerState.hs index 009764dfdb2..010486fceb2 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/LedgerState.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/LedgerState.hs @@ -10,7 +10,7 @@ module Test.Cardano.Ledger.Constrained.Preds.LedgerState where import Cardano.Ledger.Alonzo.PParams (ppuMaxValSizeL) import Cardano.Ledger.Babbage.PParams (ppuCoinsPerUTxOByteL) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Conway.Governance ( GovAction (..), GovActionId (..), @@ -120,7 +120,7 @@ ledgerStatePreds _usize p = ) , -- TODO, introduce ProjList so we can write: SumsTo (Right (Coin 1)) proposalDeposits EQL [ProjList CoinR gasDepositL currProposals] SumsTo - (Right (Coin 1)) + (Right (CompactCoin 1)) deposits EQL ( case whichCertState p of diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/PParams.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/PParams.hs index a6599aca0ad..6d63ecc8891 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/PParams.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/PParams.hs @@ -18,7 +18,7 @@ import Cardano.Ledger.BaseTypes ( NonNegativeInterval, boundRational, ) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Control.Monad (when) import GHC.Num (Natural) import Lens.Micro ((^.)) @@ -90,7 +90,7 @@ genPParams proof tx bb bh = do , MaxCollateralInputs maxCollateralInputs , CollateralPercentage collateralPercentage2 , ProtocolVersion $ protocolVersion proof - , PoolDeposit $ Coin 5 + , PoolDeposit $ CompactCoin 5 , KeyDeposit $ Coin 2 , DRepDeposit $ Coin 7 , GovActionDeposit $ Coin 13 diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs index 45fce290fea..5378fcac52f 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs @@ -62,7 +62,7 @@ import Cardano.Ledger.BaseTypes ( mkTxIxPartial, ) import Cardano.Ledger.Binary.Version (Version) -import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..)) +import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..), CompactForm) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance ( Committee (..), @@ -246,6 +246,7 @@ infixr 0 :-> data Rep era t where RationalR :: Rep era Rational + CompactCoinR :: Rep era (CompactForm Coin) CoinR :: Rep era Coin EpochR :: Rep era EpochNo EpochIntervalR :: Rep era EpochInterval @@ -400,6 +401,7 @@ typeRepOf r@(repHasInstances -> IsTypeable) = typeRep r repHasInstances :: Rep era t -> HasInstances t repHasInstances r = case r of + CompactCoinR -> IsOrd TxIdR -> IsOrd VStateR -> IsEq EnactStateR -> IsEq @@ -703,6 +705,7 @@ synopsis EnactStateR x = show (pcEnactState reify x) synopsis DRepPulserR x = show (pcDRepPulser x) synopsis DelegateeR x = show (pcDelegatee x) synopsis VoteR v = show v +synopsis CompactCoinR v = show v synSum :: Rep era a -> a -> String synSum (MapR _ CoinR) m = ", sum = " ++ show (pcCoin (Map.foldl' (<>) mempty m)) @@ -988,6 +991,7 @@ genSizedRep n DelegateeR = , DelegStakeVote <$> genSizedRep n (PoolHashR @era) <*> genSizedRep n (DRepR @era) ] genSizedRep _ VoteR = arbitrary +genSizedRep _ CompactCoinR = arbitrary genRep :: forall era b. @@ -1037,6 +1041,7 @@ shrinkRep PoolHashR t = shrink t shrinkRep WitHashR t = shrink t shrinkRep GenHashR t = shrink t shrinkRep GenDelegHashR t = shrink t +shrinkRep CompactCoinR t = shrink t shrinkRep PoolParamsR t = shrink t shrinkRep EpochR t = shrink t shrinkRep EpochIntervalR t = shrink t diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs index 2d3086e5e65..f36fe3c8032 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs @@ -121,7 +121,7 @@ import Cardano.Ledger.Shelley.Rewards (Reward (..)) import Cardano.Ledger.Shelley.TxBody (RewardAccount (..)) import Cardano.Ledger.Shelley.UTxO (EraUTxO (..), ShelleyScriptsNeeded (..)) import Cardano.Ledger.TxIn (TxIn (..)) -import Cardano.Ledger.UMap (compactCoinOrError, fromCompact, ptrMap, rdPairMap, sPoolMap, unify) +import Cardano.Ledger.UMap (compactCoinOrError, ptrMap, rdPairMap, sPoolMap, unify) import Cardano.Ledger.Val (Val (..)) import Control.Arrow (first) import Data.Default (Default (def)) @@ -189,6 +189,7 @@ import Test.Cardano.Ledger.Generic.Updaters (merge, newPParams, newTx, newTxBody import Test.Cardano.Ledger.Shelley.Utils (testGlobals) import qualified Test.Cardano.Ledger.Shelley.Utils as Utils (testGlobals) import Type.Reflection (Typeable, typeRep) +import Cardano.Ledger.Compactible (Compactible(..)) -- ======================= @@ -353,10 +354,10 @@ retiring = Var $ V "retiring" (MapR PoolHashR EpochR) (Yes NewEpochStateR retiri retiringL :: EraCertState era => NELens era (Map (KeyHash 'StakePool) EpochNo) retiringL = nesEsL . esLStateL . lsCertStateL . certPStateL . psRetiringL -poolDeposits :: EraCertState era => Term era (Map (KeyHash 'StakePool) Coin) -poolDeposits = Var $ V "poolDeposits" (MapR PoolHashR CoinR) (Yes NewEpochStateR poolDepositsL) +poolDeposits :: EraCertState era => Term era (Map (KeyHash 'StakePool) (CompactForm Coin)) +poolDeposits = Var $ V "poolDeposits" (MapR PoolHashR CompactCoinR) (Yes NewEpochStateR poolDepositsL) -poolDepositsL :: EraCertState era => NELens era (Map (KeyHash 'StakePool) Coin) +poolDepositsL :: EraCertState era => NELens era (Map (KeyHash 'StakePool) (CompactForm Coin)) poolDepositsL = nesEsL . esLStateL . lsCertStateL . certPStateL . psDepositsL committeeState :: @@ -1290,13 +1291,13 @@ maxBHSize p = (Yes (PParamsR p) (withEraPParams p (pparamsWrapperL . ppMaxBHSizeL . word16NaturalL))) ) -poolDepAmt :: Era era => Proof era -> Term era Coin +poolDepAmt :: Era era => Proof era -> Term era (CompactForm Coin) poolDepAmt p = Var $ pV p "poolDepAmt" - CoinR + CompactCoinR (Yes (PParamsR p) (withEraPParams p (pparamsWrapperL . ppPoolDepositL))) keyDepAmt :: Era era => Proof era -> Term era Coin diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs index 4a863281af4..8a1c935a4a9 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs @@ -62,7 +62,7 @@ import Cardano.Ledger.BaseTypes ( UnitInterval, ) import Cardano.Ledger.Binary (sizedValue) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance (ProposalProcedure, VotingProcedures) import Cardano.Ledger.Conway.PParams (ConwayPParams (..)) @@ -205,7 +205,7 @@ data PParamsField era | -- | The amount of a key registration deposit KeyDeposit Coin | -- | The amount of a pool registration deposit - PoolDeposit Coin + PoolDeposit (CompactForm Coin) | -- | epoch bound on pool retirement EMax EpochInterval | -- | Desired number of pools diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs index 259b3557ea8..2d627c19f46 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs @@ -69,6 +69,7 @@ import Test.Cardano.Ledger.Generic.Scriptic (Scriptic (..)) import qualified Test.Cardano.Ledger.Generic.Scriptic as Scriptic import Test.Cardano.Ledger.Shelley.Rewards (RewardUpdateOld, createRUpdOld_) import Test.Cardano.Ledger.Shelley.Utils (testGlobals) +import Cardano.Ledger.Compactible (Compactible(..)) -- ==================================================================== -- Era agnostic actions on (PParams era) (TxOut era) and @@ -118,7 +119,7 @@ depositsAndRefunds pp certificates keydeposits = List.foldl' accum (Coin 0) cert case Map.lookup hk keydeposits of Nothing -> ans Just c -> ans <-> c - accum ans (RegPoolTxCert _) = pp ^. ppPoolDepositL <+> ans + accum ans (RegPoolTxCert _) = fromCompact (pp ^. ppPoolDepositL) <+> ans accum ans (RetirePoolTxCert _ _) = ans -- The pool reward is refunded at the end of the epoch accum ans _ = ans @@ -426,7 +427,7 @@ instance TotalAda (DState era) where <> (UM.fromCompact $ UM.sumDepositUView (UM.RewDepUView (dsUnified dstate))) instance TotalAda (PState era) where - totalAda pstate = Fold.fold (psDeposits pstate) + totalAda pstate = Fold.fold (fromCompact <$> psDeposits pstate) instance TotalAda (VState era) where totalAda _ = mempty diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/GenState.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/GenState.hs index 79fc539cf48..f05f7e8f10d 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/GenState.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/GenState.hs @@ -93,7 +93,7 @@ import Cardano.Ledger.Alonzo.Scripts hiding (Script) import Cardano.Ledger.Alonzo.Tx (IsValid (..)) import Cardano.Ledger.Alonzo.TxWits (Redeemers (..)) import Cardano.Ledger.BaseTypes (EpochInterval (..), Network (Testnet), inject) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..)) import Cardano.Ledger.Credential (Credential (KeyHashObj, ScriptHashObj), StakeCredential) import Cardano.Ledger.Keys (coerceKeyRole) @@ -184,6 +184,7 @@ import Test.Tasty.QuickCheck ( frequency, generate, ) +import Cardano.Ledger.Compactible (Compactible(..)) -- ================================================= @@ -745,7 +746,7 @@ genGenEnv proof gsize = do , MaxCollateralInputs maxCollateralInputs , CollateralPercentage collateralPercentage , ProtocolVersion $ protocolVersion proof - , PoolDeposit $ Coin 5 + , PoolDeposit $ CompactCoin 5 , KeyDeposit $ Coin 2 , EMax $ EpochInterval 5 ] @@ -1170,7 +1171,7 @@ initStableFields = do modifyGenStateInitialPoolParams (Map.insert kh poolParams) modifyGenStateInitialPoolDistr (Map.insert kh ips) modifyModelPoolParams (Map.insert kh poolParams) - modifyModelKeyDeposits kh (pp ^. ppPoolDepositL) + modifyModelKeyDeposits kh (fromCompact $ pp ^. ppPoolDepositL) return kh -- This incantation gets a list of fresh (not previously generated) Credential diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/ModelState.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/ModelState.hs index 3cdbb5aedc4..d9800b6c377 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/ModelState.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/ModelState.hs @@ -107,6 +107,7 @@ import Test.Cardano.Ledger.Generic.Proof ( whichCertState, ) import Test.Cardano.Ledger.Shelley.Utils (runShelleyBase) +import Cardano.Ledger.Compactible (Compactible(..)) -- ============================================= @@ -377,7 +378,7 @@ abstract :: (EraGov era, EraCertState era) => NewEpochState era -> ModelNewEpoch abstract x = ModelNewEpochState { mPoolParams = (psStakePoolParams . certPState . lsCertState . esLState . nesEs) x - , mPoolDeposits = (psDeposits . certPState . lsCertState . esLState . nesEs) x + , mPoolDeposits = (fmap fromCompact . psDeposits . certPState . lsCertState . esLState . nesEs) x , mRewards = (UM.rewardMap . dsUnified . certDState . lsCertState . esLState . nesEs) x , mDelegations = (UM.sPoolMap . dsUnified . certDState . lsCertState . esLState . nesEs) x , mKeyDeposits = (UM.depositMap . dsUnified . certDState . lsCertState . esLState . nesEs) x diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs index 4f02b142363..33068e2cd9f 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs @@ -1134,7 +1134,7 @@ pcPParamsField x = case x of MaxTxSize natural -> [("maxTxsize", ppWord32 natural)] MaxBHSize natural -> [("maxBHsize", ppWord16 natural)] KeyDeposit coin -> [("keydeposit", pcCoin coin)] - PoolDeposit coin -> [("pooldeposit", pcCoin coin)] + PoolDeposit coin -> [("pooldeposit", pcCoin $ fromCompact coin)] EMax n -> [("emax", ppEpochInterval n)] NOpt n -> [("NOpt", ppWord16 n)] A0 i -> [("A0", viaShow i)] @@ -3286,7 +3286,7 @@ pcPParamsSynopsis p x = withEraPParams p help [ ("maxBBSize", ppWord32 (x ^. Core.ppMaxBBSizeL)) , ("maxBHSize", ppWord16 (x ^. Core.ppMaxBHSizeL)) , ("maxTxSize", ppWord32 (x ^. Core.ppMaxTxSizeL)) - , ("poolDeposit", pcCoin (x ^. Core.ppPoolDepositL)) + , ("poolDeposit", (pcCoin . fromCompact) (x ^. Core.ppPoolDepositL)) , ("keyDeposit", pcCoin (x ^. Core.ppKeyDepositL)) , ("protVer", ppString (showProtver (x ^. Core.ppProtocolVersionL))) ] @@ -3404,7 +3404,7 @@ pcPState (PState regP fregP ret dep) = [ ("regPools", ppMap pcKeyHash pcPoolParams regP) , ("futureRegPools", ppMap pcKeyHash pcPoolParams fregP) , ("retiring", ppMap pcKeyHash ppEpochNo ret) - , ("poolDeposits", ppMap pcKeyHash pcCoin dep) + , ("poolDeposits", ppMap pcKeyHash (pcCoin . fromCompact) dep) ] instance PrettyA (PState era) where