From c190ca66557eca7e0986c10164012926b1b2d359 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Mon, 12 Aug 2024 09:52:25 +0200 Subject: [PATCH 1/4] Revert "Value: deprecate some Lovelace functions. Advice to use Coin name instead." This reverts commit 3611d79a7d63857e1839f143aa65e37480d345ee. --- cardano-api/internal/Cardano/Api/Fees.hs | 4 +-- cardano-api/internal/Cardano/Api/Tx/Body.hs | 8 ++--- cardano-api/internal/Cardano/Api/Value.hs | 38 +++++---------------- cardano-api/src/Cardano/Api.hs | 5 --- 4 files changed, 14 insertions(+), 41 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index fe4e226647..477ab46115 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -269,7 +269,7 @@ estimateBalancedTxBody availableUTxOValue = mconcat [ totalUTxOValue - , negateValue (coinToValue totalDeposits) + , negateValue (lovelaceToValue totalDeposits) ] let change = toLedgerValue w $ calculateChangeValue sbe availableUTxOValue txbodycontent1 @@ -338,7 +338,7 @@ estimateBalancedTxBody , txTotalCollateral = reqCol } - let fakeUTxO = createFakeUTxO sbe txbodycontent1 $ selectCoin availableUTxOValue + let fakeUTxO = createFakeUTxO sbe txbodycontent1 $ selectLovelace availableUTxOValue balance = evaluateTransactionBalance sbe pparams poolids stakeDelegDeposits drepDelegDeposits fakeUTxO txbody2 -- check if the balance is positive or negative diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index a8131701e9..dac5a420f2 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -969,7 +969,7 @@ txOutValueToLovelace tv = txOutValueToValue :: TxOutValue era -> Value txOutValueToValue tv = case tv of - TxOutValueByron l -> coinToValue l + TxOutValueByron l -> lovelaceToValue l TxOutValueShelleyBased sbe v -> fromLedgerValue sbe v prettyRenderTxOut :: TxOutInAnyEra -> Text @@ -1781,7 +1781,7 @@ validateMintValue :: TxMintValue build era -> Either TxBodyError () validateMintValue txMintValue = case txMintValue of TxMintNone -> return () - TxMintValue _ v _ -> guard (selectCoin v == 0) ?! TxBodyMintAdaError + TxMintValue _ v _ -> guard (selectLovelace v == 0) ?! TxBodyMintAdaError inputIndexDoesNotExceedMax :: [(TxIn, a)] -> Either TxBodyError () inputIndexDoesNotExceedMax txIns = @@ -2264,8 +2264,8 @@ classifyRangeError :: TxOut CtxTx ByronEra -> TxBodyError classifyRangeError txout = case txout of TxOut (AddressInEra ByronAddressInAnyEra ByronAddress{}) (TxOutValueByron value) _ _ - | value < 0 -> TxBodyOutputNegative (coinToQuantity value) (txOutInAnyEra ByronEra txout) - | otherwise -> TxBodyOutputOverflow (coinToQuantity value) (txOutInAnyEra ByronEra txout) + | value < 0 -> TxBodyOutputNegative (lovelaceToQuantity value) (txOutInAnyEra ByronEra txout) + | otherwise -> TxBodyOutputOverflow (lovelaceToQuantity value) (txOutInAnyEra ByronEra txout) TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress _)) (TxOutValueShelleyBased w _) _ _ -> case w of {} TxOut (AddressInEra (ShelleyAddressInEra sbe) ShelleyAddress{}) _ _ _ -> case sbe of {} diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index 1b26bba494..10e0a1e45c 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -27,15 +27,10 @@ module Cardano.Api.Value , calcMinimumDeposit -- ** Ada \/ L.Coin specifically - , quantityToCoin , quantityToLovelace - , coinToQuantity , lovelaceToQuantity - , selectCoin , selectLovelace - , coinToValue , lovelaceToValue - , valueToCoin , valueToLovelace -- ** Alternative nested representation @@ -129,19 +124,11 @@ instance Semigroup Quantity where instance Monoid Quantity where mempty = Quantity 0 -{-# DEPRECATED lovelaceToQuantity "Use 'coinToQuantity' instead." #-} lovelaceToQuantity :: L.Coin -> Quantity -lovelaceToQuantity = coinToQuantity +lovelaceToQuantity (L.Coin x) = Quantity x -coinToQuantity :: L.Coin -> Quantity -coinToQuantity (L.Coin x) = Quantity x - -{-# DEPRECATED quantityToLovelace "Use 'quantityToCoin' instead." #-} quantityToLovelace :: Quantity -> L.Coin -quantityToLovelace = quantityToCoin - -quantityToCoin :: Quantity -> L.Coin -quantityToCoin (Quantity x) = L.Coin x +quantityToLovelace (Quantity x) = L.Coin x newtype PolicyId = PolicyId {unPolicyId :: ScriptHash} deriving stock (Eq, Ord) @@ -256,31 +243,22 @@ negateLedgerValue sbe v = filterValue :: (AssetId -> Bool) -> Value -> Value filterValue p (Value m) = Value (Map.filterWithKey (\k _v -> p k) m) -{-# DEPRECATED selectLovelace "Use selectCoin instead." #-} selectLovelace :: Value -> L.Coin -selectLovelace = selectCoin - -selectCoin :: Value -> L.Coin -selectCoin = quantityToLovelace . flip selectAsset AdaAssetId +selectLovelace = quantityToLovelace . flip selectAsset AdaAssetId -{-# DEPRECATED lovelaceToValue "Use 'coinToValue' instead." #-} lovelaceToValue :: L.Coin -> Value -lovelaceToValue = coinToValue +lovelaceToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity coinToValue :: L.Coin -> Value -coinToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity - -{-# DEPRECATED valueToLovelace "Use 'valueToCoin' instead." #-} -valueToLovelace :: Value -> Maybe L.Coin -valueToLovelace = valueToCoin +coinToValue = lovelaceToValue -- jky -- | Check if the 'Value' consists of /only/ 'L.Coin' and no other assets, -- and if so then return the L.Coin. -- --- See also 'selectCoin' to select the L.Coin quantity from the Value, +-- See also 'selectLovelace' to select the L.Coin quantity from the Value, -- ignoring other assets. -valueToCoin :: Value -> Maybe L.Coin -valueToCoin v = +valueToLovelace :: Value -> Maybe L.Coin +valueToLovelace v = case valueToList v of [] -> Just (L.Coin 0) [(AdaAssetId, q)] -> Just (quantityToLovelace q) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 7b73c22c81..b65e353e70 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -248,15 +248,10 @@ module Cardano.Api , fromLedgerValue -- ** Ada \/ Lovelace within multi-asset values - , quantityToCoin , quantityToLovelace - , coinToQuantity , lovelaceToQuantity - , selectCoin , selectLovelace - , coinToValue , lovelaceToValue - , valueToCoin , valueToLovelace -- * Blocks From b4122ad01c45341c2ac451558cc26342204bf012 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Mon, 12 Aug 2024 09:52:27 +0200 Subject: [PATCH 2/4] Revert "generators: Lovelace->Coin" This reverts commit 31e67e2105a673b8a20cb317b987b96bfb97b374. --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 48 +++++++++---------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 9391a5dde1..63a2e5114f 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -94,8 +94,8 @@ module Test.Gen.Cardano.Api.Typed , genTxInsReference , genTxMetadataInEra , genTxMintValue - , genCoin - , genPositiveCoin + , genLovelace + , genPositiveLovelace , genValue , genValueDefault , genVerificationKey @@ -199,11 +199,11 @@ _genAddressInEraByron = byronAddressInEra <$> genAddressByron genKESPeriod :: Gen KESPeriod genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded -genCoin :: Gen L.Coin -genCoin = L.Coin <$> Gen.integral (Range.linear 0 5000) +genLovelace :: Gen L.Coin +genLovelace = L.Coin <$> Gen.integral (Range.linear 0 5000) -genPositiveCoin :: Gen L.Coin -genPositiveCoin = L.Coin <$> Gen.integral (Range.linear 1 5000) +genPositiveLovelace :: Gen L.Coin +genPositiveLovelace = L.Coin <$> Gen.integral (Range.linear 1 5000) ---------------------------------------------------------------------------- -- SimpleScript generators @@ -632,7 +632,7 @@ genStakeAddressRequirements = ) ( \w -> StakeAddrRegistrationConway w - <$> genCoin + <$> genLovelace <*> genStakeCredential ) @@ -737,10 +737,10 @@ genTxTotalCollateral :: CardanoEra era -> Gen (TxTotalCollateral era) genTxTotalCollateral = inEonForEra (pure TxTotalCollateralNone) - (\w -> TxTotalCollateral w <$> genPositiveCoin) + (\w -> TxTotalCollateral w <$> genPositiveLovelace) genTxFee :: ShelleyBasedEra era -> Gen (TxFee era) -genTxFee w = TxFeeExplicit w <$> genCoin +genTxFee w = TxFeeExplicit w <$> genLovelace genAddressInEraByron :: Gen (AddressInEra ByronEra) genAddressInEraByron = byronAddressInEra <$> genAddressByron @@ -752,7 +752,7 @@ genTxByron = do <*> genTxBodyByron genTxOutValueByron :: Gen (TxOutValue ByronEra) -genTxOutValueByron = TxOutValueByron <$> genPositiveCoin +genTxOutValueByron = TxOutValueByron <$> genPositiveLovelace genTxOutByron :: Gen (TxOut CtxTx ByronEra) genTxOutByron = @@ -979,12 +979,12 @@ genProtocolParameters era = do protocolParamMaxBlockHeaderSize <- genNat protocolParamMaxBlockBodySize <- genNat protocolParamMaxTxSize <- genNat - protocolParamTxFeeFixed <- genCoin - protocolParamTxFeePerByte <- genCoin - protocolParamMinUTxOValue <- Gen.maybe genCoin - protocolParamStakeAddressDeposit <- genCoin - protocolParamStakePoolDeposit <- genCoin - protocolParamMinPoolCost <- genCoin + protocolParamTxFeeFixed <- genLovelace + protocolParamTxFeePerByte <- genLovelace + protocolParamMinUTxOValue <- Gen.maybe genLovelace + protocolParamStakeAddressDeposit <- genLovelace + protocolParamStakePoolDeposit <- genLovelace + protocolParamMinPoolCost <- genLovelace protocolParamPoolRetireMaxEpoch <- genEpochInterval protocolParamStakePoolTargetNum <- genNat protocolParamPoolPledgeInfluence <- genRationalInt64 @@ -1000,7 +1000,7 @@ genProtocolParameters era = do protocolParamCollateralPercent <- Gen.maybe genNat protocolParamMaxCollateralInputs <- Gen.maybe genNat protocolParamUTxOCostPerByte <- - inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genCoin)) era + inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genLovelace)) era pure ProtocolParameters{..} @@ -1016,12 +1016,12 @@ genProtocolParametersUpdate era = do protocolUpdateMaxBlockHeaderSize <- Gen.maybe genWord16 protocolUpdateMaxBlockBodySize <- Gen.maybe genWord32 protocolUpdateMaxTxSize <- Gen.maybe genWord32 - protocolUpdateTxFeeFixed <- Gen.maybe genCoin - protocolUpdateTxFeePerByte <- Gen.maybe genCoin - protocolUpdateMinUTxOValue <- Gen.maybe genCoin - protocolUpdateStakeAddressDeposit <- Gen.maybe genCoin - protocolUpdateStakePoolDeposit <- Gen.maybe genCoin - protocolUpdateMinPoolCost <- Gen.maybe genCoin + protocolUpdateTxFeeFixed <- Gen.maybe genLovelace + protocolUpdateTxFeePerByte <- Gen.maybe genLovelace + protocolUpdateMinUTxOValue <- Gen.maybe genLovelace + protocolUpdateStakeAddressDeposit <- Gen.maybe genLovelace + protocolUpdateStakePoolDeposit <- Gen.maybe genLovelace + protocolUpdateMinPoolCost <- Gen.maybe genLovelace protocolUpdatePoolRetireMaxEpoch <- Gen.maybe genEpochInterval protocolUpdateStakePoolTargetNum <- Gen.maybe genNat protocolUpdatePoolPledgeInfluence <- Gen.maybe genRationalInt64 @@ -1037,7 +1037,7 @@ genProtocolParametersUpdate era = do protocolUpdateCollateralPercent <- Gen.maybe genNat protocolUpdateMaxCollateralInputs <- Gen.maybe genNat protocolUpdateUTxOCostPerByte <- - inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genCoin)) era + inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genLovelace)) era pure ProtocolParametersUpdate{..} From 268837c53bdd6083c1dc7b2b379bdae0d66ce291 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Mon, 12 Aug 2024 09:55:29 +0200 Subject: [PATCH 3/4] Add Lovelace type synonym to Coin, to mitigate earlier API change + remove internal function --- cardano-api/internal/Cardano/Api/Value.hs | 9 +++++---- cardano-api/src/Cardano/Api.hs | 1 + 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index 10e0a1e45c..0f97c613cc 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -27,6 +27,7 @@ module Cardano.Api.Value , calcMinimumDeposit -- ** Ada \/ L.Coin specifically + , Lovelace , quantityToLovelace , lovelaceToQuantity , selectLovelace @@ -118,6 +119,9 @@ newtype Quantity = Quantity Integer deriving stock Data deriving newtype (Eq, Ord, Num, Show, ToJSON, FromJSON) +-- | A 'Coin' is a Lovelace. +type Lovelace = L.Coin + instance Semigroup Quantity where Quantity a <> Quantity b = Quantity (a + b) @@ -249,9 +253,6 @@ selectLovelace = quantityToLovelace . flip selectAsset AdaAssetId lovelaceToValue :: L.Coin -> Value lovelaceToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity -coinToValue :: L.Coin -> Value -coinToValue = lovelaceToValue -- jky - -- | Check if the 'Value' consists of /only/ 'L.Coin' and no other assets, -- and if so then return the L.Coin. -- @@ -286,7 +287,7 @@ toLedgerValue w = maryEraOnwardsConstraints w toMaryValue fromLedgerValue :: ShelleyBasedEra era -> L.Value (ShelleyLedgerEra era) -> Value fromLedgerValue sbe v = caseShelleyToAllegraOrMaryEraOnwards - (const (coinToValue v)) + (const (lovelaceToValue v)) (const (fromMaryValue v)) sbe diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index b65e353e70..4734c220c9 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -248,6 +248,7 @@ module Cardano.Api , fromLedgerValue -- ** Ada \/ Lovelace within multi-asset values + , Lovelace , quantityToLovelace , lovelaceToQuantity , selectLovelace From d673f8cd4fa914b9a3abca787718127103938182 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Tue, 13 Aug 2024 10:30:26 +0200 Subject: [PATCH 4/4] Use Lovelace type synonym in prototypes of functions in Value.hs --- cardano-api/internal/Cardano/Api/Value.hs | 24 +++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index 0f97c613cc..695cfe7ec5 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -99,16 +99,16 @@ import qualified Data.Text.Encoding as Text import GHC.Exts (IsList (..)) import Lens.Micro ((%~)) -toByronLovelace :: L.Coin -> Maybe Byron.Lovelace +toByronLovelace :: Lovelace -> Maybe Byron.Lovelace toByronLovelace (L.Coin x) = case Byron.integerToLovelace x of Left _ -> Nothing Right x' -> Just x' -fromByronLovelace :: Byron.Lovelace -> L.Coin +fromByronLovelace :: Byron.Lovelace -> Lovelace fromByronLovelace = L.Coin . Byron.lovelaceToInteger -fromShelleyDeltaLovelace :: L.DeltaCoin -> L.Coin +fromShelleyDeltaLovelace :: L.DeltaCoin -> Lovelace fromShelleyDeltaLovelace (L.DeltaCoin d) = L.Coin d -- ---------------------------------------------------------------------------- @@ -128,10 +128,10 @@ instance Semigroup Quantity where instance Monoid Quantity where mempty = Quantity 0 -lovelaceToQuantity :: L.Coin -> Quantity +lovelaceToQuantity :: Lovelace -> Quantity lovelaceToQuantity (L.Coin x) = Quantity x -quantityToLovelace :: Quantity -> L.Coin +quantityToLovelace :: Quantity -> Lovelace quantityToLovelace (Quantity x) = L.Coin x newtype PolicyId = PolicyId {unPolicyId :: ScriptHash} @@ -247,18 +247,18 @@ negateLedgerValue sbe v = filterValue :: (AssetId -> Bool) -> Value -> Value filterValue p (Value m) = Value (Map.filterWithKey (\k _v -> p k) m) -selectLovelace :: Value -> L.Coin +selectLovelace :: Value -> Lovelace selectLovelace = quantityToLovelace . flip selectAsset AdaAssetId -lovelaceToValue :: L.Coin -> Value +lovelaceToValue :: Lovelace -> Value lovelaceToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity --- | Check if the 'Value' consists of /only/ 'L.Coin' and no other assets, --- and if so then return the L.Coin. +-- | Check if the 'Value' consists of /only/ 'Lovelace' and no other assets, +-- and if so then return the Lovelace -- --- See also 'selectLovelace' to select the L.Coin quantity from the Value, +-- See also 'selectLovelace' to select the Lovelace quantity from the Value, -- ignoring other assets. -valueToLovelace :: Value -> Maybe L.Coin +valueToLovelace :: Value -> Maybe Lovelace valueToLovelace v = case valueToList v of [] -> Just (L.Coin 0) @@ -309,7 +309,7 @@ fromMaryValue (MaryValue (L.Coin lovelace) other) = -- | Calculate cost of making a UTxO entry for a given 'Value' and -- mininimum UTxO value derived from the 'ProtocolParameters' -calcMinimumDeposit :: Value -> L.Coin -> L.Coin +calcMinimumDeposit :: Value -> Lovelace -> Lovelace calcMinimumDeposit v = Mary.scaledMinDeposit (toMaryValue v)