From 626204c421df93e7e890ba402cd82462a88baa75 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 26 Jul 2022 02:10:26 +0000 Subject: [PATCH 01/22] Miscellaneous formatting fixes. --- lib/core/src/Cardano/Wallet/Api/Server.hs | 7 ++++--- .../test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs | 4 ++-- .../test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 016245b1385..43dff084615 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -2623,7 +2623,8 @@ constructSharedTransaction -> ApiT WalletId -> ApiConstructTransactionData n -> Handler (ApiConstructTransaction n) -constructSharedTransaction ctx genChange _knownPools _getPoolStatus (ApiT wid) body = do +constructSharedTransaction + ctx genChange _knownPools _getPoolStatus (ApiT wid) body = do let isNoPayload = isNothing (body ^. #payments) && isNothing (body ^. #withdrawal) && @@ -2668,8 +2669,8 @@ constructSharedTransaction ctx genChange _knownPools _getPoolStatus (ApiT wid) b (utxoAvailable, wallet, pendingTxs) <- liftHandler $ W.readWalletUTxOIndex @_ @s @k wrk wid - let runSelection outs = - W.selectAssets @_ @_ @s @k wrk era pp selectAssetsParams transform + let runSelection outs = W.selectAssets @_ @_ @s @k + wrk era pp selectAssetsParams transform where selectAssetsParams = W.SelectAssetsParams { outputs = outs diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index ecf621bef2a..afb8bdaff16 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -544,9 +544,9 @@ data MockSelectionConstraints = MockSelectionConstraints , minimumCollateralPercentage :: Natural , maximumOutputAdaQuantity - :: Coin + :: Coin , maximumOutputTokenQuantity - :: TokenQuantity + :: TokenQuantity } deriving (Eq, Generic, Show) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index c750cf96867..6f5ba7d2a73 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -190,7 +190,7 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds "BS.length (unAddress (fromCardanoAddressAny addr))" & report (BS.length (unAddress maxLengthAddress)) - "BS.length (unAddress maxLengthAddress))" + "BS.length (unAddress maxLengthAddress)" where -- Uses the Cardano API function 'calculateMinimumUTxO' to compute a -- minimum 'Coin' value. From 676f31dd3a2953c6bcf0292b97ef48964b840c17 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 26 Jul 2022 02:09:59 +0000 Subject: [PATCH 02/22] Move `ProtocolMagic` type and functions to separate module. This is necessary to avoid a circular import. --- .../Test/Integration/Scenario/API/Network.hs | 2 +- lib/core/cardano-wallet-core.cabal | 1 + lib/core/src/Cardano/Byron/Codec/Cbor.hs | 4 +- lib/core/src/Cardano/Wallet/Gen.hs | 3 +- .../Primitive/AddressDerivation/Byron.hs | 4 +- .../Primitive/AddressDerivation/Icarus.hs | 4 +- .../src/Cardano/Wallet/Primitive/Types.hs | 33 ----------- .../Wallet/Primitive/Types/ProtocolMagic.hs | 58 +++++++++++++++++++ .../src/Cardano/Wallet/Byron/Compatibility.hs | 1 + .../src/Cardano/Wallet/Shelley/Launch.hs | 10 ++-- .../src/Cardano/Wallet/Shelley/MinimumUTxO.hs | 4 +- 11 files changed, 77 insertions(+), 47 deletions(-) create mode 100644 lib/core/src/Cardano/Wallet/Primitive/Types/ProtocolMagic.hs diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs index cfdf53d9416..8e4e4f7ffe7 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs @@ -21,7 +21,7 @@ import Cardano.Wallet.Api.Types ) import Cardano.Wallet.Primitive.SyncProgress ( SyncProgress (..) ) -import Cardano.Wallet.Primitive.Types +import Cardano.Wallet.Primitive.Types.ProtocolMagic ( getProtocolMagic, mainnetMagic ) import Control.Monad ( when ) diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index feaa4dff16e..54415981fbd 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -256,6 +256,7 @@ library Cardano.Wallet.Primitive.Types.Hash Cardano.Wallet.Primitive.Types.MinimumUTxO Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen + Cardano.Wallet.Primitive.Types.ProtocolMagic Cardano.Wallet.Primitive.Types.Redeemer Cardano.Wallet.Primitive.Types.RewardAccount Cardano.Wallet.Primitive.Types.TokenBundle diff --git a/lib/core/src/Cardano/Byron/Codec/Cbor.hs b/lib/core/src/Cardano/Byron/Codec/Cbor.hs index 320a8b28ee5..a24017e9195 100644 --- a/lib/core/src/Cardano/Byron/Codec/Cbor.hs +++ b/lib/core/src/Cardano/Byron/Codec/Cbor.hs @@ -49,12 +49,12 @@ import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..), DerivationType (..), Index (..) ) import Cardano.Wallet.Primitive.Passphrase ( Passphrase (..) ) -import Cardano.Wallet.Primitive.Types - ( ProtocolMagic (..) ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) +import Cardano.Wallet.Primitive.Types.ProtocolMagic + ( ProtocolMagic (..) ) import Cardano.Wallet.Primitive.Types.Tx ( TxIn (..), TxOut (..), unsafeCoinToTxOutCoinValue ) import Control.Monad diff --git a/lib/core/src/Cardano/Wallet/Gen.hs b/lib/core/src/Cardano/Wallet/Gen.hs index 48c09a55831..14ac9965409 100644 --- a/lib/core/src/Cardano/Wallet/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Gen.hs @@ -53,7 +53,6 @@ import Cardano.Wallet.Primitive.Types ( ActiveSlotCoefficient (..) , BlockHeader (..) , ChainPoint (..) - , ProtocolMagic (..) , Slot , SlotNo (..) , WithOrigin (..) @@ -62,6 +61,8 @@ import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) +import Cardano.Wallet.Primitive.Types.ProtocolMagic + ( ProtocolMagic (..) ) import Cardano.Wallet.Unsafe ( unsafeFromHex, unsafeMkEntropy, unsafeMkPercentage ) import Data.Aeson diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs index 65e79eea6c3..69b5385ddf3 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs @@ -78,10 +78,10 @@ import Cardano.Wallet.Primitive.Passphrase , PassphraseScheme (..) , changePassphraseXPrv ) -import Cardano.Wallet.Primitive.Types - ( testnetMagic ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) +import Cardano.Wallet.Primitive.Types.ProtocolMagic + ( testnetMagic ) import Cardano.Wallet.Util ( invariant ) import Control.DeepSeq diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs index cc189ce26f3..630f5f3a9a9 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs @@ -71,10 +71,10 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( SeqState, coinTypeAda, discoverSeq, purposeBIP44 ) import Cardano.Wallet.Primitive.Passphrase ( Passphrase (..), PassphraseHash (..), changePassphraseXPrv ) -import Cardano.Wallet.Primitive.Types - ( testnetMagic ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) +import Cardano.Wallet.Primitive.Types.ProtocolMagic + ( testnetMagic ) import Cardano.Wallet.Util ( invariant ) import Control.Arrow diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 8a4e311b1f8..552ea06fa18 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -144,11 +144,6 @@ module Cardano.Wallet.Primitive.Types , rangeLowerBound , rangeUpperBound - -- * ProtocolMagic - , ProtocolMagic (..) - , mainnetMagic - , testnetMagic - -- * Polymorphic , Signature (..) @@ -216,8 +211,6 @@ import Data.Generics.Internal.VL.Lens ( set, view, (^.) ) import Data.Generics.Labels () -import Data.Int - ( Int32 ) import Data.Kind ( Type ) import Data.List @@ -226,8 +219,6 @@ import Data.Map.Strict ( Map ) import Data.Maybe ( isJust, isNothing ) -import Data.Proxy - ( Proxy (..) ) import Data.Quantity ( Percentage (..), Quantity (..), complementPercentage ) import Data.Scientific @@ -269,8 +260,6 @@ import GHC.Generics ( Generic ) import GHC.Stack ( HasCallStack ) -import GHC.TypeLits - ( KnownNat, natVal ) import Network.URI ( URI (..), uriToString ) import NoThunks.Class @@ -1381,28 +1370,6 @@ newtype StartTime = StartTime UTCTime instance NFData StartTime -{------------------------------------------------------------------------------- - Protocol Magic --------------------------------------------------------------------------------} - --- | Magic constant associated to a given network -newtype ProtocolMagic = ProtocolMagic { getProtocolMagic :: Int32 } - deriving (Generic, Show, Eq, NFData, FromJSON, ToJSON) - -instance ToText ProtocolMagic where - toText (ProtocolMagic pm) = T.pack (show pm) - -instance FromText ProtocolMagic where - fromText = fmap (ProtocolMagic . fromIntegral @Natural) . fromText - --- | Hard-coded protocol magic for the Byron MainNet -mainnetMagic :: ProtocolMagic -mainnetMagic = ProtocolMagic 764824073 - --- | Derive testnet magic from a type-level Nat -testnetMagic :: forall pm. KnownNat pm => ProtocolMagic -testnetMagic = ProtocolMagic $ fromIntegral $ natVal $ Proxy @pm - {------------------------------------------------------------------------------- Stake Pool Delegation and Registration Certificates -------------------------------------------------------------------------------} diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/ProtocolMagic.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/ProtocolMagic.hs new file mode 100644 index 00000000000..460dde8752a --- /dev/null +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/ProtocolMagic.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2018-2022 IOHK +-- License: Apache-2.0 +-- +-- Provides the 'ProtocolMagic' type and related constants. +-- +module Cardano.Wallet.Primitive.Types.ProtocolMagic + ( ProtocolMagic (..) + , mainnetMagic + , testnetMagic + ) where + +import Prelude + +import Control.DeepSeq + ( NFData (..) ) +import Data.Aeson + ( FromJSON (..), ToJSON (..) ) +import Data.Int + ( Int32 ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text.Class + ( FromText (..), ToText (..) ) +import GHC.Generics + ( Generic ) +import GHC.TypeLits + ( KnownNat, natVal ) +import Numeric.Natural + ( Natural ) + +import qualified Data.Text as T + +-- | Magic constant associated with a given network. +-- +newtype ProtocolMagic = ProtocolMagic { getProtocolMagic :: Int32 } + deriving (Generic, Show, Eq, NFData, FromJSON, ToJSON) + +instance ToText ProtocolMagic where + toText (ProtocolMagic pm) = T.pack (show pm) + +instance FromText ProtocolMagic where + fromText = fmap (ProtocolMagic . fromIntegral @Natural) . fromText + +-- | Hard-coded protocol magic for the Byron MainNet +mainnetMagic :: ProtocolMagic +mainnetMagic = ProtocolMagic 764824073 + +-- | Derive testnet magic from a type-level Nat +testnetMagic :: forall pm. KnownNat pm => ProtocolMagic +testnetMagic = ProtocolMagic $ fromIntegral $ natVal $ Proxy @pm diff --git a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs index 2a716a9950b..f4c33443ec6 100644 --- a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs @@ -102,6 +102,7 @@ import qualified Cardano.Wallet.Primitive.Types.Address as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.Coin as W import qualified Cardano.Wallet.Primitive.Types.Hash as W +import qualified Cardano.Wallet.Primitive.Types.ProtocolMagic as W import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.Tx as W import qualified Data.List.NonEmpty as NE diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs index 5065e883ddf..39aa56d8ead 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs @@ -57,8 +57,12 @@ import Cardano.Wallet.Logging ( BracketLog, BracketLog' (..), bracketTracer ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) +import Cardano.Wallet.Primitive.SyncProgress + ( SyncTolerance ) import Cardano.Wallet.Primitive.Types - ( Block (..), NetworkParameters (..), ProtocolMagic (..) ) + ( Block (..), NetworkParameters (..) ) +import Cardano.Wallet.Primitive.Types.ProtocolMagic + ( ProtocolMagic (..) ) import Cardano.Wallet.Shelley ( SomeNetworkDiscriminant (..) ) import Control.Monad.IO.Unlift @@ -96,9 +100,7 @@ import UnliftIO.Temporary ( withTempDirectory ) import qualified Cardano.Wallet.Byron.Compatibility as Byron -import Cardano.Wallet.Primitive.SyncProgress - ( SyncTolerance ) -import qualified Cardano.Wallet.Primitive.Types as W +import qualified Cardano.Wallet.Primitive.Types.ProtocolMagic as W import qualified Cardano.Wallet.Shelley.Launch.Blockfrost as Blockfrost import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.Text as T diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs index 1dfe981f197..a90eebe2690 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -20,14 +20,14 @@ import Prelude import Cardano.Wallet.Primitive.Passphrase ( Passphrase (..) ) -import Cardano.Wallet.Primitive.Types - ( ProtocolMagic (..) ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.MinimumUTxO ( MinimumUTxO (..), MinimumUTxOForShelleyBasedEra (..) ) +import Cardano.Wallet.Primitive.Types.ProtocolMagic + ( ProtocolMagic (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) import Cardano.Wallet.Primitive.Types.TokenMap From 19c6d997aed9880f0416725c5c4a2862cd5b450e Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 21 Jul 2022 06:06:07 +0000 Subject: [PATCH 03/22] Move `dummyAddress` from `SelectionContext` to `SelectionConstraints`. This allows `dummyAddress` to be specified by the caller of coin selection instead of it being a hard-coded constant. --- lib/core/src/Cardano/Wallet/CoinSelection.hs | 4 ++-- .../Cardano/Wallet/CoinSelection/Internal.hs | 20 +++++++++++-------- .../Wallet/CoinSelection/Internal/Balance.hs | 6 ++++-- .../Wallet/CoinSelection/Internal/Context.hs | 3 --- .../CoinSelection/Internal/BalanceSpec.hs | 7 ++++--- .../Wallet/CoinSelection/InternalSpec.hs | 4 +++- 6 files changed, 25 insertions(+), 19 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/CoinSelection.hs b/lib/core/src/Cardano/Wallet/CoinSelection.hs index 1fd74010ddb..ae7c6d29490 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection.hs @@ -157,8 +157,6 @@ instance SC.SelectionContext WalletSelectionContext where type Address WalletSelectionContext = Address type UTxO WalletSelectionContext = WalletUTxO - dummyAddress = Address "" - -------------------------------------------------------------------------------- -- Mapping between external (wallet) and internal UTxO identifiers -------------------------------------------------------------------------------- @@ -253,6 +251,8 @@ toInternalSelectionConstraints SelectionConstraints {..} = computeMinimumCost . toExternalSelectionSkeleton , computeSelectionLimit = computeSelectionLimit . fmap (uncurry TxOut) + , dummyAddress = + Address "" , maximumOutputAdaQuantity = txOutMaxCoin , maximumOutputTokenQuantity = diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index 83951b0d7a8..fdd312e4440 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -168,6 +168,8 @@ data SelectionConstraints ctx = SelectionConstraints :: [(Address ctx, TokenBundle)] -> SelectionLimit -- ^ Computes an upper bound for the number of ordinary inputs to -- select, given a current set of outputs. + , dummyAddress + :: Address ctx , maximumCollateralInputCount :: Int -- ^ Specifies an inclusive upper bound on the number of unique inputs @@ -383,12 +385,12 @@ performSelectionCollateral balanceResult cs ps -- this function assigns all change outputs with a dummy change address. -- selectionAllOutputs - :: forall ctx. SelectionContext ctx - => Selection ctx + :: SelectionConstraints ctx + -> Selection ctx -> [(Address ctx, TokenBundle)] -selectionAllOutputs selection = (<>) +selectionAllOutputs constraints selection = (<>) (selection ^. #outputs) - (selection ^. #change <&> (dummyAddress @ctx, )) + (selection ^. #change <&> (dummyAddress constraints, )) -- | Creates constraints and parameters for 'Balance.performSelection'. -- @@ -408,6 +410,8 @@ toBalanceConstraintsParams (constraints, params) = , computeSelectionLimit = view #computeSelectionLimit constraints & adjustComputeSelectionLimit + , dummyAddress = + view #dummyAddress constraints , assessTokenBundleSize = view #assessTokenBundleSize constraints , maximumOutputAdaQuantity = @@ -808,7 +812,7 @@ verifySelectionOutputCoinsSufficient cs _ps selection = verifyEmpty errors FailureToVerifySelectionOutputCoinsSufficient where errors :: [SelectionOutputCoinInsufficientError (Address ctx)] - errors = mapMaybe maybeError (selectionAllOutputs selection) + errors = mapMaybe maybeError (selectionAllOutputs cs selection) maybeError :: (Address ctx, TokenBundle) @@ -840,7 +844,7 @@ verifySelectionOutputSizesWithinLimit cs _ps selection = verifyEmpty errors FailureToVerifySelectionOutputSizesWithinLimit where errors :: [SelectionOutputSizeExceedsLimitError ctx] - errors = mapMaybe (verifyOutputSize cs) (selectionAllOutputs selection) + errors = mapMaybe (verifyOutputSize cs) (selectionAllOutputs cs selection) -------------------------------------------------------------------------------- -- Selection verification: output token quantities @@ -853,11 +857,11 @@ newtype FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address = verifySelectionOutputTokenQuantitiesWithinLimit :: forall ctx. SelectionContext ctx => VerifySelection ctx -verifySelectionOutputTokenQuantitiesWithinLimit _cs _ps selection = +verifySelectionOutputTokenQuantitiesWithinLimit cs _ps selection = verifyEmpty errors FailureToVerifySelectionOutputTokenQuantitiesWithinLimit where errors :: [SelectionOutputTokenQuantityExceedsLimitError ctx] - errors = verifyOutputTokenQuantities =<< selectionAllOutputs selection + errors = verifyOutputTokenQuantities =<< selectionAllOutputs cs selection -------------------------------------------------------------------------------- -- Selection error verification diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs index ca29d2ec1bd..e0af6226a12 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs @@ -228,6 +228,8 @@ data SelectionConstraints ctx = SelectionConstraints :: [(Address ctx, TokenBundle)] -> SelectionLimit -- ^ Computes an upper bound for the number of ordinary inputs to -- select, given a current set of outputs. + , dummyAddress + :: Address ctx , maximumOutputAdaQuantity :: Coin -- ^ Specifies the largest ada quantity that can appear in the token @@ -819,7 +821,7 @@ performSelection = performSelectionEmpty performSelectionNonEmpty -- selectionHasValidSurplus constraints (transformResult result) -- performSelectionEmpty - :: forall m ctx. (Functor m, SelectionContext ctx) + :: forall m ctx. (Functor m) => PerformSelection m NonEmpty ctx -> PerformSelection m [] ctx performSelectionEmpty performSelectionFn constraints params = @@ -850,7 +852,7 @@ performSelectionEmpty performSelectionFn constraints params = transform x y = maybe x y $ NE.nonEmpty $ view #outputsToCover params dummyOutput :: (Address ctx, TokenBundle) - dummyOutput = (dummyAddress @ctx, TokenBundle.fromCoin minCoin) + dummyOutput = (dummyAddress constraints, TokenBundle.fromCoin minCoin) -- The 'performSelectionNonEmpty' function imposes a precondition that all -- outputs must have at least the minimum ada quantity. Therefore, the diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Context.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Context.hs index 4e8f17e2c76..3cddb77c601 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Context.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Context.hs @@ -39,6 +39,3 @@ class -- | A unique identifier for an individual UTxO. type UTxO c - - -- | Generates a dummy address value. - dummyAddress :: Address c diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs index 6dc8a041a14..1e6b3edad0c 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs @@ -21,7 +21,7 @@ module Cardano.Wallet.CoinSelection.Internal.BalanceSpec , MockComputeMinimumAdaQuantity , MockComputeMinimumCost , MockComputeSelectionLimit - , TestAddress + , TestAddress (..) , TestSelectionContext , TestUTxO , genMockAssessTokenBundleSize @@ -1859,6 +1859,7 @@ mkBoundaryTestExpectation (BoundaryTestData params expectedResult) = do , assessTokenBundleSize = unMockAssessTokenBundleSize $ boundaryTestBundleSizeAssessor params , computeSelectionLimit = const NoLimit + , dummyAddress = TestAddress 0x0 , maximumOutputAdaQuantity = testMaximumOutputAdaQuantity , maximumOutputTokenQuantity = testMaximumOutputTokenQuantity } @@ -2489,6 +2490,8 @@ unMockSelectionConstraints m = SelectionConstraints unMockComputeMinimumCost $ view #computeMinimumCost m , computeSelectionLimit = unMockComputeSelectionLimit $ view #computeSelectionLimit m + , dummyAddress = + TestAddress 0x0 , maximumOutputAdaQuantity = testMaximumOutputAdaQuantity , maximumOutputTokenQuantity = @@ -4449,8 +4452,6 @@ instance SC.SelectionContext TestSelectionContext where type Address TestSelectionContext = TestAddress type UTxO TestSelectionContext = TestUTxO - dummyAddress = TestAddress 0x0 - newtype TestAddress = TestAddress (Hexadecimal Quid) deriving Arbitrary via Quid deriving Buildable via (Pretty TestAddress) diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index afb8bdaff16..0b8b1f1d45d 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -49,7 +49,7 @@ import Cardano.Wallet.CoinSelection.Internal.BalanceSpec , MockComputeMinimumAdaQuantity , MockComputeMinimumCost , MockComputeSelectionLimit - , TestAddress + , TestAddress (..) , TestSelectionContext , TestUTxO , genMockAssessTokenBundleSize @@ -589,6 +589,8 @@ unMockSelectionConstraints m = SelectionConstraints unMockComputeMinimumCost $ view #computeMinimumCost m , computeSelectionLimit = unMockComputeSelectionLimit $ view #computeSelectionLimit m + , dummyAddress = + TestAddress 0x0 , maximumCollateralInputCount = view #maximumCollateralInputCount m , minimumCollateralPercentage = From 521f06fff4a70e56ea6a86ca65769d4ccf9de4f8 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 29 Jul 2022 06:46:04 +0000 Subject: [PATCH 04/22] Rename `dummyAddress` to `maximumLengthChangeAddress`. This renaming is intended to more accurately reflect the intended usage. A future commit will ensure that this field is initialized to an appropriate value. --- lib/core/src/Cardano/Wallet/CoinSelection.hs | 6 ++++-- lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs | 10 +++++----- .../Cardano/Wallet/CoinSelection/Internal/Balance.hs | 7 +++++-- .../Wallet/CoinSelection/Internal/BalanceSpec.hs | 6 +++--- .../unit/Cardano/Wallet/CoinSelection/InternalSpec.hs | 4 ++-- 5 files changed, 19 insertions(+), 14 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/CoinSelection.hs b/lib/core/src/Cardano/Wallet/CoinSelection.hs index ae7c6d29490..28480aa693b 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection.hs @@ -251,12 +251,14 @@ toInternalSelectionConstraints SelectionConstraints {..} = computeMinimumCost . toExternalSelectionSkeleton , computeSelectionLimit = computeSelectionLimit . fmap (uncurry TxOut) - , dummyAddress = - Address "" , maximumOutputAdaQuantity = txOutMaxCoin , maximumOutputTokenQuantity = txOutMaxTokenQuantity + , maximumLengthChangeAddress = + -- TODO: + -- Specify a real address of the maximum length here. + Address "" , .. } diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index fdd312e4440..9c57a20a3c9 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -168,8 +168,6 @@ data SelectionConstraints ctx = SelectionConstraints :: [(Address ctx, TokenBundle)] -> SelectionLimit -- ^ Computes an upper bound for the number of ordinary inputs to -- select, given a current set of outputs. - , dummyAddress - :: Address ctx , maximumCollateralInputCount :: Int -- ^ Specifies an inclusive upper bound on the number of unique inputs @@ -186,6 +184,8 @@ data SelectionConstraints ctx = SelectionConstraints :: TokenQuantity -- ^ Specifies the largest non-ada quantity that can appear in the -- token bundle of an output. + , maximumLengthChangeAddress + :: Address ctx } deriving Generic @@ -390,7 +390,7 @@ selectionAllOutputs -> [(Address ctx, TokenBundle)] selectionAllOutputs constraints selection = (<>) (selection ^. #outputs) - (selection ^. #change <&> (dummyAddress constraints, )) + (selection ^. #change <&> (maximumLengthChangeAddress constraints, )) -- | Creates constraints and parameters for 'Balance.performSelection'. -- @@ -410,14 +410,14 @@ toBalanceConstraintsParams (constraints, params) = , computeSelectionLimit = view #computeSelectionLimit constraints & adjustComputeSelectionLimit - , dummyAddress = - view #dummyAddress constraints , assessTokenBundleSize = view #assessTokenBundleSize constraints , maximumOutputAdaQuantity = view #maximumOutputAdaQuantity constraints , maximumOutputTokenQuantity = view #maximumOutputTokenQuantity constraints + , maximumLengthChangeAddress = + view #maximumLengthChangeAddress constraints } where adjustComputeMinimumCost diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs index e0af6226a12..8c7482679f5 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs @@ -228,7 +228,7 @@ data SelectionConstraints ctx = SelectionConstraints :: [(Address ctx, TokenBundle)] -> SelectionLimit -- ^ Computes an upper bound for the number of ordinary inputs to -- select, given a current set of outputs. - , dummyAddress + , maximumLengthChangeAddress :: Address ctx , maximumOutputAdaQuantity :: Coin @@ -852,7 +852,10 @@ performSelectionEmpty performSelectionFn constraints params = transform x y = maybe x y $ NE.nonEmpty $ view #outputsToCover params dummyOutput :: (Address ctx, TokenBundle) - dummyOutput = (dummyAddress constraints, TokenBundle.fromCoin minCoin) + dummyOutput = + ( maximumLengthChangeAddress constraints + , TokenBundle.fromCoin minCoin + ) -- The 'performSelectionNonEmpty' function imposes a precondition that all -- outputs must have at least the minimum ada quantity. Therefore, the diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs index 1e6b3edad0c..932a1a6ba92 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs @@ -1859,9 +1859,9 @@ mkBoundaryTestExpectation (BoundaryTestData params expectedResult) = do , assessTokenBundleSize = unMockAssessTokenBundleSize $ boundaryTestBundleSizeAssessor params , computeSelectionLimit = const NoLimit - , dummyAddress = TestAddress 0x0 , maximumOutputAdaQuantity = testMaximumOutputAdaQuantity , maximumOutputTokenQuantity = testMaximumOutputTokenQuantity + , maximumLengthChangeAddress = TestAddress 0x0 } encodeBoundaryTestCriteria @@ -2490,12 +2490,12 @@ unMockSelectionConstraints m = SelectionConstraints unMockComputeMinimumCost $ view #computeMinimumCost m , computeSelectionLimit = unMockComputeSelectionLimit $ view #computeSelectionLimit m - , dummyAddress = - TestAddress 0x0 , maximumOutputAdaQuantity = testMaximumOutputAdaQuantity , maximumOutputTokenQuantity = testMaximumOutputTokenQuantity + , maximumLengthChangeAddress = + TestAddress 0x0 } -- | Specifies the largest ada quantity that can appear in the token bundle diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index 0b8b1f1d45d..7acb87a4d99 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -589,8 +589,6 @@ unMockSelectionConstraints m = SelectionConstraints unMockComputeMinimumCost $ view #computeMinimumCost m , computeSelectionLimit = unMockComputeSelectionLimit $ view #computeSelectionLimit m - , dummyAddress = - TestAddress 0x0 , maximumCollateralInputCount = view #maximumCollateralInputCount m , minimumCollateralPercentage = @@ -599,6 +597,8 @@ unMockSelectionConstraints m = SelectionConstraints view #maximumOutputAdaQuantity m , maximumOutputTokenQuantity = view #maximumOutputTokenQuantity m + , maximumLengthChangeAddress = + TestAddress 0x0 } -------------------------------------------------------------------------------- From b22d9c03869273fe27ac6c6073d23d44fc984142 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 26 Jul 2022 02:32:51 +0000 Subject: [PATCH 05/22] Add `BoundedAddressLength` type class and instances. This class provides a way to specify that addresses are bounded in length for a particular key type. In principle, for a given key type, the set of valid address sizes is bounded in both directions: there will exist both a minimum and maximum length. In practice, for now, we only define the `maxLengthAddressFor` function, which returns an address of maximum length for the given key. Later on, if needed, we could add a `minLengthAddressFor` function to specify minimum length addresses. Co-Authored-By: Johannes Lund --- .../Wallet/Primitive/AddressDerivation.hs | 20 ++++++++++++++ .../Primitive/AddressDerivation/Byron.hs | 26 ++++++++++++++++--- .../Primitive/AddressDerivation/Icarus.hs | 22 +++++++++++++--- .../Primitive/AddressDerivation/Shared.hs | 6 ++++- .../Primitive/AddressDerivation/Shelley.hs | 6 ++++- 5 files changed, 71 insertions(+), 9 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs index 02c00b04de3..5136407ecc3 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs @@ -65,6 +65,7 @@ module Cardano.Wallet.Primitive.AddressDerivation -- * Backends Interoperability , PaymentAddress(..) , DelegationAddress(..) + , BoundedAddressLength (..) , WalletKey(..) , PersistPrivateKey(..) , PersistPublicKey(..) @@ -609,6 +610,25 @@ class WalletKey (key :: Depth -> Type -> Type) where :: raw -> key depth raw +-- | The class of keys for which addresses are bounded in length. +-- +class BoundedAddressLength key where + -- | Returns the longest address that the wallet can generate for a given + -- key. + -- + -- This is useful in situations where we want to compute some function of + -- an output under construction (such as a minimum UTxO value), but don't + -- yet have convenient access to a real address. + -- + -- Please note that this address should: + -- + -- - never be used for anything besides its length and validity properties. + -- - never be used as a payment target within a real transaction. + -- + maxLengthAddressFor + :: Proxy key + -> Address + -- | Encoding of addresses for certain key types and backend targets. class MkKeyFingerprint key Address => PaymentAddress (network :: NetworkDiscriminant) key where diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs index 69b5385ddf3..cdcc28fbde0 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs @@ -59,7 +59,8 @@ import Cardano.Crypto.Wallet import Cardano.Mnemonic ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy ) import Cardano.Wallet.Primitive.AddressDerivation - ( Depth (..) + ( BoundedAddressLength (..) + , Depth (..) , DerivationType (..) , ErrMkKeyFingerprint (..) , Index (..) @@ -81,7 +82,7 @@ import Cardano.Wallet.Primitive.Passphrase import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.ProtocolMagic - ( testnetMagic ) + ( ProtocolMagic (..), testnetMagic ) import Cardano.Wallet.Util ( invariant ) import Control.DeepSeq @@ -105,13 +106,14 @@ import GHC.Generics import GHC.TypeLits ( KnownNat ) - import qualified Cardano.Byron.Codec.Cbor as CBOR +import qualified Cardano.Crypto.Wallet as CC import qualified Cardano.Wallet.Primitive.AddressDerivation as W import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Write as CBOR import qualified Crypto.KDF.PBKDF2 as PBKDF2 import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 {------------------------------------------------------------------------------- @@ -185,6 +187,24 @@ instance MkKeyFingerprint ByronKey Address where Just _ -> Right $ KeyFingerprint bytes Nothing -> Left $ ErrInvalidAddress addr (Proxy @ByronKey) +instance BoundedAddressLength ByronKey where + -- Matching 'paymentAddress' above. + maxLengthAddressFor _ = Address + $ CBOR.toStrictByteString + $ CBOR.encodeAddress xpub + [ CBOR.encodeDerivationPathAttr passphrase maxBound maxBound + , CBOR.encodeProtocolMagicAttr (ProtocolMagic maxBound) + ] + where + -- Must apparently always be 32 bytes: + passphrase :: Passphrase "addr-derivation-payload" + passphrase = Passphrase $ BA.convert $ BS.replicate 32 0 + + xpub :: CC.XPub + xpub = CC.toXPub $ CC.generate (BS.replicate 32 0) xprvPass + where + xprvPass = mempty :: BS.ByteString + {------------------------------------------------------------------------------- Key generation -------------------------------------------------------------------------------} diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs index 630f5f3a9a9..7054241f9ff 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs @@ -43,12 +43,12 @@ import Cardano.Crypto.Wallet , unXPub , xPrvChangePass , xprv - , xpub ) import Cardano.Mnemonic ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy, mnemonicToText ) import Cardano.Wallet.Primitive.AddressDerivation - ( Depth (..) + ( BoundedAddressLength (..) + , Depth (..) , DerivationType (..) , ErrMkKeyFingerprint (..) , HardDerivation (..) @@ -74,7 +74,7 @@ import Cardano.Wallet.Primitive.Passphrase import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.ProtocolMagic - ( testnetMagic ) + ( ProtocolMagic (..), testnetMagic ) import Cardano.Wallet.Util ( invariant ) import Control.Arrow @@ -111,6 +111,7 @@ import GHC.TypeLits ( KnownNat ) import qualified Cardano.Byron.Codec.Cbor as CBOR +import qualified Cardano.Crypto.Wallet as CC import qualified Codec.CBOR.Write as CBOR import qualified Crypto.ECC.Edwards25519 as Ed25519 import qualified Crypto.KDF.PBKDF2 as PBKDF2 @@ -404,6 +405,19 @@ instance IsOurs (SeqState n IcarusKey) RewardAccount where instance PaymentAddress n IcarusKey => MaybeLight (SeqState n IcarusKey) where maybeDiscover = Just $ DiscoverTxs discoverSeq +instance BoundedAddressLength IcarusKey where + -- Matching 'paymentAddress' above. + maxLengthAddressFor _ = Address + $ CBOR.toStrictByteString + $ CBOR.encodeAddress xpub + [ CBOR.encodeProtocolMagicAttr (ProtocolMagic maxBound) + ] + where + xpub :: CC.XPub + xpub = CC.toXPub $ CC.generate (BS.replicate 32 0) xprvPass + where + xprvPass = mempty :: BS.ByteString + {------------------------------------------------------------------------------- Storing and retrieving keys -------------------------------------------------------------------------------} @@ -428,5 +442,5 @@ instance PersistPublicKey (IcarusKey depth) where unsafeDeserializeXPub = either err IcarusKey . xpubFromText where - xpubFromText = xpub <=< fromHex @ByteString + xpubFromText = CC.xpub <=< fromHex @ByteString err _ = error "unsafeDeserializeXPub: unable to deserialize IcarusKey" diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shared.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shared.hs index ab41d2ab90f..ca61c1728e6 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shared.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shared.hs @@ -38,7 +38,8 @@ import Cardano.Crypto.Wallet import Cardano.Mnemonic ( SomeMnemonic ) import Cardano.Wallet.Primitive.AddressDerivation - ( Depth (..) + ( BoundedAddressLength (..) + , Depth (..) , DerivationType (..) , HardDerivation (..) , KeyFingerprint (..) @@ -184,6 +185,9 @@ instance MkKeyFingerprint SharedKey (Proxy (n :: NetworkDiscriminant), SharedKey paymentKeyFingerprint (_, paymentK) = Right $ KeyFingerprint $ blake2b224 $ xpubPublicKey $ getKey paymentK +instance BoundedAddressLength SharedKey where + maxLengthAddressFor _ = Address $ BS.replicate 57 0 + {------------------------------------------------------------------------------- Internals -------------------------------------------------------------------------------} diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs index b66d336f11d..926251a245d 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs @@ -55,7 +55,8 @@ import Cardano.Crypto.Wallet import Cardano.Mnemonic ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy ) import Cardano.Wallet.Primitive.AddressDerivation - ( DelegationAddress (..) + ( BoundedAddressLength (..) + , DelegationAddress (..) , Depth (..) , DerivationIndex (..) , DerivationType (..) @@ -354,6 +355,9 @@ instance MkKeyFingerprint ShelleyKey (Proxy (n :: NetworkDiscriminant), ShelleyK paymentKeyFingerprint (_, paymentK) = Right $ KeyFingerprint $ blake2b224 $ xpubPublicKey $ getKey paymentK +instance BoundedAddressLength ShelleyKey where + maxLengthAddressFor _ = Address $ BS.replicate 57 0 + {------------------------------------------------------------------------------- Dealing with Rewards -------------------------------------------------------------------------------} From 2421a739ed26b918144589e7503746d9cec54745 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 26 Jul 2022 03:33:50 +0000 Subject: [PATCH 06/22] Add `BoundedAddressLength` constraint to functions in `Wallet`. This commit adds the `BoundedAddressLength` constraint to all functions that will need access to address length bounds within `Cardano.Wallet` and `Cardano.Wallet.Api.Server`. --- lib/core/src/Cardano/Wallet.hs | 8 ++++++-- lib/core/src/Cardano/Wallet/Api/Server.hs | 14 +++++++++++++- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index c4fd5a6e5b1..a02ade0c5e1 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -290,7 +290,8 @@ import Cardano.Wallet.Network , NetworkLayer (..) ) import Cardano.Wallet.Primitive.AddressDerivation - ( DelegationAddress (..) + ( BoundedAddressLength (..) + , DelegationAddress (..) , Depth (..) , DerivationIndex (..) , DerivationPrefix (..) @@ -1568,6 +1569,7 @@ balanceTransaction , MonadRandom m , HasLogger m WalletWorkerLog ctx , Cardano.IsShelleyBasedEra era + , BoundedAddressLength k ) => ctx -> ArgGenChange s @@ -1591,6 +1593,7 @@ balanceTransactionWithSelectionStrategy :: forall era m s k ctx. ( HasTransactionLayer k ctx , GenChange s + , BoundedAddressLength k , MonadRandom m , HasLogger m WalletWorkerLog ctx , Cardano.IsShelleyBasedEra era @@ -2213,7 +2216,8 @@ data SelectAssetsParams s result = SelectAssetsParams -- selectAssets :: forall ctx m s k result. - ( HasTransactionLayer k ctx + ( BoundedAddressLength k + , HasTransactionLayer k ctx , HasLogger m WalletWorkerLog ctx , MonadRandom m ) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 43dff084615..1c61f0e2c9a 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -359,7 +359,8 @@ import Cardano.Wallet.DB import Cardano.Wallet.Network ( NetworkLayer (..), fetchRewardAccountBalances, timeInterpreter ) import Cardano.Wallet.Primitive.AddressDerivation - ( DelegationAddress (..) + ( BoundedAddressLength (..) + , DelegationAddress (..) , Depth (..) , DerivationIndex (..) , DerivationType (..) @@ -1671,6 +1672,7 @@ selectCoins , Typeable n , Typeable s , WalletKey k + , BoundedAddressLength k ) => ctx -> ArgGenChange s @@ -1722,6 +1724,7 @@ selectCoinsForJoin , SoftDerivation k , Typeable n , Typeable s + , BoundedAddressLength k ) => ctx -> IO (Set PoolId) @@ -1782,6 +1785,7 @@ selectCoinsForQuit , Typeable n , Typeable s , WalletKey k + , BoundedAddressLength k ) => ctx -> ApiT WalletId @@ -2043,6 +2047,7 @@ postTransactionOld , Typeable s , WalletKey k , AddressBookIso s + , BoundedAddressLength k ) => ctx -> ArgGenChange s @@ -2230,6 +2235,7 @@ postTransactionFeeOld , Typeable n , Typeable s , WalletKey k + , BoundedAddressLength k ) => ctx -> ApiT WalletId @@ -2281,6 +2287,7 @@ constructTransaction , Typeable n , Typeable s , WalletKey k + , BoundedAddressLength k ) => ctx -> ArgGenChange s @@ -2615,6 +2622,7 @@ constructSharedTransaction , GenChange s , HasNetworkLayer IO ctx , IsOurs s Address + , BoundedAddressLength k ) => ctx -> ArgGenChange s @@ -2717,6 +2725,7 @@ balanceTransaction ( ctx ~ ApiLayer s k , HasNetworkLayer IO ctx , GenChange s + , BoundedAddressLength k ) => ctx -> ArgGenChange s @@ -3101,6 +3110,7 @@ joinStakePool , Typeable s , WalletKey k , AddressBookIso s + , BoundedAddressLength k ) => ctx -> IO (Set PoolId) @@ -3194,6 +3204,7 @@ delegationFee :: forall ctx s n k. ( s ~ SeqState n k , ctx ~ ApiLayer s k + , BoundedAddressLength k ) => ctx -> ApiT WalletId @@ -3240,6 +3251,7 @@ quitStakePool , Typeable s , WalletKey k , AddressBookIso s + , BoundedAddressLength k ) => ctx -> ApiT WalletId From cf15978c6cca479031bf8eb95248d8ebcdf3bba4 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 19 Jul 2022 02:13:55 +0000 Subject: [PATCH 07/22] Reduce overestimation of minimum UTxO values for Shelley-era addresses. This commit reduces the overestimation of minimum UTxO values for outputs with Shelley-era addresses. It makes the following changes: - Adds an `Address` parameter to the following functions: - `Shelley.MinimumUTxO.computeMinimumCoinForUTxO` - `CoinSelection.SelectionConstraints.computeMinimumAdaQuantity` - `CoinSelection.Internal.SelectionConstraints.computeMinimumAdaQuantity` - `CoinSelection.Internal.Balance.SelectionConstraints.computeMinimumAdaQuantity` - `Primitive.Types.Tx.TxConstraints.txOutputMinimumAdaQuantity` - Adds a `maximumLengthChangeAddress` parameter to the following types: - `CoinSelection.SelectionConstraints` - `CoinSelection.Internal.SelectionConstraints` - `CoinSelection.Internal.Balance.SelectionConstraints` - Updates `Cardano.Wallet` to initialize the `maximumLengthChangeAddress` field with a value that is suitable for the current wallet key type (made available by the `BoundedLengthAddress` class constraint). - Updates `CoinSelection` modules to use the given `maximumLengthChangeAddress` parameter whenever calculating minimum ada quantities for auto-generated change outputs. - Updates `CoinSelection` modules to use real user-specified addresses whenever calculating minimum ada quantities for user-specified outputs. - Updates the Swagger API description of the `minimum_utxo_value` field with a more comprehensive description of this field's meaning, as well as a short discussion of its history. (This field should ideally be deprecated, as the protocol parameter it used to represent no longer exists.) - Updates the `Wallet.Api.Types.toApiNetworkParameters` function to return the most appropriate value for `minimum_utxo_value` that we can, given that there is no single ideal value that we can return here. (This field should ideally be deprecated, as the protocol parameter it used to represent no longer exists.) - Adds an `Address.Constants` module with a global `maxLengthAddress` constant, defined to be an address that is maximal in length when compared to the maximum length addresses for all wallet key types. - Updates the migration algorithm to use the global `maxLengthAddress` constant when computing minimum ada quantities for all generated outputs. - Extends the set of golden minimum ada quantities within `MinimumUTxOSpec` so that both Byron-era and Shelley-era addresses are covered. --- .../src/Test/Integration/Framework/DSL.hs | 17 +- lib/core/cardano-wallet-core.cabal | 1 + lib/core/src/Cardano/Wallet.hs | 38 +-- lib/core/src/Cardano/Wallet/Api/Types.hs | 29 +- lib/core/src/Cardano/Wallet/CoinSelection.hs | 8 +- .../Cardano/Wallet/CoinSelection/Internal.hs | 27 +- .../Wallet/CoinSelection/Internal/Balance.hs | 26 +- .../Wallet/Primitive/Migration/Selection.hs | 17 +- .../Primitive/Types/Address/Constants.hs | 50 ++++ .../src/Cardano/Wallet/Primitive/Types/Tx.hs | 6 +- .../CoinSelection/Internal/BalanceSpec.hs | 24 +- .../Wallet/CoinSelection/InternalSpec.hs | 3 +- .../Primitive/Migration/SelectionSpec.hs | 35 ++- .../src/Cardano/Wallet/Shelley/MinimumUTxO.hs | 67 ++--- .../Cardano/Wallet/Shelley/MinimumUTxOSpec.hs | 253 ++++++++++++------ specifications/api/swagger.yaml | 54 +++- 16 files changed, 440 insertions(+), 215 deletions(-) create mode 100644 lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index f71ea44a032..e0a32c8d36e 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -674,9 +674,20 @@ walletId = -- | Min UTxO parameter for the test cluster. minUTxOValue :: ApiEra -> Natural minUTxOValue e - | e >= ApiBabbage = 1_107_670 -- needs to be overestimated for the sake of - -- long byron addresses - | e >= ApiAlonzo = 999_978 -- From 34482 lovelace per word + | e >= ApiBabbage = 995_610 + -- This value is a slight overestimation for outputs with Shelley + -- addresses and no tokens. + -- + -- However, it would be incorrect for outputs with Byron addresses, + -- where the lower bound would be greater by the following amount: + -- + -- 4310 lovelace/byte * (86 - 57) byte ≈ 0.125 ada + -- + -- However, this value appears to be fine for the purposes of + -- integration tests. + -- + | e >= ApiAlonzo = 999_978 + -- From 34482 lovelace/word. | otherwise = 1_000_000 -- | Parameter in test cluster shelley genesis. diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 54415981fbd..517643e2ada 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -252,6 +252,7 @@ library Cardano.Wallet.Primitive.Passphrase.Types Cardano.Wallet.Primitive.Types Cardano.Wallet.Primitive.Types.Address + Cardano.Wallet.Primitive.Types.Address.Constants Cardano.Wallet.Primitive.Types.Coin Cardano.Wallet.Primitive.Types.Hash Cardano.Wallet.Primitive.Types.MinimumUTxO diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index a02ade0c5e1..d61a35623eb 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -422,8 +422,6 @@ import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) -import Cardano.Wallet.Primitive.Types.TokenMap - ( TokenMap ) import Cardano.Wallet.Primitive.Types.TokenPolicy ( TokenName (UnsafeTokenName), TokenPolicyId (UnsafeTokenPolicyId) ) import Cardano.Wallet.Primitive.Types.TokenQuantity @@ -474,7 +472,7 @@ import Cardano.Wallet.Transaction import Control.Applicative ( (<|>) ) import Control.Arrow - ( left ) + ( first, left ) import Control.DeepSeq ( NFData ) import Control.Monad @@ -547,7 +545,7 @@ import Data.Map.Strict import Data.Maybe ( fromMaybe, isJust, mapMaybe ) import Data.Proxy - ( Proxy ) + ( Proxy (..) ) import Data.Quantity ( Quantity (..) ) import Data.Set @@ -923,26 +921,28 @@ getWalletUtxoSnapshot ctx wid = do (wallet, _, pending) <- withExceptT id (readWallet @ctx @s @k ctx wid) pp <- liftIO $ currentProtocolParameters nl era <- liftIO $ currentNodeEra nl - let bundles = availableUTxO @s pending wallet + let txOuts = availableUTxO @s pending wallet & unUTxO & F.toList - & fmap (view #tokens) - pure $ pairBundleWithMinAdaQuantity era pp <$> bundles + pure $ first (view #tokens) . pairTxOutWithMinAdaQuantity era pp <$> txOuts where nl = ctx ^. networkLayer tl = ctx ^. transactionLayer @k - pairBundleWithMinAdaQuantity + pairTxOutWithMinAdaQuantity :: Cardano.AnyCardanoEra -> ProtocolParameters - -> TokenBundle - -> (TokenBundle, Coin) - pairBundleWithMinAdaQuantity era pp bundle = - (bundle, computeMinAdaQuantity $ view #tokens bundle) + -> TxOut + -> (TxOut, Coin) + pairTxOutWithMinAdaQuantity era pp out = + (out, computeMinAdaQuantity out) where - computeMinAdaQuantity :: TokenMap -> Coin - computeMinAdaQuantity = - view #txOutputMinimumAdaQuantity (constraints tl era pp) + computeMinAdaQuantity :: TxOut -> Coin + computeMinAdaQuantity (TxOut addr bundle) = + view #txOutputMinimumAdaQuantity + (constraints tl era pp) + (addr) + (view #tokens bundle) -- | List the wallet's UTxO statistics. listUtxoStatistics @@ -1988,6 +1988,8 @@ balanceTransactionWithSelectionStrategy intCast @Word16 @Int $ view #maximumCollateralInputCount pp , minimumCollateralPercentage = view #minimumCollateralPercentage pp + , maximumLengthChangeAddress = + maxLengthAddressFor $ Proxy @k } selectionParams = SelectionParams @@ -2174,8 +2176,8 @@ calcMinimumCoinValues calcMinimumCoinValues ctx era outs = do pp <- currentProtocolParameters nl pure - $ view #txOutputMinimumAdaQuantity (constraints tl era pp) - . view (#tokens . #tokens) <$> outs + $ uncurry (view #txOutputMinimumAdaQuantity (constraints tl era pp)) + . (\o -> (view #address o, view (#tokens . #tokens) o)) <$> outs where nl = ctx ^. networkLayer tl = ctx ^. transactionLayer @k @@ -2251,6 +2253,8 @@ selectAssets ctx era pp params transform = do intCast @Word16 @Int $ view #maximumCollateralInputCount pp , minimumCollateralPercentage = view #minimumCollateralPercentage pp + , maximumLengthChangeAddress = + maxLengthAddressFor $ Proxy @k } let selectionParams = SelectionParams { assetsToMint = diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 1d2180aa36e..8142d86ec18 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -293,6 +293,8 @@ import Cardano.Wallet.Primitive.AddressDerivation ) import Cardano.Wallet.Primitive.AddressDerivation.SharedKey ( purposeCIP1854 ) +import Cardano.Wallet.Primitive.AddressDerivation.Shelley + ( ShelleyKey ) import Cardano.Wallet.Primitive.AddressDiscovery.Random ( RndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential @@ -1134,7 +1136,32 @@ toApiNetworkParameters (NetworkParameters gp sp pp) txConstraints toEpochInfo = $ view #decentralizationLevel pp , desiredPoolNumber = view #desiredNumberOfStakePools pp , minimumUtxoValue = toApiCoin $ - txOutputMinimumAdaQuantity txConstraints TokenMap.empty + -- NOTE: + -- + -- In eras prior to Babbage, the ledger minimum UTxO function was + -- independent of the length of an address. + -- + -- However, from the Babbage era onwards, the ledger minimum UTxO + -- function is *dependent* on the length of an address: longer + -- addresses give rise to greater minimum UTxO values. + -- + -- Since address lengths are variable, there is no single ideal + -- constant that we can return here. + -- + -- Therefore, we return a "minimum" UTxO quantity that is likely to + -- be more useful than others: the quantity required to send a + -- 9-byte ada quantity (and no non-ada tokens) to the longest + -- possible Shelley address. + -- + -- We should consider deprecating this parameter, and replacing it + -- with era-specific protocol parameters such as: + -- + -- - lovelacePerUTxOWord (Alonzo) + -- - lovelacePerUTxOByte (Babbage) + -- + txOutputMinimumAdaQuantity txConstraints + (AD.maxLengthAddressFor $ Proxy @ShelleyKey) + TokenMap.empty , eras = apiEras , maximumCollateralInputCount = view #maximumCollateralInputCount pp diff --git a/lib/core/src/Cardano/Wallet/CoinSelection.hs b/lib/core/src/Cardano/Wallet/CoinSelection.hs index 28480aa693b..1774aa3ee49 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection.hs @@ -222,7 +222,7 @@ data SelectionConstraints = SelectionConstraints -- ^ Amount that should be taken from/returned back to the wallet for -- each stake key registration/de-registration in the transaction. , computeMinimumAdaQuantity - :: TokenMap -> Coin + :: Address -> TokenMap -> Coin -- ^ Computes the minimum ada quantity required for a given output. , computeMinimumCost :: SelectionSkeleton -> Coin @@ -239,6 +239,8 @@ data SelectionConstraints = SelectionConstraints :: Natural -- ^ Specifies the minimum required amount of collateral as a -- percentage of the total transaction fee. + , maximumLengthChangeAddress + :: Address } deriving Generic @@ -255,10 +257,6 @@ toInternalSelectionConstraints SelectionConstraints {..} = txOutMaxCoin , maximumOutputTokenQuantity = txOutMaxTokenQuantity - , maximumLengthChangeAddress = - -- TODO: - -- Specify a real address of the maximum length here. - Address "" , .. } diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index 9c57a20a3c9..2910de03afe 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -9,7 +9,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -- | -- Copyright: © 2021 IOHK @@ -159,7 +158,7 @@ data SelectionConstraints ctx = SelectionConstraints -- ^ Amount that should be taken from/returned back to the wallet for -- each stake key registration/de-registration in the transaction. , computeMinimumAdaQuantity - :: TokenMap -> Coin + :: Address ctx -> TokenMap -> Coin -- ^ Computes the minimum ada quantity required for a given output. , computeMinimumCost :: SelectionSkeleton ctx -> Coin @@ -382,7 +381,8 @@ performSelectionCollateral balanceResult cs ps -- | Returns a selection's ordinary outputs and change outputs in a single list. -- -- Since change outputs do not have addresses at the point of generation, --- this function assigns all change outputs with a dummy change address. +-- this function assigns all change outputs with a dummy change address +-- of the maximum possible length. -- selectionAllOutputs :: SelectionConstraints ctx @@ -827,6 +827,7 @@ verifySelectionOutputCoinsSufficient cs _ps selection = minimumExpectedCoin :: Coin minimumExpectedCoin = (cs ^. #computeMinimumAdaQuantity) + (fst output) (snd output ^. #tokens) -------------------------------------------------------------------------------- @@ -971,6 +972,7 @@ verifyInsufficientMinCoinValueError cs _ps e = reportedMinCoinValue = e ^. #expectedMinCoinValue verifiedMinCoinValue = (cs ^. #computeMinimumAdaQuantity) + (fst reportedOutput) (snd reportedOutput ^. #tokens) -------------------------------------------------------------------------------- @@ -1111,7 +1113,7 @@ verifyUnableToConstructChangeError cs ps errorOriginal = -- A modified set of constraints that should always allow the -- successful creation of a selection: cs' = cs - { computeMinimumAdaQuantity = const $ Coin 0 + { computeMinimumAdaQuantity = const $ const $ Coin 0 , computeMinimumCost = const $ Coin 0 , computeSelectionLimit = const Balance.NoLimit } @@ -1434,19 +1436,18 @@ prepareOutputsInternal constraints outputsUnprepared -- quantity required to make a particular output valid. -- prepareOutputsWith - :: Functor f - => (TokenMap -> Coin) + :: forall f address. Functor f + => (address -> TokenMap -> Coin) -> f (address, TokenBundle) -> f (address, TokenBundle) prepareOutputsWith minCoinValueFor = - fmap $ fmap augmentBundle + fmap augmentBundle where - augmentBundle :: TokenBundle -> TokenBundle - augmentBundle bundle - | TokenBundle.getCoin bundle == Coin 0 = - bundle & set #coin (minCoinValueFor (view #tokens bundle)) - | otherwise = - bundle + augmentBundle :: (address, TokenBundle) -> (address, TokenBundle) + augmentBundle (addr, bundle) = (addr,) $ + if TokenBundle.getCoin bundle == Coin 0 + then bundle & set #coin (minCoinValueFor addr (view #tokens bundle)) + else bundle -- | Indicates a problem when preparing outputs for a coin selection. -- diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs index 8c7482679f5..4f10177687e 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs @@ -219,7 +219,7 @@ data SelectionConstraints ctx = SelectionConstraints -- the 'TokenBundleSizeAssessor' type to learn about the expected -- properties of this field. , computeMinimumAdaQuantity - :: TokenMap -> Coin + :: Address ctx -> TokenMap -> Coin -- ^ Computes the minimum ada quantity required for a given output. , computeMinimumCost :: SelectionSkeleton ctx -> Coin @@ -851,11 +851,11 @@ performSelectionEmpty performSelectionFn constraints params = transform :: a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a transform x y = maybe x y $ NE.nonEmpty $ view #outputsToCover params + dummyAddress :: Address ctx + dummyAddress = maximumLengthChangeAddress constraints + dummyOutput :: (Address ctx, TokenBundle) - dummyOutput = - ( maximumLengthChangeAddress constraints - , TokenBundle.fromCoin minCoin - ) + dummyOutput = (dummyAddress, TokenBundle.fromCoin minCoin) -- The 'performSelectionNonEmpty' function imposes a precondition that all -- outputs must have at least the minimum ada quantity. Therefore, the @@ -872,7 +872,8 @@ performSelectionEmpty performSelectionFn constraints params = minCoin :: Coin minCoin = max (Coin 1) - (view #computeMinimumAdaQuantity constraints TokenMap.empty) + (view #computeMinimumAdaQuantity constraints dummyAddress TokenMap.empty + ) performSelectionNonEmpty :: forall m ctx. (HasCallStack, MonadRandom m, SelectionContext ctx) @@ -917,6 +918,7 @@ performSelectionNonEmpty constraints params , computeSelectionLimit , maximumOutputAdaQuantity , maximumOutputTokenQuantity + , maximumLengthChangeAddress } = constraints SelectionParams { outputsToCover @@ -956,17 +958,17 @@ performSelectionNonEmpty constraints params mkInsufficientMinCoinValueError :: (Address ctx, TokenBundle) -> Maybe (InsufficientMinCoinValueError ctx) - mkInsufficientMinCoinValueError o - | view #coin (snd o) >= expectedMinCoinValue = + mkInsufficientMinCoinValueError (addr, bundle) + | view #coin bundle >= expectedMinCoinValue = Nothing | otherwise = Just $ InsufficientMinCoinValueError { expectedMinCoinValue - , outputWithInsufficientAda = o + , outputWithInsufficientAda = (addr, bundle) } where - expectedMinCoinValue = computeMinimumAdaQuantity - (view #tokens $ snd o) + expectedMinCoinValue = computeMinimumAdaQuantity addr + (view #tokens bundle) -- Given a UTxO index that corresponds to a valid selection covering -- 'outputsToCover', 'predictChange' yields a non-empty list of assets @@ -1084,7 +1086,7 @@ performSelectionNonEmpty constraints params where mChangeGenerated :: Either UnableToConstructChangeError [TokenBundle] mChangeGenerated = makeChange MakeChangeCriteria - { minCoinFor = computeMinimumAdaQuantity + { minCoinFor = computeMinimumAdaQuantity maximumLengthChangeAddress , bundleSizeAssessor = TokenBundleSizeAssessor assessTokenBundleSize , requiredCost , extraCoinSource diff --git a/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs b/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs index 9fa5d1f0dbe..71a8289871d 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs @@ -56,6 +56,8 @@ module Cardano.Wallet.Primitive.Migration.Selection import Prelude +import Cardano.Wallet.Primitive.Types.Address.Constants + ( maxLengthAddress ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -274,7 +276,15 @@ assignMinimumAdaQuantity :: TxConstraints -> TokenMap -> TokenBundle assignMinimumAdaQuantity constraints m = TokenBundle c m where - c = txOutputMinimumAdaQuantity constraints m + -- Using @maxLengthAddressFor $ Proxy @k@ via @constraints@ would not help + -- here, as outputs created by the migration algorithm are assigned with + -- user-defined addresses. + -- + -- Something we /could/ do would be to pass in the actual user-defined + -- addresses here, since they are available in the 'createMigrationPlan' + -- server handler. + -- + c = txOutputMinimumAdaQuantity constraints maxLengthAddress m -------------------------------------------------------------------------------- -- Adding value to outputs @@ -835,8 +845,9 @@ checkOutputMinimumAdaQuantities constraints selection = , expectedMinimumAdaQuantity } where - expectedMinimumAdaQuantity = - txOutputMinimumAdaQuantity constraints (view #tokens outputBundle) + expectedMinimumAdaQuantity = txOutputMinimumAdaQuantity constraints + maxLengthAddress + (view #tokens outputBundle) -------------------------------------------------------------------------------- -- Selection correctness: output sizes diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs new file mode 100644 index 00000000000..74b9058fb17 --- /dev/null +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2022 IOHK +-- License: Apache-2.0 +-- +-- Provides various 'Address' constants used by the wallet or its tests. +-- +module Cardano.Wallet.Primitive.Types.Address.Constants + ( maxLengthAddress + ) where + +import Prelude + +import Cardano.Wallet.Primitive.AddressDerivation + ( BoundedAddressLength (..) ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Icarus + ( IcarusKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Shared + ( SharedKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Shelley + ( ShelleyKey ) +import Cardano.Wallet.Primitive.Types.Address + ( Address (..) ) +import Data.Proxy + ( Proxy (..) ) + +import Data.Function + ( on ) + +import qualified Data.ByteString as BS +import qualified Data.List as L + +-- | A dummy 'Address' of the greatest length that the wallet can generate. +-- +-- Please note that this address should: +-- +-- - never be used for anything besides its length and validity properties. +-- - never be used as a payment target within a real transaction. +-- +maxLengthAddress :: Address +maxLengthAddress = L.maximumBy (compare `on` (BS.length . unAddress)) + [ maxLengthAddressFor $ Proxy @ByronKey + , maxLengthAddressFor $ Proxy @IcarusKey + , maxLengthAddressFor $ Proxy @ShelleyKey + , maxLengthAddressFor $ Proxy @SharedKey + ] diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs index 91a63be518b..18dfd4fea1b 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs @@ -83,7 +83,6 @@ module Cardano.Wallet.Primitive.Types.Tx , TxConstraints (..) , txOutputCoinCost , txOutputCoinSize - , txOutputCoinMinimum , txOutputHasValidSize , txOutputHasValidTokenQuantities , TxSize (..) @@ -971,7 +970,7 @@ data TxConstraints = TxConstraints -- ^ The maximum size of a transaction output. , txOutputMaximumTokenQuantity :: TokenQuantity -- ^ The maximum token quantity that can appear in a transaction output. - , txOutputMinimumAdaQuantity :: TokenMap -> Coin + , txOutputMinimumAdaQuantity :: Address -> TokenMap -> Coin -- ^ The variable minimum ada quantity of a transaction output. , txRewardWithdrawalCost :: Coin -> Coin -- ^ The variable cost of a reward withdrawal. @@ -988,9 +987,6 @@ txOutputCoinCost constraints = txOutputCost constraints . TokenBundle.fromCoin txOutputCoinSize :: TxConstraints -> Coin -> TxSize txOutputCoinSize constraints = txOutputSize constraints . TokenBundle.fromCoin -txOutputCoinMinimum :: TxConstraints -> Coin -txOutputCoinMinimum constraints = txOutputMinimumAdaQuantity constraints mempty - txOutputHasValidSize :: TxConstraints -> TokenBundle -> Bool txOutputHasValidSize constraints b = txOutputSize constraints b <= txOutputMaximumSize constraints diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs index 932a1a6ba92..18aa01f059e 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs @@ -1091,7 +1091,8 @@ prop_performSelection mockConstraints params coverage = constraints { assessTokenBundleSize = unMockAssessTokenBundleSize MockAssessTokenBundleSizeUnlimited - , computeMinimumAdaQuantity = computeMinimumAdaQuantityZero + , computeMinimumAdaQuantity = + const computeMinimumAdaQuantityZero , computeMinimumCost = computeMinimumCostZero , computeSelectionLimit = const NoLimit } @@ -1854,7 +1855,7 @@ mkBoundaryTestExpectation (BoundaryTestData params expectedResult) = do fmap decodeBoundaryTestResult actualResult `shouldBe` Right expectedResult where constraints = SelectionConstraints - { computeMinimumAdaQuantity = computeMinimumAdaQuantityZero + { computeMinimumAdaQuantity = const computeMinimumAdaQuantityZero , computeMinimumCost = computeMinimumCostZero , assessTokenBundleSize = unMockAssessTokenBundleSize $ boundaryTestBundleSizeAssessor params @@ -2537,17 +2538,17 @@ shrinkMockComputeMinimumAdaQuantity = \case [MockComputeMinimumAdaQuantityZero] unMockComputeMinimumAdaQuantity - :: MockComputeMinimumAdaQuantity -> (TokenMap -> Coin) + :: MockComputeMinimumAdaQuantity -> (TestAddress -> TokenMap -> Coin) unMockComputeMinimumAdaQuantity = \case MockComputeMinimumAdaQuantityZero -> - computeMinimumAdaQuantityZero + const computeMinimumAdaQuantityZero MockComputeMinimumAdaQuantityLinear -> - computeMinimumAdaQuantityLinear + const computeMinimumAdaQuantityLinear -- | Returns a constant minimum ada quantity of zero. -- computeMinimumAdaQuantityZero :: TokenMap -> Coin -computeMinimumAdaQuantityZero = const (Coin 0) +computeMinimumAdaQuantityZero = const $ Coin 0 -- | A dummy function for calculating the minimum ada quantity to pay for a -- token map. @@ -2747,8 +2748,10 @@ makeChangeWith :: MakeChangeData -> Either UnableToConstructChangeError [TokenBundle] makeChangeWith p = makeChange p - { minCoinFor = unMockComputeMinimumAdaQuantity $ minCoinFor p - , bundleSizeAssessor = mkTokenBundleSizeAssessor $ bundleSizeAssessor p + { minCoinFor = + unMockComputeMinimumAdaQuantity (minCoinFor p) (TestAddress 0x0) + , bundleSizeAssessor = + mkTokenBundleSizeAssessor $ bundleSizeAssessor p } prop_makeChange_identity @@ -3010,7 +3013,8 @@ prop_makeChange_success_minValueRespected p = F.foldr ((.&&.) . checkMinValue) (property True) where minCoinValueFor :: TokenMap -> Coin - minCoinValueFor = unMockComputeMinimumAdaQuantity (minCoinFor p) + minCoinValueFor = + unMockComputeMinimumAdaQuantity (minCoinFor p) (TestAddress 0x0) checkMinValue :: TokenBundle -> Property checkMinValue m@TokenBundle{coin,tokens} = @@ -3096,7 +3100,7 @@ prop_makeChange_fail_minValueTooBig p = totalInputValue totalOutputValue minCoinValueFor = - unMockComputeMinimumAdaQuantity (minCoinFor p) + unMockComputeMinimumAdaQuantity (minCoinFor p) (TestAddress 0x0) totalMinCoinDeposit = F.foldr Coin.add (Coin 0) (minCoinValueFor . view #tokens <$> change) where diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index 7acb87a4d99..be75050783f 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -480,7 +480,8 @@ prop_prepareOutputsWith_preparedOrExistedBefore minCoinValueDef outs = | outputCoin before /= Coin 0 = outputCoin after == outputCoin before | otherwise = - outputCoin after == minCoinValueFor (view #tokens $ snd before) + outputCoin after == + uncurry minCoinValueFor (view #tokens <$> before) where outputCoin = view #coin . snd diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs index 24af1a013ff..1c6e142a91d 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs @@ -26,6 +26,8 @@ import Cardano.Wallet.Primitive.Migration.Selection , minimizeFee , minimizeFeeStep ) +import Cardano.Wallet.Primitive.Types.Address + ( Address ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.Hash @@ -43,7 +45,6 @@ import Cardano.Wallet.Primitive.Types.Tx , TxSize (..) , txOutMaxCoin , txOutputCoinCost - , txOutputCoinMinimum , txOutputCoinSize , txOutputHasValidSize , txOutputHasValidTokenQuantities @@ -853,8 +854,8 @@ data MockTxOutputMinimumAdaQuantity = MockTxOutputMinimumAdaQuantity unMockTxOutputMinimumAdaQuantity :: MockTxOutputMinimumAdaQuantity - -> (TokenMap -> Coin) -unMockTxOutputMinimumAdaQuantity mock m = + -> (Address -> TokenMap -> Coin) +unMockTxOutputMinimumAdaQuantity mock _addr m = let assetCount = TokenMap.size m in perOutput mock <> mtimesDefault assetCount (perOutputAsset mock) @@ -864,6 +865,16 @@ genMockTxOutputMinimumAdaQuantity = MockTxOutputMinimumAdaQuantity <$> genCoinRange (Coin 4) (Coin 8) <*> genCoinRange (Coin 1) (Coin 2) +-- Addresses are currently never used within the mock minimum ada quantity +-- calculation. However, 'unMockTxOutputMinimumAdaQuantity' still requires an +-- address. For convenience, we define a dummy address that produces an error +-- if it is used unexpectedly. +-- +-- See 'unMockTxOutputMinimumAdaQuantity'. +-- +dummyAddress :: Address +dummyAddress = error "dummyAddress" + -------------------------------------------------------------------------------- -- Mock maximum transaction sizes -------------------------------------------------------------------------------- @@ -923,19 +934,21 @@ genMockInputId = MockInputId . BS.pack <$> genCoinAboveMinimumAdaQuantity :: MockTxConstraints -> Gen Coin genCoinAboveMinimumAdaQuantity mockConstraints = - genCoinRange - (txOutputCoinMinimum constraints) - (txOutputCoinMinimum constraints `scaleCoin` 1000) + genCoinRange lo hi where constraints = unMockTxConstraints mockConstraints + lo = txOutputMinimumAdaQuantity constraints dummyAddress TokenMap.empty + hi = lo `scaleCoin` 1000 genCoinBelowMinimumAdaQuantity :: MockTxConstraints -> Gen Coin genCoinBelowMinimumAdaQuantity mockConstraints = - genCoinRange - (Coin 1) - (Coin.distance (txOutputCoinMinimum constraints) (Coin 1)) + genCoinRange lo hi where constraints = unMockTxConstraints mockConstraints + lo = Coin 1 + hi = Coin.difference + (txOutputMinimumAdaQuantity constraints dummyAddress TokenMap.empty) + (Coin 1) genCoinRange :: Coin -> Coin -> Gen Coin genCoinRange (Coin minCoin) (Coin maxCoin) = @@ -961,7 +974,7 @@ genTokenBundleMixed mockConstraints = genTokenBundleWithMinimumAdaQuantity :: MockTxConstraints -> Gen TokenBundle genTokenBundleWithMinimumAdaQuantity mockConstraints = do m <- genTokenMap mockConstraints - let minAda = txOutputMinimumAdaQuantity constraints m + let minAda = txOutputMinimumAdaQuantity constraints dummyAddress m pure $ TokenBundle minAda m where constraints = unMockTxConstraints mockConstraints @@ -969,7 +982,7 @@ genTokenBundleWithMinimumAdaQuantity mockConstraints = do genTokenBundleAboveMinimumAdaQuantity :: MockTxConstraints -> Gen TokenBundle genTokenBundleAboveMinimumAdaQuantity mockConstraints = do m <- genTokenMap mockConstraints - let minAda = txOutputMinimumAdaQuantity constraints m + let minAda = txOutputMinimumAdaQuantity constraints dummyAddress m c <- genCoinRange (minAda <> Coin 1) (minAda `scaleCoin` 1000) pure $ TokenBundle c m where diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs index a90eebe2690..5a086652a36 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/MinimumUTxO.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} @@ -11,23 +10,18 @@ module Cardano.Wallet.Shelley.MinimumUTxO ( computeMinimumCoinForUTxO , maxLengthCoin - , maxLengthAddress , unsafeLovelaceToWalletCoin , unsafeValueToLovelace ) where import Prelude -import Cardano.Wallet.Primitive.Passphrase - ( Passphrase (..) ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.MinimumUTxO ( MinimumUTxO (..), MinimumUTxOForShelleyBasedEra (..) ) -import Cardano.Wallet.Primitive.Types.ProtocolMagic - ( ProtocolMagic (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) import Cardano.Wallet.Primitive.Types.TokenMap @@ -48,23 +42,23 @@ import Numeric.Natural ( Natural ) import qualified Cardano.Api.Shelley as Cardano -import qualified Cardano.Byron.Codec.Cbor as Byron -import qualified Cardano.Crypto.Wallet as CC -import qualified Codec.CBOR.Write as CBOR -import qualified Data.ByteArray as BA -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 + :: HasCallStack + => MinimumUTxO + -> Address + -> TokenMap + -> Coin computeMinimumCoinForUTxO = \case MinimumUTxONone -> - const (Coin 0) + \_addr _tokenMap -> Coin 0 MinimumUTxOConstant c -> - const c - MinimumUTxOForShelleyBasedEraOf pp -> - computeMinimumCoinForShelleyBasedEra pp + \_addr _tokenMap -> c + MinimumUTxOForShelleyBasedEraOf minUTxO -> + computeMinimumCoinForShelleyBasedEra minUTxO -- | Computes a minimum 'Coin' value for a 'TokenMap' that is destined for -- inclusion in a transaction output. @@ -76,13 +70,14 @@ computeMinimumCoinForUTxO = \case computeMinimumCoinForShelleyBasedEra :: HasCallStack => MinimumUTxOForShelleyBasedEra + -> Address -> TokenMap -> Coin computeMinimumCoinForShelleyBasedEra - (MinimumUTxOForShelleyBasedEra era pp) tokenMap = + (MinimumUTxOForShelleyBasedEra era pp) addr tokenMap = extractResult $ Cardano.calculateMinimumUTxO era - (embedTokenMapWithinPaddedTxOut era tokenMap) + (embedTokenMapWithinPaddedTxOut era addr tokenMap) (Cardano.fromLedgerPParams era pp) where extractResult :: Either Cardano.MinimumUTxOError Cardano.Value -> Coin @@ -138,41 +133,11 @@ computeMinimumCoinForShelleyBasedEra -- embedTokenMapWithinPaddedTxOut :: Cardano.ShelleyBasedEra era + -> Address -> TokenMap -> Cardano.TxOut Cardano.CtxTx era -embedTokenMapWithinPaddedTxOut era m = - toCardanoTxOut era $ TxOut maxLengthAddress $ TokenBundle maxLengthCoin m - --- | An 'Address' value that is maximal in length when serialized to bytes. --- --- When serialized to bytes, this 'Address' value has a length that is greater --- than or equal to the serialized length of any 'Address' value that is valid --- for inclusion in a transaction output. --- -maxLengthAddress :: Address -maxLengthAddress = longestByronAddrGeneratedByWallet - where - -- This should be the longest possible address the wallet can generate, - -- with a length of 86 bytes. (We can look at the callsites to encodeAddress - -- to confirm) - -- - -- With 4310 lovelace/byte, the minimum utxo value for a pure-ada output is - -- now 1.107670 ada (according to /v2/network/information). The largest - -- possible overestimation should be (86-29) bytes, or 0.245670 ada. - longestByronAddrGeneratedByWallet = Address - $ CBOR.toStrictByteString - $ Byron.encodeAddress xpub - [ Byron.encodeDerivationPathAttr pwd maxBound maxBound - , Byron.encodeProtocolMagicAttr (ProtocolMagic maxBound) - ] - where - -- Must apparently always be 32 bytes - pwd :: Passphrase "addr-derivation-payload" - pwd = Passphrase $ BA.convert $ BS.replicate 32 0 - - xpub = CC.toXPub $ CC.generate (BS.replicate 32 0) xprvPass - where - xprvPass = mempty :: BS.ByteString +embedTokenMapWithinPaddedTxOut era addr m = + toCardanoTxOut era $ TxOut addr $ TokenBundle maxLengthCoin m -- | A 'Coin' value that is maximal in length when serialized to bytes. -- diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs index 6f5ba7d2a73..d5fc1fce7a2 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/MinimumUTxOSpec.hs @@ -17,8 +17,16 @@ import Cardano.Api ( ShelleyBasedEra (..) ) import Cardano.Api.Gen ( genAddressAny ) +import Cardano.Wallet.Primitive.AddressDerivation + ( BoundedAddressLength (..) ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Shelley + ( ShelleyKey ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) +import Cardano.Wallet.Primitive.Types.Address.Constants + ( maxLengthAddress ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.MinimumUTxO @@ -57,13 +65,14 @@ import Cardano.Wallet.Shelley.Compatibility ( toCardanoTxOut ) import Cardano.Wallet.Shelley.MinimumUTxO ( computeMinimumCoinForUTxO - , maxLengthAddress , maxLengthCoin , unsafeLovelaceToWalletCoin , unsafeValueToLovelace ) import Control.Monad ( forM_ ) +import Data.Data + ( Proxy (..) ) import Data.Default ( Default (..) ) import Data.Function @@ -122,30 +131,60 @@ spec = do 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 + describe "Byron-style addresses" $ do + + goldenTests_computeMinimumCoinForUTxO + "Shelley" + goldenMinimumUTxO_ShelleyEra + goldenMinimumCoins_ByronAddress_ShelleyEra + goldenTests_computeMinimumCoinForUTxO + "Allegra" + goldenMinimumUTxO_AllegraEra + goldenMinimumCoins_ByronAddress_AllegraEra + goldenTests_computeMinimumCoinForUTxO + "Mary" + goldenMinimumUTxO_MaryEra + goldenMinimumCoins_ByronAddress_MaryEra + goldenTests_computeMinimumCoinForUTxO + "Alonzo" + goldenMinimumUTxO_AlonzoEra + goldenMinimumCoins_ByronAddress_AlonzoEra + goldenTests_computeMinimumCoinForUTxO + "Babbage" + goldenMinimumUTxO_BabbageEra + goldenMinimumCoins_ByronAddress_BabbageEra + + describe "Shelley-style addresses" $ do + + goldenTests_computeMinimumCoinForUTxO + "Shelley" + goldenMinimumUTxO_ShelleyEra + goldenMinimumCoins_ShelleyAddress_ShelleyEra + goldenTests_computeMinimumCoinForUTxO + "Allegra" + goldenMinimumUTxO_AllegraEra + goldenMinimumCoins_ShelleyAddress_AllegraEra + goldenTests_computeMinimumCoinForUTxO + "Mary" + goldenMinimumUTxO_MaryEra + goldenMinimumCoins_ShelleyAddress_MaryEra + goldenTests_computeMinimumCoinForUTxO + "Alonzo" + goldenMinimumUTxO_AlonzoEra + goldenMinimumCoins_ShelleyAddress_AlonzoEra + goldenTests_computeMinimumCoinForUTxO + "Babbage" + goldenMinimumUTxO_BabbageEra + goldenMinimumCoins_ShelleyAddress_BabbageEra -- 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 $ + :: MinimumUTxO -> Address -> TokenMap -> Property +prop_computeMinimumCoinForUTxO_evaluation minimumUTxO addr m = property $ -- Use an arbitrary test to force evaluation of the result: - computeMinimumCoinForUTxO minimumUTxO m >= Coin 0 + computeMinimumCoinForUTxO minimumUTxO addr m >= Coin 0 -- Check that 'computeMinimumCoinForUTxO' produces a result that is within -- bounds, as determined by the Cardano API function 'calculateMinimumUTxO'. @@ -158,6 +197,7 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds tokenBundle addr (MinimumUTxOForShelleyBasedEra era pp) = let ourResult = ourComputeMinCoin + (fromCardanoAddressAny addr) (TokenBundle.tokens tokenBundle) apiResultMinBound = apiComputeMinCoin (fromCardanoAddressAny addr) @@ -210,9 +250,9 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_bounds -- Uses the wallet function 'computeMinimumCoinForUTxO' to compute a -- minimum 'Coin' value. -- - ourComputeMinCoin :: TokenMap -> Coin - ourComputeMinCoin = - computeMinimumCoinForUTxO (minimumUTxOForShelleyBasedEra era pp) + ourComputeMinCoin :: Address -> TokenMap -> Coin + ourComputeMinCoin = computeMinimumCoinForUTxO + (minimumUTxOForShelleyBasedEra era pp) -- Compares the stability of: -- @@ -290,8 +330,8 @@ prop_computeMinimumCoinForUTxO_shelleyBasedEra_stability -- minimum 'Coin' value. -- ourComputeMinCoin :: TokenMap -> Coin - ourComputeMinCoin = - computeMinimumCoinForUTxO (minimumUTxOForShelleyBasedEra era pp) + ourComputeMinCoin = computeMinimumCoinForUTxO + (minimumUTxOForShelleyBasedEra era pp) (fromCardanoAddressAny addr) -------------------------------------------------------------------------------- -- Golden tests @@ -302,100 +342,156 @@ goldenTests_computeMinimumCoinForUTxO -- ^ The era name. -> MinimumUTxO -- ^ The minimum UTxO function. - -> [(TokenMap, Coin)] + -> [(Address, TokenMap, Coin)] -- ^ Mappings from 'TokenMap' values to expected minimum 'Coin' values. -> Spec goldenTests_computeMinimumCoinForUTxO - eraName minimumUTxO expectedMinimumCoins = + testName minimumUTxO expectedMinimumCoins = goldenTests title - (uncurry computeMinimumCoinForUTxO) + (\(minUTxO, addr, m) -> computeMinimumCoinForUTxO minUTxO addr m) (mkTest <$> expectedMinimumCoins) where mkTest - :: (TokenMap, Coin) -> GoldenTestData (MinimumUTxO, TokenMap) Coin - mkTest (tokenMap, coinExpected) = GoldenTestData - { params = (minimumUTxO, tokenMap) + :: (Address, TokenMap, Coin) + -> GoldenTestData (MinimumUTxO, Address, TokenMap) Coin + mkTest (addr, tokenMap, coinExpected) = GoldenTestData + { params = (minimumUTxO, addr, tokenMap) , resultExpected = coinExpected } title = unwords - ["goldenTests_computeMinimumCoinForUTxO", eraName] + ["goldenTests_computeMinimumCoinForUTxO:", testName] -------------------------------------------------------------------------------- -- Golden 'MinimumUTxO' values -------------------------------------------------------------------------------- -goldenMinimumUTxO_Shelley :: MinimumUTxO -goldenMinimumUTxO_Shelley = +goldenMinimumUTxO_ShelleyEra :: MinimumUTxO +goldenMinimumUTxO_ShelleyEra = minimumUTxOForShelleyBasedEra ShelleyBasedEraShelley def {Shelley._minUTxOValue = testParameter_minUTxOValue_Shelley} -goldenMinimumUTxO_Allegra :: MinimumUTxO -goldenMinimumUTxO_Allegra = +goldenMinimumUTxO_AllegraEra :: MinimumUTxO +goldenMinimumUTxO_AllegraEra = minimumUTxOForShelleyBasedEra ShelleyBasedEraAllegra def {Shelley._minUTxOValue = testParameter_minUTxOValue_Allegra} -goldenMinimumUTxO_Mary :: MinimumUTxO -goldenMinimumUTxO_Mary = +goldenMinimumUTxO_MaryEra :: MinimumUTxO +goldenMinimumUTxO_MaryEra = minimumUTxOForShelleyBasedEra ShelleyBasedEraMary def {Shelley._minUTxOValue = testParameter_minUTxOValue_Mary} -goldenMinimumUTxO_Alonzo :: MinimumUTxO -goldenMinimumUTxO_Alonzo = +goldenMinimumUTxO_AlonzoEra :: MinimumUTxO +goldenMinimumUTxO_AlonzoEra = minimumUTxOForShelleyBasedEra ShelleyBasedEraAlonzo def {Alonzo._coinsPerUTxOWord = testParameter_coinsPerUTxOWord_Alonzo} -goldenMinimumUTxO_Babbage :: MinimumUTxO -goldenMinimumUTxO_Babbage = +goldenMinimumUTxO_BabbageEra :: MinimumUTxO +goldenMinimumUTxO_BabbageEra = minimumUTxOForShelleyBasedEra ShelleyBasedEraBabbage def {Babbage._coinsPerUTxOByte = testParameter_coinsPerUTxOByte_Babbage} -------------------------------------------------------------------------------- --- Golden minimum 'Coin' values +-- Golden minimum 'Coin' values: Byron-style addresses +-------------------------------------------------------------------------------- + +maxLengthAddressBryon :: Address +maxLengthAddressBryon = maxLengthAddressFor $ Proxy @ByronKey + +goldenMinimumCoins_ByronAddress_ShelleyEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ByronAddress_ShelleyEra = + [ (maxLengthAddressBryon, goldenTokenMap_0, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_1, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_2, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_3, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_4, Coin 1_000_000) + ] + +goldenMinimumCoins_ByronAddress_AllegraEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ByronAddress_AllegraEra = + [ (maxLengthAddressBryon, goldenTokenMap_0, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_1, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_2, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_3, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_4, Coin 1_000_000) + ] + +goldenMinimumCoins_ByronAddress_MaryEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ByronAddress_MaryEra = + [ (maxLengthAddressBryon, goldenTokenMap_0, Coin 1_000_000) + , (maxLengthAddressBryon, goldenTokenMap_1, Coin 1_444_443) + , (maxLengthAddressBryon, goldenTokenMap_2, Coin 1_555_554) + , (maxLengthAddressBryon, goldenTokenMap_3, Coin 1_740_739) + , (maxLengthAddressBryon, goldenTokenMap_4, Coin 1_999_998) + ] + +goldenMinimumCoins_ByronAddress_AlonzoEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ByronAddress_AlonzoEra = + [ (maxLengthAddressBryon, goldenTokenMap_0, Coin 999_978) + , (maxLengthAddressBryon, goldenTokenMap_1, Coin 1_344_798) + , (maxLengthAddressBryon, goldenTokenMap_2, Coin 1_448_244) + , (maxLengthAddressBryon, goldenTokenMap_3, Coin 1_620_654) + , (maxLengthAddressBryon, goldenTokenMap_4, Coin 1_862_028) + ] + +goldenMinimumCoins_ByronAddress_BabbageEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ByronAddress_BabbageEra = + [ (maxLengthAddressBryon, goldenTokenMap_0, Coin 1_107_670) + , (maxLengthAddressBryon, goldenTokenMap_1, Coin 1_262_830) + , (maxLengthAddressBryon, goldenTokenMap_2, Coin 1_435_230) + , (maxLengthAddressBryon, goldenTokenMap_3, Coin 1_435_230) + , (maxLengthAddressBryon, goldenTokenMap_4, Coin 2_124_830) + ] + +-------------------------------------------------------------------------------- +-- Golden minimum 'Coin' values: Shelley-style addresses -------------------------------------------------------------------------------- -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) +maxLengthAddressShelley :: Address +maxLengthAddressShelley = maxLengthAddressFor $ Proxy @ShelleyKey + +goldenMinimumCoins_ShelleyAddress_ShelleyEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ShelleyAddress_ShelleyEra = + [ (maxLengthAddressShelley, goldenTokenMap_0, Coin 1_000_000) + , (maxLengthAddressShelley, goldenTokenMap_1, Coin 1_000_000) + , (maxLengthAddressShelley, goldenTokenMap_2, Coin 1_000_000) + , (maxLengthAddressShelley, goldenTokenMap_3, Coin 1_000_000) + , (maxLengthAddressShelley, 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_ShelleyAddress_AllegraEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ShelleyAddress_AllegraEra = + [ (maxLengthAddressShelley, goldenTokenMap_0, Coin 1_000_000) + , (maxLengthAddressShelley, goldenTokenMap_1, Coin 1_000_000) + , (maxLengthAddressShelley, goldenTokenMap_2, Coin 1_000_000) + , (maxLengthAddressShelley, goldenTokenMap_3, Coin 1_000_000) + , (maxLengthAddressShelley, 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_ShelleyAddress_MaryEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ShelleyAddress_MaryEra = + [ (maxLengthAddressShelley, goldenTokenMap_0, Coin 1_000_000) + , (maxLengthAddressShelley, goldenTokenMap_1, Coin 1_444_443) + , (maxLengthAddressShelley, goldenTokenMap_2, Coin 1_555_554) + , (maxLengthAddressShelley, goldenTokenMap_3, Coin 1_740_739) + , (maxLengthAddressShelley, 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_ShelleyAddress_AlonzoEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ShelleyAddress_AlonzoEra = + [ (maxLengthAddressShelley, goldenTokenMap_0, Coin 999_978) + , (maxLengthAddressShelley, goldenTokenMap_1, Coin 1_344_798) + , (maxLengthAddressShelley, goldenTokenMap_2, Coin 1_448_244) + , (maxLengthAddressShelley, goldenTokenMap_3, Coin 1_620_654) + , (maxLengthAddressShelley, goldenTokenMap_4, Coin 1_862_028) ] -goldenMinimumCoins_Babbage :: [(TokenMap, Coin)] -goldenMinimumCoins_Babbage = - [ (goldenTokenMap_0, Coin 1_107_670) - , (goldenTokenMap_1, Coin 1_262_830) - , (goldenTokenMap_2, Coin 1_435_230) - , (goldenTokenMap_3, Coin 1_435_230) - , (goldenTokenMap_4, Coin 2_124_830) +goldenMinimumCoins_ShelleyAddress_BabbageEra :: [(Address, TokenMap, Coin)] +goldenMinimumCoins_ShelleyAddress_BabbageEra = + [ (maxLengthAddressShelley, goldenTokenMap_0, Coin 995_610) + , (maxLengthAddressShelley, goldenTokenMap_1, Coin 1_150_770) + , (maxLengthAddressShelley, goldenTokenMap_2, Coin 1_323_170) + , (maxLengthAddressShelley, goldenTokenMap_3, Coin 1_323_170) + , (maxLengthAddressShelley, goldenTokenMap_4, Coin 2_012_770) ] -------------------------------------------------------------------------------- @@ -520,6 +616,9 @@ fromCardanoAddressAny = Address . Cardano.serialiseToRawBytes instance Arbitrary Cardano.AddressAny where arbitrary = genAddressAny +instance Arbitrary Address where + arbitrary = fromCardanoAddressAny <$> arbitrary + instance Arbitrary TokenBundle where arbitrary = sized genTxOutTokenBundle shrink = shrinkTokenBundle diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 624d34e36b9..161a33656a5 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -2202,13 +2202,55 @@ components: minimum_utxo_value: <<: *amount description: | - The minimum ada / Lovelace quantity required for new transaction outputs. + The absolute minimum quantity of ada required for a new transaction + output created with the wallet. + + In general, the ledger rules require that every transaction output + has a minimum quantity of ada. This minimum quantity is determined + by an era-specific function whose value increases as the number of + different assets increases, as the quantity of any individual asset + increases, as the length of the target address increases, and if a + datum hash is added. + + Therefore, the value reported by this field should only be viewed + as an absolute minimum, and only applies to outputs that send ada + (and no other assets) to Shelley-era addresses. If an output + contains other assets, specifies a datum hash, or sends funds to a + Byron-era address, then the minimum value required by the ledger + (and the wallet) will be higher than the value reported by this + field. + + When using the wallet to construct or balance a transaction, if the + caller specifies an output with a non-zero ada quantity, then the + wallet will verify that the specified quantity is not less than the + minimum quantity required by the ledger, and if this verification + step fails, return an error that reports the required minimum. If + the caller specifies an output without an ada quantity, then the + wallet will automatically assign a minimal ada quantity to that + output. + + In the Shelley, Allegra, and Mary eras, the `minimum_utxo_value` + field was equivalent to the ledger `minUTxOValue` protocol + parameter. + + In the Alonzo era, the `minUTxOValue` protocol parameter was + replaced by the `coinsPerUTxOWord` protocol parameter. In this era, + the minimum ada quantity for an output was determined by + multiplying the `coinsPerUTxOWord` parameter by the length (in + 8-byte words) of the in-memory representation of that output, which + was not dependent on the length of the address. Therefore, in this + era, specifying a longer address would not require an increase in + the minimum ada quantity. + + In the Babbage era, the `coinsPerUTxOWord` protocol parameter was + replaced by the `coinsPerUTxOByte` protocol parameter. In this era, + the minimum ada quantity for an output is determined by multiplying + the `coinsPerUTxOByte` parameter by the length (in bytes) of the + serialised representation of the output, which is dependent on the + length of the address (among other factors). Therefore, in this + era, specifying a longer address will require an increase in the + minimum ada quantity. - It is only applicable for pure-ada outputs. If outputs contain other assets - or a datum hash, the true minimum will be higher than this value. - - With Alonzo, `minimum_utxo_value` is not a real protocol parameter, but rather - derived from from the Alonzo genesis `adaPerUTxOWord`. eras: *ApiEraInfo maximum_collateral_input_count: <<: *collateralInputCount From daeeb88bc55547dade7e257875c68f857fab61f1 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 29 Jul 2022 04:13:17 +0000 Subject: [PATCH 08/22] Replace `genCoinRange` with `chooseCoin` in `Migration.SelectionSpec`. At the time `SelectionSpec` was originally written, there was no reusable function available for choosing `Coin` values from a range, so we defined the `genCoinRange` function for this purpose. But now we have a standard `chooseCoin` function, we can use that to replace function `genCoinRange` within `SelectionSpec`. --- .../Primitive/Migration/SelectionSpec.hs | 28 +++++++++---------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs index 1c6e142a91d..226e0591685 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs @@ -30,6 +30,8 @@ import Cardano.Wallet.Primitive.Types.Address ( Address ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) +import Cardano.Wallet.Primitive.Types.Coin.Gen + ( chooseCoin ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -102,7 +104,7 @@ import Test.QuickCheck , withMaxSuccess ) import Test.QuickCheck.Extra - ( chooseNatural, report, verify ) + ( report, verify ) import qualified Cardano.Wallet.Primitive.Migration.Selection as Selection import qualified Cardano.Wallet.Primitive.Types.Coin as Coin @@ -395,7 +397,7 @@ prop_minimizeFee (Blind mockConstraints) = prop_minimizeFee_inner mockConstraints feeExcessToMinimize outputs where genFeeExcess :: Gen Coin - genFeeExcess = genCoinRange (Coin 0) (Coin 10_000) + genFeeExcess = chooseCoin (Coin 0, Coin 10_000) genOutputs :: Gen (NonEmpty TokenBundle) genOutputs = do @@ -487,7 +489,7 @@ prop_minimizeFeeStep (Blind mockConstraints) = prop_minimizeFeeStep_inner mockConstraints feeExcessToMinimize output where genFeeExcess :: Gen Coin - genFeeExcess = genCoinRange (Coin 0) (Coin 10_000) + genFeeExcess = chooseCoin (Coin 0, Coin 10_000) genOutput :: Gen TokenBundle genOutput = genTokenBundleMixed mockConstraints @@ -787,8 +789,8 @@ data MockTxCostFunction = MockTxCostFunction genMockTxCostFunction :: Gen MockTxCostFunction genMockTxCostFunction = MockTxCostFunction - <$> genCoinRange (Coin 0) (Coin 1000) - <*> genCoinRange (Coin 1) (Coin 4) + <$> chooseCoin (Coin 0, Coin 1000) + <*> chooseCoin (Coin 1, Coin 4) -------------------------------------------------------------------------------- -- Mock base transaction sizes @@ -862,8 +864,8 @@ unMockTxOutputMinimumAdaQuantity mock _addr m = genMockTxOutputMinimumAdaQuantity :: Gen MockTxOutputMinimumAdaQuantity genMockTxOutputMinimumAdaQuantity = MockTxOutputMinimumAdaQuantity - <$> genCoinRange (Coin 4) (Coin 8) - <*> genCoinRange (Coin 1) (Coin 2) + <$> chooseCoin (Coin 4, Coin 8) + <*> chooseCoin (Coin 1, Coin 2) -- Addresses are currently never used within the mock minimum ada quantity -- calculation. However, 'unMockTxOutputMinimumAdaQuantity' still requires an @@ -934,7 +936,7 @@ genMockInputId = MockInputId . BS.pack <$> genCoinAboveMinimumAdaQuantity :: MockTxConstraints -> Gen Coin genCoinAboveMinimumAdaQuantity mockConstraints = - genCoinRange lo hi + chooseCoin (lo, hi) where constraints = unMockTxConstraints mockConstraints lo = txOutputMinimumAdaQuantity constraints dummyAddress TokenMap.empty @@ -942,7 +944,7 @@ genCoinAboveMinimumAdaQuantity mockConstraints = genCoinBelowMinimumAdaQuantity :: MockTxConstraints -> Gen Coin genCoinBelowMinimumAdaQuantity mockConstraints = - genCoinRange lo hi + chooseCoin (lo, hi) where constraints = unMockTxConstraints mockConstraints lo = Coin 1 @@ -950,10 +952,6 @@ genCoinBelowMinimumAdaQuantity mockConstraints = (txOutputMinimumAdaQuantity constraints dummyAddress TokenMap.empty) (Coin 1) -genCoinRange :: Coin -> Coin -> Gen Coin -genCoinRange (Coin minCoin) (Coin maxCoin) = - Coin <$> chooseNatural (minCoin, maxCoin) - genTokenBundleMixed :: MockTxConstraints -> Gen TokenBundle genTokenBundleMixed mockConstraints = genInner `suchThat` txOutputHasValidSize constraints @@ -983,7 +981,7 @@ genTokenBundleAboveMinimumAdaQuantity :: MockTxConstraints -> Gen TokenBundle genTokenBundleAboveMinimumAdaQuantity mockConstraints = do m <- genTokenMap mockConstraints let minAda = txOutputMinimumAdaQuantity constraints dummyAddress m - c <- genCoinRange (minAda <> Coin 1) (minAda `scaleCoin` 1000) + c <- chooseCoin (minAda <> Coin 1, minAda `scaleCoin` 1000) pure $ TokenBundle c m where constraints = unMockTxConstraints mockConstraints @@ -1032,7 +1030,7 @@ mockAssetIds = genRewardWithdrawal :: Gen RewardWithdrawal genRewardWithdrawal = RewardWithdrawal <$> oneof [ pure (Coin 0) - , genCoinRange (Coin 1) (Coin 1_000_000) + , chooseCoin (Coin 1, Coin 1_000_000) ] -------------------------------------------------------------------------------- From 7509c9c70f38969dcb3d64eb2c905848e7041e17 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 29 Jul 2022 07:59:16 +0000 Subject: [PATCH 09/22] Use a minimum-length address for the dummy output in module `Balance`. We do need to use a valid address here, since the `performSelectionNonEmpty` function currently needs a valid address in order to compute and validate minimum ada quantities. However, since the dummy output is always eventually thrown away, we should use the shortest possible valid address in order to minimize any overestimation of the required cost. --- lib/core/src/Cardano/Wallet/CoinSelection.hs | 4 ++++ .../Cardano/Wallet/CoinSelection/Internal.hs | 4 ++++ .../Wallet/CoinSelection/Internal/Balance.hs | 4 +++- .../Primitive/Types/Address/Constants.hs | 18 ++++++++++++++++++ .../CoinSelection/Internal/BalanceSpec.hs | 3 +++ .../Wallet/CoinSelection/InternalSpec.hs | 2 ++ 6 files changed, 34 insertions(+), 1 deletion(-) diff --git a/lib/core/src/Cardano/Wallet/CoinSelection.hs b/lib/core/src/Cardano/Wallet/CoinSelection.hs index 1774aa3ee49..4669212d879 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection.hs @@ -96,6 +96,8 @@ import Cardano.Wallet.Primitive.Collateral ( asCollateral ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) +import Cardano.Wallet.Primitive.Types.Address.Constants + ( minLengthAddress ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -257,6 +259,8 @@ toInternalSelectionConstraints SelectionConstraints {..} = txOutMaxCoin , maximumOutputTokenQuantity = txOutMaxTokenQuantity + , minimumLengthChangeAddress = + minLengthAddress , .. } diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index 2910de03afe..af083aa0689 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -185,6 +185,8 @@ data SelectionConstraints ctx = SelectionConstraints -- token bundle of an output. , maximumLengthChangeAddress :: Address ctx + , minimumLengthChangeAddress + :: Address ctx } deriving Generic @@ -418,6 +420,8 @@ toBalanceConstraintsParams (constraints, params) = view #maximumOutputTokenQuantity constraints , maximumLengthChangeAddress = view #maximumLengthChangeAddress constraints + , minimumLengthChangeAddress = + view #minimumLengthChangeAddress constraints } where adjustComputeMinimumCost diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs index 4f10177687e..218e3ac867a 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs @@ -230,6 +230,8 @@ data SelectionConstraints ctx = SelectionConstraints -- select, given a current set of outputs. , maximumLengthChangeAddress :: Address ctx + , minimumLengthChangeAddress + :: Address ctx , maximumOutputAdaQuantity :: Coin -- ^ Specifies the largest ada quantity that can appear in the token @@ -852,7 +854,7 @@ performSelectionEmpty performSelectionFn constraints params = transform x y = maybe x y $ NE.nonEmpty $ view #outputsToCover params dummyAddress :: Address ctx - dummyAddress = maximumLengthChangeAddress constraints + dummyAddress = minimumLengthChangeAddress constraints dummyOutput :: (Address ctx, TokenBundle) dummyOutput = (dummyAddress, TokenBundle.fromCoin minCoin) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs index 74b9058fb17..84bf20e5c9a 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Constants.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} @@ -9,6 +10,7 @@ -- module Cardano.Wallet.Primitive.Types.Address.Constants ( maxLengthAddress + , minLengthAddress ) where import Prelude @@ -48,3 +50,19 @@ maxLengthAddress = L.maximumBy (compare `on` (BS.length . unAddress)) , maxLengthAddressFor $ Proxy @ShelleyKey , maxLengthAddressFor $ Proxy @SharedKey ] + +-- | A dummy 'Address' of the shortest length that the wallet can generate. +-- +-- Please note that this address should: +-- +-- - never be used for anything besides its length and validity properties. +-- - never be used as a payment target within a real transaction. +-- +minLengthAddress :: Address +minLengthAddress = minLengthAddressShelley + where + minLengthAddressShelley = + Address $ BS.singleton enterpriseAddressHeaderByte <> payload + where + enterpriseAddressHeaderByte = 0b01100000 + payload = BS.replicate 28 0 diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs index 18aa01f059e..a5937044537 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs @@ -1863,6 +1863,7 @@ mkBoundaryTestExpectation (BoundaryTestData params expectedResult) = do , maximumOutputAdaQuantity = testMaximumOutputAdaQuantity , maximumOutputTokenQuantity = testMaximumOutputTokenQuantity , maximumLengthChangeAddress = TestAddress 0x0 + , minimumLengthChangeAddress = TestAddress 0x0 } encodeBoundaryTestCriteria @@ -2497,6 +2498,8 @@ unMockSelectionConstraints m = SelectionConstraints testMaximumOutputTokenQuantity , maximumLengthChangeAddress = TestAddress 0x0 + , minimumLengthChangeAddress = + TestAddress 0x0 } -- | Specifies the largest ada quantity that can appear in the token bundle diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index be75050783f..44c7e8d5a12 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -600,6 +600,8 @@ unMockSelectionConstraints m = SelectionConstraints view #maximumOutputTokenQuantity m , maximumLengthChangeAddress = TestAddress 0x0 + , minimumLengthChangeAddress = + TestAddress 0x0 } -------------------------------------------------------------------------------- From aa78b3152628cb594805a6e5a9c9d84dc1637b75 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Mon, 25 Jul 2022 21:15:55 +0200 Subject: [PATCH 10/22] Raise `UnableToConstructChange.shortfall` values for `balanceTx` golden tests. In the case of delegation, the wallet typically calls coin selection without any user-specified outputs. In such cases, coin selection will use a temporary dummy output to act as a target for change generation, defined within the `performSelectionEmpty` function. Although we have adjusted this function to use a valid address of minimal length, this address is still longer than the null-length dummy address that we were able to use when the `computeMinimumCoinForUTxO` function did not require an address. This increase in address length causes an increase in the estimated cost when generating change. Therefore, any `UnableToConstructChange` errors will report ada shortfalls that are larger in magnitude than before. A future commit will adjust `performSelectionEmpty` so that it can use a null-length address again, so we can minimize the cost overestimation. --- lib/shelley/test/data/balanceTx/delegate/golden | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/shelley/test/data/balanceTx/delegate/golden b/lib/shelley/test/data/balanceTx/delegate/golden index 8eae0fa1cab..65c3798c8cd 100644 --- a/lib/shelley/test/data/balanceTx/delegate/golden +++ b/lib/shelley/test/data/balanceTx/delegate/golden @@ -38,10 +38,10 @@ 1.850000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1850000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}})))) 1.900000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1900000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}})))) 1.950000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1950000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}})))) - 2.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 180901})))) - 2.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 130901})))) - 2.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 80901})))) - 2.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180901, shortfall = Coin 30901})))) + 2.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 182177})))) + 2.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 132177})))) + 2.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 82177})))) + 2.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 32177})))) 2.200000,0.200000,0.175401 2.250000,0.250000,0.175401 2.300000,0.300000,0.175401 From a049485eb71ee68e099d6f792a45f9574d965897 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Fri, 29 Jul 2022 09:15:41 +0000 Subject: [PATCH 11/22] Raise cost of joining and quitting in `STAKE_POOLS_{JOIN,QUIT}_01x`. In the case of delegation, the wallet typically calls coin selection without any user-specified outputs. In such cases, coin selection will use a temporary dummy output to act as a target for change generation, defined within the `performSelectionEmpty` function. Although we have adjusted this function to use a valid address of minimal length, this address is still longer than the null-length dummy address that we were able to use when the `computeMinimumCoinForUTxO` function did not require an address. This increase in address length causes an increase in the estimated cost when generating change. Therefore, this also raises the cost of joining or quitting a stake pool. A future commit will adjust `performSelectionEmpty` so that it can use a null-length address again, so we can minimize the cost overestimation. --- .../src/Test/Integration/Scenario/API/Shelley/StakePools.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs index 641cd1f79ce..2eee9d85794 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs @@ -1433,8 +1433,8 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do costOfJoining :: Context -> Natural costOfJoining ctx = if _mainEra ctx >= ApiBabbage - then costOf (\coeff cst -> 458 * coeff + cst) ctx - else costOf (\coeff cst -> 454 * coeff + cst) ctx + then costOf (\coeff cst -> 487 * coeff + cst) ctx + else costOf (\coeff cst -> 483 * coeff + cst) ctx costOfQuitting :: Context -> Natural costOfQuitting ctx = From a813ed506cf042c53965c5df06a84adf20487420 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 2 Aug 2022 02:52:05 +0000 Subject: [PATCH 12/22] Use `errMsg403MinUTxOValue` instead of magic constants in integration tests. This allows us to revise the error message without causing multiple integration tests to fail unnecessarily. --- .../Test/Integration/Scenario/API/Byron/Transactions.hs | 3 ++- .../Integration/Scenario/API/Byron/TransactionsNew.hs | 8 ++++++-- .../Test/Integration/Scenario/API/Shelley/Transactions.hs | 2 +- .../Integration/Scenario/API/Shelley/TransactionsNew.hs | 2 +- 4 files changed, 10 insertions(+), 5 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs index bb84076f509..6f525259afa 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs @@ -106,6 +106,7 @@ import Test.Integration.Framework.Request ( RequestException ) import Test.Integration.Framework.TestData ( errMsg400StartTimeLaterThanEndTime + , errMsg403MinUTxOValue , errMsg404NoAsset , errMsg404NoWallet , steveToken @@ -186,7 +187,7 @@ spec = describe "BYRON_TRANSACTIONS" $ do rtx <- request @(ApiTransaction n) ctx (Link.createTransactionOld @'Byron wSrc) Default payload expectResponseCode HTTP.status403 rtx - expectErrorMessage "Some outputs have ada values that are too small." rtx + expectErrorMessage errMsg403MinUTxOValue rtx describe "BYRON_TRANS_ASSETS_CREATE_02a - Multi-asset transaction with no ADA" $ forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/TransactionsNew.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/TransactionsNew.hs index 09e78863513..58e80c4d545 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/TransactionsNew.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/TransactionsNew.hs @@ -78,7 +78,11 @@ import Test.Integration.Framework.DSL , verify ) import Test.Integration.Framework.TestData - ( errMsg403Fee, errMsg403InvalidConstructTx, errMsg403NotEnoughMoney ) + ( errMsg403Fee + , errMsg403InvalidConstructTx + , errMsg403MinUTxOValue + , errMsg403NotEnoughMoney + ) import qualified Cardano.Wallet.Api.Link as Link import qualified Network.HTTP.Types.Status as HTTP @@ -324,7 +328,7 @@ spec = describe "NEW_BYRON_TRANSACTIONS" $ do (Link.createUnsignedTransaction @'Byron wa) Default payload verify rTx [ expectResponseCode HTTP.status403 - , expectErrorMessage "Some outputs have ada values that are too small." + , expectErrorMessage errMsg403MinUTxOValue ] describe "BYRON_TRANS_NEW_ASSETS_CREATE_01c - Multi-asset tx without Ada" $ diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index 158c2209800..cd73eb10fdc 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -683,7 +683,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (Link.createTransactionOld @'Shelley wSrc) Default payload -- It should fail with InsufficientMinCoinValueError expectResponseCode HTTP.status403 rtx - expectErrorMessage "Some outputs have ada values that are too small." rtx + expectErrorMessage errMsg403MinUTxOValue rtx it "TRANS_ASSETS_CREATE_02a - Multi-asset transaction without Ada" $ \ctx -> runResourceT $ do wSrc <- fixtureMultiAssetWallet ctx diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs index 92f3d40889d..ad629b9f4bc 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs @@ -1051,7 +1051,7 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do (Link.createUnsignedTransaction @'Shelley wa) Default payload verify rTx [ expectResponseCode HTTP.status403 - , expectErrorMessage "Some outputs have ada values that are too small." + , expectErrorMessage errMsg403MinUTxOValue ] it "TRANS_NEW_ASSETS_CREATE_01c - Multi-asset tx without Ada" $ \ctx -> runResourceT $ do From eab4ba99bcc96055059149946050a2869c21b2a7 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 04:41:17 +0000 Subject: [PATCH 13/22] Add `SelectionOutputCoinInsufficient` constructor to `SelectionOutputError`. It's advantageous to perform all validation of user-specified outputs within the top-level `CoinSelection.Internal` module, rather than deferring some parts of the validation process to `CoinSelection.Internal.Balance`. Justification: Performing validation of user-specified outputs within the top-level coin selection module means that we don't have to do it again within lower-level internal modules. Goal: We can eventually relax the restriction requiring us to always provide valid addresses when calling `performSelectionNonEmpty`, which also means we can eventually use a null-length address for the dummy output within `performSelectionEmpty`. --- .../Test/Integration/Framework/TestData.hs | 10 ++++++++ lib/core/src/Cardano/Wallet/Api/Server.hs | 25 +++++++++++++++++++ lib/core/src/Cardano/Wallet/CoinSelection.hs | 2 ++ .../Cardano/Wallet/CoinSelection/Internal.hs | 10 ++++++-- .../Wallet/CoinSelection/InternalSpec.hs | 7 ++++++ 5 files changed, 52 insertions(+), 2 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index 15d5699aba8..a2eb6347ba8 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -83,6 +83,7 @@ module Test.Integration.Framework.TestData , errMsg403WithdrawalNotWorth , errMsg403NotAShelleyWallet , errMsg403MinUTxOValue + , errMsg403MinUTxOValueNew , errMsg403CouldntIdentifyAddrAsMine , errMsg503PastHorizon , errMsg403WrongIndex @@ -322,6 +323,15 @@ errMsg403MinUTxOValue = \I'll handle that minimum value myself when you do not explicitly specify \ \an ada value for an output. Otherwise, you must specify enough ada." +errMsg403MinUTxOValueNew :: String +errMsg403MinUTxOValueNew = unwords + [ "One of the outputs you've specified has an ada quantity that is" + , "below the minimum required. Either increase the ada quantity to" + , "at least the minimum, or specify an ada quantity of zero, in" + , "which case the wallet will automatically assign the correct" + , "minimum ada quantity to the output." + ] + errMsg409WalletExists :: String -> String errMsg409WalletExists walId = "This operation would yield a wallet with the following\ \ id: " ++ walId ++ " However, I already know of a wallet with this id." diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 1c61f0e2c9a..30badbaf184 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -343,6 +343,7 @@ import Cardano.Wallet.CoinSelection , SelectionCollateralError , SelectionError (..) , SelectionOf (..) + , SelectionOutputCoinInsufficientError (..) , SelectionOutputError (..) , SelectionOutputSizeExceedsLimitError (..) , SelectionOutputTokenQuantityExceedsLimitError (..) @@ -5081,11 +5082,35 @@ instance IsServerError (ErrInvalidDerivationIndex 'Soft level) where instance IsServerError (SelectionOutputError WalletSelectionContext) where toServerError = \case + SelectionOutputCoinInsufficient e -> + toServerError e SelectionOutputSizeExceedsLimit e -> toServerError e SelectionOutputTokenQuantityExceedsLimit e -> toServerError e +instance IsServerError + (SelectionOutputCoinInsufficientError Address) + where + toServerError e = + apiError err403 UtxoTooSmall $ T.unlines [preamble, details] + where + preamble = T.unwords + [ "One of the outputs you've specified has an ada quantity that is" + , "below the minimum required. Either increase the ada quantity to" + , "at least the minimum, or specify an ada quantity of zero, in" + , "which case the wallet will automatically assign the correct" + , "minimum ada quantity to the output." + ] + details = T.unlines + [ "Destination address:" + , pretty (fst $ view #output e) + , "Required minimum ada quantity:" + , pretty (view #minimumExpectedCoin e) + , "Specified ada quantity:" + , pretty (TokenBundle.getCoin $ snd $ view #output e) + ] + instance IsServerError (SelectionOutputSizeExceedsLimitError WalletSelectionContext) where diff --git a/lib/core/src/Cardano/Wallet/CoinSelection.hs b/lib/core/src/Cardano/Wallet/CoinSelection.hs index 4669212d879..be0baa996bc 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection.hs @@ -59,6 +59,7 @@ module Cardano.Wallet.CoinSelection , SelectionBalanceError (..) , SelectionCollateralError , SelectionOutputError (..) + , SelectionOutputCoinInsufficientError (..) , SelectionOutputSizeExceedsLimitError (..) , SelectionOutputTokenQuantityExceedsLimitError (..) , UnableToConstructChangeError (..) @@ -79,6 +80,7 @@ import Cardano.Wallet.CoinSelection.Internal ( SelectionCollateralError , SelectionCollateralRequirement (..) , SelectionError (..) + , SelectionOutputCoinInsufficientError (..) , SelectionOutputError (..) , SelectionOutputSizeExceedsLimitError (..) , SelectionOutputTokenQuantityExceedsLimitError (..) diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index af083aa0689..cc7d8efd5b3 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -31,6 +31,7 @@ module Cardano.Wallet.CoinSelection.Internal -- * Output preparation , prepareOutputsWith , SelectionOutputError (..) + , SelectionOutputCoinInsufficientError (..) , SelectionOutputSizeExceedsLimitError (..) , SelectionOutputTokenQuantityExceedsLimitError (..) @@ -808,7 +809,7 @@ data SelectionOutputCoinInsufficientError address = { minimumExpectedCoin :: Coin , output :: (address, TokenBundle) } - deriving (Eq, Show) + deriving (Eq, Generic, Show) verifySelectionOutputCoinsSufficient :: forall ctx. SelectionContext ctx => VerifySelection ctx @@ -1193,6 +1194,9 @@ verifySelectionOutputError :: SelectionContext ctx => VerifySelectionError (SelectionOutputError ctx) ctx verifySelectionOutputError cs ps = \case + SelectionOutputCoinInsufficient _e -> + -- TODO: verify this error: + VerificationSuccess SelectionOutputSizeExceedsLimit e -> verifySelectionOutputSizeExceedsLimitError cs ps e SelectionOutputTokenQuantityExceedsLimit e -> @@ -1456,7 +1460,9 @@ prepareOutputsWith minCoinValueFor = -- | Indicates a problem when preparing outputs for a coin selection. -- data SelectionOutputError ctx - = SelectionOutputSizeExceedsLimit + = SelectionOutputCoinInsufficient + (SelectionOutputCoinInsufficientError (Address ctx)) + | SelectionOutputSizeExceedsLimit (SelectionOutputSizeExceedsLimitError ctx) | SelectionOutputTokenQuantityExceedsLimit (SelectionOutputTokenQuantityExceedsLimitError ctx) diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index 44c7e8d5a12..4109dd85c06 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -256,6 +256,9 @@ prop_performSelection_coverage params r innerProperty = cover 0.1 (isSelectionCollateralError r) "isSelectionCollateralError" $ + cover 0.1 + (isSelectionOutputError_SelectionOutputCoinInsufficient r) + "isSelectionOutputError_SelectionOutputCoinInsufficient" $ cover 0.1 (isSelectionOutputError_SelectionOutputSizeExceedsLimit r) "isSelectionOutputError_SelectionOutputSizeExceedsLimit" $ @@ -283,6 +286,9 @@ prop_performSelection_coverage params r innerProperty = isSelectionCollateralError = \case Left (SelectionCollateralErrorOf _) -> True; _ -> False + isSelectionOutputError_SelectionOutputCoinInsufficient = \case + Left (SelectionOutputErrorOf SelectionOutputCoinInsufficient {}) + -> True; _ -> False isSelectionOutputError_SelectionOutputSizeExceedsLimit = \case Left (SelectionOutputErrorOf SelectionOutputSizeExceedsLimit {}) -> True; _ -> False @@ -308,6 +314,7 @@ prop_performSelection_coverage params r innerProperty = SelectionCollateralErrorOf e -> case e of SelectionCollateralError {} -> () SelectionOutputErrorOf e -> case e of + SelectionOutputCoinInsufficient {} -> () SelectionOutputSizeExceedsLimit {} -> () SelectionOutputTokenQuantityExceedsLimit {} -> () From c1f2c9addcc33473adde6a32d8954fd4c740ef68 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 05:13:56 +0000 Subject: [PATCH 14/22] Verify ada quantities of user-specified outputs in `CoinSelection.Internal`. As a result of this commit, verification is now performed in two places: - `CoinSelection.Internal` - `CoinSelection.Internal.Balance` The second verification step, within the `Balance` module, is now redundant, and should never fail in production. We will remove this redundant step from the `Balance` module in a later commit. --- .../Test/Integration/Framework/TestData.hs | 10 ++--- .../Cardano/Wallet/CoinSelection/Internal.hs | 37 +++++++++++++++++++ 2 files changed, 42 insertions(+), 5 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index a2eb6347ba8..198146bed66 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -82,8 +82,8 @@ module Test.Integration.Framework.TestData , errMsg400MinWithdrawalWrong , errMsg403WithdrawalNotWorth , errMsg403NotAShelleyWallet + , errMsg403MinUTxOValueOld , errMsg403MinUTxOValue - , errMsg403MinUTxOValueNew , errMsg403CouldntIdentifyAddrAsMine , errMsg503PastHorizon , errMsg403WrongIndex @@ -316,15 +316,15 @@ errMsg403InvalidConstructTx = \any payments, withdrawals, delegations, metadata nor minting. \ \Include at least one of them." -errMsg403MinUTxOValue :: String -errMsg403MinUTxOValue = +errMsg403MinUTxOValueOld :: String +errMsg403MinUTxOValueOld = "Some outputs have ada values that are too small. There's a \ \minimum ada value specified by the protocol that each output must satisfy. \ \I'll handle that minimum value myself when you do not explicitly specify \ \an ada value for an output. Otherwise, you must specify enough ada." -errMsg403MinUTxOValueNew :: String -errMsg403MinUTxOValueNew = unwords +errMsg403MinUTxOValue :: String +errMsg403MinUTxOValue = unwords [ "One of the outputs you've specified has an ada quantity that is" , "below the minimum required. Either increase the ada quantity to" , "at least the minimum, or specify an ada quantity of zero, in" diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index cc7d8efd5b3..d267c0c2fde 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -1407,6 +1407,12 @@ prepareOutputsInternal constraints outputsUnprepared -- We encountered one or more excessive token quantities. -- Just report the first such quantity: SelectionOutputTokenQuantityExceedsLimit e + | e : _ <- insufficientCoins = + Left $ + -- We encountered one or more outputs with an ada quantity that is + -- below the minimum required quantity. + -- Just report the first such output: + SelectionOutputCoinInsufficient e | otherwise = pure outputsToCover where @@ -1427,6 +1433,13 @@ prepareOutputsInternal constraints outputsUnprepared :: [SelectionOutputTokenQuantityExceedsLimitError ctx] excessiveTokenQuantities = verifyOutputTokenQuantities =<< outputsToCover + -- The complete list of outputs whose ada quantities are below the minimum + -- required: + insufficientCoins + :: [SelectionOutputCoinInsufficientError (Address ctx)] + insufficientCoins = + mapMaybe (verifyOutputCoinSufficient constraints) outputsToCover + outputsToCover = prepareOutputsWith computeMinimumAdaQuantity outputsUnprepared @@ -1539,3 +1552,27 @@ verifyOutputTokenQuantities out = , (asset, quantity) <- TokenMap.toFlatList $ (snd out) ^. #tokens , quantity > txOutMaxTokenQuantity ] + +-- | Verifies that an output's ada quantity is sufficient. +-- +-- An output's ada quantity must be greater than or equal to the minimum +-- required quantity for that output. +-- +verifyOutputCoinSufficient + :: SelectionConstraints ctx + -> (Address ctx, TokenBundle) + -> Maybe (SelectionOutputCoinInsufficientError (Address ctx)) +verifyOutputCoinSufficient constraints output + | actualCoin >= minimumExpectedCoin = + Nothing + | otherwise = + Just SelectionOutputCoinInsufficientError {minimumExpectedCoin, output} + where + actualCoin :: Coin + actualCoin = snd output ^. #coin + + minimumExpectedCoin :: Coin + minimumExpectedCoin = + (constraints ^. #computeMinimumAdaQuantity) + (fst output) + (snd output ^. #tokens) From 7381e2f364e398ac2bf639e6413d176f8a9f6202 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 05:21:00 +0000 Subject: [PATCH 15/22] Remove coverage check for `SelectionBalanceError.InsufficientMinCoinValues`. This commit removes the now-failing coverage check for `CoinSelection.Internal.Balance.InsufficientMinCoinValues` from `CoinSelection.InternalSpec`. This coverage check can no longer fire, as insufficient ada quantities are now detected at the top level within the `prepareOutputsInternal` function of module `CoinSelection.Internal`. Therefore, if we call coin selection through `CoinSelection.Internal`, it should no longer possible to trigger `Balance.InsufficientMinCoinValues`. A later commit will remove `Balance.InsufficientMinCoinValues` entirely, in favour of using `SelectionOutputErrorInsufficientCoinError` from `CoinSelection.Internal`. --- .../test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index 4109dd85c06..9ac2b13d2b4 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -244,9 +244,6 @@ prop_performSelection_coverage params r innerProperty = cover 0.1 (isSelectionBalanceError_SelectionLimitReached r) "isSelectionBalanceError_SelectionLimitReached" $ - cover 0.1 - (isSelectionBalanceError_InsufficientMinCoinValues r) - "isSelectionBalanceError_InsufficientMinCoinValues" $ cover 0.1 (isSelectionBalanceError_UnableToConstructChange r) "isSelectionBalanceError_UnableToConstructChange" $ @@ -274,9 +271,6 @@ prop_performSelection_coverage params r innerProperty = isSelectionBalanceError_SelectionLimitReached = \case Left (SelectionBalanceErrorOf Balance.SelectionLimitReached {}) -> True; _ -> False - isSelectionBalanceError_InsufficientMinCoinValues = \case - Left (SelectionBalanceErrorOf Balance.InsufficientMinCoinValues {}) - -> True; _ -> False isSelectionBalanceError_UnableToConstructChange = \case Left (SelectionBalanceErrorOf Balance.UnableToConstructChange {}) -> True; _ -> False From ac4ae3d9a6beda90d69f2e48114cec957c760727 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 05:34:10 +0000 Subject: [PATCH 16/22] Verify values of type `SelectionOutputCoinInsufficientError`. We repurpose the existing verification function, and make it target values of type `SelectionOutputCoinInsufficientError` instead of the soon-to-be-removed `InsufficientMinCoinValues` type from `Balance`. --- .../Cardano/Wallet/CoinSelection/Internal.hs | 27 ++++++++++--------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index d267c0c2fde..0b9a1ee3fed 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -906,8 +906,9 @@ verifySelectionBalanceError cs ps = \case verifyBalanceInsufficientError cs ps e Balance.EmptyUTxO -> verifyEmptyUTxOError cs ps () - Balance.InsufficientMinCoinValues es -> - F.foldMap (verifyInsufficientMinCoinValueError cs ps) es + Balance.InsufficientMinCoinValues _es -> + -- TODO: Completely remove this pattern match. + VerificationSuccess Balance.UnableToConstructChange e-> verifyUnableToConstructChangeError cs ps e Balance.SelectionLimitReached e -> @@ -955,26 +956,27 @@ verifyEmptyUTxOError _cs SelectionParams {utxoAvailableForInputs} _e = -- Selection error verification: insufficient minimum ada quantity errors -------------------------------------------------------------------------------- -data FailureToVerifyInsufficientMinCoinValueError address = - FailureToVerifyInsufficientMinCoinValueError +data FailureToVerifySelectionOutputCoinInsufficientError address = + FailureToVerifySelectionOutputCoinInsufficientError { reportedOutput :: (address, TokenBundle) , reportedMinCoinValue :: Coin , verifiedMinCoinValue :: Coin } deriving (Eq, Show) -verifyInsufficientMinCoinValueError +verifySelectionOutputCoinInsufficientError :: SelectionContext ctx - => VerifySelectionError (Balance.InsufficientMinCoinValueError ctx) ctx -verifyInsufficientMinCoinValueError cs _ps e = + => VerifySelectionError + (SelectionOutputCoinInsufficientError (Address ctx)) ctx +verifySelectionOutputCoinInsufficientError cs _ps e = verifyAll [ reportedMinCoinValue == verifiedMinCoinValue , reportedMinCoinValue > snd reportedOutput ^. #coin ] - FailureToVerifyInsufficientMinCoinValueError {..} + FailureToVerifySelectionOutputCoinInsufficientError {..} where - reportedOutput = e ^. #outputWithInsufficientAda - reportedMinCoinValue = e ^. #expectedMinCoinValue + reportedOutput = e ^. #output + reportedMinCoinValue = e ^. #minimumExpectedCoin verifiedMinCoinValue = (cs ^. #computeMinimumAdaQuantity) (fst reportedOutput) @@ -1194,9 +1196,8 @@ verifySelectionOutputError :: SelectionContext ctx => VerifySelectionError (SelectionOutputError ctx) ctx verifySelectionOutputError cs ps = \case - SelectionOutputCoinInsufficient _e -> - -- TODO: verify this error: - VerificationSuccess + SelectionOutputCoinInsufficient e -> + verifySelectionOutputCoinInsufficientError cs ps e SelectionOutputSizeExceedsLimit e -> verifySelectionOutputSizeExceedsLimitError cs ps e SelectionOutputTokenQuantityExceedsLimit e -> From 87bc3fa35286b44757a12520a5466cd5ce490cd8 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 05:51:24 +0000 Subject: [PATCH 17/22] Adjust `TransactionSpec` to detect `SelectionOutputCoinInsufficientError`. Now that coin selection returns `SelectionOutputCoinInsufficientError` in preference to the soon-to-be-deleted `InsufficientMinCoinValues` error, we must adjust the coverage checks within `TransactionSpec` to expect the new error type instead of the old. --- .../test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index d90dda46b5f..d778f2f60d5 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -94,6 +94,7 @@ import Cardano.Wallet.CoinSelection ( SelectionBalanceError (..) , SelectionError (..) , SelectionOf (..) + , SelectionOutputError (..) , UnableToConstructChangeError (..) , WalletUTxO (..) , balanceMissing @@ -3612,9 +3613,9 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx') seed Left (ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError - (SelectionBalanceErrorOf - (InsufficientMinCoinValues _)))) -> - label "outputs below minCoinValue" $ property True + (SelectionOutputErrorOf + (SelectionOutputCoinInsufficient _)))) -> + label "output below minCoinValue" $ property True Left (ErrBalanceTxExistingCollateral) -> label "existing collateral" True Left (ErrBalanceTxExistingTotalCollateral) -> From 4de24a4cd457cf246cbd976e3cc0475440bf1373 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 05:54:16 +0000 Subject: [PATCH 18/22] Remove the now-unused `InsufficientMinCoinValues` error. This error has now been completely superseded by `SelectionOutputCoinInsufficientError`. --- .../Test/Integration/Framework/TestData.hs | 8 --- lib/core/src/Cardano/Wallet/Api/Server.hs | 12 +--- .../Cardano/Wallet/CoinSelection/Internal.hs | 3 - .../Wallet/CoinSelection/Internal/Balance.hs | 59 +------------------ .../CoinSelection/Internal/BalanceSpec.hs | 21 ------- .../Wallet/CoinSelection/InternalSpec.hs | 1 - 6 files changed, 3 insertions(+), 101 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index 198146bed66..bbabce5480d 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -82,7 +82,6 @@ module Test.Integration.Framework.TestData , errMsg400MinWithdrawalWrong , errMsg403WithdrawalNotWorth , errMsg403NotAShelleyWallet - , errMsg403MinUTxOValueOld , errMsg403MinUTxOValue , errMsg403CouldntIdentifyAddrAsMine , errMsg503PastHorizon @@ -316,13 +315,6 @@ errMsg403InvalidConstructTx = \any payments, withdrawals, delegations, metadata nor minting. \ \Include at least one of them." -errMsg403MinUTxOValueOld :: String -errMsg403MinUTxOValueOld = - "Some outputs have ada values that are too small. There's a \ - \minimum ada value specified by the protocol that each output must satisfy. \ - \I'll handle that minimum value myself when you do not explicitly specify \ - \an ada value for an output. Otherwise, you must specify enough ada." - errMsg403MinUTxOValue :: String errMsg403MinUTxOValue = unwords [ "One of the outputs you've specified has an ada quantity that is" diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 30badbaf184..09bc0ee9bb8 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -605,7 +605,7 @@ import Data.Type.Equality import Data.Word ( Word32 ) import Fmt - ( blockListF, indentF, listF, pretty ) + ( listF, pretty ) import GHC.Generics ( Generic ) import GHC.Stack @@ -5196,16 +5196,6 @@ instance IsServerError (SelectionBalanceError WalletSelectionContext) where , "sending a smaller amount. I had already selected " , showT (length $ view #inputsSelected e), " inputs." ] - InsufficientMinCoinValues xs -> - apiError err403 UtxoTooSmall $ mconcat - [ "Some outputs have ada values that are too small. " - , "There's a minimum ada value specified by the " - , "protocol that each output must satisfy. I'll handle " - , "that minimum value myself when you do not explicitly " - , "specify an ada value for an output. Otherwise, you " - , "must specify enough ada. Here are the problematic " - , "outputs:\n" <> pretty (indentF 2 $ blockListF xs) - ] UnableToConstructChange e -> apiError err403 CannotCoverFee $ T.unwords [ "I am unable to finalize the transaction, as there" diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index 0b9a1ee3fed..dd2777a1b87 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -906,9 +906,6 @@ verifySelectionBalanceError cs ps = \case verifyBalanceInsufficientError cs ps e Balance.EmptyUTxO -> verifyEmptyUTxOError cs ps () - Balance.InsufficientMinCoinValues _es -> - -- TODO: Completely remove this pattern match. - VerificationSuccess Balance.UnableToConstructChange e-> verifyUnableToConstructChangeError cs ps e Balance.SelectionLimitReached e -> diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs index 218e3ac867a..3572c1baaa6 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs @@ -43,7 +43,6 @@ module Cardano.Wallet.CoinSelection.Internal.Balance , SelectionStrategy (..) , SelectionBalanceError (..) , BalanceInsufficientError (..) - , InsufficientMinCoinValueError (..) , UnableToConstructChangeError (..) -- * Selection limits @@ -136,7 +135,7 @@ import Cardano.Wallet.Primitive.Types.Coin import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) import Cardano.Wallet.Primitive.Types.TokenMap - ( AssetId, Flat (..), Lexicographic (..), TokenMap ) + ( AssetId, Lexicographic (..), TokenMap ) import Cardano.Wallet.Primitive.Types.TokenQuantity ( TokenQuantity (..) ) import Cardano.Wallet.Primitive.Types.Tx @@ -176,7 +175,7 @@ import Data.Semigroup import Data.Set ( Set ) import Fmt - ( Buildable (..), Builder, blockMapF, nameF, unlinesF ) + ( Buildable (..), Builder, blockMapF ) import GHC.Generics ( Generic ) import GHC.Stack @@ -693,8 +692,6 @@ data SelectionBalanceError ctx BalanceInsufficientError | SelectionLimitReached (SelectionLimitReachedError ctx) - | InsufficientMinCoinValues - (NonEmpty (InsufficientMinCoinValueError ctx)) | UnableToConstructChange UnableToConstructChangeError | EmptyUTxO @@ -740,34 +737,6 @@ balanceMissing :: BalanceInsufficientError -> TokenBundle balanceMissing (BalanceInsufficientError available required) = TokenBundle.difference required available --- | Indicates that a particular output does not have the minimum coin quantity --- expected by the protocol. --- --- See also: 'prepareOutputs'. --- -data InsufficientMinCoinValueError ctx = InsufficientMinCoinValueError - { outputWithInsufficientAda - :: !(Address ctx, TokenBundle) - -- ^ The particular output that does not have the minimum coin quantity - -- expected by the protocol. - , expectedMinCoinValue - :: !Coin - -- ^ The minimum coin quantity expected for this output. - } deriving Generic - -deriving instance SelectionContext ctx => - Eq (InsufficientMinCoinValueError ctx) -deriving instance SelectionContext ctx => - Show (InsufficientMinCoinValueError ctx) - -instance SelectionContext ctx => Buildable (InsufficientMinCoinValueError ctx) - where - build (InsufficientMinCoinValueError (a, b) c) = unlinesF @[] - [ nameF "Expected min coin value" (build c) - , nameF "Address" (build a) - , nameF "Token bundle" (build (Flat b)) - ] - data UnableToConstructChangeError = UnableToConstructChangeError { requiredCost :: !Coin @@ -886,11 +855,6 @@ performSelectionNonEmpty constraints params pure $ Left $ BalanceInsufficient $ BalanceInsufficientError {utxoBalanceAvailable, utxoBalanceRequired} - -- Are the minimum ada quantities of the outputs too small? - | not (null insufficientMinCoinValues) = - pure $ Left $ InsufficientMinCoinValues $ - NE.fromList insufficientMinCoinValues - | otherwise = do maybeSelection <- runSelectionNonEmpty RunSelectionParams { selectionLimit @@ -953,25 +917,6 @@ performSelectionNonEmpty constraints params utxoBalanceSufficient :: Bool utxoBalanceSufficient = isUTxOBalanceSufficient params - insufficientMinCoinValues :: [InsufficientMinCoinValueError ctx] - insufficientMinCoinValues = - mapMaybe mkInsufficientMinCoinValueError outputsToCover - where - mkInsufficientMinCoinValueError - :: (Address ctx, TokenBundle) - -> Maybe (InsufficientMinCoinValueError ctx) - mkInsufficientMinCoinValueError (addr, bundle) - | view #coin bundle >= expectedMinCoinValue = - Nothing - | otherwise = - Just $ InsufficientMinCoinValueError - { expectedMinCoinValue - , outputWithInsufficientAda = (addr, bundle) - } - where - expectedMinCoinValue = computeMinimumAdaQuantity addr - (view #tokens bundle) - -- Given a UTxO index that corresponds to a valid selection covering -- 'outputsToCover', 'predictChange' yields a non-empty list of assets -- expected for change outputs. diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs index a5937044537..9eba22d9e75 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs @@ -47,7 +47,6 @@ import Cardano.Numeric.Util import Cardano.Wallet.CoinSelection.Internal.Balance ( AssetCount (..) , BalanceInsufficientError (..) - , InsufficientMinCoinValueError (..) , MakeChangeCriteria (..) , PerformSelection , RunSelectionParams (..) @@ -983,8 +982,6 @@ prop_performSelection mockConstraints params coverage = onBalanceInsufficient e SelectionLimitReached e -> onSelectionLimitReached e - InsufficientMinCoinValues es -> - onInsufficientMinCoinValues es UnableToConstructChange e -> onUnableToConstructChange e EmptyUTxO -> @@ -1039,24 +1036,6 @@ prop_performSelection mockConstraints params coverage = errorBalanceSelected = F.foldMap (view #tokens . snd) errorInputsSelected - onInsufficientMinCoinValues - :: NonEmpty (InsufficientMinCoinValueError TestSelectionContext) - -> Property - onInsufficientMinCoinValues es = - counterexample "onInsufficientMinCoinValues" $ - report es - "error values" $ - report - (NE.zip (expectedMinCoinValue <$> es) (actualMinCoinValue <$> es)) - "(expected, actual) pairs" $ - verify - (all (\e -> expectedMinCoinValue e > actualMinCoinValue e) es) - "all (λe -> expectedMinCoinValue e > actualMinCoinValue e) es" $ - property True - where - actualMinCoinValue - = view #coin . snd . outputWithInsufficientAda - onUnableToConstructChange :: UnableToConstructChangeError -> Property onUnableToConstructChange e = counterexample "onUnableToConstructChange" $ diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index 9ac2b13d2b4..ce8a59741d2 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -302,7 +302,6 @@ prop_performSelection_coverage params r innerProperty = SelectionBalanceErrorOf e -> case e of Balance.BalanceInsufficient {} -> () Balance.SelectionLimitReached {} -> () - Balance.InsufficientMinCoinValues {} -> () Balance.UnableToConstructChange {} -> () Balance.EmptyUTxO {} -> () SelectionCollateralErrorOf e -> case e of From 10f52c9923cc03963da2ec101ad3e0e94b83fb64 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 06:25:50 +0000 Subject: [PATCH 19/22] Use a null address and minimal coin value within `performSelectionEmpty`. Now that `performSelectionNonEmpty` no longer needs to validate the minimum ada quantities of user-specified outputs (a responsibility that has been moved to the top-level coin selection module), we are free to choose any `Address` (even if invalid) and any non-zero `Coin` value for the dummy output used by `performSelectionEmpty`. In order to minimize any overestimation in cost resulting from the use of a dummy output, we choose the shortest possible `Address` (which is a null-length address) and the smallest possible non-zero `Coin` value. --- lib/core/src/Cardano/Wallet/CoinSelection.hs | 6 +-- .../Cardano/Wallet/CoinSelection/Internal.hs | 6 +-- .../Wallet/CoinSelection/Internal/Balance.hs | 47 ++++++++++--------- .../CoinSelection/Internal/BalanceSpec.hs | 4 +- .../Wallet/CoinSelection/InternalSpec.hs | 2 +- 5 files changed, 34 insertions(+), 31 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/CoinSelection.hs b/lib/core/src/Cardano/Wallet/CoinSelection.hs index be0baa996bc..0fe889d7be9 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection.hs @@ -98,8 +98,6 @@ import Cardano.Wallet.Primitive.Collateral ( asCollateral ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) -import Cardano.Wallet.Primitive.Types.Address.Constants - ( minLengthAddress ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -261,8 +259,8 @@ toInternalSelectionConstraints SelectionConstraints {..} = txOutMaxCoin , maximumOutputTokenQuantity = txOutMaxTokenQuantity - , minimumLengthChangeAddress = - minLengthAddress + , nullAddress = + Address "" , .. } diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index dd2777a1b87..4d179fe19b9 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -186,7 +186,7 @@ data SelectionConstraints ctx = SelectionConstraints -- token bundle of an output. , maximumLengthChangeAddress :: Address ctx - , minimumLengthChangeAddress + , nullAddress :: Address ctx } deriving Generic @@ -421,8 +421,8 @@ toBalanceConstraintsParams (constraints, params) = view #maximumOutputTokenQuantity constraints , maximumLengthChangeAddress = view #maximumLengthChangeAddress constraints - , minimumLengthChangeAddress = - view #minimumLengthChangeAddress constraints + , nullAddress = + view #nullAddress constraints } where adjustComputeMinimumCost diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs index 3572c1baaa6..74b3a2864b0 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs @@ -229,8 +229,6 @@ data SelectionConstraints ctx = SelectionConstraints -- select, given a current set of outputs. , maximumLengthChangeAddress :: Address ctx - , minimumLengthChangeAddress - :: Address ctx , maximumOutputAdaQuantity :: Coin -- ^ Specifies the largest ada quantity that can appear in the token @@ -239,6 +237,8 @@ data SelectionConstraints ctx = SelectionConstraints :: TokenQuantity -- ^ Specifies the largest non-ada quantity that can appear in the -- token bundle of an output. + , nullAddress + :: Address ctx } deriving Generic @@ -804,7 +804,7 @@ performSelectionEmpty performSelectionFn constraints params = -> SelectionParamsOf NonEmpty ctx transformParams p@SelectionParams {..} = p { extraCoinSource = - transform (`Coin.add` minCoin) (const id) extraCoinSource + transform (`Coin.add` dummyCoin) (const id) extraCoinSource , outputsToCover = transform (const (dummyOutput :| [])) (const . id) outputsToCover } @@ -814,7 +814,7 @@ performSelectionEmpty performSelectionFn constraints params = -> SelectionResultOf [] ctx transformResult r@SelectionResult {..} = r { extraCoinSource = - transform (`Coin.difference` minCoin) (const id) extraCoinSource + transform (`Coin.difference` dummyCoin) (const id) extraCoinSource , outputsCovered = transform (const []) (const . F.toList) outputsCovered } @@ -822,29 +822,34 @@ performSelectionEmpty performSelectionFn constraints params = transform :: a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a transform x y = maybe x y $ NE.nonEmpty $ view #outputsToCover params - dummyAddress :: Address ctx - dummyAddress = minimumLengthChangeAddress constraints - + -- A dummy output that is added before calling 'performSelectionNonEmpty' + -- and removed immediately after selection is complete. + -- dummyOutput :: (Address ctx, TokenBundle) - dummyOutput = (dummyAddress, TokenBundle.fromCoin minCoin) + dummyOutput = (dummyAddress, TokenBundle.fromCoin dummyCoin) - -- The 'performSelectionNonEmpty' function imposes a precondition that all - -- outputs must have at least the minimum ada quantity. Therefore, the - -- dummy output must also satisfy this condition. + -- A dummy 'Address' value for the dummy output. -- - -- However, we must also ensure that the value is non-zero, since: + -- We can use a null address here, as 'performSelectionNonEmpty' does not + -- verify the minimum ada quantities of user-specified outputs, and hence + -- we do not need to provide a valid address. -- - -- 1. Under some cost models, the 'computeMinimumAdaQuantity' function - -- has a constant value of zero. + -- Using a null address allows us to minimize any overestimation in cost + -- resulting from the use of a dummy output. -- - -- 2. The change generation algorithm requires that the total ada balance - -- of all outputs is non-zero. + dummyAddress = nullAddress constraints + + -- A dummy 'Coin' value for the dummy output. -- - minCoin :: Coin - minCoin = max - (Coin 1) - (view #computeMinimumAdaQuantity constraints dummyAddress TokenMap.empty - ) + -- This value is chosen to be as small as possible in order to minimize + -- any overestimation in cost resulting from the use of a dummy output. + -- + -- However, we cannot choose a value of zero, since the change generation + -- algorithm requires that the total ada balance of all outputs is + -- non-zero, so instead we specify the smallest possible non-zero value. + -- + dummyCoin :: Coin + dummyCoin = Coin 1 performSelectionNonEmpty :: forall m ctx. (HasCallStack, MonadRandom m, SelectionContext ctx) diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs index 9eba22d9e75..f68168d1b14 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs @@ -1842,7 +1842,7 @@ mkBoundaryTestExpectation (BoundaryTestData params expectedResult) = do , maximumOutputAdaQuantity = testMaximumOutputAdaQuantity , maximumOutputTokenQuantity = testMaximumOutputTokenQuantity , maximumLengthChangeAddress = TestAddress 0x0 - , minimumLengthChangeAddress = TestAddress 0x0 + , nullAddress = TestAddress 0x0 } encodeBoundaryTestCriteria @@ -2477,7 +2477,7 @@ unMockSelectionConstraints m = SelectionConstraints testMaximumOutputTokenQuantity , maximumLengthChangeAddress = TestAddress 0x0 - , minimumLengthChangeAddress = + , nullAddress = TestAddress 0x0 } diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs index ce8a59741d2..70fc5535eba 100644 --- a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs @@ -600,7 +600,7 @@ unMockSelectionConstraints m = SelectionConstraints view #maximumOutputTokenQuantity m , maximumLengthChangeAddress = TestAddress 0x0 - , minimumLengthChangeAddress = + , nullAddress = TestAddress 0x0 } From 6a8d81d87319aab5ad67cdfc8fe88227584b6464 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 07:24:57 +0000 Subject: [PATCH 20/22] Lower `UnableToConstructChange.shortfall` values for `balanceTx` golden tests. The previous commit adjusted the dummy output used by function `performSelectionEmpty` so that it uses a null-length `Address` value. This null-length `Address` value is identical to the one we used before we adjusted `computeMinimumCoinForUTxO` to require a valid `Address`. However, we were also able to adjust `performSelectionNonEmpty` so that it no longer needs to validate minimum ada quantities of user-specified outputs, and consequently we were able to reduce the dummy output's `Coin` value to just `Coin 1`, which has the smallest space cost of any non-zero `Coin` value. This results in a further reduction in cost overestimation while constructing change, which results in smaller `shortfall` values within `UnableToConstructChange` errors. --- lib/shelley/test/data/balanceTx/delegate/golden | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/shelley/test/data/balanceTx/delegate/golden b/lib/shelley/test/data/balanceTx/delegate/golden index 65c3798c8cd..ffd1989265b 100644 --- a/lib/shelley/test/data/balanceTx/delegate/golden +++ b/lib/shelley/test/data/balanceTx/delegate/golden @@ -38,10 +38,10 @@ 1.850000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1850000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}})))) 1.900000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1900000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}})))) 1.950000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (BalanceInsufficient (BalanceInsufficientError {utxoBalanceAvailable = TokenBundle {coin = Coin 1950000, tokens = TokenMap (fromList [])}, utxoBalanceRequired = TokenBundle {coin = Coin 2000000, tokens = TokenMap (fromList [])}})))) - 2.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 182177})))) - 2.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 132177})))) - 2.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 82177})))) - 2.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 182177, shortfall = Coin 32177})))) + 2.000000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 180725})))) + 2.050000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 130725})))) + 2.100000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 80725})))) + 2.150000,ErrBalanceTxSelectAssets (ErrSelectAssetsSelectionError (SelectionBalanceErrorOf (UnableToConstructChange (UnableToConstructChangeError {requiredCost = Coin 180725, shortfall = Coin 30725})))) 2.200000,0.200000,0.175401 2.250000,0.250000,0.175401 2.300000,0.300000,0.175401 From 06b4fe04b0ca9f954d52102720d82ae7ef91d039 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 1 Aug 2022 07:58:46 +0000 Subject: [PATCH 21/22] Lower cost of joining and quitting in `STAKE_POOLS_{JOIN,QUIT}_01x`. A previous commit adjusted the dummy output used by function `performSelectionEmpty` so that it uses a null-length `Address` value. This null-length `Address` value is identical to the one we used before we adjusted `computeMinimumCoinForUTxO` to require a valid `Address`. However, we were also able to adjust `performSelectionNonEmpty` so that it no longer needs to validate minimum ada quantities of user-specified outputs, and consequently we were able to reduce the dummy output's `Coin` value to just `Coin 1`, which has the smallest space cost of any non-zero `Coin` value. This results in a further reduction in cost overestimation while constructing change, which results in a lower cost when joining and quitting stake pools. --- .../src/Test/Integration/Scenario/API/Shelley/StakePools.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs index 2eee9d85794..0cd62edd209 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs @@ -1433,8 +1433,8 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do costOfJoining :: Context -> Natural costOfJoining ctx = if _mainEra ctx >= ApiBabbage - then costOf (\coeff cst -> 487 * coeff + cst) ctx - else costOf (\coeff cst -> 483 * coeff + cst) ctx + then costOf (\coeff cst -> 454 * coeff + cst) ctx + else costOf (\coeff cst -> 450 * coeff + cst) ctx costOfQuitting :: Context -> Natural costOfQuitting ctx = From cbc2c203946a237f42df30c445d19ce07f66361e Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 2 Aug 2022 02:01:35 +0000 Subject: [PATCH 22/22] Use `SelectionContext` parameter consistently in `SelectionOutputError`. This refactoring adjusts type `SelectionOutputCoinInsufficientError` so that it takes a `ctx` parameter, rather than an `Address ctx` parameter. As a result, all `SelectionOutputError` constructors now use the same style of parameterisation: ``` data SelectionOutputError ctx = SelectionOutputCoinInsufficient (SelectionOutputCoinInsufficientError ctx) | SelectionOutputSizeExceedsLimit (SelectionOutputSizeExceedsLimitError ctx) | SelectionOutputTokenQuantityExceedsLimit (SelectionOutputTokenQuantityExceedsLimitError ctx) ``` --- lib/core/src/Cardano/Wallet/Api/Server.hs | 2 +- .../Cardano/Wallet/CoinSelection/Internal.hs | 28 +++++++++++-------- 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 09bc0ee9bb8..dd94112f5a6 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -5090,7 +5090,7 @@ instance IsServerError (SelectionOutputError WalletSelectionContext) where toServerError e instance IsServerError - (SelectionOutputCoinInsufficientError Address) + (SelectionOutputCoinInsufficientError WalletSelectionContext) where toServerError e = apiError err403 UtxoTooSmall $ T.unlines [preamble, details] diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs index 4d179fe19b9..52237d8afb9 100644 --- a/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs +++ b/lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs @@ -799,29 +799,34 @@ verifySelectionInputCountWithinLimit cs _ps selection = -- Selection verification: minimum ada quantities -------------------------------------------------------------------------------- -newtype FailureToVerifySelectionOutputCoinsSufficient address = +newtype FailureToVerifySelectionOutputCoinsSufficient ctx = FailureToVerifySelectionOutputCoinsSufficient - (NonEmpty (SelectionOutputCoinInsufficientError address)) + (NonEmpty (SelectionOutputCoinInsufficientError ctx)) deriving (Eq, Show) -data SelectionOutputCoinInsufficientError address = +data SelectionOutputCoinInsufficientError ctx = SelectionOutputCoinInsufficientError { minimumExpectedCoin :: Coin - , output :: (address, TokenBundle) + , output :: (Address ctx, TokenBundle) } - deriving (Eq, Generic, Show) + deriving Generic + +deriving instance SelectionContext ctx => + Eq (SelectionOutputCoinInsufficientError ctx) +deriving instance SelectionContext ctx => + Show (SelectionOutputCoinInsufficientError ctx) verifySelectionOutputCoinsSufficient :: forall ctx. SelectionContext ctx => VerifySelection ctx verifySelectionOutputCoinsSufficient cs _ps selection = verifyEmpty errors FailureToVerifySelectionOutputCoinsSufficient where - errors :: [SelectionOutputCoinInsufficientError (Address ctx)] + errors :: [SelectionOutputCoinInsufficientError ctx] errors = mapMaybe maybeError (selectionAllOutputs cs selection) maybeError :: (Address ctx, TokenBundle) - -> Maybe (SelectionOutputCoinInsufficientError (Address ctx)) + -> Maybe (SelectionOutputCoinInsufficientError ctx) maybeError output | snd output ^. #coin < minimumExpectedCoin = Just SelectionOutputCoinInsufficientError @@ -963,8 +968,7 @@ data FailureToVerifySelectionOutputCoinInsufficientError address = verifySelectionOutputCoinInsufficientError :: SelectionContext ctx - => VerifySelectionError - (SelectionOutputCoinInsufficientError (Address ctx)) ctx + => VerifySelectionError (SelectionOutputCoinInsufficientError ctx) ctx verifySelectionOutputCoinInsufficientError cs _ps e = verifyAll [ reportedMinCoinValue == verifiedMinCoinValue @@ -1434,7 +1438,7 @@ prepareOutputsInternal constraints outputsUnprepared -- The complete list of outputs whose ada quantities are below the minimum -- required: insufficientCoins - :: [SelectionOutputCoinInsufficientError (Address ctx)] + :: [SelectionOutputCoinInsufficientError ctx] insufficientCoins = mapMaybe (verifyOutputCoinSufficient constraints) outputsToCover @@ -1472,7 +1476,7 @@ prepareOutputsWith minCoinValueFor = -- data SelectionOutputError ctx = SelectionOutputCoinInsufficient - (SelectionOutputCoinInsufficientError (Address ctx)) + (SelectionOutputCoinInsufficientError ctx) | SelectionOutputSizeExceedsLimit (SelectionOutputSizeExceedsLimitError ctx) | SelectionOutputTokenQuantityExceedsLimit @@ -1559,7 +1563,7 @@ verifyOutputTokenQuantities out = verifyOutputCoinSufficient :: SelectionConstraints ctx -> (Address ctx, TokenBundle) - -> Maybe (SelectionOutputCoinInsufficientError (Address ctx)) + -> Maybe (SelectionOutputCoinInsufficientError ctx) verifyOutputCoinSufficient constraints output | actualCoin >= minimumExpectedCoin = Nothing