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{..} 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..695cfe7ec5 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -27,15 +27,11 @@ module Cardano.Api.Value , calcMinimumDeposit -- ** Ada \/ L.Coin specifically - , quantityToCoin + , Lovelace , quantityToLovelace - , coinToQuantity , lovelaceToQuantity - , selectCoin , selectLovelace - , coinToValue , lovelaceToValue - , valueToCoin , valueToLovelace -- ** Alternative nested representation @@ -103,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 -- ---------------------------------------------------------------------------- @@ -123,25 +119,20 @@ 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) instance Monoid Quantity where mempty = Quantity 0 -{-# DEPRECATED lovelaceToQuantity "Use 'coinToQuantity' instead." #-} -lovelaceToQuantity :: L.Coin -> Quantity -lovelaceToQuantity = coinToQuantity - -coinToQuantity :: L.Coin -> Quantity -coinToQuantity (L.Coin x) = Quantity x - -{-# DEPRECATED quantityToLovelace "Use 'quantityToCoin' instead." #-} -quantityToLovelace :: Quantity -> L.Coin -quantityToLovelace = quantityToCoin +lovelaceToQuantity :: Lovelace -> Quantity +lovelaceToQuantity (L.Coin x) = Quantity x -quantityToCoin :: Quantity -> L.Coin -quantityToCoin (Quantity x) = L.Coin x +quantityToLovelace :: Quantity -> Lovelace +quantityToLovelace (Quantity x) = L.Coin x newtype PolicyId = PolicyId {unPolicyId :: ScriptHash} deriving stock (Eq, Ord) @@ -256,31 +247,19 @@ 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 - -{-# DEPRECATED lovelaceToValue "Use 'coinToValue' instead." #-} -lovelaceToValue :: L.Coin -> Value -lovelaceToValue = coinToValue - -coinToValue :: L.Coin -> Value -coinToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity +selectLovelace :: Value -> Lovelace +selectLovelace = quantityToLovelace . flip selectAsset AdaAssetId -{-# DEPRECATED valueToLovelace "Use 'valueToCoin' instead." #-} -valueToLovelace :: Value -> Maybe L.Coin -valueToLovelace = valueToCoin +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 'selectCoin' to select the L.Coin quantity from the Value, +-- See also 'selectLovelace' to select the Lovelace quantity from the Value, -- ignoring other assets. -valueToCoin :: Value -> Maybe L.Coin -valueToCoin v = +valueToLovelace :: Value -> Maybe Lovelace +valueToLovelace v = case valueToList v of [] -> Just (L.Coin 0) [(AdaAssetId, q)] -> Just (quantityToLovelace q) @@ -308,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 @@ -330,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) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 7b73c22c81..4734c220c9 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -248,15 +248,11 @@ module Cardano.Api , fromLedgerValue -- ** Ada \/ Lovelace within multi-asset values - , quantityToCoin + , Lovelace , quantityToLovelace - , coinToQuantity , lovelaceToQuantity - , selectCoin , selectLovelace - , coinToValue , lovelaceToValue - , valueToCoin , valueToLovelace -- * Blocks