From ad11edbc15f24520a17cc337fe9bfa5cf54c1b40 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 03:07:32 +0000 Subject: [PATCH 01/36] Miscellaneous formatting fixes. --- .../src/Cardano/Wallet/Primitive/Types.hs | 19 ++++++++++++------- .../Cardano/Wallet/Shelley/Compatibility.hs | 2 +- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 5e5866f0bd3..0a259a2ec7c 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -1162,13 +1162,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 value: " + <> build (pp ^. #minimumUTxOvalue) + , "Eras:\n" + <> indentF 2 (build (pp ^. #eras)) + , "Execution unit prices: " + <> maybe "not specified" build (pp ^. #executionUnitPrices) ] data ExecutionUnits = ExecutionUnits diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index e495433cab8..09f193f8d4b 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -416,6 +416,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 @@ -872,7 +873,6 @@ fromBabbagePParams eraInfo currentNodeProtocolParameters pp = where fromByteToWord (W.Coin v) = W.Coin $ 8 * v - -- | Extract the current network decentralization level from the given set of -- protocol parameters. decentralizationLevelFromPParams From 3f3b549f86c9f0eecac8ac4eb847c2c702ff20ff Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 4 Jul 2022 05:21:22 +0000 Subject: [PATCH 02/36] Add dependency on library `int-cast`. --- lib/shelley/cardano-wallet.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index 08b5ef2fc28..80091b5af14 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -273,6 +273,7 @@ test-suite unit , time , hspec , hspec-core + , int-cast , memory , MonadRandom , optparse-applicative From 76c275684b53ed2cff0bd6dfcea7158cf76a09df Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 4 Jul 2022 05:31:09 +0000 Subject: [PATCH 03/36] Add dependency on library `generics-sop`. --- lib/shelley/cardano-wallet.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index 80091b5af14..d597a37ec9e 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -267,6 +267,7 @@ test-suite unit , fmt , generic-arbitrary , generic-lens + , generics-sop , hspec-core , hspec-golden , iohk-monitoring From 45ba2f50970cfc8f90228b62a6797e58f784a9e1 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 03:15:12 +0000 Subject: [PATCH 04/36] Add function `fromAllegraPParams`. --- .../Cardano/Wallet/Shelley/Compatibility.hs | 29 +++++++++++++++++++ .../Cardano/Wallet/Shelley/Network/Node.hs | 3 +- 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index 09f193f8d4b..abe7a597e09 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -87,6 +87,7 @@ module Cardano.Wallet.Shelley.Compatibility , fromCardanoLovelace , rewardAccountFromAddress , fromShelleyPParams + , fromAllegraPParams , fromAlonzoPParams , fromBabbagePParams , fromLedgerExUnits @@ -317,6 +318,7 @@ import Ouroboros.Consensus.Cardano.Block ( CardanoBlock , CardanoEras , HardForkBlock (..) + , StandardAllegra , StandardAlonzo , StandardBabbage , StandardShelley @@ -353,6 +355,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 @@ -809,6 +812,32 @@ fromShelleyPParams eraInfo currentNodeProtocolParameters pp = , currentNodeProtocolParameters } +fromAllegraPParams + :: HasCallStack + => 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 + , minimumUTxOvalue = + MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp + , stakeKeyDeposit = stakeKeyDepositFromPParams pp + , eras = fromBoundToEpochNo <$> eraInfo + -- Collateral inputs were not supported or required in Allegra: + , maximumCollateralInputCount = 0 + , minimumCollateralPercentage = 0 + , executionUnitPrices = Nothing + , currentNodeProtocolParameters + } + fromBoundToEpochNo :: Bound -> W.EpochNo fromBoundToEpochNo (Bound _relTime _slotNo (EpochNo e)) = W.EpochNo $ fromIntegral e diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs index 4e43455e60f..1158240684a 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs @@ -78,6 +78,7 @@ import Cardano.Wallet.Primitive.Types.Tx ( SealedTx (..) ) import Cardano.Wallet.Shelley.Compatibility ( StandardCrypto + , fromAllegraPParams , fromAlonzoPParams , fromBabbagePParams , fromNonMyopicMemberRewards @@ -714,7 +715,7 @@ 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 <$> LSQry Shelley.GetCurrentPParams) From 55fad34b6c49a2d6dcd39c39595deaa272e0d2c0 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 03:20:08 +0000 Subject: [PATCH 05/36] Add function `fromMaryPParams`. --- .../Cardano/Wallet/Shelley/Compatibility.hs | 29 +++++++++++++++++++ .../Cardano/Wallet/Shelley/Network/Node.hs | 3 +- 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index abe7a597e09..d55af0fec33 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -88,6 +88,7 @@ module Cardano.Wallet.Shelley.Compatibility , rewardAccountFromAddress , fromShelleyPParams , fromAllegraPParams + , fromMaryPParams , fromAlonzoPParams , fromBabbagePParams , fromLedgerExUnits @@ -321,6 +322,7 @@ import Ouroboros.Consensus.Cardano.Block , StandardAllegra , StandardAlonzo , StandardBabbage + , StandardMary , StandardShelley ) import Ouroboros.Consensus.HardFork.Combinator.AcrossEras @@ -374,6 +376,7 @@ 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 @@ -838,6 +841,32 @@ fromAllegraPParams eraInfo currentNodeProtocolParameters pp = , currentNodeProtocolParameters } +fromMaryPParams + :: HasCallStack + => 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 + , minimumUTxOvalue = + MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue 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 diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs index 1158240684a..7b825758b17 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Node.hs @@ -81,6 +81,7 @@ import Cardano.Wallet.Shelley.Compatibility , fromAllegraPParams , fromAlonzoPParams , fromBabbagePParams + , fromMaryPParams , fromNonMyopicMemberRewards , fromPoint , fromPoolDistr @@ -717,7 +718,7 @@ mkTipSyncClient tr np onPParamsUpdate onInterpreterUpdate onEraUpdate = do <$> LSQry Shelley.GetCurrentPParams) (fromAllegraPParams eraBounds ppNode <$> LSQry Shelley.GetCurrentPParams) - (fromShelleyPParams eraBounds ppNode + (fromMaryPParams eraBounds ppNode <$> LSQry Shelley.GetCurrentPParams) (fromAlonzoPParams eraBounds ppNode <$> LSQry Shelley.GetCurrentPParams) From 04af270e53f0419282355eecf4e907784f1efdec Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 03:28:35 +0000 Subject: [PATCH 06/36] Specialize function `fromShelleyPParams` to the Shelley era. --- lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index d55af0fec33..17db140e4ae 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -381,6 +381,7 @@ 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 @@ -793,7 +794,7 @@ fromShelleyPParams :: HasCallStack => W.EraInfo Bound -> Maybe Cardano.ProtocolParameters - -> SLAPI.PParams era + -> Shelley.PParams StandardShelley -> W.ProtocolParameters fromShelleyPParams eraInfo currentNodeProtocolParameters pp = W.ProtocolParameters @@ -1043,7 +1044,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) From 66f908600c806de57e012ecd545c2735206f8246 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 05:39:01 +0000 Subject: [PATCH 07/36] Add type `MinimumUTxO` with generators and shrinkers. --- lib/core/cardano-wallet-core.cabal | 11 +- .../Wallet/Primitive/Types/MinimumUTxO.hs | 127 +++++++++++++++++ .../Wallet/Primitive/Types/MinimumUTxO/Gen.hs | 133 ++++++++++++++++++ 3 files changed, 268 insertions(+), 3 deletions(-) create mode 100644 lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs create mode 100644 lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs 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/Wallet/Primitive/Types/MinimumUTxO.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs new file mode 100644 index 00000000000..cc152a30a23 --- /dev/null +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs @@ -0,0 +1,127 @@ +{-# 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 + ( MinimumUTxO (..) + , minimumUTxONone + , minimumUTxOConstant + , minimumUTxOForShelleyBasedEra + , ProtocolParametersForShelleyBasedEra (..) + ) + 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 +-------------------------------------------------------------------------------- + +data MinimumUTxO where + MinimumUTxONone + :: MinimumUTxO + MinimumUTxOConstant + :: Coin + -> MinimumUTxO + MinimumUTxOForShelleyBasedEra + :: ProtocolParametersForShelleyBasedEra + -> MinimumUTxO + +instance Buildable MinimumUTxO where + build = \case + MinimumUTxONone -> + "MinimumUTxONone" + MinimumUTxOConstant c -> blockListF + [ "MinimumUTxOConstant" + , build c + ] + MinimumUTxOForShelleyBasedEra pp -> blockListF + [ "MinimumUTxOForShelleyBasedEra" + , build pp + ] + +instance Eq MinimumUTxO where + (==) = (==) `on` show + +instance NFData MinimumUTxO where + rnf = \case + MinimumUTxONone -> + rnf () + MinimumUTxOConstant c -> + rnf c + MinimumUTxOForShelleyBasedEra pp -> + rnf pp + +instance Show MinimumUTxO where + show = \case + MinimumUTxONone -> + "MinimumUTxONone" + MinimumUTxOConstant c -> unwords + [ "MinimumUTxOConstant" + , show c + ] + MinimumUTxOForShelleyBasedEra pp -> unwords + [ "MinimumUTxOForShelleyBasedEra" + , show pp + ] + +minimumUTxONone :: MinimumUTxO +minimumUTxONone = MinimumUTxONone + +minimumUTxOConstant :: Coin -> MinimumUTxO +minimumUTxOConstant = MinimumUTxOConstant + +minimumUTxOForShelleyBasedEra + :: ShelleyBasedEra era + -> PParams (ShelleyLedgerEra era) + -> MinimumUTxO +minimumUTxOForShelleyBasedEra era pp = + MinimumUTxOForShelleyBasedEra $ + ProtocolParametersForShelleyBasedEra era pp + +-------------------------------------------------------------------------------- +-- The 'ProtocolParametersForShelleyBasedEra' type +-------------------------------------------------------------------------------- + +data ProtocolParametersForShelleyBasedEra where + ProtocolParametersForShelleyBasedEra + :: ShelleyBasedEra era + -> PParams (ShelleyLedgerEra era) + -> ProtocolParametersForShelleyBasedEra + +instance Buildable ProtocolParametersForShelleyBasedEra where + build (ProtocolParametersForShelleyBasedEra era _) = blockListF + [ "ProtocolParametersForShelleyBasedEra" + , show era + ] + +instance Eq ProtocolParametersForShelleyBasedEra where + (==) = (==) `on` show + +instance NFData ProtocolParametersForShelleyBasedEra where + rnf (ProtocolParametersForShelleyBasedEra !_ !_) = rnf () + +instance Show ProtocolParametersForShelleyBasedEra where + show (ProtocolParametersForShelleyBasedEra era pp) = unwords + [ show era + , show (fromLedgerPParams 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..ae47f8bbed3 --- /dev/null +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2022 IOHK +-- License: Apache-2.0 +-- +-- Defines generators and shrinkers for the 'MinimumUTxO' data type. +-- +module Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen + ( genMinimumUTxO + , genProtocolParametersForShelleyBasedEra + , shrinkMinimumUTxO + , shrinkProtocolParametersForShelleyBasedEra + ) + where + +import Prelude + +import Cardano.Api + ( ShelleyBasedEra (..) ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO (..), ProtocolParametersForShelleyBasedEra (..) ) +import Data.Bits + ( Bits ) +import Data.Default + ( Default (..) ) +import Data.IntCast + ( intCast, intCastMaybe ) +import Data.Maybe + ( fromMaybe ) +import Numeric.Natural + ( Natural ) +import Test.QuickCheck + ( Gen, choose, 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, genMinimumUTxOForShelleyBasedEra) + ] + where + genMinimumUTxONone :: Gen MinimumUTxO + genMinimumUTxONone = pure MinimumUTxONone + + genMinimumUTxOConstant :: Gen MinimumUTxO + genMinimumUTxOConstant = MinimumUTxOConstant . Coin + <$> genInterestingCoinValue + + genMinimumUTxOForShelleyBasedEra :: Gen MinimumUTxO + genMinimumUTxOForShelleyBasedEra = MinimumUTxOForShelleyBasedEra + <$> genProtocolParametersForShelleyBasedEra + +shrinkMinimumUTxO :: MinimumUTxO -> [MinimumUTxO] +shrinkMinimumUTxO = const [] + +-------------------------------------------------------------------------------- +-- Generating 'ProtocolParametersForShelleyBasedEra' values +-------------------------------------------------------------------------------- + +genProtocolParametersForShelleyBasedEra + :: Gen ProtocolParametersForShelleyBasedEra +genProtocolParametersForShelleyBasedEra = oneof + [ genShelley + , genAllegra + , genMary + , genAlonzo + , genBabbage + ] + where + genShelley :: Gen ProtocolParametersForShelleyBasedEra + genShelley = do + minUTxOValue <- genInterestingLedgerCoin + pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraShelley + def {Shelley._minUTxOValue = minUTxOValue} + + genAllegra :: Gen ProtocolParametersForShelleyBasedEra + genAllegra = do + minUTxOValue <- genInterestingLedgerCoin + pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraAllegra + def {Shelley._minUTxOValue = minUTxOValue} + + genMary :: Gen ProtocolParametersForShelleyBasedEra + genMary = do + minUTxOValue <- genInterestingLedgerCoin + pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraMary + def {Shelley._minUTxOValue = minUTxOValue} + + genAlonzo :: Gen ProtocolParametersForShelleyBasedEra + genAlonzo = do + coinsPerUTxOWord <- genInterestingLedgerCoin + pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraAlonzo + def {Alonzo._coinsPerUTxOWord = coinsPerUTxOWord} + + genBabbage :: Gen ProtocolParametersForShelleyBasedEra + genBabbage = do + coinsPerUTxOByte <- genInterestingLedgerCoin + pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraBabbage + def {Babbage._coinsPerUTxOByte = coinsPerUTxOByte} + +shrinkProtocolParametersForShelleyBasedEra + :: ProtocolParametersForShelleyBasedEra + -> [ProtocolParametersForShelleyBasedEra] +shrinkProtocolParametersForShelleyBasedEra = const [] + +-------------------------------------------------------------------------------- +-- Internal functions +-------------------------------------------------------------------------------- + +genInterestingCoinValue :: Gen Natural +genInterestingCoinValue = do + base <- (1_000_000 *) <$> choose (0, 8) + offset <- choose @Integer (-10, 10) + pure $ intCastMaybeZero $ base + offset + +genInterestingLedgerCoin :: Gen Ledger.Coin +genInterestingLedgerCoin = Ledger.Coin . intCast + <$> genInterestingCoinValue + +intCastMaybeZero :: (Integral a, Integral b, Bits a, Bits b) => a -> b +intCastMaybeZero = fromMaybe 0 . intCastMaybe From d6175a5a8b26a028fafa16000b03fe3fd463954b Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 06:00:49 +0000 Subject: [PATCH 08/36] Add field `minimumUTxO` to `ProtocolParameters` primitive type. --- lib/core/src/Cardano/Wallet/Primitive/Types.hs | 8 ++++++++ .../Cardano/Wallet/DummyTarget/Primitive/Types.hs | 3 +++ lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs | 4 ++++ .../src/Cardano/Wallet/Byron/Compatibility.hs | 4 ++++ .../src/Cardano/Wallet/Shelley/Compatibility.hs | 12 ++++++++++++ .../src/Cardano/Wallet/Shelley/Network/Blockfrost.hs | 4 ++++ .../unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 5 +++++ 7 files changed, 40 insertions(+) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 0a259a2ec7c..de79be08fe8 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -181,6 +181,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 @@ -1111,6 +1113,9 @@ data ProtocolParameters = ProtocolParameters :: Word16 -- ^ The current desired number of stakepools in the network. -- Also known as k parameter. + , minimumUTxO + :: MinimumUTxO + -- ^ Represents a way of calculating minimum UTxO values. , minimumUTxOvalue :: MinimumUTxOValue -- ^ The minimum UTxO value. @@ -1151,6 +1156,7 @@ instance NFData ProtocolParameters where [ rnf decentralizationLevel , rnf txParameters , rnf desiredNumberOfStakePools + , rnf minimumUTxO , rnf minimumUTxOvalue , rnf stakeKeyDeposit , rnf eras @@ -1168,6 +1174,8 @@ instance Buildable ProtocolParameters where <> build (pp ^. #txParameters) , "Desired number of pools: " <> build (pp ^. #desiredNumberOfStakePools) + , "Minimum UTxO: " + <> build (pp ^. #minimumUTxO) , "Minimum UTxO value: " <> build (pp ^. #minimumUTxOvalue) , "Eras:\n" 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..129be1671f6 100644 --- a/lib/core/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs +++ b/lib/core/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs @@ -47,6 +47,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,6 +125,7 @@ dummyProtocolParameters = ProtocolParameters { decentralizationLevel = minBound , txParameters = dummyTxParameters , desiredNumberOfStakePools = 100 + , minimumUTxO = MinimumUTxONone , minimumUTxOvalue = MinimumUTxOValue $ Coin 0 , stakeKeyDeposit = Coin 0 , eras = emptyEraInfo diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs index 76e771240c2..8d8bbe79b0a 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs @@ -120,6 +120,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,6 +686,7 @@ instance Arbitrary ProtocolParameters where <@> shrink <:> shrink <:> shrink + <:> shrinkMinimumUTxO <:> shrink <:> shrink <:> shrink @@ -696,6 +699,7 @@ instance Arbitrary ProtocolParameters where <$> arbitrary <*> arbitrary <*> choose (0, 100) + <*> genMinimumUTxO <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs index 73aad03ffef..dcacf2ff62b 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,6 +143,7 @@ mainnetNetworkParameters = W.NetworkParameters , getMaxExecutionUnits = W.ExecutionUnits 0 0 } , desiredNumberOfStakePools = 0 + , minimumUTxO = minimumUTxONone , minimumUTxOvalue = W.MinimumUTxOValue $ W.Coin 0 , stakeKeyDeposit = W.Coin 0 , eras = W.emptyEraInfo @@ -364,6 +367,7 @@ protocolParametersFromPP eraInfo currentNodeProtocolParameters pp = , getMaxExecutionUnits = W.ExecutionUnits 0 0 } , desiredNumberOfStakePools = 0 + , minimumUTxO = minimumUTxONone , minimumUTxOvalue = W.MinimumUTxOValue $ W.Coin 0 , stakeKeyDeposit = W.Coin 0 , eras = fromBound <$> eraInfo diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index 17db140e4ae..4f06407f904 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -229,6 +229,8 @@ import Cardano.Wallet.Primitive.Types , 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 @@ -805,6 +807,8 @@ fromShelleyPParams eraInfo currentNodeProtocolParameters pp = maryTokenBundleMaxSize (W.ExecutionUnits 0 0) pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraShelley pp , minimumUTxOvalue = MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp @@ -831,6 +835,8 @@ fromAllegraPParams eraInfo currentNodeProtocolParameters pp = maryTokenBundleMaxSize (W.ExecutionUnits 0 0) pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra pp , minimumUTxOvalue = MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp @@ -857,6 +863,8 @@ fromMaryPParams eraInfo currentNodeProtocolParameters pp = maryTokenBundleMaxSize (W.ExecutionUnits 0 0) pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraMary pp , minimumUTxOvalue = MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp @@ -888,6 +896,8 @@ fromAlonzoPParams eraInfo currentNodeProtocolParameters pp = pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo pp , minimumUTxOvalue = MinimumUTxOValueCostPerWord . toWalletCoin $ Alonzo._coinsPerUTxOWord pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp @@ -917,6 +927,8 @@ fromBabbagePParams eraInfo currentNodeProtocolParameters pp = pp , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp + , minimumUTxO = + minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage pp , minimumUTxOvalue = MinimumUTxOValueCostPerWord . fromByteToWord . toWalletCoin $ Babbage._coinsPerUTxOByte pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs index e3bd08a13b5..2735fadc14e 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs @@ -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 + ( minimumUTxONone ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -865,6 +867,8 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do } , maximumCollateralInputCount = maxCollateralInputs , minimumCollateralPercentage = collateralPercent + -- TODO: Determine the appropriate value for this field: + , minimumUTxO = minimumUTxONone , currentNodeProtocolParameters = Just Node.ProtocolParameters diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index a8cfed5ff8f..804ec0a7872 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -161,6 +161,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,6 +2135,8 @@ dummyProtocolParameters = ProtocolParameters error "dummyProtocolParameters: txParameters" , desiredNumberOfStakePools = error "dummyProtocolParameters: desiredNumberOfStakePools" + , minimumUTxO = + error "dummyProtocolParameters: minimumUTxO" , minimumUTxOvalue = error "dummyProtocolParameters: minimumUTxOvalue" , stakeKeyDeposit = @@ -2181,6 +2185,7 @@ mockProtocolParameters = dummyProtocolParameters , getTokenBundleMaxSize = TokenBundleMaxSize $ TxSize 4000 , getMaxExecutionUnits = ExecutionUnits 10_000_000_000 14_000_000 } + , minimumUTxO = MinimumUTxOConstant $ Coin 1000000 , minimumUTxOvalue = MinimumUTxOValue $ Coin 1000000 , maximumCollateralInputCount = 3 , minimumCollateralPercentage = 150 From 6f7de9b141dbb274fe08cf319143333980e1503b Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 06:28:27 +0000 Subject: [PATCH 09/36] Add function `computeMinimumCoinForUTxO`. --- lib/shelley/cardano-wallet.cabal | 3 + .../src/Cardano/Wallet/Shelley/MinimumUTxO.hs | 155 ++++++++++++++++ .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 166 ++++++++++++++++++ 3 files changed, 324 insertions(+) create mode 100644 lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs create mode 100644 lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index d597a37ec9e..097e3d9dd46 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -125,6 +125,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 @@ -282,6 +283,7 @@ test-suite unit , ouroboros-network , cardano-ledger-shelley , plutus-core + , quickcheck-classes , text , text-class , transformers @@ -301,6 +303,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/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs new file mode 100644 index 00000000000..3f0b88daf1b --- /dev/null +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2022 IOHK +-- License: Apache-2.0 +-- +-- Computing minimum UTxO values. +-- +module Cardano.Wallet.Shelley.MinimumUTxO + ( computeMinimumCoinForUTxO + , 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 (..), ProtocolParametersForShelleyBasedEra (..) ) +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 ) +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 + MinimumUTxOForShelleyBasedEra pp -> + computeMinimumCoinForShelleyBasedEra pp + +computeMinimumCoinForShelleyBasedEra + :: HasCallStack + => ProtocolParametersForShelleyBasedEra + -> TokenMap + -> Coin +computeMinimumCoinForShelleyBasedEra + (ProtocolParametersForShelleyBasedEra 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 -> + -- We assume that the provided protocol parameters record has all + -- the required parameters for the given era. If this assumption is + -- violated, 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 in the +-- serialized length of its input, 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 dummyAddress $ TokenBundle dummyCoin m + where + dummyAddress :: Address + dummyAddress = Address $ BS.pack $ replicate maximumAddressLength 0 + where + maximumAddressLength :: Int + maximumAddressLength = 57 + + dummyCoin :: Coin + dummyCoin = 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/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs new file mode 100644 index 00000000000..b93e4435bdb --- /dev/null +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Wallet.Shelley.MinimumUTxOSpec + ( spec + ) where + +import Prelude + +import Cardano.Api.Gen + ( genAddressShelley ) +import Cardano.Wallet.Primitive.Types.Address + ( Address (..) ) +import Cardano.Wallet.Primitive.Types.Coin + ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.Coin.Gen + ( chooseCoin, shrinkCoin ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO + ( MinimumUTxO + , ProtocolParametersForShelleyBasedEra (..) + , minimumUTxOForShelleyBasedEra + ) +import Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen + ( genMinimumUTxO + , genProtocolParametersForShelleyBasedEra + , shrinkMinimumUTxO + , shrinkProtocolParametersForShelleyBasedEra + ) +import Cardano.Wallet.Primitive.Types.TokenBundle + ( TokenBundle (..) ) +import Cardano.Wallet.Primitive.Types.TokenMap + ( TokenMap ) +import Cardano.Wallet.Primitive.Types.TokenMap.Gen + ( genTokenMap, shrinkTokenMap ) +import Cardano.Wallet.Primitive.Types.Tx + ( TxOut (..) ) +import Cardano.Wallet.Shelley.Compatibility + ( fromCardanoAddress, toCardanoTxOut ) +import Cardano.Wallet.Shelley.MinimumUTxO + ( computeMinimumCoinForUTxO + , unsafeLovelaceToWalletCoin + , unsafeValueToLovelace + ) +import Data.Function + ( (&) ) +import Data.IntCast + ( intCast ) +import Data.Word + ( Word64 ) +import Generics.SOP + ( NP (..) ) +import Numeric.Natural + ( Natural ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..), Property, property ) +import Test.QuickCheck.Classes + ( eqLaws, showLaws ) +import Test.QuickCheck.Extra + ( genericRoundRobinShrink, report, (<:>), (<@>) ) +import Test.Utils.Laws + ( testLawsMany ) + +import qualified Cardano.Api.Shelley as Cardano +import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle +import qualified Data.ByteString as BS + +spec :: Spec +spec = do + describe "Class instances obey laws" $ do + testLawsMany @MinimumUTxO + [ eqLaws + , showLaws + ] + + describe "computeMinimumCoinForUTxO" $ do + it "prop_computeMinimumCoinForUTxO" $ + prop_computeMinimumCoinForUTxO + & property + it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound" $ + prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound + & property + +prop_computeMinimumCoinForUTxO :: MinimumUTxO -> TokenMap -> Property +prop_computeMinimumCoinForUTxO minimumUTxO m = property $ + computeMinimumCoinForUTxO minimumUTxO m >= Coin 0 + +prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound + :: TokenBundle + -> Cardano.Address Cardano.ShelleyAddr + -> ProtocolParametersForShelleyBasedEra + -> Property +prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound + tokenBundle addr (ProtocolParametersForShelleyBasedEra era pp) = + case apiResultMaybe of + Left e -> error $ unwords + [ "Failed to obtain result from Cardano API:" + , show e + ] + Right value -> prop_inner + $ unsafeLovelaceToWalletCoin + $ unsafeValueToLovelace value + where + prop_inner :: Coin -> Property + prop_inner apiResult = + ourResult >= apiResult + & report + (apiResult) + "apiResult" + & report + (ourResult) + "ourResult" + & report + (BS.length (Cardano.serialiseToRawBytes addr)) + "BS.length (Cardano.serialiseToRawBytes addr))" + & report + (BS.length (unAddress (fromCardanoAddress addr))) + "BS.length (unAddress (fromCardanoAddress addr))" + + apiResultMaybe :: Either Cardano.MinimumUTxOError Cardano.Value + apiResultMaybe = + Cardano.calculateMinimumUTxO era apiTxOut apiProtocolParameters + where + apiTxOut = + toCardanoTxOut era $ + TxOut (fromCardanoAddress addr) tokenBundle + + apiProtocolParameters :: Cardano.ProtocolParameters + apiProtocolParameters = + Cardano.fromLedgerPParams era pp + + ourResult :: Coin + ourResult = computeMinimumCoinForUTxO + (minimumUTxOForShelleyBasedEra era pp) + (TokenBundle.tokens tokenBundle) + +-------------------------------------------------------------------------------- +-- Arbitrary instances +-------------------------------------------------------------------------------- + +instance Arbitrary (Cardano.Address Cardano.ShelleyAddr) where + arbitrary = genAddressShelley + +instance Arbitrary TokenBundle where + arbitrary = TokenBundle + <$> chooseCoin (Coin 0, Coin $ intCast @Word64 @Natural $ maxBound) + <*> genTokenMap + shrink = genericRoundRobinShrink + <@> shrinkCoin + <:> shrinkTokenMap + <:> Nil + +instance Arbitrary MinimumUTxO where + arbitrary = genMinimumUTxO + shrink = shrinkMinimumUTxO + +instance Arbitrary ProtocolParametersForShelleyBasedEra where + arbitrary = genProtocolParametersForShelleyBasedEra + shrink = shrinkProtocolParametersForShelleyBasedEra + +instance Arbitrary TokenMap where + arbitrary = genTokenMap + shrink = shrinkTokenMap From d32b55ad0ffd375853a5a2bb04e86eb704bc32c0 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 30 Jun 2022 06:31:17 +0000 Subject: [PATCH 10/36] Use `computeMinimumCoinForUTxO` within `TransactionLayer.constraints`. --- lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) 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} From 4935f2636a2508f42401d22ce2c2c087811d0d20 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 1 Jul 2022 06:31:44 +0000 Subject: [PATCH 11/36] Simplify minimum UTxO value lookup within `toApiNetworkParameters`. --- lib/core/src/Cardano/Wallet/Api/Types.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) 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 From 03d1c6c84dd07d1bbd1dea0efebbdb3897836185 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 1 Jul 2022 06:46:37 +0000 Subject: [PATCH 12/36] Remove field `minimumUTxOvalue` from primitive type `ProtocolParameters`. --- .../src/Cardano/Wallet/Primitive/Types.hs | 6 ----- .../Wallet/DummyTarget/Primitive/Types.hs | 2 -- .../test/unit/Cardano/Wallet/DB/Arbitrary.hs | 2 -- .../src/Cardano/Wallet/Byron/Compatibility.hs | 2 -- .../Cardano/Wallet/Shelley/Compatibility.hs | 22 +++---------------- .../Wallet/Shelley/Network/Blockfrost.hs | 5 ----- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 4 ---- 7 files changed, 3 insertions(+), 40 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index de79be08fe8..d5dbf9bd7c7 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -1116,9 +1116,6 @@ data ProtocolParameters = ProtocolParameters , minimumUTxO :: MinimumUTxO -- ^ Represents a way of calculating minimum UTxO values. - , minimumUTxOvalue - :: MinimumUTxOValue - -- ^ The minimum UTxO value. , stakeKeyDeposit :: Coin -- ^ Registering a stake key requires storage on the node and as such @@ -1157,7 +1154,6 @@ instance NFData ProtocolParameters where , rnf txParameters , rnf desiredNumberOfStakePools , rnf minimumUTxO - , rnf minimumUTxOvalue , rnf stakeKeyDeposit , rnf eras , rnf maximumCollateralInputCount @@ -1176,8 +1172,6 @@ instance Buildable ProtocolParameters where <> build (pp ^. #desiredNumberOfStakePools) , "Minimum UTxO: " <> build (pp ^. #minimumUTxO) - , "Minimum UTxO value: " - <> build (pp ^. #minimumUTxOvalue) , "Eras:\n" <> indentF 2 (build (pp ^. #eras)) , "Execution unit prices: " 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 129be1671f6..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 (..) @@ -126,7 +125,6 @@ dummyProtocolParameters = ProtocolParameters , txParameters = dummyTxParameters , desiredNumberOfStakePools = 100 , minimumUTxO = MinimumUTxONone - , minimumUTxOvalue = MinimumUTxOValue $ Coin 0 , 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 8d8bbe79b0a..435e4761b06 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs @@ -692,7 +692,6 @@ instance Arbitrary ProtocolParameters where <:> shrink <:> shrink <:> shrink - <:> shrink <:> const [] <:> Nil arbitrary = ProtocolParameters @@ -702,7 +701,6 @@ instance Arbitrary ProtocolParameters where <*> genMinimumUTxO <*> arbitrary <*> arbitrary - <*> arbitrary <*> genMaximumCollateralInputCount <*> genMinimumCollateralPercentage <*> arbitrary diff --git a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs index dcacf2ff62b..2a716a9950b 100644 --- a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs @@ -144,7 +144,6 @@ mainnetNetworkParameters = W.NetworkParameters } , desiredNumberOfStakePools = 0 , minimumUTxO = minimumUTxONone - , minimumUTxOvalue = W.MinimumUTxOValue $ W.Coin 0 , stakeKeyDeposit = W.Coin 0 , eras = W.emptyEraInfo -- Collateral inputs were not supported or required in Byron: @@ -368,7 +367,6 @@ protocolParametersFromPP eraInfo currentNodeProtocolParameters pp = } , desiredNumberOfStakePools = 0 , minimumUTxO = minimumUTxONone - , minimumUTxOvalue = W.MinimumUTxOValue $ W.Coin 0 , 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 4f06407f904..bed7ffc34b0 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -222,7 +222,6 @@ import Cardano.Wallet.Primitive.AddressDerivation import Cardano.Wallet.Primitive.Types ( Certificate (..) , ChainPoint (..) - , MinimumUTxOValue (..) , PoolCertificate (..) , PoolRegistrationCertificate (..) , PoolRetirementCertificate (..) @@ -793,8 +792,7 @@ fromMaxSize :: Natural -> Quantity "byte" Word16 fromMaxSize = Quantity . fromIntegral fromShelleyPParams - :: HasCallStack - => W.EraInfo Bound + :: W.EraInfo Bound -> Maybe Cardano.ProtocolParameters -> Shelley.PParams StandardShelley -> W.ProtocolParameters @@ -809,8 +807,6 @@ fromShelleyPParams eraInfo currentNodeProtocolParameters pp = desiredNumberOfStakePoolsFromPParams pp , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraShelley pp - , minimumUTxOvalue = - MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo -- Collateral inputs were not supported or required in Shelley: @@ -821,8 +817,7 @@ fromShelleyPParams eraInfo currentNodeProtocolParameters pp = } fromAllegraPParams - :: HasCallStack - => W.EraInfo Bound + :: W.EraInfo Bound -> Maybe Cardano.ProtocolParameters -> Allegra.PParams StandardAllegra -> W.ProtocolParameters @@ -837,8 +832,6 @@ fromAllegraPParams eraInfo currentNodeProtocolParameters pp = desiredNumberOfStakePoolsFromPParams pp , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra pp - , minimumUTxOvalue = - MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo -- Collateral inputs were not supported or required in Allegra: @@ -849,8 +842,7 @@ fromAllegraPParams eraInfo currentNodeProtocolParameters pp = } fromMaryPParams - :: HasCallStack - => W.EraInfo Bound + :: W.EraInfo Bound -> Maybe Cardano.ProtocolParameters -> Mary.PParams StandardMary -> W.ProtocolParameters @@ -865,8 +857,6 @@ fromMaryPParams eraInfo currentNodeProtocolParameters pp = desiredNumberOfStakePoolsFromPParams pp , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraMary pp - , minimumUTxOvalue = - MinimumUTxOValue . toWalletCoin $ SLAPI._minUTxOValue pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo -- Collateral inputs were not supported or required in Mary: @@ -898,8 +888,6 @@ fromAlonzoPParams eraInfo currentNodeProtocolParameters pp = desiredNumberOfStakePoolsFromPParams pp , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo pp - , minimumUTxOvalue = MinimumUTxOValueCostPerWord - . toWalletCoin $ Alonzo._coinsPerUTxOWord pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo , maximumCollateralInputCount = unsafeIntToWord $ @@ -929,8 +917,6 @@ fromBabbagePParams eraInfo currentNodeProtocolParameters pp = desiredNumberOfStakePoolsFromPParams pp , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage pp - , minimumUTxOvalue = MinimumUTxOValueCostPerWord - . fromByteToWord . toWalletCoin $ Babbage._coinsPerUTxOByte pp , stakeKeyDeposit = stakeKeyDepositFromPParams pp , eras = fromBoundToEpochNo <$> eraInfo , maximumCollateralInputCount = unsafeIntToWord $ @@ -941,8 +927,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. diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs index 2735fadc14e..4d21613edd3 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs @@ -94,7 +94,6 @@ import Cardano.Wallet.Primitive.Types , FeePolicy (LinearFee) , GenesisParameters (..) , LinearFunction (..) - , MinimumUTxOValue (..) , NetworkParameters (..) , PoolId , ProtocolParameters (..) @@ -815,10 +814,6 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do BF.unQuantity _protocolParamsMaxTxExMem "MaxTxExMem" desiredNumberOfStakePools <- _protocolParamsNOpt "NOpt" - minimumUTxOvalue <- - MinimumUTxOValueCostPerWord . Coin - <$> intCast @_ @Integer _protocolParamsCoinsPerUtxoWord - "CoinsPerUtxoWord" stakeKeyDeposit <- Coin <$> intCast @_ @Integer _protocolParamsKeyDeposit "KeyDeposit" diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 804ec0a7872..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) @@ -2137,8 +2136,6 @@ dummyProtocolParameters = ProtocolParameters error "dummyProtocolParameters: desiredNumberOfStakePools" , minimumUTxO = error "dummyProtocolParameters: minimumUTxO" - , minimumUTxOvalue = - error "dummyProtocolParameters: minimumUTxOvalue" , stakeKeyDeposit = error "dummyProtocolParameters: stakeKeyDeposit" , eras = @@ -2186,7 +2183,6 @@ mockProtocolParameters = dummyProtocolParameters , getMaxExecutionUnits = ExecutionUnits 10_000_000_000 14_000_000 } , minimumUTxO = MinimumUTxOConstant $ Coin 1000000 - , minimumUTxOvalue = MinimumUTxOValue $ Coin 1000000 , maximumCollateralInputCount = 3 , minimumCollateralPercentage = 150 } From 33f480f6b26285e144e4261fa73d8437705e9d81 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 4 Jul 2022 08:22:59 +0000 Subject: [PATCH 13/36] Use type name `MinimumUTxOForShelleyBasedEra`. --- .../Wallet/Primitive/Types/MinimumUTxO.hs | 42 ++++++++--------- .../Wallet/Primitive/Types/MinimumUTxO/Gen.hs | 47 +++++++++---------- .../src/Cardano/Wallet/Shelley/MinimumUTxO.hs | 8 ++-- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 16 +++---- 4 files changed, 54 insertions(+), 59 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs index cc152a30a23..ce9c4d4d443 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs @@ -13,7 +13,7 @@ module Cardano.Wallet.Primitive.Types.MinimumUTxO , minimumUTxONone , minimumUTxOConstant , minimumUTxOForShelleyBasedEra - , ProtocolParametersForShelleyBasedEra (..) + , MinimumUTxOForShelleyBasedEra (..) ) where @@ -42,8 +42,8 @@ data MinimumUTxO where MinimumUTxOConstant :: Coin -> MinimumUTxO - MinimumUTxOForShelleyBasedEra - :: ProtocolParametersForShelleyBasedEra + MinimumUTxOForShelleyBasedEraOf + :: MinimumUTxOForShelleyBasedEra -> MinimumUTxO instance Buildable MinimumUTxO where @@ -54,9 +54,9 @@ instance Buildable MinimumUTxO where [ "MinimumUTxOConstant" , build c ] - MinimumUTxOForShelleyBasedEra pp -> blockListF + MinimumUTxOForShelleyBasedEraOf m -> blockListF [ "MinimumUTxOForShelleyBasedEra" - , build pp + , build m ] instance Eq MinimumUTxO where @@ -68,7 +68,7 @@ instance NFData MinimumUTxO where rnf () MinimumUTxOConstant c -> rnf c - MinimumUTxOForShelleyBasedEra pp -> + MinimumUTxOForShelleyBasedEraOf pp -> rnf pp instance Show MinimumUTxO where @@ -79,7 +79,7 @@ instance Show MinimumUTxO where [ "MinimumUTxOConstant" , show c ] - MinimumUTxOForShelleyBasedEra pp -> unwords + MinimumUTxOForShelleyBasedEraOf pp -> unwords [ "MinimumUTxOForShelleyBasedEra" , show pp ] @@ -95,33 +95,33 @@ minimumUTxOForShelleyBasedEra -> PParams (ShelleyLedgerEra era) -> MinimumUTxO minimumUTxOForShelleyBasedEra era pp = - MinimumUTxOForShelleyBasedEra $ - ProtocolParametersForShelleyBasedEra era pp + MinimumUTxOForShelleyBasedEraOf $ + MinimumUTxOForShelleyBasedEra era pp -------------------------------------------------------------------------------- --- The 'ProtocolParametersForShelleyBasedEra' type +-- The 'MinimumUTxOForShelleyBasedEra' type -------------------------------------------------------------------------------- -data ProtocolParametersForShelleyBasedEra where - ProtocolParametersForShelleyBasedEra +data MinimumUTxOForShelleyBasedEra where + MinimumUTxOForShelleyBasedEra :: ShelleyBasedEra era -> PParams (ShelleyLedgerEra era) - -> ProtocolParametersForShelleyBasedEra + -> MinimumUTxOForShelleyBasedEra -instance Buildable ProtocolParametersForShelleyBasedEra where - build (ProtocolParametersForShelleyBasedEra era _) = blockListF - [ "ProtocolParametersForShelleyBasedEra" +instance Buildable MinimumUTxOForShelleyBasedEra where + build (MinimumUTxOForShelleyBasedEra era _) = blockListF + [ "MinimumUTxOForShelleyBasedEra" , show era ] -instance Eq ProtocolParametersForShelleyBasedEra where +instance Eq MinimumUTxOForShelleyBasedEra where (==) = (==) `on` show -instance NFData ProtocolParametersForShelleyBasedEra where - rnf (ProtocolParametersForShelleyBasedEra !_ !_) = rnf () +instance NFData MinimumUTxOForShelleyBasedEra where + rnf (MinimumUTxOForShelleyBasedEra !_ !_) = rnf () -instance Show ProtocolParametersForShelleyBasedEra where - show (ProtocolParametersForShelleyBasedEra era pp) = unwords +instance Show MinimumUTxOForShelleyBasedEra where + show (MinimumUTxOForShelleyBasedEra era pp) = unwords [ show era , show (fromLedgerPParams 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 index ae47f8bbed3..a3909bcda69 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs @@ -9,9 +9,9 @@ -- module Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen ( genMinimumUTxO - , genProtocolParametersForShelleyBasedEra + , genMinimumUTxOForShelleyBasedEra , shrinkMinimumUTxO - , shrinkProtocolParametersForShelleyBasedEra + , shrinkMinimumUTxOForShelleyBasedEra ) where @@ -22,7 +22,7 @@ import Cardano.Api import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.MinimumUTxO - ( MinimumUTxO (..), ProtocolParametersForShelleyBasedEra (..) ) + ( MinimumUTxO (..), MinimumUTxOForShelleyBasedEra (..) ) import Data.Bits ( Bits ) import Data.Default @@ -49,7 +49,7 @@ genMinimumUTxO :: Gen MinimumUTxO genMinimumUTxO = frequency [ (1, genMinimumUTxONone) , (1, genMinimumUTxOConstant) - , (8, genMinimumUTxOForShelleyBasedEra) + , (8, MinimumUTxOForShelleyBasedEraOf <$> genMinimumUTxOForShelleyBasedEra) ] where genMinimumUTxONone :: Gen MinimumUTxO @@ -59,20 +59,16 @@ genMinimumUTxO = frequency genMinimumUTxOConstant = MinimumUTxOConstant . Coin <$> genInterestingCoinValue - genMinimumUTxOForShelleyBasedEra :: Gen MinimumUTxO - genMinimumUTxOForShelleyBasedEra = MinimumUTxOForShelleyBasedEra - <$> genProtocolParametersForShelleyBasedEra - shrinkMinimumUTxO :: MinimumUTxO -> [MinimumUTxO] shrinkMinimumUTxO = const [] -------------------------------------------------------------------------------- --- Generating 'ProtocolParametersForShelleyBasedEra' values +-- Generating 'MinimumUTxOForShelleyBasedEra' values -------------------------------------------------------------------------------- -genProtocolParametersForShelleyBasedEra - :: Gen ProtocolParametersForShelleyBasedEra -genProtocolParametersForShelleyBasedEra = oneof +genMinimumUTxOForShelleyBasedEra + :: Gen MinimumUTxOForShelleyBasedEra +genMinimumUTxOForShelleyBasedEra = oneof [ genShelley , genAllegra , genMary @@ -80,40 +76,39 @@ genProtocolParametersForShelleyBasedEra = oneof , genBabbage ] where - genShelley :: Gen ProtocolParametersForShelleyBasedEra + genShelley :: Gen MinimumUTxOForShelleyBasedEra genShelley = do minUTxOValue <- genInterestingLedgerCoin - pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraShelley + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraShelley def {Shelley._minUTxOValue = minUTxOValue} - genAllegra :: Gen ProtocolParametersForShelleyBasedEra + genAllegra :: Gen MinimumUTxOForShelleyBasedEra genAllegra = do minUTxOValue <- genInterestingLedgerCoin - pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraAllegra + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra def {Shelley._minUTxOValue = minUTxOValue} - genMary :: Gen ProtocolParametersForShelleyBasedEra + genMary :: Gen MinimumUTxOForShelleyBasedEra genMary = do minUTxOValue <- genInterestingLedgerCoin - pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraMary + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraMary def {Shelley._minUTxOValue = minUTxOValue} - genAlonzo :: Gen ProtocolParametersForShelleyBasedEra + genAlonzo :: Gen MinimumUTxOForShelleyBasedEra genAlonzo = do coinsPerUTxOWord <- genInterestingLedgerCoin - pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraAlonzo + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo def {Alonzo._coinsPerUTxOWord = coinsPerUTxOWord} - genBabbage :: Gen ProtocolParametersForShelleyBasedEra + genBabbage :: Gen MinimumUTxOForShelleyBasedEra genBabbage = do coinsPerUTxOByte <- genInterestingLedgerCoin - pure $ ProtocolParametersForShelleyBasedEra ShelleyBasedEraBabbage + pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage def {Babbage._coinsPerUTxOByte = coinsPerUTxOByte} -shrinkProtocolParametersForShelleyBasedEra - :: ProtocolParametersForShelleyBasedEra - -> [ProtocolParametersForShelleyBasedEra] -shrinkProtocolParametersForShelleyBasedEra = const [] +shrinkMinimumUTxOForShelleyBasedEra + :: MinimumUTxOForShelleyBasedEra -> [MinimumUTxOForShelleyBasedEra] +shrinkMinimumUTxOForShelleyBasedEra = const [] -------------------------------------------------------------------------------- -- Internal functions diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs index 3f0b88daf1b..2425fed77e9 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -20,7 +20,7 @@ import Cardano.Wallet.Primitive.Types.Address import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.MinimumUTxO - ( MinimumUTxO (..), ProtocolParametersForShelleyBasedEra (..) ) + ( MinimumUTxO (..), MinimumUTxOForShelleyBasedEra (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) import Cardano.Wallet.Primitive.Types.TokenMap @@ -52,16 +52,16 @@ computeMinimumCoinForUTxO = \case const (Coin 0) MinimumUTxOConstant c -> const c - MinimumUTxOForShelleyBasedEra pp -> + MinimumUTxOForShelleyBasedEraOf pp -> computeMinimumCoinForShelleyBasedEra pp computeMinimumCoinForShelleyBasedEra :: HasCallStack - => ProtocolParametersForShelleyBasedEra + => MinimumUTxOForShelleyBasedEra -> TokenMap -> Coin computeMinimumCoinForShelleyBasedEra - (ProtocolParametersForShelleyBasedEra era pp) tokenMap = + (MinimumUTxOForShelleyBasedEra era pp) tokenMap = extractResult $ Cardano.calculateMinimumUTxO era (embedTokenMapWithinPaddedTxOut era tokenMap) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index b93e4435bdb..145e6c20889 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -19,14 +19,14 @@ import Cardano.Wallet.Primitive.Types.Coin.Gen ( chooseCoin, shrinkCoin ) import Cardano.Wallet.Primitive.Types.MinimumUTxO ( MinimumUTxO - , ProtocolParametersForShelleyBasedEra (..) + , MinimumUTxOForShelleyBasedEra (..) , minimumUTxOForShelleyBasedEra ) import Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen ( genMinimumUTxO - , genProtocolParametersForShelleyBasedEra + , genMinimumUTxOForShelleyBasedEra , shrinkMinimumUTxO - , shrinkProtocolParametersForShelleyBasedEra + , shrinkMinimumUTxOForShelleyBasedEra ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) @@ -91,10 +91,10 @@ prop_computeMinimumCoinForUTxO minimumUTxO m = property $ prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound :: TokenBundle -> Cardano.Address Cardano.ShelleyAddr - -> ProtocolParametersForShelleyBasedEra + -> MinimumUTxOForShelleyBasedEra -> Property prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound - tokenBundle addr (ProtocolParametersForShelleyBasedEra era pp) = + tokenBundle addr (MinimumUTxOForShelleyBasedEra era pp) = case apiResultMaybe of Left e -> error $ unwords [ "Failed to obtain result from Cardano API:" @@ -157,9 +157,9 @@ instance Arbitrary MinimumUTxO where arbitrary = genMinimumUTxO shrink = shrinkMinimumUTxO -instance Arbitrary ProtocolParametersForShelleyBasedEra where - arbitrary = genProtocolParametersForShelleyBasedEra - shrink = shrinkProtocolParametersForShelleyBasedEra +instance Arbitrary MinimumUTxOForShelleyBasedEra where + arbitrary = genMinimumUTxOForShelleyBasedEra + shrink = shrinkMinimumUTxOForShelleyBasedEra instance Arbitrary TokenMap where arbitrary = genTokenMap From c9a8558cb547b6bd70d92c449a4cd80f87db07cd Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 5 Jul 2022 02:44:16 +0000 Subject: [PATCH 14/36] Extract out constants `maxLengthCoin` and `maxLengthAddress`. --- .../src/Cardano/Wallet/Shelley/MinimumUTxO.hs | 35 ++++++++++++++----- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs index 2425fed77e9..5fc36cd1d21 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -9,6 +9,8 @@ -- module Cardano.Wallet.Shelley.MinimumUTxO ( computeMinimumCoinForUTxO + , maxLengthCoin + , maxLengthAddress , unsafeLovelaceToWalletCoin , unsafeValueToLovelace ) where @@ -34,7 +36,7 @@ import Data.Function import Data.IntCast ( intCast, intCastMaybe ) import Data.Word - ( Word64 ) + ( Word64, Word8 ) import GHC.Stack ( HasCallStack ) import Numeric.Natural @@ -113,16 +115,31 @@ embedTokenMapWithinPaddedTxOut -> TokenMap -> Cardano.TxOut Cardano.CtxTx era embedTokenMapWithinPaddedTxOut era m = - toCardanoTxOut era $ TxOut dummyAddress $ TokenBundle dummyCoin 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 - dummyAddress :: Address - dummyAddress = Address $ BS.pack $ replicate maximumAddressLength 0 - where - maximumAddressLength :: Int - maximumAddressLength = 57 + maxAddressLength :: Int + maxAddressLength = 57 - dummyCoin :: Coin - dummyCoin = Coin $ intCast @Word64 @Natural $ maxBound + 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. -- From aad20539715ba7eb4a53e32b33ea7c358f384c3f Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 5 Jul 2022 02:44:49 +0000 Subject: [PATCH 15/36] Revise `computeMinimumCoinForUTxO` property to check upper and lower bounds. --- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 84 +++++++++++-------- 1 file changed, 50 insertions(+), 34 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 145e6c20889..2385b72a111 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -40,6 +40,8 @@ import Cardano.Wallet.Shelley.Compatibility ( fromCardanoAddress, toCardanoTxOut ) import Cardano.Wallet.Shelley.MinimumUTxO ( computeMinimumCoinForUTxO + , maxLengthAddress + , maxLengthCoin , unsafeLovelaceToWalletCoin , unsafeValueToLovelace ) @@ -60,7 +62,7 @@ import Test.QuickCheck import Test.QuickCheck.Classes ( eqLaws, showLaws ) import Test.QuickCheck.Extra - ( genericRoundRobinShrink, report, (<:>), (<@>) ) + ( genericRoundRobinShrink, report, verify, (<:>), (<@>) ) import Test.Utils.Laws ( testLawsMany ) @@ -80,58 +82,72 @@ spec = do it "prop_computeMinimumCoinForUTxO" $ prop_computeMinimumCoinForUTxO & property - it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound" $ - prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound + it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds" $ + prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds & property prop_computeMinimumCoinForUTxO :: MinimumUTxO -> TokenMap -> Property prop_computeMinimumCoinForUTxO minimumUTxO m = property $ computeMinimumCoinForUTxO minimumUTxO m >= Coin 0 -prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound +prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds :: TokenBundle -> Cardano.Address Cardano.ShelleyAddr -> MinimumUTxOForShelleyBasedEra -> Property -prop_computeMinimumCoinForUTxO_shelleyBasedEra_lowerBound +prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds tokenBundle addr (MinimumUTxOForShelleyBasedEra era pp) = - case apiResultMaybe of + case apiResultBoundsM of Left e -> error $ unwords [ "Failed to obtain result from Cardano API:" , show e ] - Right value -> prop_inner - $ unsafeLovelaceToWalletCoin - $ unsafeValueToLovelace value + Right apiResultBounds -> prop_inner apiResultBounds where - prop_inner :: Coin -> Property - prop_inner apiResult = - ourResult >= apiResult - & report - (apiResult) - "apiResult" - & report - (ourResult) - "ourResult" - & report - (BS.length (Cardano.serialiseToRawBytes addr)) - "BS.length (Cardano.serialiseToRawBytes addr))" - & report - (BS.length (unAddress (fromCardanoAddress addr))) - "BS.length (unAddress (fromCardanoAddress addr))" - - apiResultMaybe :: Either Cardano.MinimumUTxOError Cardano.Value - apiResultMaybe = - Cardano.calculateMinimumUTxO era apiTxOut apiProtocolParameters + prop_inner :: (Coin, Coin) -> Property + prop_inner (apiResultMinBound, apiResultMaxBound) = 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 (fromCardanoAddress addr))) + "BS.length (unAddress (fromCardanoAddress addr))" + & report + (BS.length (unAddress maxLengthAddress)) + "BS.length (unAddress maxLengthAddress))" + + apiResultBoundsM :: Either Cardano.MinimumUTxOError (Coin, Coin) + apiResultBoundsM = (,) + <$> apiCalculateMinimumUTxO apiTxOutMinBound + <*> apiCalculateMinimumUTxO apiTxOutMaxBound where - apiTxOut = - toCardanoTxOut era $ - TxOut (fromCardanoAddress addr) tokenBundle - - apiProtocolParameters :: Cardano.ProtocolParameters - apiProtocolParameters = + apiCalculateMinimumUTxO tx = + fmap (unsafeLovelaceToWalletCoin . unsafeValueToLovelace) $ + Cardano.calculateMinimumUTxO era tx $ Cardano.fromLedgerPParams era pp + apiTxOutMinBound = + toCardanoTxOut era $ TxOut (fromCardanoAddress addr) tokenBundle + + apiTxOutMaxBound = + toCardanoTxOut era $ TxOut maxLengthAddress $ + TokenBundle.setCoin tokenBundle maxLengthCoin + ourResult :: Coin ourResult = computeMinimumCoinForUTxO (minimumUTxOForShelleyBasedEra era pp) From 527529b9059c1f5b192ae1edd634d73bbe1bbd07 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 5 Jul 2022 03:57:12 +0000 Subject: [PATCH 16/36] Add function `genAddressAny` to `Cardano.Api.Gen`. --- lib/core/src/Cardano/Api/Gen.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) 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 From a46f5006339deb1bf293e4b9dc37fefbfec7d477 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 5 Jul 2022 03:58:22 +0000 Subject: [PATCH 17/36] Revise `computeMinimumCoinForUTxO` property to test Byron and Shelley addresses. --- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 23 ++++++++++++------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 2385b72a111..94c03b7d9e1 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -10,7 +10,7 @@ module Cardano.Wallet.Shelley.MinimumUTxOSpec import Prelude import Cardano.Api.Gen - ( genAddressShelley ) + ( genAddressAny ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Coin @@ -37,7 +37,7 @@ import Cardano.Wallet.Primitive.Types.TokenMap.Gen import Cardano.Wallet.Primitive.Types.Tx ( TxOut (..) ) import Cardano.Wallet.Shelley.Compatibility - ( fromCardanoAddress, toCardanoTxOut ) + ( toCardanoTxOut ) import Cardano.Wallet.Shelley.MinimumUTxO ( computeMinimumCoinForUTxO , maxLengthAddress @@ -92,7 +92,7 @@ prop_computeMinimumCoinForUTxO minimumUTxO m = property $ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds :: TokenBundle - -> Cardano.Address Cardano.ShelleyAddr + -> Cardano.AddressAny -> MinimumUTxOForShelleyBasedEra -> Property prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds @@ -125,8 +125,8 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds (BS.length (Cardano.serialiseToRawBytes addr)) "BS.length (Cardano.serialiseToRawBytes addr))" & report - (BS.length (unAddress (fromCardanoAddress addr))) - "BS.length (unAddress (fromCardanoAddress addr))" + (BS.length (unAddress (fromCardanoAddressAny addr))) + "BS.length (unAddress (fromCardanoAddressAny addr))" & report (BS.length (unAddress maxLengthAddress)) "BS.length (unAddress maxLengthAddress))" @@ -142,7 +142,7 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds Cardano.fromLedgerPParams era pp apiTxOutMinBound = - toCardanoTxOut era $ TxOut (fromCardanoAddress addr) tokenBundle + toCardanoTxOut era $ TxOut (fromCardanoAddressAny addr) tokenBundle apiTxOutMaxBound = toCardanoTxOut era $ TxOut maxLengthAddress $ @@ -153,12 +153,19 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds (minimumUTxOForShelleyBasedEra era pp) (TokenBundle.tokens tokenBundle) +-------------------------------------------------------------------------------- +-- Utility functions +-------------------------------------------------------------------------------- + +fromCardanoAddressAny :: Cardano.AddressAny -> Address +fromCardanoAddressAny = Address . Cardano.serialiseToRawBytes + -------------------------------------------------------------------------------- -- Arbitrary instances -------------------------------------------------------------------------------- -instance Arbitrary (Cardano.Address Cardano.ShelleyAddr) where - arbitrary = genAddressShelley +instance Arbitrary Cardano.AddressAny where + arbitrary = genAddressAny instance Arbitrary TokenBundle where arbitrary = TokenBundle From ae5790f8e0638cde14b5fffa168e60c7ebb48607 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 5 Jul 2022 04:32:22 +0000 Subject: [PATCH 18/36] Add explanatory comments to properties in `MinimumUTxOSpec`. --- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 94c03b7d9e1..14b6a2fa616 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -79,17 +79,25 @@ spec = do ] describe "computeMinimumCoinForUTxO" $ do - it "prop_computeMinimumCoinForUTxO" $ - prop_computeMinimumCoinForUTxO + it "prop_computeMinimumCoinForUTxO_evaluation" $ + prop_computeMinimumCoinForUTxO_evaluation & property it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds" $ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds & property -prop_computeMinimumCoinForUTxO :: MinimumUTxO -> TokenMap -> Property -prop_computeMinimumCoinForUTxO minimumUTxO m = property $ +-- 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 From d9c8cae02bfd97d52e50faf30a832ba30303e9ae Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 5 Jul 2022 04:54:19 +0000 Subject: [PATCH 19/36] Use more robust generator for `TokenBundle` values. --- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 27 ++++++------------- 1 file changed, 8 insertions(+), 19 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 14b6a2fa616..16c7eab6146 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -15,8 +15,6 @@ import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) -import Cardano.Wallet.Primitive.Types.Coin.Gen - ( chooseCoin, shrinkCoin ) import Cardano.Wallet.Primitive.Types.MinimumUTxO ( MinimumUTxO , MinimumUTxOForShelleyBasedEra (..) @@ -30,12 +28,16 @@ import Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) +import Cardano.Wallet.Primitive.Types.TokenBundle.Gen + ( shrinkTokenBundle ) import Cardano.Wallet.Primitive.Types.TokenMap ( TokenMap ) import Cardano.Wallet.Primitive.Types.TokenMap.Gen ( genTokenMap, shrinkTokenMap ) import Cardano.Wallet.Primitive.Types.Tx ( TxOut (..) ) +import Cardano.Wallet.Primitive.Types.Tx.Gen + ( genTxOutTokenBundle ) import Cardano.Wallet.Shelley.Compatibility ( toCardanoTxOut ) import Cardano.Wallet.Shelley.MinimumUTxO @@ -47,22 +49,14 @@ import Cardano.Wallet.Shelley.MinimumUTxO ) import Data.Function ( (&) ) -import Data.IntCast - ( intCast ) -import Data.Word - ( Word64 ) -import Generics.SOP - ( NP (..) ) -import Numeric.Natural - ( Natural ) import Test.Hspec ( Spec, describe, it ) import Test.QuickCheck - ( Arbitrary (..), Property, property ) + ( Arbitrary (..), Property, property, sized ) import Test.QuickCheck.Classes ( eqLaws, showLaws ) import Test.QuickCheck.Extra - ( genericRoundRobinShrink, report, verify, (<:>), (<@>) ) + ( report, verify ) import Test.Utils.Laws ( testLawsMany ) @@ -176,13 +170,8 @@ instance Arbitrary Cardano.AddressAny where arbitrary = genAddressAny instance Arbitrary TokenBundle where - arbitrary = TokenBundle - <$> chooseCoin (Coin 0, Coin $ intCast @Word64 @Natural $ maxBound) - <*> genTokenMap - shrink = genericRoundRobinShrink - <@> shrinkCoin - <:> shrinkTokenMap - <:> Nil + arbitrary = sized genTxOutTokenBundle + shrink = shrinkTokenBundle instance Arbitrary MinimumUTxO where arbitrary = genMinimumUTxO From 009d3e3a2cbe532f61a8757b4f7fb762c430e45c Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 5 Jul 2022 07:43:46 +0000 Subject: [PATCH 20/36] Use coins-per-word-based calculation for Blockfrost. --- lib/shelley/cardano-wallet.cabal | 1 + .../Cardano/Wallet/Shelley/Network/Blockfrost.hs | 15 ++++++++++++--- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index 097e3d9dd46..e7d73e5d8b6 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 diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs index 4d21613edd3..1fc73884611 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 (..) ) @@ -120,7 +121,7 @@ import Cardano.Wallet.Primitive.Types.Coin import Cardano.Wallet.Primitive.Types.Hash ( Hash ) import Cardano.Wallet.Primitive.Types.MinimumUTxO - ( minimumUTxONone ) + ( minimumUTxOForShelleyBasedEra ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -164,6 +165,8 @@ import Data.Bifunctor ( first ) import Data.Bitraversable ( bitraverse ) +import Data.Default + ( Default (..) ) import Data.Function ( (&) ) import Data.Functor @@ -229,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 @@ -814,6 +819,9 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do BF.unQuantity _protocolParamsMaxTxExMem "MaxTxExMem" desiredNumberOfStakePools <- _protocolParamsNOpt "NOpt" + coinsPerUTxOWord <- Ledger.Coin + <$> intCast @_ @Integer _protocolParamsCoinsPerUtxoWord + "CoinsPerUtxoWord" stakeKeyDeposit <- Coin <$> intCast @_ @Integer _protocolParamsKeyDeposit "KeyDeposit" @@ -862,8 +870,9 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do } , maximumCollateralInputCount = maxCollateralInputs , minimumCollateralPercentage = collateralPercent - -- TODO: Determine the appropriate value for this field: - , minimumUTxO = minimumUTxONone + -- TODO: Revise this so that we are not hard-coding the era: + , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo + def {Alonzo._coinsPerUTxOWord = coinsPerUTxOWord} , currentNodeProtocolParameters = Just Node.ProtocolParameters From c26ef6fe8a2ebb3ff9d61d8e490f457f2b883a58 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 6 Jul 2022 05:51:58 +0000 Subject: [PATCH 21/36] Extract out `getMinimumUTxOFunction` within Blockfrost network layer. This function encapsulates the logic of constructing an era-specific minimum UTxO function, and reduces the complexity of the `fromBlockfrostPP` function. --- .../Wallet/Shelley/Network/Blockfrost.hs | 39 +++++++++++++++---- 1 file changed, 31 insertions(+), 8 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs index 1fc73884611..d632fa6697a 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs @@ -121,7 +121,7 @@ import Cardano.Wallet.Primitive.Types.Coin import Cardano.Wallet.Primitive.Types.Hash ( Hash ) import Cardano.Wallet.Primitive.Types.MinimumUTxO - ( minimumUTxOForShelleyBasedEra ) + ( MinimumUTxO, minimumUTxOForShelleyBasedEra ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -791,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 @@ -819,9 +819,8 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do BF.unQuantity _protocolParamsMaxTxExMem "MaxTxExMem" desiredNumberOfStakePools <- _protocolParamsNOpt "NOpt" - coinsPerUTxOWord <- Ledger.Coin - <$> intCast @_ @Integer _protocolParamsCoinsPerUtxoWord - "CoinsPerUtxoWord" + minimumUTxO <- + getMinimumUTxOFunction pp stakeKeyDeposit <- Coin <$> intCast @_ @Integer _protocolParamsKeyDeposit "KeyDeposit" @@ -870,9 +869,6 @@ fromBlockfrostPP network BF.ProtocolParams{..} = do } , maximumCollateralInputCount = maxCollateralInputs , minimumCollateralPercentage = collateralPercent - -- TODO: Revise this so that we are not hard-coding the era: - , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo - def {Alonzo._coinsPerUTxOWord = coinsPerUTxOWord} , currentNodeProtocolParameters = Just Node.ProtocolParameters @@ -938,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)) & From c2a55f61df0f23a40fa7b215a4df8c77a730cc08 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 7 Jul 2022 02:42:19 +0000 Subject: [PATCH 22/36] Generalize function `verify` in `Test.QuickCheck.Extra`. This allows `verify` to modify any `Testable` value. --- lib/test-utils/src/Test/QuickCheck/Extra.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From c4f01d9c1fb74d9765bb221642dafe5526f218db Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 7 Jul 2022 03:53:49 +0000 Subject: [PATCH 23/36] Add property `prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability`. This function compares the stability of: - the Cardano API function 'calculateMinimumUTxO' - the wallet function 'computeMinimumCoinForUTxO' --- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 83 ++++++++++++++++++- 1 file changed, 82 insertions(+), 1 deletion(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 16c7eab6146..9cb2a4338cc 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -52,7 +52,14 @@ import Data.Function import Test.Hspec ( Spec, describe, it ) import Test.QuickCheck - ( Arbitrary (..), Property, property, sized ) + ( Arbitrary (..) + , Property + , checkCoverage + , conjoin + , cover + , property + , sized + ) import Test.QuickCheck.Classes ( eqLaws, showLaws ) import Test.QuickCheck.Extra @@ -79,6 +86,9 @@ spec = do it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds" $ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds & property + it "prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability" $ + prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability + & property -- Check that it's possible to evaluate 'computeMinimumCoinForUTxO' without -- any run-time error. @@ -155,6 +165,77 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds (minimumUTxOForShelleyBasedEra era pp) (TokenBundle.tokens tokenBundle) +-- Compares the stability of: +-- +-- - the Cardano API function 'calculateMinimumUTxO' +-- - the wallet function 'computeMinimumCoinForUTxO' +-- +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) + -------------------------------------------------------------------------------- -- Utility functions -------------------------------------------------------------------------------- From 6bd15b1b942a7e9fccb11e4cc665b0c26d30da06 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 7 Jul 2022 05:22:27 +0000 Subject: [PATCH 24/36] Simplify property `prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds`. Simplify this property by moving the error pattern match to inner function `apiComputeMinCoin`. We assume that error pattern will never match. But if it does, then this property will still fail. --- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 105 +++++++++--------- 1 file changed, 53 insertions(+), 52 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 9cb2a4338cc..506fd2c87d8 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -109,61 +109,62 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds -> Property prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds tokenBundle addr (MinimumUTxOForShelleyBasedEra era pp) = - case apiResultBoundsM of - Left e -> error $ unwords - [ "Failed to obtain result from Cardano API:" - , show e - ] - Right apiResultBounds -> prop_inner apiResultBounds + 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 - prop_inner :: (Coin, Coin) -> Property - prop_inner (apiResultMinBound, apiResultMaxBound) = 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))" - - apiResultBoundsM :: Either Cardano.MinimumUTxOError (Coin, Coin) - apiResultBoundsM = (,) - <$> apiCalculateMinimumUTxO apiTxOutMinBound - <*> apiCalculateMinimumUTxO apiTxOutMaxBound + -- 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 - apiCalculateMinimumUTxO tx = - fmap (unsafeLovelaceToWalletCoin . unsafeValueToLovelace) $ - Cardano.calculateMinimumUTxO era tx $ - Cardano.fromLedgerPParams era pp - - apiTxOutMinBound = - toCardanoTxOut era $ TxOut (fromCardanoAddressAny addr) tokenBundle - - apiTxOutMaxBound = - toCardanoTxOut era $ TxOut maxLengthAddress $ - TokenBundle.setCoin tokenBundle maxLengthCoin + raiseApiError e = error $ unwords + ["Failed to obtain result from Cardano API:", show e] + toApiTxOut = toCardanoTxOut era . TxOut a + unsafeValueToWalletCoin = + (unsafeLovelaceToWalletCoin . unsafeValueToLovelace) - ourResult :: Coin - ourResult = computeMinimumCoinForUTxO - (minimumUTxOForShelleyBasedEra era pp) - (TokenBundle.tokens tokenBundle) + -- Uses the wallet function 'computeMinimumCoinForUTxO' to compute a + -- minimum 'Coin' value. + -- + ourComputeMinCoin :: TokenMap -> Coin + ourComputeMinCoin = + computeMinimumCoinForUTxO (minimumUTxOForShelleyBasedEra era pp) -- Compares the stability of: -- From 4f348ca748b232cd0805918fe62b60ba2855b7e5 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 8 Jul 2022 05:42:41 +0000 Subject: [PATCH 25/36] Add golden tests for minimum UTxO values. We add golden minimum UTxO values for all Shelley-based eras. --- lib/shelley/cardano-wallet.cabal | 1 + .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 287 +++++++++++++++++- 2 files changed, 277 insertions(+), 11 deletions(-) diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index e7d73e5d8b6..02fca9476dd 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -264,6 +264,7 @@ test-suite unit , strict-containers , containers , contra-tracer + , data-default , directory , filepath , fmt diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 506fd2c87d8..cb9abd86d20 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -1,7 +1,12 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{- HLINT ignore "Use camelCase" -} module Cardano.Wallet.Shelley.MinimumUTxOSpec ( spec @@ -9,6 +14,8 @@ module Cardano.Wallet.Shelley.MinimumUTxOSpec import Prelude +import Cardano.Api + ( ShelleyBasedEra (..) ) import Cardano.Api.Gen ( genAddressAny ) import Cardano.Wallet.Primitive.Types.Address @@ -31,11 +38,15 @@ import Cardano.Wallet.Primitive.Types.TokenBundle import Cardano.Wallet.Primitive.Types.TokenBundle.Gen ( shrinkTokenBundle ) import Cardano.Wallet.Primitive.Types.TokenMap - ( 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 (..) ) + ( TxOut (..), txOutMaxTokenQuantity, txOutMinTokenQuantity ) import Cardano.Wallet.Primitive.Types.Tx.Gen ( genTxOutTokenBundle ) import Cardano.Wallet.Shelley.Compatibility @@ -47,8 +58,16 @@ import Cardano.Wallet.Shelley.MinimumUTxO , unsafeLovelaceToWalletCoin , unsafeValueToLovelace ) +import Control.Monad + ( forM_ ) +import Data.Default + ( Default (..) ) import Data.Function ( (&) ) +import Data.Generics.Internal.VL.Lens + ( view ) +import GHC.Generics + ( Generic ) import Test.Hspec ( Spec, describe, it ) import Test.QuickCheck @@ -57,6 +76,8 @@ import Test.QuickCheck , checkCoverage , conjoin , cover + , elements + , frequency , property , sized ) @@ -66,10 +87,19 @@ import Test.QuickCheck.Extra ( report, verify ) import Test.Utils.Laws ( testLawsMany ) +import Test.Utils.Pretty + ( (====) ) 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.Coin as Ledger +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 @@ -80,15 +110,36 @@ spec = do ] describe "computeMinimumCoinForUTxO" $ 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 "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. @@ -237,6 +288,220 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability 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) + , result = coinExpected + } + title = unwords + ["goldenTests_computeMinimumCoinForUTxO", eraName] + +-------------------------------------------------------------------------------- +-- Golden 'MinimumUTxO' values +-------------------------------------------------------------------------------- + +goldenMinimumUTxO_Shelley :: MinimumUTxO +goldenMinimumUTxO_Shelley = + minimumUTxOForShelleyBasedEra ShelleyBasedEraShelley + -- Value derived from 'mainnet-shelley-genesis.json': + def {Shelley._minUTxOValue = Ledger.Coin 1_000_000} + +goldenMinimumUTxO_Allegra :: MinimumUTxO +goldenMinimumUTxO_Allegra = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra + -- Value derived from 'mainnet-shelley-genesis.json': + def {Shelley._minUTxOValue = Ledger.Coin 1_000_000} + +goldenMinimumUTxO_Mary :: MinimumUTxO +goldenMinimumUTxO_Mary = + minimumUTxOForShelleyBasedEra ShelleyBasedEraMary + -- Value derived from 'mainnet-shelley-genesis.json': + def {Shelley._minUTxOValue = Ledger.Coin 1_000_000} + +goldenMinimumUTxO_Alonzo :: MinimumUTxO +goldenMinimumUTxO_Alonzo = + minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo + -- Value derived from 'mainnet-alonzo-genesis.json': + def {Alonzo._coinsPerUTxOWord = Ledger.Coin 34_482} + +goldenMinimumUTxO_Babbage :: MinimumUTxO +goldenMinimumUTxO_Babbage = + minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage + -- Value derived from 'mainnet-alonzo-genesis.json': + def {Babbage._coinsPerUTxOByte = Ledger.Coin 4_310} + +-------------------------------------------------------------------------------- +-- 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 + , result :: result + } + deriving (Eq, Generic, Show) + +goldenTests + :: (Eq result, Show result) + => String + -> (params -> result) + -> [GoldenTestData params result] + -> Spec +goldenTests title f goldenTestData = + describe title $ + forM_ (zip testNumbers goldenTestData) $ + \(testNumber :: Int, test) -> do + let subtitle = "golden test #" <> show testNumber + it subtitle $ + let resultExpected = view #result test in + let resultActual = f (view #params test) in + property $ resultExpected ==== resultActual + where + testNumbers :: [Int] + testNumbers = [0 ..] + -------------------------------------------------------------------------------- -- Utility functions -------------------------------------------------------------------------------- From f75c995a7c085ef6c34b0ccd331b0cbb1b7fc8e5 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 8 Jul 2022 05:43:25 +0000 Subject: [PATCH 26/36] Include golden `TokenMap` values in generator for `TokenMap`. --- .../test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index cb9abd86d20..ef0a05dc7cc 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -529,5 +529,8 @@ instance Arbitrary MinimumUTxOForShelleyBasedEra where shrink = shrinkMinimumUTxOForShelleyBasedEra instance Arbitrary TokenMap where - arbitrary = genTokenMap + arbitrary = frequency + [ (4, genTokenMap) + , (1, elements goldenTokenMaps) + ] shrink = shrinkTokenMap From 75015c2612da3fb00d513c12e53fc834139bb2b6 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 8 Jul 2022 06:49:15 +0000 Subject: [PATCH 27/36] Disable `PartialTypeSignatures` in `Shelley.Compatibility`. This extension was only used once in the whole module. In the particular case it was used, it is arguably clearer and safer to state the era explicitly. --- lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index bed7ffc34b0..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 #-} @@ -1907,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 From 763a0d3b81bcf570783bbd5866808bd9a509f03f Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 8 Jul 2022 07:09:15 +0000 Subject: [PATCH 28/36] Remove legacy function `computeMinimumAdaQuantity` from `Compatibility.Ledger`. --- .../Wallet/Shelley/Compatibility/Ledger.hs | 91 +------ .../Shelley/Compatibility/LedgerSpec.hs | 226 +----------------- 2 files changed, 5 insertions(+), 312 deletions(-) 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/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 From fc2344e5f526820ae204bda5f7eadd2836d99951 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 8 Jul 2022 07:14:44 +0000 Subject: [PATCH 29/36] Remove legacy type `MinimumUTxOValue` from `Primitive.Types`. --- lib/core/src/Cardano/Wallet/Primitive/Types.hs | 18 ------------------ .../test/unit/Cardano/Wallet/DB/Arbitrary.hs | 5 ----- 2 files changed, 23 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index d5dbf9bd7c7..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 (..) @@ -1083,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 diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs index 435e4761b06..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 (..) @@ -720,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 From 964faa46b5be5b6f1948ae68904eef1431ed4a22 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 11 Jul 2022 02:30:49 +0000 Subject: [PATCH 30/36] Improve clarity of counterexample output within golden tests. In particular, we indicate more clearly which value was expected, and which value was returned. For example: ``` Failures: lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs:490:9: 1) computeMinimumCoinForUTxO, Golden Tests, goldenTests_computeMinimumCoinForUTxO Babbage, golden test #3 Falsified (after 1 test): resultExpected: Coin 1323170 Coin 1323170 resultReturned: Coin 1357650 Condition violated: resultReturned == resultExpected ``` --- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 33 +++++++++---------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index ef0a05dc7cc..49d3ba343b7 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -64,10 +63,6 @@ import Data.Default ( Default (..) ) import Data.Function ( (&) ) -import Data.Generics.Internal.VL.Lens - ( view ) -import GHC.Generics - ( Generic ) import Test.Hspec ( Spec, describe, it ) import Test.QuickCheck @@ -87,8 +82,6 @@ import Test.QuickCheck.Extra ( report, verify ) import Test.Utils.Laws ( testLawsMany ) -import Test.Utils.Pretty - ( (====) ) import qualified Cardano.Api.Shelley as Cardano import qualified Cardano.Ledger.Alonzo.PParams as Alonzo @@ -310,7 +303,7 @@ goldenTests_computeMinimumCoinForUTxO :: (TokenMap, Coin) -> GoldenTestData (MinimumUTxO, TokenMap) Coin mkTest (tokenMap, coinExpected) = GoldenTestData { params = (minimumUTxO, tokenMap) - , result = coinExpected + , resultExpected = coinExpected } title = unwords ["goldenTests_computeMinimumCoinForUTxO", eraName] @@ -479,9 +472,9 @@ mkAssetId pid name = AssetId data GoldenTestData params result = GoldenTestData { params :: params - , result :: result + , resultExpected :: result } - deriving (Eq, Generic, Show) + deriving (Eq, Show) goldenTests :: (Eq result, Show result) @@ -491,13 +484,17 @@ goldenTests -> Spec goldenTests title f goldenTestData = describe title $ - forM_ (zip testNumbers goldenTestData) $ - \(testNumber :: Int, test) -> do - let subtitle = "golden test #" <> show testNumber - it subtitle $ - let resultExpected = view #result test in - let resultActual = f (view #params test) in - property $ resultExpected ==== resultActual + 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 ..] From bda565130a581686257673335011e72fecd3265a Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Jul 2022 01:50:31 +0000 Subject: [PATCH 31/36] Add further explanatory comments. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/3368#discussion_r913636498 https://github.com/input-output-hk/cardano-wallet/pull/3368#discussion_r918476952 --- .../Wallet/Primitive/Types/MinimumUTxO.hs | 47 ++++++++++++------- .../src/Cardano/Wallet/Shelley/MinimumUTxO.hs | 22 +++++++-- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 1 + 3 files changed, 51 insertions(+), 19 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs index ce9c4d4d443..bd5bdbaf011 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs @@ -9,11 +9,15 @@ -- Defines the 'MinimumUTxO' type and related functions. -- module Cardano.Wallet.Primitive.Types.MinimumUTxO - ( MinimumUTxO (..) + ( + -- * Types + MinimumUTxO (..) + , MinimumUTxOForShelleyBasedEra (..) + + -- * Constructor functions , minimumUTxONone , minimumUTxOConstant , minimumUTxOForShelleyBasedEra - , MinimumUTxOForShelleyBasedEra (..) ) where @@ -36,15 +40,20 @@ import Fmt -- 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. MinimumUTxOForShelleyBasedEraOf :: MinimumUTxOForShelleyBasedEra -> MinimumUTxO + -- ^ Indicates a Shelley-based era-specific minimum UTxO function. instance Buildable MinimumUTxO where build = \case @@ -84,24 +93,12 @@ instance Show MinimumUTxO where , show pp ] -minimumUTxONone :: MinimumUTxO -minimumUTxONone = MinimumUTxONone - -minimumUTxOConstant :: Coin -> MinimumUTxO -minimumUTxOConstant = MinimumUTxOConstant - -minimumUTxOForShelleyBasedEra - :: ShelleyBasedEra era - -> PParams (ShelleyLedgerEra era) - -> MinimumUTxO -minimumUTxOForShelleyBasedEra era pp = - MinimumUTxOForShelleyBasedEraOf $ - MinimumUTxOForShelleyBasedEra era pp - -------------------------------------------------------------------------------- -- The 'MinimumUTxOForShelleyBasedEra' type -------------------------------------------------------------------------------- +-- | Represents a minimum UTxO function that is specific to a Shelley-based era. +-- data MinimumUTxOForShelleyBasedEra where MinimumUTxOForShelleyBasedEra :: ShelleyBasedEra era @@ -125,3 +122,21 @@ instance Show MinimumUTxOForShelleyBasedEra where [ 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/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs index 5fc36cd1d21..e4751a829db 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -57,6 +57,13 @@ computeMinimumCoinForUTxO = \case 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 @@ -79,9 +86,18 @@ computeMinimumCoinForShelleyBasedEra & unsafeValueToLovelace & unsafeLovelaceToWalletCoin Left e -> - -- We assume that the provided protocol parameters record has all - -- the required parameters for the given era. If this assumption is - -- violated, we have no way to continue, and must raise an error: + -- 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:" diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 49d3ba343b7..1e7d35a299f 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -340,6 +340,7 @@ goldenMinimumUTxO_Babbage :: MinimumUTxO goldenMinimumUTxO_Babbage = minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage -- Value derived from 'mainnet-alonzo-genesis.json': + -- >>> 34_482 `div` 8 == 4_310 def {Babbage._coinsPerUTxOByte = Ledger.Coin 4_310} -------------------------------------------------------------------------------- From a4d65199280ac39690482ff4416708f175567cfd Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Jul 2022 10:35:38 +0000 Subject: [PATCH 32/36] Add commentary to `prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability`. We further explain the purpose of this property. If the Cardano API function `calculateMinimumUTxO` is ever changed so that it computes a fixed point before returning its result, this property will fail. However, this is valuable information, as it tells us that we might be able to revise our implementation of `computeMinimumCoinForUTxO` to reduce the level of overestimation. In response to review feedback. --- .../test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 1e7d35a299f..3b4590ae3f5 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -215,6 +215,14 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds -- - 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 From 114cf90e0b8be67b730b9c296f31f2a49a5ec4d8 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 13 Jul 2022 04:11:05 +0000 Subject: [PATCH 33/36] Improve realism of generated test protocol parameters in `MinimumUTxO.Gen`. This commit introduces generator function `genLedgerCoinOfSimilarMagnitude`, which, when given a coin value, will generate another coin value that is of a similar magnitude. When generating test values of `MinimumUTxO`, we apply the generator function `genLedgerCoinOfSimilarMagnitude` to protocol parameter values obtained from real mainnet genesis files. This enables us to generate more realistic values of `MinimumUTxO`. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/3368#discussion_r918912368 --- .../Wallet/Primitive/Types/MinimumUTxO/Gen.hs | 105 +++++++++++++----- 1 file changed, 78 insertions(+), 27 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs index a3909bcda69..dcbe898fe07 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs @@ -1,5 +1,5 @@ {-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE TypeApplications #-} +{- HLINT ignore "Use camelCase" -} -- | -- Copyright: © 2022 IOHK @@ -12,6 +12,8 @@ module Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen , genMinimumUTxOForShelleyBasedEra , shrinkMinimumUTxO , shrinkMinimumUTxOForShelleyBasedEra + , genCoinOfSimilarMagnitude + , genLedgerCoinOfSimilarMagnitude ) where @@ -21,20 +23,16 @@ 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.Bits - ( Bits ) import Data.Default ( Default (..) ) -import Data.IntCast - ( intCast, intCastMaybe ) -import Data.Maybe - ( fromMaybe ) -import Numeric.Natural - ( Natural ) +import Data.Semigroup + ( stimes ) import Test.QuickCheck - ( Gen, choose, frequency, oneof ) + ( Gen, chooseInteger, frequency, oneof ) import qualified Cardano.Ledger.Alonzo.PParams as Alonzo import qualified Cardano.Ledger.Babbage.PParams as Babbage @@ -56,8 +54,9 @@ genMinimumUTxO = frequency genMinimumUTxONone = pure MinimumUTxONone genMinimumUTxOConstant :: Gen MinimumUTxO - genMinimumUTxOConstant = MinimumUTxOConstant . Coin - <$> genInterestingCoinValue + genMinimumUTxOConstant = MinimumUTxOConstant <$> + -- The 'MinimumUTxOConstant' constructor is only used for testing. + genCoinOfSimilarMagnitude (Coin 1_000_000) shrinkMinimumUTxO :: MinimumUTxO -> [MinimumUTxO] shrinkMinimumUTxO = const [] @@ -78,31 +77,36 @@ genMinimumUTxOForShelleyBasedEra = oneof where genShelley :: Gen MinimumUTxOForShelleyBasedEra genShelley = do - minUTxOValue <- genInterestingLedgerCoin + minUTxOValue <- genLedgerCoinOfSimilarMagnitude + testParameter_minUTxOValue_Shelley pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraShelley def {Shelley._minUTxOValue = minUTxOValue} genAllegra :: Gen MinimumUTxOForShelleyBasedEra genAllegra = do - minUTxOValue <- genInterestingLedgerCoin + minUTxOValue <- genLedgerCoinOfSimilarMagnitude + testParameter_minUTxOValue_Allegra pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra def {Shelley._minUTxOValue = minUTxOValue} genMary :: Gen MinimumUTxOForShelleyBasedEra genMary = do - minUTxOValue <- genInterestingLedgerCoin + minUTxOValue <- genLedgerCoinOfSimilarMagnitude + testParameter_minUTxOValue_Mary pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraMary def {Shelley._minUTxOValue = minUTxOValue} genAlonzo :: Gen MinimumUTxOForShelleyBasedEra genAlonzo = do - coinsPerUTxOWord <- genInterestingLedgerCoin + coinsPerUTxOWord <- genLedgerCoinOfSimilarMagnitude + testParameter_coinsPerUTxOWord_Alonzo pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo def {Alonzo._coinsPerUTxOWord = coinsPerUTxOWord} genBabbage :: Gen MinimumUTxOForShelleyBasedEra genBabbage = do - coinsPerUTxOByte <- genInterestingLedgerCoin + coinsPerUTxOByte <- genLedgerCoinOfSimilarMagnitude + testParameter_coinsPerUTxOByte_Babbage pure $ MinimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage def {Babbage._coinsPerUTxOByte = coinsPerUTxOByte} @@ -110,19 +114,66 @@ 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 -------------------------------------------------------------------------------- -genInterestingCoinValue :: Gen Natural -genInterestingCoinValue = do - base <- (1_000_000 *) <$> choose (0, 8) - offset <- choose @Integer (-10, 10) - pure $ intCastMaybeZero $ base + offset +-- | 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) -genInterestingLedgerCoin :: Gen Ledger.Coin -genInterestingLedgerCoin = Ledger.Coin . intCast - <$> genInterestingCoinValue +-- | 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) -intCastMaybeZero :: (Integral a, Integral b, Bits a, Bits b) => a -> b -intCastMaybeZero = fromMaybe 0 . intCastMaybe +-- | 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) From f08e0a01364cd20ee0d26bab7874dfbb7f25243b Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 13 Jul 2022 04:28:08 +0000 Subject: [PATCH 34/36] Reuse test protocol parameters from `MinimumUTxO.Gen` in `MinimumUTxOSpec`. Since we've already defined a set of test protocol parameter values within `MinimumUTxO.Gen`, we might as well re-use these test parameter values within `MinimumUTxOSpec`. This reduces the amount of repetition. --- .../Wallet/Primitive/Types/MinimumUTxO/Gen.hs | 13 ++++++++--- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 22 +++++++++---------- 2 files changed, 20 insertions(+), 15 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs index dcbe898fe07..dee5d7af175 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO/Gen.hs @@ -8,12 +8,19 @@ -- Defines generators and shrinkers for the 'MinimumUTxO' data type. -- module Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen - ( genMinimumUTxO + ( + -- * Generators and shrinkers + genMinimumUTxO , genMinimumUTxOForShelleyBasedEra , shrinkMinimumUTxO , shrinkMinimumUTxOForShelleyBasedEra - , genCoinOfSimilarMagnitude - , genLedgerCoinOfSimilarMagnitude + + -- * Test protocol parameter values + , testParameter_minUTxOValue_Shelley + , testParameter_minUTxOValue_Allegra + , testParameter_minUTxOValue_Mary + , testParameter_coinsPerUTxOWord_Alonzo + , testParameter_coinsPerUTxOByte_Babbage ) where diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 3b4590ae3f5..6a2aa90c9a5 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -31,6 +31,11 @@ import Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen , 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 (..) ) @@ -86,7 +91,6 @@ import Test.Utils.Laws 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.Coin as Ledger 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 @@ -323,33 +327,27 @@ goldenTests_computeMinimumCoinForUTxO goldenMinimumUTxO_Shelley :: MinimumUTxO goldenMinimumUTxO_Shelley = minimumUTxOForShelleyBasedEra ShelleyBasedEraShelley - -- Value derived from 'mainnet-shelley-genesis.json': - def {Shelley._minUTxOValue = Ledger.Coin 1_000_000} + def {Shelley._minUTxOValue = testParameter_minUTxOValue_Shelley} goldenMinimumUTxO_Allegra :: MinimumUTxO goldenMinimumUTxO_Allegra = minimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra - -- Value derived from 'mainnet-shelley-genesis.json': - def {Shelley._minUTxOValue = Ledger.Coin 1_000_000} + def {Shelley._minUTxOValue = testParameter_minUTxOValue_Allegra} goldenMinimumUTxO_Mary :: MinimumUTxO goldenMinimumUTxO_Mary = minimumUTxOForShelleyBasedEra ShelleyBasedEraMary - -- Value derived from 'mainnet-shelley-genesis.json': - def {Shelley._minUTxOValue = Ledger.Coin 1_000_000} + def {Shelley._minUTxOValue = testParameter_minUTxOValue_Mary} goldenMinimumUTxO_Alonzo :: MinimumUTxO goldenMinimumUTxO_Alonzo = minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo - -- Value derived from 'mainnet-alonzo-genesis.json': - def {Alonzo._coinsPerUTxOWord = Ledger.Coin 34_482} + def {Alonzo._coinsPerUTxOWord = testParameter_coinsPerUTxOWord_Alonzo} goldenMinimumUTxO_Babbage :: MinimumUTxO goldenMinimumUTxO_Babbage = minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage - -- Value derived from 'mainnet-alonzo-genesis.json': - -- >>> 34_482 `div` 8 == 4_310 - def {Babbage._coinsPerUTxOByte = Ledger.Coin 4_310} + def {Babbage._coinsPerUTxOByte = testParameter_coinsPerUTxOByte_Babbage} -------------------------------------------------------------------------------- -- Golden minimum 'Coin' values From eb446c64aa6febf3fd3f06f950ef904f2ec019c4 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 13 Jul 2022 05:29:48 +0000 Subject: [PATCH 35/36] Adjust monotonicity comment for function `embedTokenMapWithinPaddedTxOut`. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/3368#discussion_r918940878 --- lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs index e4751a829db..d5ce6f71c1b 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -121,10 +121,11 @@ computeMinimumCoinForShelleyBasedEra -- 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 in the --- serialized length of its input, 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. +-- 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 From 727c7cb95840f0deb99b2570e4fc7df6c8211219 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 13 Jul 2022 05:35:53 +0000 Subject: [PATCH 36/36] Describe motivation for `MinimumUTxOConstant` constructor. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/3368#discussion_r918974435 --- lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs index bd5bdbaf011..0da512278e0 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/MinimumUTxO.hs @@ -49,7 +49,9 @@ data MinimumUTxO where MinimumUTxOConstant :: Coin -> MinimumUTxO - -- ^ Indicates a constant minimum UTxO value. + -- ^ 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