diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 4697234943b..feaa4dff16e 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -52,11 +52,14 @@ library , cardano-crypto-class , cardano-crypto-test , cardano-numeric - , cardano-ledger-core + , cardano-ledger-alonzo + , cardano-ledger-alonzo-test + , cardano-ledger-babbage , cardano-ledger-byron-test - , cardano-ledger-shelley-test + , cardano-ledger-core , cardano-ledger-shelley - , cardano-ledger-alonzo + , cardano-ledger-shelley-ma + , cardano-ledger-shelley-test , cardano-slotting , cborg , containers @@ -251,6 +254,8 @@ library Cardano.Wallet.Primitive.Types.Address Cardano.Wallet.Primitive.Types.Coin Cardano.Wallet.Primitive.Types.Hash + Cardano.Wallet.Primitive.Types.MinimumUTxO + Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen Cardano.Wallet.Primitive.Types.Redeemer Cardano.Wallet.Primitive.Types.RewardAccount Cardano.Wallet.Primitive.Types.TokenBundle diff --git a/lib/core/src/Cardano/Api/Gen.hs b/lib/core/src/Cardano/Api/Gen.hs index 35767727055..cd4513b8c3b 100644 --- a/lib/core/src/Cardano/Api/Gen.hs +++ b/lib/core/src/Cardano/Api/Gen.hs @@ -9,7 +9,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cardano.Api.Gen - ( genAddressByron + ( genAddressAny + , genAddressByron , genAddressInEra , genAddressShelley , genAlphaNum @@ -860,6 +861,14 @@ genPaymentCredential = byScript :: Gen PaymentCredential byScript = PaymentCredentialByScript <$> genScriptHash +genAddressAny :: Gen AddressAny +genAddressAny = oneof + [ AddressByron + <$> genAddressByron + , AddressShelley + <$> genAddressShelley + ] + genAddressByron :: Gen (Address ByronAddr) genAddressByron = makeByronAddress <$> genNetworkId <*> genVerificationKey AsByronKey diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 95518e4cf57..951cb368c11 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -308,7 +308,6 @@ import Cardano.Wallet.Primitive.Types , EpochNo (..) , ExecutionUnitPrices (..) , GenesisParameters (..) - , MinimumUTxOValue (..) , NetworkParameters (..) , NonWalletCertificate (..) , PoolId (..) @@ -1129,11 +1128,8 @@ toApiNetworkParameters (NetworkParameters gp sp pp) txConstraints toEpochInfo = $ getDecentralizationLevel $ view #decentralizationLevel pp , desiredPoolNumber = view #desiredNumberOfStakePools pp - , minimumUtxoValue = toApiCoin $ case (view #minimumUTxOvalue pp) of - MinimumUTxOValue c -> - c - MinimumUTxOValueCostPerWord _perWord -> - txOutputMinimumAdaQuantity txConstraints TokenMap.empty + , minimumUtxoValue = toApiCoin $ + txOutputMinimumAdaQuantity txConstraints TokenMap.empty , eras = apiEras , maximumCollateralInputCount = view #maximumCollateralInputCount pp diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 5e5866f0bd3..6fba60db82b 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -72,7 +72,6 @@ module Cardano.Wallet.Primitive.Types , GenesisParameters (..) , SlottingParameters (..) , ProtocolParameters (..) - , MinimumUTxOValue (..) , TxParameters (..) , TokenBundleMaxSize (..) , EraInfo (..) @@ -181,6 +180,8 @@ import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..), hashFromText ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount (..) ) import Cardano.Wallet.Primitive.Types.Tx @@ -1081,23 +1082,6 @@ instance Buildable (EraInfo EpochNo) where boundF (Just e) = " from " <> build e boundF Nothing = " " -data MinimumUTxOValue - -- | In Shelley, tx outputs could only be created if they were larger than - -- this `MinimumUTxOValue`. - = MinimumUTxOValue Coin - - -- | With Alonzo, `MinimumUTxOValue` is replaced by an ada-cost per word of - -- the output. Note that the alonzo ledger assumes fixed sizes for address - -- and coin, so the size is not the serialized size exactly. - | MinimumUTxOValueCostPerWord Coin - deriving (Eq, Generic, Show) - -instance NFData MinimumUTxOValue - -instance Buildable MinimumUTxOValue where - build (MinimumUTxOValue c) = "constant " <> build c - build (MinimumUTxOValueCostPerWord c) = build c <> " per word" - -- | Protocol parameters that can be changed through the update system. -- data ProtocolParameters = ProtocolParameters @@ -1111,9 +1095,9 @@ data ProtocolParameters = ProtocolParameters :: Word16 -- ^ The current desired number of stakepools in the network. -- Also known as k parameter. - , minimumUTxOvalue - :: MinimumUTxOValue - -- ^ The minimum UTxO value. + , minimumUTxO + :: MinimumUTxO + -- ^ Represents a way of calculating minimum UTxO values. , stakeKeyDeposit :: Coin -- ^ Registering a stake key requires storage on the node and as such @@ -1151,7 +1135,7 @@ instance NFData ProtocolParameters where [ rnf decentralizationLevel , rnf txParameters , rnf desiredNumberOfStakePools - , rnf minimumUTxOvalue + , rnf minimumUTxO , rnf stakeKeyDeposit , rnf eras , rnf maximumCollateralInputCount @@ -1162,13 +1146,18 @@ instance NFData ProtocolParameters where instance Buildable ProtocolParameters where build pp = blockListF' "" id - [ "Decentralization level: " <> build (pp ^. #decentralizationLevel) - , "Transaction parameters: " <> build (pp ^. #txParameters) - , "Desired number of pools: " <> build (pp ^. #desiredNumberOfStakePools) - , "Minimum UTxO value: " <> build (pp ^. #minimumUTxOvalue) - , "Eras:\n" <> indentF 2 (build (pp ^. #eras)) - , "Execution unit prices: " <> - maybe "not specified" build (pp ^. #executionUnitPrices) + [ "Decentralization level: " + <> build (pp ^. #decentralizationLevel) + , "Transaction parameters: " + <> build (pp ^. #txParameters) + , "Desired number of pools: " + <> build (pp ^. #desiredNumberOfStakePools) + , "Minimum UTxO: " + <> build (pp ^. #minimumUTxO) + , "Eras:\n" + <> indentF 2 (build (pp ^. #eras)) + , "Execution unit prices: " + <> maybe "not specified" build (pp ^. #executionUnitPrices) ] data ExecutionUnits = ExecutionUnits diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs new file mode 100644 index 00000000000..0da512278e0 --- /dev/null +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} + +-- | +-- Copyright: © 2022 IOHK +-- License: Apache-2.0 +-- +-- Defines the 'MinimumUTxO' type and related functions. +-- +module Cardano.Wallet.Primitive.Types.MinimumUTxO + ( + -- * Types + MinimumUTxO (..) + , MinimumUTxOForShelleyBasedEra (..) + + -- * Constructor functions + , minimumUTxONone + , minimumUTxOConstant + , minimumUTxOForShelleyBasedEra + ) + where + +import Prelude + +import Cardano.Api.Shelley + ( ShelleyBasedEra, ShelleyLedgerEra, fromLedgerPParams ) +import Cardano.Ledger.Core + ( PParams ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin ) +import Control.DeepSeq + ( NFData (..) ) +import Data.Function + ( on ) +import Fmt + ( Buildable (..), blockListF ) + +-------------------------------------------------------------------------------- +-- The 'MinimumUTxO' type +-------------------------------------------------------------------------------- + +-- | Represents a function for computing minimum UTxO values. +-- +data MinimumUTxO where + MinimumUTxONone + :: MinimumUTxO + -- ^ Indicates that there is no minimum UTxO value. + MinimumUTxOConstant + :: Coin + -> MinimumUTxO + -- ^ Indicates a constant minimum UTxO value. This constructor is + -- useful for writing tests, where we often want to have precise + -- control over the value that is chosen. + MinimumUTxOForShelleyBasedEraOf + :: MinimumUTxOForShelleyBasedEra + -> MinimumUTxO + -- ^ Indicates a Shelley-based era-specific minimum UTxO function. + +instance Buildable MinimumUTxO where + build = \case + MinimumUTxONone -> + "MinimumUTxONone" + MinimumUTxOConstant c -> blockListF + [ "MinimumUTxOConstant" + , build c + ] + MinimumUTxOForShelleyBasedEraOf m -> blockListF + [ "MinimumUTxOForShelleyBasedEra" + , build m + ] + +instance Eq MinimumUTxO where + (==) = (==) `on` show + +instance NFData MinimumUTxO where + rnf = \case + MinimumUTxONone -> + rnf () + MinimumUTxOConstant c -> + rnf c + MinimumUTxOForShelleyBasedEraOf pp -> + rnf pp + +instance Show MinimumUTxO where + show = \case + MinimumUTxONone -> + "MinimumUTxONone" + MinimumUTxOConstant c -> unwords + [ "MinimumUTxOConstant" + , show c + ] + MinimumUTxOForShelleyBasedEraOf pp -> unwords + [ "MinimumUTxOForShelleyBasedEra" + , show pp + ] + +-------------------------------------------------------------------------------- +-- The 'MinimumUTxOForShelleyBasedEra' type +-------------------------------------------------------------------------------- + +-- | Represents a minimum UTxO function that is specific to a Shelley-based era. +-- +data MinimumUTxOForShelleyBasedEra where + MinimumUTxOForShelleyBasedEra + :: ShelleyBasedEra era + -> PParams (ShelleyLedgerEra era) + -> MinimumUTxOForShelleyBasedEra + +instance Buildable MinimumUTxOForShelleyBasedEra where + build (MinimumUTxOForShelleyBasedEra era _) = blockListF + [ "MinimumUTxOForShelleyBasedEra" + , show era + ] + +instance Eq MinimumUTxOForShelleyBasedEra where + (==) = (==) `on` show + +instance NFData MinimumUTxOForShelleyBasedEra where + rnf (MinimumUTxOForShelleyBasedEra !_ !_) = rnf () + +instance Show MinimumUTxOForShelleyBasedEra where + show (MinimumUTxOForShelleyBasedEra era pp) = unwords + [ show era + , show (fromLedgerPParams era pp) + ] + +-------------------------------------------------------------------------------- +-- Constructor functions +-------------------------------------------------------------------------------- + +minimumUTxONone :: MinimumUTxO +minimumUTxONone = MinimumUTxONone + +minimumUTxOConstant :: Coin -> MinimumUTxO +minimumUTxOConstant = MinimumUTxOConstant + +minimumUTxOForShelleyBasedEra + :: ShelleyBasedEra era + -> PParams (ShelleyLedgerEra era) + -> MinimumUTxO +minimumUTxOForShelleyBasedEra era pp = + MinimumUTxOForShelleyBasedEraOf $ + MinimumUTxOForShelleyBasedEra era pp diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs new file mode 100644 index 00000000000..dee5d7af175 --- /dev/null +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE NumericUnderscores #-} +{- HLINT ignore "Use camelCase" -} + +-- | +-- Copyright: © 2022 IOHK +-- License: Apache-2.0 +-- +-- Defines generators and shrinkers for the 'MinimumUTxO' data type. +-- +module Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen + ( + -- * Generators and shrinkers + genMinimumUTxO + , genMinimumUTxOForShelleyBasedEra + , shrinkMinimumUTxO + , shrinkMinimumUTxOForShelleyBasedEra + + -- * Test protocol parameter values + , testParameter_minUTxOValue_Shelley + , testParameter_minUTxOValue_Allegra + , testParameter_minUTxOValue_Mary + , testParameter_coinsPerUTxOWord_Alonzo + , testParameter_coinsPerUTxOByte_Babbage + ) + where + +import Prelude + +import Cardano.Api + ( ShelleyBasedEra (..) ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.Coin.Gen + ( chooseCoin ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO (..), MinimumUTxOForShelleyBasedEra (..) ) +import Data.Default + ( Default (..) ) +import Data.Semigroup + ( stimes ) +import Test.QuickCheck + ( Gen, chooseInteger, frequency, oneof ) + +import qualified Cardano.Ledger.Alonzo.PParams as Alonzo +import qualified Cardano.Ledger.Babbage.PParams as Babbage +import qualified Cardano.Ledger.Coin as Ledger +import qualified Cardano.Ledger.Shelley.PParams as Shelley + +-------------------------------------------------------------------------------- +-- Generating 'MinimumUTxO' values +-------------------------------------------------------------------------------- + +genMinimumUTxO :: Gen MinimumUTxO +genMinimumUTxO = frequency + [ (1, genMinimumUTxONone) + , (1, genMinimumUTxOConstant) + , (8, MinimumUTxOForShelleyBasedEraOf <$> genMinimumUTxOForShelleyBasedEra) + ] + where + genMinimumUTxONone :: Gen MinimumUTxO + genMinimumUTxONone = pure MinimumUTxONone + + genMinimumUTxOConstant :: Gen MinimumUTxO + genMinimumUTxOConstant = MinimumUTxOConstant <$> + -- The 'MinimumUTxOConstant' constructor is only used for testing. + genCoinOfSimilarMagnitude (Coin 1_000_000) + +shrinkMinimumUTxO :: MinimumUTxO -> [MinimumUTxO] +shrinkMinimumUTxO = const [] + +-------------------------------------------------------------------------------- +-- Generating 'MinimumUTxOForShelleyBasedEra' values +-------------------------------------------------------------------------------- + +genMinimumUTxOForShelleyBasedEra + :: Gen MinimumUTxOForShelleyBasedEra +genMinimumUTxOForShelleyBasedEra = oneof + [ genShelley + , genAllegra + , genMary + , genAlonzo + , genBabbage + ] + where + genShelley :: Gen MinimumUTxOForShelleyBasedEra + genShelley = do + minUTxOValue <- genLedgerCoinOfSimilarMagnitude + testParameter_minUTxOValue_Shelley + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraShelley + def {Shelley._minUTxOValue = minUTxOValue} + + genAllegra :: Gen MinimumUTxOForShelleyBasedEra + genAllegra = do + minUTxOValue <- genLedgerCoinOfSimilarMagnitude + testParameter_minUTxOValue_Allegra + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra + def {Shelley._minUTxOValue = minUTxOValue} + + genMary :: Gen MinimumUTxOForShelleyBasedEra + genMary = do + minUTxOValue <- genLedgerCoinOfSimilarMagnitude + testParameter_minUTxOValue_Mary + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraMary + def {Shelley._minUTxOValue = minUTxOValue} + + genAlonzo :: Gen MinimumUTxOForShelleyBasedEra + genAlonzo = do + coinsPerUTxOWord <- genLedgerCoinOfSimilarMagnitude + testParameter_coinsPerUTxOWord_Alonzo + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo + def {Alonzo._coinsPerUTxOWord = coinsPerUTxOWord} + + genBabbage :: Gen MinimumUTxOForShelleyBasedEra + genBabbage = do + coinsPerUTxOByte <- genLedgerCoinOfSimilarMagnitude + testParameter_coinsPerUTxOByte_Babbage + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage + def {Babbage._coinsPerUTxOByte = coinsPerUTxOByte} + +shrinkMinimumUTxOForShelleyBasedEra + :: MinimumUTxOForShelleyBasedEra -> [MinimumUTxOForShelleyBasedEra] +shrinkMinimumUTxOForShelleyBasedEra = const [] + +-------------------------------------------------------------------------------- +-- Test protocol parameter values +-------------------------------------------------------------------------------- + +-- | A test value of the Shelley-era 'minUTxOValue' parameter. +-- +-- Value derived from 'mainnet-shelley-genesis.json'. +-- +testParameter_minUTxOValue_Shelley :: Ledger.Coin +testParameter_minUTxOValue_Shelley = Ledger.Coin 1_000_000 + +-- | A test value of the Allegra-era 'minUTxOValue' parameter. +-- +-- Value derived from 'mainnet-shelley-genesis.json'. +-- +testParameter_minUTxOValue_Allegra :: Ledger.Coin +testParameter_minUTxOValue_Allegra = Ledger.Coin 1_000_000 + +-- | A test value of the Mary-era 'minUTxOValue' parameter. +-- +-- Value derived from 'mainnet-shelley-genesis.json'. +-- +testParameter_minUTxOValue_Mary :: Ledger.Coin +testParameter_minUTxOValue_Mary = Ledger.Coin 1_000_000 + +-- | A test value of the Alonzo-era 'coinsPerUTxOWord' parameter. +-- +-- Value derived from 'mainnet-alonzo-genesis.json'. +-- +testParameter_coinsPerUTxOWord_Alonzo :: Ledger.Coin +testParameter_coinsPerUTxOWord_Alonzo = Ledger.Coin 34_482 + +-- | A test value of the Babbage-era 'coinsPerUTxOByte' parameter. +-- +-- Value derived from 'mainnet-alonzo-genesis.json': +-- >>> 34_482 `div` 8 == 4_310 +-- +testParameter_coinsPerUTxOByte_Babbage :: Ledger.Coin +testParameter_coinsPerUTxOByte_Babbage = Ledger.Coin 4_310 + +-------------------------------------------------------------------------------- +-- Internal functions +-------------------------------------------------------------------------------- + +-- | Chooses a 'Ledger.Coin' value from within the given range. +-- +chooseLedgerCoin :: (Ledger.Coin, Ledger.Coin) -> Gen Ledger.Coin +chooseLedgerCoin (Ledger.Coin lo, Ledger.Coin hi) = + Ledger.Coin <$> chooseInteger (lo, hi) + +-- | Generates a wallet 'Coin' value that has a similar magnitude to the given +-- value. +-- +genCoinOfSimilarMagnitude :: Coin -> Gen Coin +genCoinOfSimilarMagnitude coin = + chooseCoin (mempty, stimes (2 :: Int) coin) + +-- | Generates a 'Ledger.Coin' value that has a similar magnitude to the given +-- value. +-- +genLedgerCoinOfSimilarMagnitude :: Ledger.Coin -> Gen Ledger.Coin +genLedgerCoinOfSimilarMagnitude coin = + chooseLedgerCoin (mempty, stimes (2 :: Int) coin) diff --git a/lib/core/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs b/lib/core/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs index d0d7924de61..22c49202d42 100644 --- a/lib/core/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs +++ b/lib/core/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs @@ -32,7 +32,6 @@ import Cardano.Wallet.Primitive.Types , FeePolicy (..) , GenesisParameters (..) , LinearFunction (..) - , MinimumUTxOValue (..) , NetworkParameters (..) , ProtocolParameters (..) , SlotLength (..) @@ -47,6 +46,8 @@ import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..), mockHash ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO (MinimumUTxONone) ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount (..) ) import Cardano.Wallet.Primitive.Types.Tx @@ -123,7 +124,7 @@ dummyProtocolParameters = ProtocolParameters { decentralizationLevel = minBound , txParameters = dummyTxParameters , desiredNumberOfStakePools = 100 - , minimumUTxOvalue = MinimumUTxOValue $ Coin 0 + , minimumUTxO = MinimumUTxONone , stakeKeyDeposit = Coin 0 , eras = emptyEraInfo , maximumCollateralInputCount = 3 diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs index 76e771240c2..bbff48b6526 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs @@ -94,7 +94,6 @@ import Cardano.Wallet.Primitive.Types , ExecutionUnits (..) , FeePolicy (..) , LinearFunction (LinearFunction) - , MinimumUTxOValue (..) , PoolId (..) , ProtocolParameters (..) , Range (..) @@ -120,6 +119,8 @@ import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..), mockHash ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen + ( genMinimumUTxO, shrinkMinimumUTxO ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle.Gen @@ -684,7 +685,7 @@ instance Arbitrary ProtocolParameters where <@> shrink <:> shrink <:> shrink - <:> shrink + <:> shrinkMinimumUTxO <:> shrink <:> shrink <:> shrink @@ -696,7 +697,7 @@ instance Arbitrary ProtocolParameters where <$> arbitrary <*> arbitrary <*> choose (0, 100) - <*> arbitrary + <*> genMinimumUTxO <*> arbitrary <*> arbitrary <*> genMaximumCollateralInputCount @@ -718,10 +719,6 @@ instance Arbitrary ExecutionUnitPrices where shrink = genericShrink arbitrary = genericArbitrary -instance Arbitrary MinimumUTxOValue where - shrink = genericShrink - arbitrary = genericArbitrary - instance Arbitrary (EraInfo EpochNo) where arbitrary = genericArbitrary shrink = genericShrink diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index 08b5ef2fc28..02fca9476dd 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -62,6 +62,7 @@ library , cborg , containers , contra-tracer + , data-default , directory , extra , filepath @@ -125,6 +126,7 @@ library Cardano.Wallet.Shelley.Launch.Blockfrost Cardano.Wallet.Shelley.Launch.Cluster Cardano.Wallet.Shelley.Logging + Cardano.Wallet.Shelley.MinimumUTxO Cardano.Wallet.Shelley.Network Cardano.Wallet.Shelley.Network.Blockfrost Cardano.Wallet.Shelley.Network.Blockfrost.Conversion @@ -262,17 +264,20 @@ test-suite unit , strict-containers , containers , contra-tracer + , data-default , directory , filepath , fmt , generic-arbitrary , generic-lens + , generics-sop , hspec-core , hspec-golden , iohk-monitoring , time , hspec , hspec-core + , int-cast , memory , MonadRandom , optparse-applicative @@ -280,6 +285,7 @@ test-suite unit , ouroboros-network , cardano-ledger-shelley , plutus-core + , quickcheck-classes , text , text-class , transformers @@ -299,6 +305,7 @@ test-suite unit Cardano.Wallet.Shelley.Compatibility.LedgerSpec Cardano.Wallet.Shelley.LaunchSpec Cardano.Wallet.Shelley.Launch.BlockfrostSpec + Cardano.Wallet.Shelley.MinimumUTxOSpec Cardano.Wallet.Shelley.NetworkSpec Cardano.Wallet.Shelley.Network.BlockfrostSpec Cardano.Wallet.Shelley.TransactionSpec diff --git a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs index 73aad03ffef..2a716a9950b 100644 --- a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs @@ -66,6 +66,8 @@ import Cardano.Crypto ( serializeCborHash ) import Cardano.Crypto.ProtocolMagic ( ProtocolMagicId, unProtocolMagicId ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( minimumUTxONone ) import Cardano.Wallet.Unsafe ( unsafeFromHex ) import Crypto.Hash.Utils @@ -141,7 +143,7 @@ mainnetNetworkParameters = W.NetworkParameters , getMaxExecutionUnits = W.ExecutionUnits 0 0 } , desiredNumberOfStakePools = 0 - , minimumUTxOvalue = W.MinimumUTxOValue $ W.Coin 0 + , minimumUTxO = minimumUTxONone , stakeKeyDeposit = W.Coin 0 , eras = W.emptyEraInfo -- Collateral inputs were not supported or required in Byron: @@ -364,7 +366,7 @@ protocolParametersFromPP eraInfo currentNodeProtocolParameters pp = , getMaxExecutionUnits = W.ExecutionUnits 0 0 } , desiredNumberOfStakePools = 0 - , minimumUTxOvalue = W.MinimumUTxOValue $ W.Coin 0 + , minimumUTxO = minimumUTxONone , stakeKeyDeposit = W.Coin 0 , eras = fromBound <$> eraInfo -- Collateral inputs were not supported or required in Byron: diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index e495433cab8..7aab06cca91 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -8,7 +8,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE QuasiQuotes #-} @@ -87,6 +86,8 @@ module Cardano.Wallet.Shelley.Compatibility , fromCardanoLovelace , rewardAccountFromAddress , fromShelleyPParams + , fromAllegraPParams + , fromMaryPParams , fromAlonzoPParams , fromBabbagePParams , fromLedgerExUnits @@ -220,13 +221,14 @@ import Cardano.Wallet.Primitive.AddressDerivation import Cardano.Wallet.Primitive.Types ( Certificate (..) , ChainPoint (..) - , MinimumUTxOValue (..) , PoolCertificate (..) , PoolRegistrationCertificate (..) , PoolRetirementCertificate (..) , ProtocolParameters (txParameters) , TxParameters (getTokenBundleMaxSize) ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( minimumUTxOForShelleyBasedEra ) import Cardano.Wallet.Primitive.Types.TokenMap ( TokenMap, toNestedList ) import Cardano.Wallet.Primitive.Types.TokenPolicy @@ -317,8 +319,10 @@ import Ouroboros.Consensus.Cardano.Block ( CardanoBlock , CardanoEras , HardForkBlock (..) + , StandardAllegra , StandardAlonzo , StandardBabbage + , StandardMary , StandardShelley ) import Ouroboros.Consensus.HardFork.Combinator.AcrossEras @@ -353,6 +357,7 @@ import qualified Cardano.Byron.Codec.Cbor as CBOR import qualified Cardano.Chain.Common as Byron import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Ledger.Address as SL +import qualified Cardano.Ledger.Allegra as Allegra import qualified Cardano.Ledger.Alonzo as Alonzo import qualified Cardano.Ledger.Alonzo.Data as Alonzo import qualified Cardano.Ledger.Alonzo.Language as Alonzo @@ -371,10 +376,12 @@ import qualified Cardano.Ledger.Core as SL.Core import qualified Cardano.Ledger.Credential as SL import qualified Cardano.Ledger.Crypto as SL import qualified Cardano.Ledger.Era as Ledger.Era +import qualified Cardano.Ledger.Mary as Mary import qualified Cardano.Ledger.Mary.Value as SL import qualified Cardano.Ledger.SafeHash as SafeHash import qualified Cardano.Ledger.Shelley as SL hiding ( Value ) +import qualified Cardano.Ledger.Shelley as Shelley import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.API as SLAPI import qualified Cardano.Ledger.Shelley.BlockChain as SL @@ -416,6 +423,7 @@ import qualified Ouroboros.Consensus.Shelley.Ledger as O import qualified Ouroboros.Consensus.Shelley.Protocol.Abstract as Consensus import qualified Ouroboros.Network.Block as O import qualified Ouroboros.Network.Point as Point + -------------------------------------------------------------------------------- -- -- Chain Parameters @@ -783,10 +791,9 @@ fromMaxSize :: Natural -> Quantity "byte" Word16 fromMaxSize = Quantity . fromIntegral fromShelleyPParams - :: HasCallStack - => W.EraInfo Bound + :: W.EraInfo Bound -> Maybe Cardano.ProtocolParameters - -> SLAPI.PParams era + -> Shelley.PParams StandardShelley -> W.ProtocolParameters fromShelleyPParams eraInfo currentNodeProtocolParameters pp = W.ProtocolParameters @@ -797,8 +804,8 @@ fromShelleyPParams eraInfo currentNodeProtocolParameters pp = maryTokenBundleMaxSize (W.ExecutionUnits 0 0) pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp - , minimumUTxOvalue = - MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraShelley pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo -- Collateral inputs were not supported or required in Shelley: @@ -808,6 +815,56 @@ fromShelleyPParams eraInfo currentNodeProtocolParameters pp = , currentNodeProtocolParameters } +fromAllegraPParams + :: W.EraInfo Bound + -> Maybe Cardano.ProtocolParameters + -> Allegra.PParams StandardAllegra + -> W.ProtocolParameters +fromAllegraPParams eraInfo currentNodeProtocolParameters pp = + W.ProtocolParameters + { decentralizationLevel = + decentralizationLevelFromPParams pp + , txParameters = + txParametersFromPParams + maryTokenBundleMaxSize (W.ExecutionUnits 0 0) pp + , desiredNumberOfStakePools = + desiredNumberOfStakePoolsFromPParams pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra pp + , stakeKeyDeposit = stakeKeyDepositFromPParams pp + , eras = fromBoundToEpochNo <$> eraInfo + -- Collateral inputs were not supported or required in Allegra: + , maximumCollateralInputCount = 0 + , minimumCollateralPercentage = 0 + , executionUnitPrices = Nothing + , currentNodeProtocolParameters + } + +fromMaryPParams + :: W.EraInfo Bound + -> Maybe Cardano.ProtocolParameters + -> Mary.PParams StandardMary + -> W.ProtocolParameters +fromMaryPParams eraInfo currentNodeProtocolParameters pp = + W.ProtocolParameters + { decentralizationLevel = + decentralizationLevelFromPParams pp + , txParameters = + txParametersFromPParams + maryTokenBundleMaxSize (W.ExecutionUnits 0 0) pp + , desiredNumberOfStakePools = + desiredNumberOfStakePoolsFromPParams pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraMary pp + , stakeKeyDeposit = stakeKeyDepositFromPParams pp + , eras = fromBoundToEpochNo <$> eraInfo + -- Collateral inputs were not supported or required in Mary: + , maximumCollateralInputCount = 0 + , minimumCollateralPercentage = 0 + , executionUnitPrices = Nothing + , currentNodeProtocolParameters + } + fromBoundToEpochNo :: Bound -> W.EpochNo fromBoundToEpochNo (Bound _relTime _slotNo (EpochNo e)) = W.EpochNo $ fromIntegral e @@ -828,8 +885,8 @@ fromAlonzoPParams eraInfo currentNodeProtocolParameters pp = pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp - , minimumUTxOvalue = MinimumUTxOValueCostPerWord - . toWalletCoin $ Alonzo._coinsPerUTxOWord pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo , maximumCollateralInputCount = unsafeIntToWord $ @@ -857,8 +914,8 @@ fromBabbagePParams eraInfo currentNodeProtocolParameters pp = pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp - , minimumUTxOvalue = MinimumUTxOValueCostPerWord - . fromByteToWord . toWalletCoin $ Babbage._coinsPerUTxOByte pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo , maximumCollateralInputCount = unsafeIntToWord $ @@ -869,9 +926,6 @@ fromBabbagePParams eraInfo currentNodeProtocolParameters pp = Just $ executionUnitPricesFromPParams pp , currentNodeProtocolParameters } - where - fromByteToWord (W.Coin v) = W.Coin $ 8 * v - -- | Extract the current network decentralization level from the given set of -- protocol parameters. @@ -985,7 +1039,7 @@ localNodeConnectInfo sp net = LocalNodeConnectInfo params net . nodeSocketFile -- | Convert genesis data into blockchain params and an initial set of UTxO fromGenesisData - :: forall e crypto. (Era e, e ~ SL.ShelleyEra crypto) + :: forall e crypto. (e ~ SL.ShelleyEra crypto, crypto ~ StandardCrypto) => ShelleyGenesis e -> [(SL.Addr crypto, SL.Coin)] -> (W.NetworkParameters, W.Block) @@ -1852,7 +1906,7 @@ toCardanoTxOut era = case era of <$> deserialiseFromRawBytes AsByronAddress addr ] - toBabbageTxOut :: HasCallStack => W.TxOut -> Cardano.TxOut ctx _ + toBabbageTxOut :: HasCallStack => W.TxOut -> Cardano.TxOut ctx BabbageEra toBabbageTxOut (W.TxOut (W.Address addr) tokens) = Cardano.TxOut addrInEra diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility/Ledger.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility/Ledger.hs index 8c283abd58a..122e4a702eb 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility/Ledger.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility/Ledger.hs @@ -14,11 +14,8 @@ -- module Cardano.Wallet.Shelley.Compatibility.Ledger ( - -- * Exported ledger functions - computeMinimumAdaQuantity - -- * Conversions from wallet types to ledger specification types - , toLedgerCoin + toLedgerCoin , toLedgerTokenBundle , toLedgerTokenPolicyId , toLedgerTokenName @@ -38,9 +35,6 @@ module Cardano.Wallet.Shelley.Compatibility.Ledger -- types , Convert (..) - -- * Internal functions - , computeMinimumAdaQuantityInternal - ) where import Prelude @@ -51,8 +45,6 @@ import Cardano.Crypto.Hash ( hashFromBytes, hashToBytes ) import Cardano.Ledger.SafeHash ( unsafeMakeSafeHash ) -import Cardano.Wallet.Primitive.Types - ( MinimumUTxOValue (..) ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Coin @@ -61,8 +53,6 @@ import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) -import Cardano.Wallet.Primitive.Types.TokenMap - ( TokenMap ) import Cardano.Wallet.Primitive.Types.TokenPolicy ( TokenName (..), TokenPolicyId (..) ) import Cardano.Wallet.Primitive.Types.TokenQuantity @@ -93,7 +83,6 @@ import Ouroboros.Consensus.Shelley.Eras import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Ledger.Address as Ledger import qualified Cardano.Ledger.Alonzo as Alonzo -import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo import qualified Cardano.Ledger.Babbage as Babbage import qualified Cardano.Ledger.Babbage.TxBody as Babbage @@ -101,41 +90,14 @@ import qualified Cardano.Ledger.Crypto as Ledger import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Mary.Value as Ledger import qualified Cardano.Ledger.Shelley.API as Ledger -import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as Ledger import qualified Cardano.Ledger.ShelleyMA.Timelocks as MA import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap -import qualified Data.ByteString as BS import qualified Data.Map.Strict as Map import qualified Data.Map.Strict.NonEmptyMap as NonEmptyMap import qualified Ouroboros.Network.Block as O --------------------------------------------------------------------------------- --- Public functions --------------------------------------------------------------------------------- - --- | Uses the ledger specification to compute the minimum required ada quantity --- for a token map. --- -computeMinimumAdaQuantity - :: MinimumUTxOValue - -- ^ The absolute minimum ada quantity specified by the protocol. - -> TokenMap - -- ^ The token map to evaluate. - -> Coin - -- ^ The minimum ada quantity for the given token map. -computeMinimumAdaQuantity protocolMinimum m = - -- Note: - -- - -- We assume here that 'computeMinimumAdaQuantityInternal' has the property - -- of being constant w.r.t. to the ada value. Assuming this property holds, - -- it is safe to call it with an ada value of 0. - -- - -- See 'prop_computeMinimumAdaQuantity_agnosticToAdaQuantity'. - -- - computeMinimumAdaQuantityInternal protocolMinimum (TokenBundle (Coin 0) m) - -------------------------------------------------------------------------------- -- Roundtrip conversion between wallet types and ledger specification types -------------------------------------------------------------------------------- @@ -342,54 +304,3 @@ toWalletScript keyrole = fromLedgerScript ActiveUntilSlot $ fromIntegral slot fromLedgerScript (MA.RequireTimeStart (O.SlotNo slot)) = ActiveFromSlot $ fromIntegral slot - --------------------------------------------------------------------------------- --- Internal functions --------------------------------------------------------------------------------- - --- | Uses the ledger specification to compute the minimum required ada quantity --- for a token bundle. --- --- This function is intended to be constant with respect to: --- --- - the ada quantity; --- - the quantities of individual assets. --- --- See the following properties: --- --- - 'prop_computeMinimumAdaQuantity_agnosticToAdaQuantity'; --- - 'prop_computeMinimumAdaQuantity_agnosticToAssetQuantities'. --- --- TODO: [ADP-954] Datum hashes are currently not taken into account. -computeMinimumAdaQuantityInternal - :: MinimumUTxOValue - -- ^ The absolute minimum ada quantity specified by the protocol. - -> TokenBundle - -- ^ The token bundle to evaluate. - -> Coin - -- ^ The minimum ada quantity for the given token bundle. -computeMinimumAdaQuantityInternal (MinimumUTxOValue protocolMinimum) bundle = - toWalletCoin $ - Ledger.scaledMinDeposit - (toLedgerTokenBundle bundle) - (toLedgerCoin protocolMinimum) -computeMinimumAdaQuantityInternal (MinimumUTxOValueCostPerWord (Coin perWord)) bundle = - let - outputSize = Alonzo.utxoEntrySize $ - toAlonzoTxOut (TxOut dummyAddr bundle) Nothing - in - Coin $ fromIntegral outputSize * perWord - where - -- We just need an address the ledger can deserialize. It doesn't actually - -- use the length of it. - -- - -- This should not change (if Alonzo is already in-use, it would have to be - -- changed in a new era). - -- - -- Regardless, the dummy address is a payment / enterprise address -- can't - -- get any shorter than that. The integration tests use longer addresses. - -- They should break if this were to be wrong. - -- - -- Because the ledger function is pure and not taking a network, passing in - -- a mainnet network should be fine regardless of network. - dummyAddr = Address $ BS.pack $ 97 : replicate 28 0 diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs new file mode 100644 index 00000000000..d5ce6f71c1b --- /dev/null +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2022 IOHK +-- License: Apache-2.0 +-- +-- Computing minimum UTxO values. +-- +module Cardano.Wallet.Shelley.MinimumUTxO + ( computeMinimumCoinForUTxO + , maxLengthCoin + , maxLengthAddress + , unsafeLovelaceToWalletCoin + , unsafeValueToLovelace + ) where + +import Prelude + +import Cardano.Wallet.Primitive.Types.Address + ( Address (..) ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO (..), MinimumUTxOForShelleyBasedEra (..) ) +import Cardano.Wallet.Primitive.Types.TokenBundle + ( TokenBundle (..) ) +import Cardano.Wallet.Primitive.Types.TokenMap + ( TokenMap ) +import Cardano.Wallet.Primitive.Types.Tx + ( TxOut (..) ) +import Cardano.Wallet.Shelley.Compatibility + ( toCardanoTxOut ) +import Data.Function + ( (&) ) +import Data.IntCast + ( intCast, intCastMaybe ) +import Data.Word + ( Word64, Word8 ) +import GHC.Stack + ( HasCallStack ) +import Numeric.Natural + ( Natural ) + +import qualified Cardano.Api.Shelley as Cardano +import qualified Data.ByteString as BS + +-- | Computes a minimum 'Coin' value for a 'TokenMap' that is destined for +-- inclusion in a transaction output. +-- +computeMinimumCoinForUTxO :: HasCallStack => MinimumUTxO -> TokenMap -> Coin +computeMinimumCoinForUTxO = \case + MinimumUTxONone -> + const (Coin 0) + MinimumUTxOConstant c -> + const c + MinimumUTxOForShelleyBasedEraOf pp -> + computeMinimumCoinForShelleyBasedEra pp + +-- | Computes a minimum 'Coin' value for a 'TokenMap' that is destined for +-- inclusion in a transaction output. +-- +-- This function returns a value that is specific to a given Shelley-based era. +-- Importantly, a value that is valid in one era will not necessarily be valid +-- in another era. +-- +computeMinimumCoinForShelleyBasedEra + :: HasCallStack + => MinimumUTxOForShelleyBasedEra + -> TokenMap + -> Coin +computeMinimumCoinForShelleyBasedEra + (MinimumUTxOForShelleyBasedEra era pp) tokenMap = + extractResult $ + Cardano.calculateMinimumUTxO era + (embedTokenMapWithinPaddedTxOut era tokenMap) + (Cardano.fromLedgerPParams era pp) + where + extractResult :: Either Cardano.MinimumUTxOError Cardano.Value -> Coin + extractResult = \case + Right value -> + -- We assume that the returned value is a non-negative ada quantity + -- with no other assets. If this assumption is violated, we have no + -- way to continue, and must raise an error: + value + & unsafeValueToLovelace + & unsafeLovelaceToWalletCoin + Left e -> + -- The 'Cardano.calculateMinimumUTxO' function should only return + -- an error if a required protocol parameter is missing. + -- + -- However, given that values of 'MinimumUTxOForShelleyBasedEra' + -- can only be constructed by supplying an era-specific protocol + -- parameters record, it should be impossible to trigger this + -- condition. + -- + -- Any violation of this assumption indicates a programming error. + -- If this condition is triggered, we have no way to continue, and + -- must raise an error: + -- + error $ unwords + [ "computeMinimumCoinForUTxO:" + , "unexpected error:" + , show e + ] + +-- | Embeds a 'TokenMap' within a padded 'Cardano.TxOut' value. +-- +-- When computing the minimum UTxO quantity for a given 'TokenMap', we do not +-- have access to an address or to an ada quantity. +-- +-- However, in order to compute a minimum UTxO quantity through the Cardano +-- API, we must supply a 'TxOut' value with a valid address and ada quantity. +-- +-- It's imperative that we do not underestimate minimum UTxO quantities, as +-- this may result in the creation of transactions that are unacceptable to +-- the ledger. In the case of change generation, this would be particularly +-- problematic, as change outputs are generated automatically, and users do +-- not have direct control over the ada quantities generated. +-- +-- However, while we cannot underestimate minimum UTxO quantities, we are at +-- liberty to moderately overestimate them. +-- +-- Since the minimum UTxO quantity function is monotonically increasing w.r.t. +-- the size of the address and ada quantity, if we supply a 'TxOut' with an +-- address and ada quantity whose serialized lengths are the maximum possible +-- lengths, we can be confident that the resultant value will not be an +-- underestimate. +-- +embedTokenMapWithinPaddedTxOut + :: Cardano.ShelleyBasedEra era + -> TokenMap + -> Cardano.TxOut Cardano.CtxTx era +embedTokenMapWithinPaddedTxOut era m = + toCardanoTxOut era $ TxOut maxLengthAddress $ TokenBundle maxLengthCoin m + +-- | An 'Address' value that is maximal in length when serialized to bytes. +-- +-- When serialized to bytes, this 'Address' value has a length that is greater +-- than or equal to the serialized length of any 'Address' value that is valid +-- for inclusion in a transaction output. +-- +maxLengthAddress :: Address +maxLengthAddress = Address $ BS.pack $ replicate maxAddressLength nullByte + where + maxAddressLength :: Int + maxAddressLength = 57 + + nullByte :: Word8 + nullByte = 0 + +-- | A 'Coin' value that is maximal in length when serialized to bytes. +-- +-- When serialized to bytes, this 'Coin' value has a length that is greater +-- than or equal to the serialized length of any 'Coin' value that is valid +-- for inclusion in a transaction output. +-- +maxLengthCoin :: Coin +maxLengthCoin = Coin $ intCast @Word64 @Natural $ maxBound + +-- | Extracts a 'Coin' value from a 'Cardano.Lovelace' value. +-- +-- Fails with a run-time error if the value is negative. +-- +unsafeLovelaceToWalletCoin :: HasCallStack => Cardano.Lovelace -> Coin +unsafeLovelaceToWalletCoin (Cardano.Lovelace v) = + case intCastMaybe @Integer @Natural v of + Nothing -> error $ unwords + [ "unsafeLovelaceToWalletCoin:" + , "encountered negative value:" + , show v + ] + Just lovelaceNonNegative -> + Coin lovelaceNonNegative + +-- | Extracts a 'Cardano.Lovelace' value from a 'Cardano.Value'. +-- +-- Fails with a run-time error if the 'Cardano.Value' contains any non-ada +-- assets. +-- +unsafeValueToLovelace :: HasCallStack => Cardano.Value -> Cardano.Lovelace +unsafeValueToLovelace v = + case Cardano.valueToLovelace v of + Nothing -> error $ unwords + [ "unsafeValueToLovelace:" + , "encountered value with non-ada assets:" + , show v + ] + Just lovelace -> lovelace diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs index e3bd08a13b5..d632fa6697a 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs @@ -40,6 +40,7 @@ import Cardano.Api , ExecutionUnits (executionMemory, executionSteps) , NetworkId (..) , PlutusScriptVersion (PlutusScriptV1) + , ShelleyBasedEra (ShelleyBasedEraAlonzo) , TxMetadata (TxMetadata) , TxMetadataValue (..) ) @@ -94,7 +95,6 @@ import Cardano.Wallet.Primitive.Types , FeePolicy (LinearFee) , GenesisParameters (..) , LinearFunction (..) - , MinimumUTxOValue (..) , NetworkParameters (..) , PoolId , ProtocolParameters (..) @@ -120,6 +120,8 @@ import Cardano.Wallet.Primitive.Types.Coin ( Coin (Coin, unCoin) ) import Cardano.Wallet.Primitive.Types.Hash ( Hash ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO, minimumUTxOForShelleyBasedEra ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -163,6 +165,8 @@ import Data.Bifunctor ( first ) import Data.Bitraversable ( bitraverse ) +import Data.Default + ( Default (..) ) import Data.Function ( (&) ) import Data.Functor @@ -228,6 +232,8 @@ import UnliftIO.STM import qualified Blockfrost.Client as BF import qualified Cardano.Api.Shelley as Node +import qualified Cardano.Ledger.Alonzo.PParams as Alonzo +import qualified Cardano.Ledger.Coin as Ledger import qualified Cardano.Slotting.Time as ST import qualified Cardano.Wallet.Network.Light as LN import qualified Cardano.Wallet.Primitive.Types.Coin as Coin @@ -785,7 +791,7 @@ fromBlockfrostPP :: NetworkId -> BF.ProtocolParams -> Either BlockfrostError ProtocolParameters -fromBlockfrostPP network BF.ProtocolParams{..} = do +fromBlockfrostPP network pp@BF.ProtocolParams{..} = do decentralizationLevel <- let percentage = mkPercentage $ toRational _protocolParamsDecentralisationParam @@ -813,10 +819,8 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do BF.unQuantity _protocolParamsMaxTxExMem "MaxTxExMem" desiredNumberOfStakePools <- _protocolParamsNOpt "NOpt" - minimumUTxOvalue <- - MinimumUTxOValueCostPerWord . Coin - <$> intCast @_ @Integer _protocolParamsCoinsPerUtxoWord - "CoinsPerUtxoWord" + minimumUTxO <- + getMinimumUTxOFunction pp stakeKeyDeposit <- Coin <$> intCast @_ @Integer _protocolParamsKeyDeposit "KeyDeposit" @@ -930,6 +934,33 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do } , .. } +-- | Selects a minimum UTxO function that is appropriate for the current era. +-- +-- TODO: [ADP-1994] +-- +-- This function is currently hard-wired to select the Alonzo era minimum UTxO +-- function, which computes a result based on the 'coinsPerUTxOWord' protocol +-- parameter. +-- +-- However, the Babbage era will switch to a minimum UTxO function that depends +-- on the 'coinsPerUTxOByte' protocol parameter. +-- +-- We should revise this function so that it's capable of selecting a minimum +-- UTxO function that's appropriate for the current era. +-- +getMinimumUTxOFunction + :: BF.ProtocolParams + -> Either BlockfrostError MinimumUTxO +getMinimumUTxOFunction BF.ProtocolParams {_protocolParamsCoinsPerUtxoWord} = + minimumUTxOForAlonzoEra . Ledger.Coin + <$> intCast @_ @Integer _protocolParamsCoinsPerUtxoWord + "CoinsPerUtxoWord" + where + minimumUTxOForAlonzoEra :: Ledger.Coin -> MinimumUTxO + minimumUTxOForAlonzoEra coinsPerUTxOWord = minimumUTxOForShelleyBasedEra + ShelleyBasedEraAlonzo + def {Alonzo._coinsPerUTxOWord = coinsPerUTxOWord} + eraByEpoch :: NetworkId -> EpochNo -> Either BlockfrostError AnyCardanoEra eraByEpoch networkId epoch = dropWhile ((> epoch) . snd) (reverse (Fixture.eraBoundaries networkId)) & diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs index 4e43455e60f..7b825758b17 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs @@ -78,8 +78,10 @@ import Cardano.Wallet.Primitive.Types.Tx ( SealedTx (..) ) import Cardano.Wallet.Shelley.Compatibility ( StandardCrypto + , fromAllegraPParams , fromAlonzoPParams , fromBabbagePParams + , fromMaryPParams , fromNonMyopicMemberRewards , fromPoint , fromPoolDistr @@ -714,9 +716,9 @@ mkTipSyncClient tr np onPParamsUpdate onInterpreterUpdate onEraUpdate = do <$> LSQry Byron.GetUpdateInterfaceState) (fromShelleyPParams eraBounds ppNode <$> LSQry Shelley.GetCurrentPParams) - (fromShelleyPParams eraBounds ppNode + (fromAllegraPParams eraBounds ppNode <$> LSQry Shelley.GetCurrentPParams) - (fromShelleyPParams eraBounds ppNode + (fromMaryPParams eraBounds ppNode <$> LSQry Shelley.GetCurrentPParams) (fromAlonzoPParams eraBounds ppNode <$> LSQry Shelley.GetCurrentPParams) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs index 5bbae53577d..6618bb9ed4c 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs @@ -178,7 +178,9 @@ import Cardano.Wallet.Shelley.Compatibility , toStakePoolDlgCert ) import Cardano.Wallet.Shelley.Compatibility.Ledger - ( computeMinimumAdaQuantity, toAlonzoTxOut, toBabbageTxOut ) + ( toAlonzoTxOut, toBabbageTxOut ) +import Cardano.Wallet.Shelley.MinimumUTxO + ( computeMinimumCoinForUTxO ) import Cardano.Wallet.Transaction ( AnyScript (..) , DelegationAction (..) @@ -1496,7 +1498,7 @@ txConstraints era protocolParams witnessTag = TxConstraints TokenQuantity $ fromIntegral $ maxBound @Word64 txOutputMinimumAdaQuantity = - computeMinimumAdaQuantity (minimumUTxOvalue protocolParams) + computeMinimumCoinForUTxO (minimumUTxO protocolParams) txRewardWithdrawalCost c = marginalCostOf empty {txRewardWithdrawal = c} diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs index 5a125698689..d2794315c79 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/Compatibility/LedgerSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -10,12 +9,10 @@ module Cardano.Wallet.Shelley.Compatibility.LedgerSpec import Prelude -import Cardano.Wallet.Primitive.Types - ( MinimumUTxOValue (..) ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle - ( Flat (..), TokenBundle ) + ( TokenBundle ) import Cardano.Wallet.Primitive.Types.TokenBundle.Gen ( genTokenBundleSmallRange, shrinkTokenBundleSmallRange ) import Cardano.Wallet.Primitive.Types.TokenPolicy @@ -26,50 +23,20 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity ( TokenQuantity (..) ) import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen ( genTokenQuantityFullRange, shrinkTokenQuantityFullRange ) -import Cardano.Wallet.Primitive.Types.Tx - ( txOutMaxCoin - , txOutMaxTokenQuantity - , txOutMinCoin - , txOutMinTokenQuantity - ) import Cardano.Wallet.Primitive.Types.Tx.Gen - ( genTxOutCoin, genTxOutTokenBundle, shrinkTxOutCoin ) + ( genTxOutCoin, shrinkTxOutCoin ) import Cardano.Wallet.Shelley.Compatibility.Ledger - ( Convert (..), computeMinimumAdaQuantityInternal ) -import Data.Bifunctor - ( second ) + ( Convert (..) ) import Data.Proxy ( Proxy (..) ) import Data.Typeable ( Typeable, typeRep ) -import Data.Word - ( Word64 ) -import Fmt - ( pretty ) import Test.Hspec ( Spec, describe, it, parallel ) import Test.Hspec.Core.QuickCheck ( modifyMaxSuccess ) import Test.QuickCheck - ( Arbitrary (..) - , Blind (..) - , Positive (..) - , Property - , checkCoverage - , conjoin - , counterexample - , cover - , genericShrink - , oneof - , property - , withMaxSuccess - , (=/=) - , (===) - ) - -import qualified Cardano.Wallet.Primitive.Types.Coin as Coin -import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle -import qualified Data.Set as Set + ( Arbitrary (..), property, (===) ) spec :: Spec spec = describe "Cardano.Wallet.Shelley.Compatibility.LedgerSpec" $ @@ -84,161 +51,10 @@ spec = describe "Cardano.Wallet.Shelley.Compatibility.LedgerSpec" $ ledgerRoundtrip $ Proxy @TokenPolicyId ledgerRoundtrip $ Proxy @TokenQuantity - parallel $ describe "Properties for computeMinimumAdaQuantity" $ do - - it "prop_computeMinimumAdaQuantity_forCoin" $ - property prop_computeMinimumAdaQuantity_forCoin - it "prop_computeMinimumAdaQuantity_agnosticToAdaQuantity" $ - property prop_computeMinimumAdaQuantity_agnosticToAdaQuantity - it "prop_computeMinimumAdaQuantity_agnosticToAssetQuantities" $ - property prop_computeMinimumAdaQuantity_agnosticToAssetQuantities - - parallel $ describe "Unit tests for computeMinimumAdaQuantity" $ do - - it "unit_computeMinimumAdaQuantity_emptyBundle" $ - property unit_computeMinimumAdaQuantity_emptyBundle - it "unit_computeMinimumAdaQuantity_fixedSizeBundle_8" $ - property unit_computeMinimumAdaQuantity_fixedSizeBundle_8 - it "unit_computeMinimumAdaQuantity_fixedSizeBundle_64" $ - property unit_computeMinimumAdaQuantity_fixedSizeBundle_64 - it "unit_computeMinimumAdaQuantity_fixedSizeBundle_256" $ - property unit_computeMinimumAdaQuantity_fixedSizeBundle_256 - --------------------------------------------------------------------------------- --- Properties --------------------------------------------------------------------------------- - -prop_computeMinimumAdaQuantity_forCoin - :: MinimumUTxOValue - -> Coin - -> Property -prop_computeMinimumAdaQuantity_forCoin minParam c = - computeMinimumAdaQuantityInternal - minParam - (TokenBundle.fromCoin c) - === expectedMinimumAdaQuantity - where - expectedMinimumAdaQuantity = case minParam of - MinimumUTxOValue c' -> c' - MinimumUTxOValueCostPerWord (Coin x) -> Coin $ x * 29 - -prop_computeMinimumAdaQuantity_agnosticToAdaQuantity - :: Blind TokenBundle - -> MinimumUTxOValue - -> Property -prop_computeMinimumAdaQuantity_agnosticToAdaQuantity - (Blind bundle) minParam = - counterexample counterexampleText $ conjoin - [ compute bundle === compute bundleWithCoinMinimized - , compute bundle === compute bundleWithCoinMaximized - , bundleWithCoinMinimized =/= bundleWithCoinMaximized - ] - where - bundleWithCoinMinimized = TokenBundle.setCoin bundle txOutMinCoin - bundleWithCoinMaximized = TokenBundle.setCoin bundle txOutMaxCoin - compute = computeMinimumAdaQuantityInternal minParam - counterexampleText = unlines - [ "bundle:" - , pretty (Flat bundle) - , "bundle minimized:" - , pretty (Flat bundleWithCoinMinimized) - , "bundle maximized:" - , pretty (Flat bundleWithCoinMaximized) - ] - -prop_computeMinimumAdaQuantity_agnosticToAssetQuantities - :: Blind TokenBundle - -> MinimumUTxOValue - -> Property -prop_computeMinimumAdaQuantity_agnosticToAssetQuantities - (Blind bundle) minVal = - checkCoverage $ - cover 40 (assetCount >= 1) - "Token bundle has at least 1 non-ada asset" $ - cover 20 (assetCount >= 2) - "Token bundle has at least 2 non-ada assets" $ - cover 10 (assetCount >= 4) - "Token bundle has at least 4 non-ada assets" $ - counterexample counterexampleText $ conjoin - [ compute bundle === compute bundleMinimized - , compute bundle === compute bundleMaximized - , assetCount === assetCountMinimized - , assetCount === assetCountMaximized - , if assetCount == 0 - then bundleMinimized === bundleMaximized - else bundleMinimized =/= bundleMaximized - ] - where - assetCount = Set.size $ TokenBundle.getAssets bundle - assetCountMinimized = Set.size $ TokenBundle.getAssets bundleMinimized - assetCountMaximized = Set.size $ TokenBundle.getAssets bundleMaximized - bundleMinimized = bundle `setAllQuantitiesTo` txOutMinTokenQuantity - bundleMaximized = bundle `setAllQuantitiesTo` txOutMaxTokenQuantity - compute = computeMinimumAdaQuantityInternal minVal - setAllQuantitiesTo = flip (adjustAllQuantities . const) - counterexampleText = unlines - [ "bundle:" - , pretty (Flat bundle) - , "bundle minimized:" - , pretty (Flat bundleMinimized) - , "bundle maximized:" - , pretty (Flat bundleMaximized) - ] - --------------------------------------------------------------------------------- --- Unit tests --------------------------------------------------------------------------------- - --- | Creates a test to compute the minimum ada quantity for a token bundle with --- a fixed number of assets, where the expected result is a constant. --- --- Policy identifiers, asset names, token quantities are all allowed to vary. --- -unit_computeMinimumAdaQuantity_fixedSizeBundle - :: TokenBundle - -- ^ Fixed size bundle - -> Coin - -- ^ Expected minimum ada quantity - -> Property -unit_computeMinimumAdaQuantity_fixedSizeBundle bundle expectation = - withMaxSuccess 100 $ - computeMinimumAdaQuantityInternal (MinimumUTxOValue protocolMinimum) bundle === expectation - where - protocolMinimum = Coin 1_000_000 - -unit_computeMinimumAdaQuantity_emptyBundle :: Property -unit_computeMinimumAdaQuantity_emptyBundle = - unit_computeMinimumAdaQuantity_fixedSizeBundle TokenBundle.empty $ - Coin 1000000 - -unit_computeMinimumAdaQuantity_fixedSizeBundle_8 - :: Blind (FixedSize8 TokenBundle) -> Property -unit_computeMinimumAdaQuantity_fixedSizeBundle_8 (Blind (FixedSize8 b)) = - unit_computeMinimumAdaQuantity_fixedSizeBundle b $ - Coin 3888885 - -unit_computeMinimumAdaQuantity_fixedSizeBundle_64 - :: Blind (FixedSize64 TokenBundle) -> Property -unit_computeMinimumAdaQuantity_fixedSizeBundle_64 (Blind (FixedSize64 b)) = - unit_computeMinimumAdaQuantity_fixedSizeBundle b $ - Coin 22555533 - -unit_computeMinimumAdaQuantity_fixedSizeBundle_256 - :: Blind (FixedSize256 TokenBundle) -> Property -unit_computeMinimumAdaQuantity_fixedSizeBundle_256 (Blind (FixedSize256 b)) = - unit_computeMinimumAdaQuantity_fixedSizeBundle b $ - Coin 86555469 - -------------------------------------------------------------------------------- -- Utilities -------------------------------------------------------------------------------- -adjustAllQuantities - :: (TokenQuantity -> TokenQuantity) -> TokenBundle -> TokenBundle -adjustAllQuantities adjust b = uncurry TokenBundle.fromFlatList $ second - (fmap (fmap adjust)) - (TokenBundle.toFlatList b) - ledgerRoundtrip :: forall w l. (Arbitrary w, Eq w, Show w, Typeable w, Convert w l) => Proxy w @@ -252,19 +68,6 @@ ledgerRoundtrip proxy = it title $ , "'" ] --------------------------------------------------------------------------------- --- Adaptors --------------------------------------------------------------------------------- - -newtype FixedSize8 a = FixedSize8 { unFixedSize8 :: a } - deriving (Eq, Show) - -newtype FixedSize64 a = FixedSize64 { unFixedSize64 :: a } - deriving (Eq, Show) - -newtype FixedSize256 a = FixedSize256 { unFixedSize256 :: a } - deriving (Eq, Show) - -------------------------------------------------------------------------------- -- Arbitraries -------------------------------------------------------------------------------- @@ -275,31 +78,10 @@ instance Arbitrary Coin where arbitrary = genTxOutCoin shrink = shrinkTxOutCoin -instance Arbitrary MinimumUTxOValue where - arbitrary = oneof - [ MinimumUTxOValue . Coin.fromWord64 . (* 1_000_000) <$> genSmallWord - , MinimumUTxOValueCostPerWord . Coin.fromWord64 <$> genSmallWord - ] - where - genSmallWord = fromIntegral @Int @Word64 . getPositive <$> arbitrary - shrink = genericShrink - instance Arbitrary TokenBundle where arbitrary = genTokenBundleSmallRange shrink = shrinkTokenBundleSmallRange -instance Arbitrary (FixedSize8 TokenBundle) where - arbitrary = FixedSize8 <$> genTxOutTokenBundle 8 - -- No shrinking - -instance Arbitrary (FixedSize64 TokenBundle) where - arbitrary = FixedSize64 <$> genTxOutTokenBundle 64 - -- No shrinking - -instance Arbitrary (FixedSize256 TokenBundle) where - arbitrary = FixedSize256 <$> genTxOutTokenBundle 256 - -- No shrinking - instance Arbitrary TokenName where arbitrary = genTokenNameLargeRange -- No shrinking diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs new file mode 100644 index 00000000000..6a2aa90c9a5 --- /dev/null +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -0,0 +1,540 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- HLINT ignore "Use camelCase" -} + +module Cardano.Wallet.Shelley.MinimumUTxOSpec + ( spec + ) where + +import Prelude + +import Cardano.Api + ( ShelleyBasedEra (..) ) +import Cardano.Api.Gen + ( genAddressAny ) +import Cardano.Wallet.Primitive.Types.Address + ( Address (..) ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO + , MinimumUTxOForShelleyBasedEra (..) + , minimumUTxOForShelleyBasedEra + ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen + ( genMinimumUTxO + , genMinimumUTxOForShelleyBasedEra + , shrinkMinimumUTxO + , shrinkMinimumUTxOForShelleyBasedEra + , testParameter_coinsPerUTxOByte_Babbage + , testParameter_coinsPerUTxOWord_Alonzo + , testParameter_minUTxOValue_Allegra + , testParameter_minUTxOValue_Mary + , testParameter_minUTxOValue_Shelley + ) +import Cardano.Wallet.Primitive.Types.TokenBundle + ( TokenBundle (..) ) +import Cardano.Wallet.Primitive.Types.TokenBundle.Gen + ( shrinkTokenBundle ) +import Cardano.Wallet.Primitive.Types.TokenMap + ( AssetId (..), TokenMap ) +import Cardano.Wallet.Primitive.Types.TokenMap.Gen + ( genTokenMap, shrinkTokenMap ) +import Cardano.Wallet.Primitive.Types.TokenPolicy + ( TokenName (UnsafeTokenName) ) +import Cardano.Wallet.Primitive.Types.TokenPolicy.Gen + ( mkTokenPolicyId ) +import Cardano.Wallet.Primitive.Types.Tx + ( TxOut (..), txOutMaxTokenQuantity, txOutMinTokenQuantity ) +import Cardano.Wallet.Primitive.Types.Tx.Gen + ( genTxOutTokenBundle ) +import Cardano.Wallet.Shelley.Compatibility + ( toCardanoTxOut ) +import Cardano.Wallet.Shelley.MinimumUTxO + ( computeMinimumCoinForUTxO + , maxLengthAddress + , maxLengthCoin + , unsafeLovelaceToWalletCoin + , unsafeValueToLovelace + ) +import Control.Monad + ( forM_ ) +import Data.Default + ( Default (..) ) +import Data.Function + ( (&) ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..) + , Property + , checkCoverage + , conjoin + , cover + , elements + , frequency + , property + , sized + ) +import Test.QuickCheck.Classes + ( eqLaws, showLaws ) +import Test.QuickCheck.Extra + ( report, verify ) +import Test.Utils.Laws + ( testLawsMany ) + +import qualified Cardano.Api.Shelley as Cardano +import qualified Cardano.Ledger.Alonzo.PParams as Alonzo +import qualified Cardano.Ledger.Babbage.PParams as Babbage +import qualified Cardano.Ledger.Shelley.PParams as Shelley +import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle +import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = do + describe "Class instances obey laws" $ do + testLawsMany @MinimumUTxO + [ eqLaws + , showLaws + ] + + describe "computeMinimumCoinForUTxO" $ do + + describe "Properties" $ do + + it "prop_computeMinimumCoinForUTxO_evaluation" $ + prop_computeMinimumCoinForUTxO_evaluation + & property + it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds" $ + prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds + & property + it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability" $ + prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability + & property + + describe "Golden Tests" $ do + + goldenTests_computeMinimumCoinForUTxO "Shelley" + goldenMinimumUTxO_Shelley + goldenMinimumCoins_Shelley + goldenTests_computeMinimumCoinForUTxO "Allegra" + goldenMinimumUTxO_Allegra + goldenMinimumCoins_Allegra + goldenTests_computeMinimumCoinForUTxO "Mary" + goldenMinimumUTxO_Mary + goldenMinimumCoins_Mary + goldenTests_computeMinimumCoinForUTxO "Alonzo" + goldenMinimumUTxO_Alonzo + goldenMinimumCoins_Alonzo + goldenTests_computeMinimumCoinForUTxO "Babbage" + goldenMinimumUTxO_Babbage + goldenMinimumCoins_Babbage + +-- Check that it's possible to evaluate 'computeMinimumCoinForUTxO' without +-- any run-time error. +-- +prop_computeMinimumCoinForUTxO_evaluation + :: MinimumUTxO -> TokenMap -> Property +prop_computeMinimumCoinForUTxO_evaluation minimumUTxO m = property $ + -- Use an arbitrary test to force evaluation of the result: + computeMinimumCoinForUTxO minimumUTxO m >= Coin 0 + +-- Check that 'computeMinimumCoinForUTxO' produces a result that is within +-- bounds, as determined by the Cardano API function 'calculateMinimumUTxO'. +-- +prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds + :: TokenBundle + -> Cardano.AddressAny + -> MinimumUTxOForShelleyBasedEra + -> Property +prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds + tokenBundle addr (MinimumUTxOForShelleyBasedEra era pp) = + let ourResult = ourComputeMinCoin + (TokenBundle.tokens tokenBundle) + apiResultMinBound = apiComputeMinCoin + (fromCardanoAddressAny addr) + (tokenBundle) + apiResultMaxBound = apiComputeMinCoin + (maxLengthAddress) + (TokenBundle.setCoin tokenBundle maxLengthCoin) + in + property True + & verify + (ourResult >= apiResultMinBound) + "ourResult >= apiResultMinBound" + & verify + (ourResult <= apiResultMaxBound) + "ourResult <= apiResultMaxBound" + & report + (apiResultMinBound) + "apiResultMinBound" + & report + (apiResultMaxBound) + "apiResultMaxBound" + & report + (ourResult) + "ourResult" + & report + (BS.length (Cardano.serialiseToRawBytes addr)) + "BS.length (Cardano.serialiseToRawBytes addr))" + & report + (BS.length (unAddress (fromCardanoAddressAny addr))) + "BS.length (unAddress (fromCardanoAddressAny addr))" + & report + (BS.length (unAddress maxLengthAddress)) + "BS.length (unAddress maxLengthAddress))" + where + -- Uses the Cardano API function 'calculateMinimumUTxO' to compute a + -- minimum 'Coin' value. + -- + apiComputeMinCoin :: Address -> TokenBundle -> Coin + apiComputeMinCoin a b + = either raiseApiError unsafeValueToWalletCoin + $ Cardano.calculateMinimumUTxO era (toApiTxOut b) + $ Cardano.fromLedgerPParams era pp + where + raiseApiError e = error $ unwords + ["Failed to obtain result from Cardano API:", show e] + toApiTxOut = toCardanoTxOut era . TxOut a + unsafeValueToWalletCoin = + (unsafeLovelaceToWalletCoin . unsafeValueToLovelace) + + -- Uses the wallet function 'computeMinimumCoinForUTxO' to compute a + -- minimum 'Coin' value. + -- + ourComputeMinCoin :: TokenMap -> Coin + ourComputeMinCoin = + computeMinimumCoinForUTxO (minimumUTxOForShelleyBasedEra era pp) + +-- Compares the stability of: +-- +-- - the Cardano API function 'calculateMinimumUTxO' +-- - the wallet function 'computeMinimumCoinForUTxO' +-- +-- In particular, we: +-- +-- Demonstrate that applying the Cardano API function to its own result can +-- lead to an increase in the ada quantity. +-- +-- Demonstrate that applying the Cardano API function to the result of the +-- wallet function does not lead to an increase in the ada quantity. +-- +prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability + :: TokenMap + -> Cardano.AddressAny + -> MinimumUTxOForShelleyBasedEra + -> Property +prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability + tokenMap addr (MinimumUTxOForShelleyBasedEra era pp) = + conjoin + [ prop_apiFunctionStability + , prop_ourFunctionStability + ] + where + -- Demonstrate that applying the Cardano API function to its own result can + -- lead to an increase in the ada quantity. + -- + prop_apiFunctionStability :: Property + prop_apiFunctionStability = + let apiResult0 = apiComputeMinCoin $ TokenBundle (Coin 0) tokenMap + apiResult1 = apiComputeMinCoin $ TokenBundle apiResult0 tokenMap + in + property True + & verify (apiResult0 <= apiResult1) "apiResult0 <= apiResult1" + & cover 10 (apiResult0 == apiResult1) "apiResult0 == apiResult1" + & cover 10 (apiResult0 < apiResult1) "apiResult0 < apiResult1" + & report apiResult0 "apiResult0" + & report apiResult1 "apiResult1" + & checkCoverage + + -- Demonstrate that applying the Cardano API function to the result of the + -- wallet function does not lead to an increase in the ada quantity. + -- + prop_ourFunctionStability :: Property + prop_ourFunctionStability = + let ourResult0 = ourComputeMinCoin tokenMap + ourResult1 = apiComputeMinCoin $ TokenBundle ourResult0 tokenMap + in + property True + & verify (ourResult0 >= ourResult1) "ourResult0 >= ourResult1" + & cover 10 (ourResult0 == ourResult1) "ourResult0 == ourResult1" + & cover 10 (ourResult0 > ourResult1) "ourResult0 > ourResult1" + & report ourResult0 "ourResult0" + & report ourResult1 "ourResult1" + & checkCoverage + + -- Uses the Cardano API function 'calculateMinimumUTxO' to compute a + -- minimum 'Coin' value. + -- + apiComputeMinCoin :: TokenBundle -> Coin + apiComputeMinCoin b + = either raiseApiError unsafeValueToWalletCoin + $ Cardano.calculateMinimumUTxO era (toApiTxOut b) + $ Cardano.fromLedgerPParams era pp + where + raiseApiError e = error $ unwords + ["Failed to obtain result from Cardano API:", show e] + toApiTxOut = toCardanoTxOut era . TxOut (fromCardanoAddressAny addr) + unsafeValueToWalletCoin = + (unsafeLovelaceToWalletCoin . unsafeValueToLovelace) + + -- Uses the wallet function 'computeMinimumCoinForUTxO' to compute a + -- minimum 'Coin' value. + -- + ourComputeMinCoin :: TokenMap -> Coin + ourComputeMinCoin = + computeMinimumCoinForUTxO (minimumUTxOForShelleyBasedEra era pp) + +-------------------------------------------------------------------------------- +-- Golden tests +-------------------------------------------------------------------------------- + +goldenTests_computeMinimumCoinForUTxO + :: String + -- ^ The era name. + -> MinimumUTxO + -- ^ The minimum UTxO function. + -> [(TokenMap, Coin)] + -- ^ Mappings from 'TokenMap' values to expected minimum 'Coin' values. + -> Spec +goldenTests_computeMinimumCoinForUTxO + eraName minimumUTxO expectedMinimumCoins = + goldenTests title + (uncurry computeMinimumCoinForUTxO) + (mkTest <$> expectedMinimumCoins) + where + mkTest + :: (TokenMap, Coin) -> GoldenTestData (MinimumUTxO, TokenMap) Coin + mkTest (tokenMap, coinExpected) = GoldenTestData + { params = (minimumUTxO, tokenMap) + , resultExpected = coinExpected + } + title = unwords + ["goldenTests_computeMinimumCoinForUTxO", eraName] + +-------------------------------------------------------------------------------- +-- Golden 'MinimumUTxO' values +-------------------------------------------------------------------------------- + +goldenMinimumUTxO_Shelley :: MinimumUTxO +goldenMinimumUTxO_Shelley = + minimumUTxOForShelleyBasedEra ShelleyBasedEraShelley + def {Shelley._minUTxOValue = testParameter_minUTxOValue_Shelley} + +goldenMinimumUTxO_Allegra :: MinimumUTxO +goldenMinimumUTxO_Allegra = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra + def {Shelley._minUTxOValue = testParameter_minUTxOValue_Allegra} + +goldenMinimumUTxO_Mary :: MinimumUTxO +goldenMinimumUTxO_Mary = + minimumUTxOForShelleyBasedEra ShelleyBasedEraMary + def {Shelley._minUTxOValue = testParameter_minUTxOValue_Mary} + +goldenMinimumUTxO_Alonzo :: MinimumUTxO +goldenMinimumUTxO_Alonzo = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo + def {Alonzo._coinsPerUTxOWord = testParameter_coinsPerUTxOWord_Alonzo} + +goldenMinimumUTxO_Babbage :: MinimumUTxO +goldenMinimumUTxO_Babbage = + minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage + def {Babbage._coinsPerUTxOByte = testParameter_coinsPerUTxOByte_Babbage} + +-------------------------------------------------------------------------------- +-- Golden minimum 'Coin' values +-------------------------------------------------------------------------------- + +goldenMinimumCoins_Shelley :: [(TokenMap, Coin)] +goldenMinimumCoins_Shelley = + [ (goldenTokenMap_0, Coin 1_000_000) + , (goldenTokenMap_1, Coin 1_000_000) + , (goldenTokenMap_2, Coin 1_000_000) + , (goldenTokenMap_3, Coin 1_000_000) + , (goldenTokenMap_4, Coin 1_000_000) + ] + +goldenMinimumCoins_Allegra :: [(TokenMap, Coin)] +goldenMinimumCoins_Allegra = + [ (goldenTokenMap_0, Coin 1_000_000) + , (goldenTokenMap_1, Coin 1_000_000) + , (goldenTokenMap_2, Coin 1_000_000) + , (goldenTokenMap_3, Coin 1_000_000) + , (goldenTokenMap_4, Coin 1_000_000) + ] + +goldenMinimumCoins_Mary :: [(TokenMap, Coin)] +goldenMinimumCoins_Mary = + [ (goldenTokenMap_0, Coin 1_000_000) + , (goldenTokenMap_1, Coin 1_444_443) + , (goldenTokenMap_2, Coin 1_555_554) + , (goldenTokenMap_3, Coin 1_740_739) + , (goldenTokenMap_4, Coin 1_999_998) + ] + +goldenMinimumCoins_Alonzo :: [(TokenMap, Coin)] +goldenMinimumCoins_Alonzo = + [ (goldenTokenMap_0, Coin 999_978) + , (goldenTokenMap_1, Coin 1_344_798) + , (goldenTokenMap_2, Coin 1_448_244) + , (goldenTokenMap_3, Coin 1_620_654) + , (goldenTokenMap_4, Coin 1_862_028) + ] + +goldenMinimumCoins_Babbage :: [(TokenMap, Coin)] +goldenMinimumCoins_Babbage = + [ (goldenTokenMap_0, Coin 995_610) + , (goldenTokenMap_1, Coin 1_150_770) + , (goldenTokenMap_2, Coin 1_323_170) + , (goldenTokenMap_3, Coin 1_323_170) + , (goldenTokenMap_4, Coin 2_012_770) + ] + +-------------------------------------------------------------------------------- +-- Golden 'TokenMap' values +-------------------------------------------------------------------------------- + +goldenTokenMaps :: [TokenMap] +goldenTokenMaps = + [ goldenTokenMap_0 + , goldenTokenMap_1 + , goldenTokenMap_2 + , goldenTokenMap_3 + , goldenTokenMap_4 + ] + +goldenTokenMap_0 :: TokenMap +goldenTokenMap_0 = TokenMap.empty + +goldenTokenMap_1 :: TokenMap +goldenTokenMap_1 = TokenMap.fromFlatList + [ (goldenAssetId_A_1_short, txOutMinTokenQuantity) + ] + +goldenTokenMap_2 :: TokenMap +goldenTokenMap_2 = TokenMap.fromFlatList + [ (goldenAssetId_A_1_long, txOutMaxTokenQuantity) + ] + +goldenTokenMap_3 :: TokenMap +goldenTokenMap_3 = TokenMap.fromFlatList + [ (goldenAssetId_A_1_short, txOutMinTokenQuantity) + , (goldenAssetId_A_2_short, txOutMinTokenQuantity) + , (goldenAssetId_B_1_short, txOutMinTokenQuantity) + , (goldenAssetId_B_2_short, txOutMinTokenQuantity) + ] + +goldenTokenMap_4 :: TokenMap +goldenTokenMap_4 = TokenMap.fromFlatList + [ (goldenAssetId_A_1_long, txOutMaxTokenQuantity) + , (goldenAssetId_A_2_long, txOutMaxTokenQuantity) + , (goldenAssetId_B_1_long, txOutMaxTokenQuantity) + , (goldenAssetId_B_2_long, txOutMaxTokenQuantity) + ] + +-------------------------------------------------------------------------------- +-- Golden 'AssetId' values +-------------------------------------------------------------------------------- + +goldenAssetId_A_1_short :: AssetId +goldenAssetId_A_1_short = mkAssetId 'A' "1" + +goldenAssetId_A_2_short :: AssetId +goldenAssetId_A_2_short = mkAssetId 'A' "2" + +goldenAssetId_B_1_short :: AssetId +goldenAssetId_B_1_short = mkAssetId 'B' "1" + +goldenAssetId_B_2_short :: AssetId +goldenAssetId_B_2_short = mkAssetId 'B' "2" + +goldenAssetId_A_1_long :: AssetId +goldenAssetId_A_1_long = mkAssetId 'A' (replicate 32 '1') + +goldenAssetId_A_2_long :: AssetId +goldenAssetId_A_2_long = mkAssetId 'A' (replicate 32 '2') + +goldenAssetId_B_1_long :: AssetId +goldenAssetId_B_1_long = mkAssetId 'B' (replicate 32 '1') + +goldenAssetId_B_2_long :: AssetId +goldenAssetId_B_2_long = mkAssetId 'B' (replicate 32 '2') + +mkAssetId :: Char -> String -> AssetId +mkAssetId pid name = AssetId + (mkTokenPolicyId pid) + (UnsafeTokenName $ T.encodeUtf8 $ T.pack name) + +-------------------------------------------------------------------------------- +-- Golden test support +-------------------------------------------------------------------------------- + +data GoldenTestData params result = GoldenTestData + { params :: params + , resultExpected :: result + } + deriving (Eq, Show) + +goldenTests + :: (Eq result, Show result) + => String + -> (params -> result) + -> [GoldenTestData params result] + -> Spec +goldenTests title f goldenTestData = + describe title $ + forM_ (zip testNumbers goldenTestData) $ \(testNumber, testData) -> do + let subtitle = "golden test #" <> show testNumber + it subtitle $ do + let GoldenTestData {params, resultExpected} = testData + let resultReturned = f params + property True + & verify + (resultReturned == resultExpected) + "resultReturned == resultExpected" + & report resultReturned "resultReturned" + & report resultExpected "resultExpected" + where + testNumbers :: [Int] + testNumbers = [0 ..] + +-------------------------------------------------------------------------------- +-- Utility functions +-------------------------------------------------------------------------------- + +fromCardanoAddressAny :: Cardano.AddressAny -> Address +fromCardanoAddressAny = Address . Cardano.serialiseToRawBytes + +-------------------------------------------------------------------------------- +-- Arbitrary instances +-------------------------------------------------------------------------------- + +instance Arbitrary Cardano.AddressAny where + arbitrary = genAddressAny + +instance Arbitrary TokenBundle where + arbitrary = sized genTxOutTokenBundle + shrink = shrinkTokenBundle + +instance Arbitrary MinimumUTxO where + arbitrary = genMinimumUTxO + shrink = shrinkMinimumUTxO + +instance Arbitrary MinimumUTxOForShelleyBasedEra where + arbitrary = genMinimumUTxOForShelleyBasedEra + shrink = shrinkMinimumUTxOForShelleyBasedEra + +instance Arbitrary TokenMap where + arbitrary = frequency + [ (4, genTokenMap) + , (1, elements goldenTokenMaps) + ] + shrink = shrinkTokenMap diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index a8cfed5ff8f..240dcd275bf 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -143,7 +143,6 @@ import Cardano.Wallet.Primitive.Types , FeePolicy (..) , GenesisParameters (..) , LinearFunction (..) - , MinimumUTxOValue (..) , PoolId (PoolId) , ProtocolParameters (..) , SlotLength (SlotLength) @@ -161,6 +160,8 @@ import Cardano.Wallet.Primitive.Types.Coin.Gen ( genCoin, genCoinPositive, shrinkCoin, shrinkCoinPositive ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..), mockHash ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO (..) ) import Cardano.Wallet.Primitive.Types.Redeemer ( Redeemer (..) ) import Cardano.Wallet.Primitive.Types.RewardAccount @@ -2133,8 +2134,8 @@ dummyProtocolParameters = ProtocolParameters error "dummyProtocolParameters: txParameters" , desiredNumberOfStakePools = error "dummyProtocolParameters: desiredNumberOfStakePools" - , minimumUTxOvalue = - error "dummyProtocolParameters: minimumUTxOvalue" + , minimumUTxO = + error "dummyProtocolParameters: minimumUTxO" , stakeKeyDeposit = error "dummyProtocolParameters: stakeKeyDeposit" , eras = @@ -2181,7 +2182,7 @@ mockProtocolParameters = dummyProtocolParameters , getTokenBundleMaxSize = TokenBundleMaxSize $ TxSize 4000 , getMaxExecutionUnits = ExecutionUnits 10_000_000_000 14_000_000 } - , minimumUTxOvalue = MinimumUTxOValue $ Coin 1000000 + , minimumUTxO = MinimumUTxOConstant $ Coin 1000000 , maximumCollateralInputCount = 3 , minimumCollateralPercentage = 150 } diff --git a/lib/test-utils/src/Test/QuickCheck/Extra.hs b/lib/test-utils/src/Test/QuickCheck/Extra.hs index 087866462e0..2f8e95bbe11 100644 --- a/lib/test-utils/src/Test/QuickCheck/Extra.hs +++ b/lib/test-utils/src/Test/QuickCheck/Extra.hs @@ -543,7 +543,7 @@ report a name = counterexample $ -- -- On failure, reports the name of the condition that failed. -- -verify :: Bool -> String -> Property -> Property +verify :: Testable t => Bool -> String -> t -> Property verify condition conditionTitle = (.&&.) (counterexample counterexampleText $ property condition) where