From 31e67e2105a673b8a20cb317b987b96bfb97b374 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Thu, 8 Aug 2024 11:12:07 +0200 Subject: [PATCH 1/2] generators: Lovelace->Coin --- 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 0f1be0bb23..839748f4d2 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -93,8 +93,8 @@ module Test.Gen.Cardano.Api.Typed , genTxInsReference , genTxMetadataInEra , genTxMintValue - , genLovelace - , genPositiveLovelace + , genCoin + , genPositiveCoin , genValue , genValueDefault , genVerificationKey @@ -197,11 +197,11 @@ _genAddressInEraByron = byronAddressInEra <$> genAddressByron genKESPeriod :: Gen KESPeriod genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded -genLovelace :: Gen L.Coin -genLovelace = L.Coin <$> Gen.integral (Range.linear 0 5000) +genCoin :: Gen L.Coin +genCoin = L.Coin <$> Gen.integral (Range.linear 0 5000) -genPositiveLovelace :: Gen L.Coin -genPositiveLovelace = L.Coin <$> Gen.integral (Range.linear 1 5000) +genPositiveCoin :: Gen L.Coin +genPositiveCoin = L.Coin <$> Gen.integral (Range.linear 1 5000) ---------------------------------------------------------------------------- -- SimpleScript generators @@ -631,7 +631,7 @@ genStakeAddressRequirements = ) ( \w -> StakeAddrRegistrationConway w - <$> genLovelace + <$> genCoin <*> genStakeCredential ) @@ -736,10 +736,10 @@ genTxTotalCollateral :: CardanoEra era -> Gen (TxTotalCollateral era) genTxTotalCollateral = inEonForEra (pure TxTotalCollateralNone) - (\w -> TxTotalCollateral w <$> genPositiveLovelace) + (\w -> TxTotalCollateral w <$> genPositiveCoin) genTxFee :: ShelleyBasedEra era -> Gen (TxFee era) -genTxFee w = TxFeeExplicit w <$> genLovelace +genTxFee w = TxFeeExplicit w <$> genCoin genAddressInEraByron :: Gen (AddressInEra ByronEra) genAddressInEraByron = byronAddressInEra <$> genAddressByron @@ -751,7 +751,7 @@ genTxByron = do <*> genTxBodyByron genTxOutValueByron :: Gen (TxOutValue ByronEra) -genTxOutValueByron = TxOutValueByron <$> genPositiveLovelace +genTxOutValueByron = TxOutValueByron <$> genPositiveCoin genTxOutByron :: Gen (TxOut CtxTx ByronEra) genTxOutByron = @@ -964,12 +964,12 @@ genProtocolParameters era = do protocolParamMaxBlockHeaderSize <- genNat protocolParamMaxBlockBodySize <- genNat protocolParamMaxTxSize <- genNat - protocolParamTxFeeFixed <- genLovelace - protocolParamTxFeePerByte <- genLovelace - protocolParamMinUTxOValue <- Gen.maybe genLovelace - protocolParamStakeAddressDeposit <- genLovelace - protocolParamStakePoolDeposit <- genLovelace - protocolParamMinPoolCost <- genLovelace + protocolParamTxFeeFixed <- genCoin + protocolParamTxFeePerByte <- genCoin + protocolParamMinUTxOValue <- Gen.maybe genCoin + protocolParamStakeAddressDeposit <- genCoin + protocolParamStakePoolDeposit <- genCoin + protocolParamMinPoolCost <- genCoin protocolParamPoolRetireMaxEpoch <- genEpochInterval protocolParamStakePoolTargetNum <- genNat protocolParamPoolPledgeInfluence <- genRationalInt64 @@ -985,7 +985,7 @@ genProtocolParameters era = do protocolParamCollateralPercent <- Gen.maybe genNat protocolParamMaxCollateralInputs <- Gen.maybe genNat protocolParamUTxOCostPerByte <- - inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genLovelace)) era + inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genCoin)) era pure ProtocolParameters{..} @@ -1001,12 +1001,12 @@ genProtocolParametersUpdate era = do protocolUpdateMaxBlockHeaderSize <- Gen.maybe genWord16 protocolUpdateMaxBlockBodySize <- Gen.maybe genWord32 protocolUpdateMaxTxSize <- Gen.maybe genWord32 - protocolUpdateTxFeeFixed <- Gen.maybe genLovelace - protocolUpdateTxFeePerByte <- Gen.maybe genLovelace - protocolUpdateMinUTxOValue <- Gen.maybe genLovelace - protocolUpdateStakeAddressDeposit <- Gen.maybe genLovelace - protocolUpdateStakePoolDeposit <- Gen.maybe genLovelace - protocolUpdateMinPoolCost <- Gen.maybe genLovelace + protocolUpdateTxFeeFixed <- Gen.maybe genCoin + protocolUpdateTxFeePerByte <- Gen.maybe genCoin + protocolUpdateMinUTxOValue <- Gen.maybe genCoin + protocolUpdateStakeAddressDeposit <- Gen.maybe genCoin + protocolUpdateStakePoolDeposit <- Gen.maybe genCoin + protocolUpdateMinPoolCost <- Gen.maybe genCoin protocolUpdatePoolRetireMaxEpoch <- Gen.maybe genEpochInterval protocolUpdateStakePoolTargetNum <- Gen.maybe genNat protocolUpdatePoolPledgeInfluence <- Gen.maybe genRationalInt64 @@ -1022,7 +1022,7 @@ genProtocolParametersUpdate era = do protocolUpdateCollateralPercent <- Gen.maybe genNat protocolUpdateMaxCollateralInputs <- Gen.maybe genNat protocolUpdateUTxOCostPerByte <- - inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genLovelace)) era + inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genCoin)) era pure ProtocolParametersUpdate{..} From 3611d79a7d63857e1839f143aa65e37480d345ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Thu, 8 Aug 2024 11:17:13 +0200 Subject: [PATCH 2/2] Value: deprecate some Lovelace functions. Advice to use Coin name instead. --- 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, 41 insertions(+), 14 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 654ae049d4..032cabb100 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -272,7 +272,7 @@ estimateBalancedTxBody availableUTxOValue = mconcat [ totalUTxOValue - , negateValue (lovelaceToValue totalDeposits) + , negateValue (coinToValue totalDeposits) ] let change = toLedgerValue w $ calculateChangeValue sbe availableUTxOValue txbodycontent1 @@ -341,7 +341,7 @@ estimateBalancedTxBody , txTotalCollateral = reqCol } - let fakeUTxO = createFakeUTxO sbe txbodycontent1 $ selectLovelace availableUTxOValue + let fakeUTxO = createFakeUTxO sbe txbodycontent1 $ selectCoin 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 f1fc18bb83..3ef72fe1b8 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -952,7 +952,7 @@ txOutValueToLovelace tv = txOutValueToValue :: TxOutValue era -> Value txOutValueToValue tv = case tv of - TxOutValueByron l -> lovelaceToValue l + TxOutValueByron l -> coinToValue l TxOutValueShelleyBased sbe v -> fromLedgerValue sbe v prettyRenderTxOut :: TxOutInAnyEra -> Text @@ -1683,7 +1683,7 @@ validateMintValue :: TxMintValue build era -> Either TxBodyError () validateMintValue txMintValue = case txMintValue of TxMintNone -> return () - TxMintValue _ v _ -> guard (selectLovelace v == 0) ?! TxBodyMintAdaError + TxMintValue _ v _ -> guard (selectCoin v == 0) ?! TxBodyMintAdaError inputIndexDoesNotExceedMax :: [(TxIn, a)] -> Either TxBodyError () inputIndexDoesNotExceedMax txIns = @@ -2171,8 +2171,8 @@ classifyRangeError :: TxOut CtxTx ByronEra -> TxBodyError classifyRangeError txout = case txout of TxOut (AddressInEra ByronAddressInAnyEra ByronAddress{}) (TxOutValueByron value) _ _ - | value < 0 -> TxBodyOutputNegative (lovelaceToQuantity value) (txOutInAnyEra ByronEra txout) - | otherwise -> TxBodyOutputOverflow (lovelaceToQuantity value) (txOutInAnyEra ByronEra txout) + | value < 0 -> TxBodyOutputNegative (coinToQuantity value) (txOutInAnyEra ByronEra txout) + | otherwise -> TxBodyOutputOverflow (coinToQuantity 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 10e0a1e45c..1b26bba494 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -27,10 +27,15 @@ module Cardano.Api.Value , calcMinimumDeposit -- ** Ada \/ L.Coin specifically + , quantityToCoin , quantityToLovelace + , coinToQuantity , lovelaceToQuantity + , selectCoin , selectLovelace + , coinToValue , lovelaceToValue + , valueToCoin , valueToLovelace -- ** Alternative nested representation @@ -124,11 +129,19 @@ instance Semigroup Quantity where instance Monoid Quantity where mempty = Quantity 0 +{-# DEPRECATED lovelaceToQuantity "Use 'coinToQuantity' instead." #-} lovelaceToQuantity :: L.Coin -> Quantity -lovelaceToQuantity (L.Coin x) = Quantity x +lovelaceToQuantity = coinToQuantity +coinToQuantity :: L.Coin -> Quantity +coinToQuantity (L.Coin x) = Quantity x + +{-# DEPRECATED quantityToLovelace "Use 'quantityToCoin' instead." #-} quantityToLovelace :: Quantity -> L.Coin -quantityToLovelace (Quantity x) = L.Coin x +quantityToLovelace = quantityToCoin + +quantityToCoin :: Quantity -> L.Coin +quantityToCoin (Quantity x) = L.Coin x newtype PolicyId = PolicyId {unPolicyId :: ScriptHash} deriving stock (Eq, Ord) @@ -243,22 +256,31 @@ 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 = quantityToLovelace . flip selectAsset AdaAssetId +selectLovelace = selectCoin + +selectCoin :: Value -> L.Coin +selectCoin = quantityToLovelace . flip selectAsset AdaAssetId +{-# DEPRECATED lovelaceToValue "Use 'coinToValue' instead." #-} lovelaceToValue :: L.Coin -> Value -lovelaceToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity +lovelaceToValue = coinToValue coinToValue :: L.Coin -> Value -coinToValue = lovelaceToValue -- jky +coinToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity + +{-# DEPRECATED valueToLovelace "Use 'valueToCoin' instead." #-} +valueToLovelace :: Value -> Maybe L.Coin +valueToLovelace = valueToCoin -- | Check if the 'Value' consists of /only/ 'L.Coin' and no other assets, -- and if so then return the L.Coin. -- --- See also 'selectLovelace' to select the L.Coin quantity from the Value, +-- See also 'selectCoin' to select the L.Coin quantity from the Value, -- ignoring other assets. -valueToLovelace :: Value -> Maybe L.Coin -valueToLovelace v = +valueToCoin :: Value -> Maybe L.Coin +valueToCoin 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 0baabb2da8..406af60a49 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -247,10 +247,15 @@ module Cardano.Api , fromLedgerValue -- ** Ada \/ Lovelace within multi-asset values + , quantityToCoin , quantityToLovelace + , coinToQuantity , lovelaceToQuantity + , selectCoin , selectLovelace + , coinToValue , lovelaceToValue + , valueToCoin , valueToLovelace -- * Blocks