From 1d8f422f54aee089260c0a53c5d1fe287a8d9af7 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 10 Mar 2021 05:19:45 +0000 Subject: [PATCH] Add type `TokenBundleSizeAssessor`. This type acts as a central point of reference for the expected properties of token bundle size assessment functions. This change also adjusts multiple function type signatures, replacing `TokenBundle -> TokenBundleSizeAssessment` with `TokenBundleSizeAssessor`. In response to review feedback: https://github.com/input-output-hk/cardano-wallet/pull/2552#discussion_r590349490 --- lib/core/src/Cardano/Wallet.hs | 2 +- .../Primitive/CoinSelection/MA/RoundRobin.hs | 40 +++++++++---------- .../src/Cardano/Wallet/Primitive/Types/Tx.hs | 25 ++++++++++++ lib/core/src/Cardano/Wallet/Transaction.hs | 17 ++------ .../CoinSelection/MA/RoundRobinSpec.hs | 23 ++++++----- lib/core/test/unit/Cardano/WalletSpec.hs | 4 +- .../Cardano/Wallet/Shelley/Compatibility.hs | 22 +++++----- .../src/Cardano/Wallet/Shelley/Transaction.hs | 3 +- .../Wallet/Shelley/CompatibilitySpec.hs | 6 +-- 9 files changed, 82 insertions(+), 60 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index de938a71d33..0440a7b724a 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -1403,7 +1403,7 @@ selectAssets ctx (utxo, cp, pending) tx outs transform = do sel <- performSelection (calcMinimumCoinValue tl pp) (calcMinimumCost tl pp tx) - (assessTokenBundleSize tl) + (tokenBundleSizeAssessor tl) (initSelectionCriteria tl pp tx utxo outs) liftIO $ traceWith tr $ MsgSelectionDone sel withExceptT ErrSelectAssetsSelectionError $ except $ diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobin.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobin.hs index 11c312a9f7b..a6329bcc8a1 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobin.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobin.hs @@ -96,6 +96,7 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity ( TokenQuantity (..) ) import Cardano.Wallet.Primitive.Types.Tx ( TokenBundleSizeAssessment (..) + , TokenBundleSizeAssessor (..) , TxIn , TxOut , txOutCoin @@ -380,7 +381,7 @@ prepareOutputsWith minCoinValueFor = fmap $ \out -> if TokenBundle.getCoin bundle == Coin 0 then bundle { coin = minCoinValueFor (view #tokens bundle) } else bundle --- + -- | Performs a coin selection and generates change bundles in one step. -- -- Returns 'BalanceInsufficient' if the total balance of 'utxoAvailable' is not @@ -408,12 +409,14 @@ performSelection -- ^ A function that computes the extra cost corresponding to a given -- selection. This function must not depend on the magnitudes of -- individual asset quantities held within each change output. - -> (TokenBundle -> TokenBundleSizeAssessment) - -- ^ A function that assesses the size of a token bundle. + -> TokenBundleSizeAssessor + -- ^ A function that assesses the size of a token bundle. See the + -- documentation for 'TokenBundleSizeAssessor' to learn about the + -- expected properties of this function. -> SelectionCriteria -- ^ The selection goal to satisfy. -> m (Either SelectionError (SelectionResult TokenBundle)) -performSelection minCoinFor costFor assessBundleSize criteria +performSelection minCoinFor costFor bundleSizeAssessor criteria | not (balanceRequired `leq` balanceAvailable) = pure $ Left $ BalanceInsufficient $ BalanceInsufficientError { balanceAvailable, balanceRequired } @@ -504,7 +507,7 @@ performSelection minCoinFor costFor assessBundleSize criteria (fmap (TokenMap.getAssets . view #tokens)) (makeChange MakeChangeCriteria { minCoinFor = noMinimumCoin - , assessBundleSize + , bundleSizeAssessor , requiredCost = noCost , extraCoinSource , inputBundles @@ -568,7 +571,7 @@ performSelection minCoinFor costFor assessBundleSize criteria mChangeGenerated :: Either UnableToConstructChangeError [TokenBundle] mChangeGenerated = makeChange MakeChangeCriteria { minCoinFor - , assessBundleSize + , bundleSizeAssessor , requiredCost , extraCoinSource , inputBundles = view #tokens . snd <$> inputsSelected @@ -807,11 +810,11 @@ runSelectionStep lens s -- | Criteria for the 'makeChange' function. -- -data MakeChangeCriteria minCoinFor assessBundleSize = MakeChangeCriteria +data MakeChangeCriteria minCoinFor bundleSizeAssessor = MakeChangeCriteria { minCoinFor :: minCoinFor -- ^ A function that computes the minimum required ada quantity for a -- particular output. - , assessBundleSize :: assessBundleSize + , bundleSizeAssessor :: bundleSizeAssessor -- ^ A function to assess the size of a token bundle. , requiredCost :: Coin -- ^ The minimal (and optimal) delta between the total ada balance @@ -834,10 +837,9 @@ data MakeChangeCriteria minCoinFor assessBundleSize = MakeChangeCriteria -- | Indicates 'True' if and only if a token bundle exceeds the maximum size -- that can be included in a transaction output. -- -tokenBundleSizeExceedsLimit - :: (TokenBundle -> TokenBundleSizeAssessment) -> TokenBundle -> Bool -tokenBundleSizeExceedsLimit calculateBundleSize b = - case calculateBundleSize b of +tokenBundleSizeExceedsLimit :: TokenBundleSizeAssessor -> TokenBundle -> Bool +tokenBundleSizeExceedsLimit (TokenBundleSizeAssessor assess) b = + case assess b of TokenBundleSizeWithinLimit-> False TokenBundleSizeExceedsLimit -> @@ -863,9 +865,7 @@ tokenBundleSizeExceedsLimit calculateBundleSize b = -- to every output token bundle. -- makeChange - :: MakeChangeCriteria - (TokenMap -> Coin) - (TokenBundle -> TokenBundleSizeAssessment) + :: MakeChangeCriteria (TokenMap -> Coin) TokenBundleSizeAssessor -- ^ Criteria for making change. -> Either UnableToConstructChangeError [TokenBundle] -- ^ Generated change bundles. @@ -882,7 +882,7 @@ makeChange criteria where MakeChangeCriteria { minCoinFor - , assessBundleSize + , bundleSizeAssessor , requiredCost , extraCoinSource , inputBundles @@ -958,10 +958,10 @@ makeChange criteria -- a bundle that is marginally over the limit, which would cause -- the resultant transaction to be rejected. -- - assessBundleSizeWithMaxCoin - :: TokenBundle -> TokenBundleSizeAssessment - assessBundleSizeWithMaxCoin = - assessBundleSize . flip TokenBundle.setCoin (maxBound @Coin) + assessBundleSizeWithMaxCoin :: TokenBundleSizeAssessor + assessBundleSizeWithMaxCoin = TokenBundleSizeAssessor + $ assessTokenBundleSize bundleSizeAssessor + . flip TokenBundle.setCoin (maxBound @Coin) -- Change for user-specified assets: assets that were present in the -- original set of user-specified outputs ('outputsToCover'). diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs index 5b0d316557f..27f2b9b4c87 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs @@ -28,6 +28,7 @@ module Cardano.Wallet.Primitive.Types.Tx , UnsignedTx (..) , TransactionInfo (..) , Direction (..) + , TokenBundleSizeAssessor (..) , TokenBundleSizeAssessment (..) -- * Functions @@ -437,6 +438,30 @@ toTxHistory :: TransactionInfo -> (Tx, TxMeta) toTxHistory info = (fromTransactionInfo info, txInfoMeta info) +-- | A function capable of assessing the size of a token bundle relative to the +-- upper limit of what can be included in a single transaction output. +-- +-- In general, a token bundle size assessment function 'f' should satisfy the +-- following properties: +-- +-- * Enlarging a bundle that exceeds the limit should also result in a +-- bundle that exceeds the limit: +-- @ +-- f b1 == TokenBundleSizeExceedsLimit +-- ==> f (b1 `add` b2) == TokenBundleSizeExceedsLimit +-- @ +-- +-- * Shrinking a bundle that's within the limit should also result in a +-- bundle that's within the limit: +-- @ +-- f b1 == TokenBundleWithinLimit +-- ==> f (b1 `difference` b2) == TokenBundleWithinLimit +-- @ +-- +newtype TokenBundleSizeAssessor = TokenBundleSizeAssessor + { assessTokenBundleSize :: TokenBundle -> TokenBundleSizeAssessment + } + -- | Indicates the size of a token bundle relative to the upper limit of what -- can be included in a single transaction output, defined by the protocol. -- diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs index fc76ef5cfed..5441ff8b804 100644 --- a/lib/core/src/Cardano/Wallet/Transaction.hs +++ b/lib/core/src/Cardano/Wallet/Transaction.hs @@ -48,17 +48,10 @@ import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) 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.Tx - ( SealedTx (..) - , TokenBundleSizeAssessment (..) - , Tx (..) - , TxMetadata - , TxOut - ) + ( SealedTx (..), TokenBundleSizeAssessor, Tx (..), TxMetadata, TxOut ) import Cardano.Wallet.Primitive.Types.UTxOIndex ( UTxOIndex ) import Data.ByteString @@ -124,11 +117,9 @@ data TransactionLayer k = TransactionLayer -> Coin -- ^ The minimum ada value needed in a UTxO carrying the asset bundle - , assessTokenBundleSize - :: TokenBundle - -- A token bundle - -> TokenBundleSizeAssessment - -- ^ An assessment of the token bundle's size. + , tokenBundleSizeAssessor + :: TokenBundleSizeAssessor + -- ^ A function to assess the size of a token bundle. , decodeSignedTx :: AnyCardanoEra diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs index 0fdcd1a53c3..405aecbcec5 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs @@ -91,6 +91,7 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen ( genTokenQuantitySmallPositive, shrinkTokenQuantitySmallPositive ) import Cardano.Wallet.Primitive.Types.Tx ( TokenBundleSizeAssessment (..) + , TokenBundleSizeAssessor (..) , TxIn (..) , TxOut (..) , txOutCoin @@ -1111,7 +1112,7 @@ data BoundaryTestData = BoundaryTestData data BoundaryTestCriteria = BoundaryTestCriteria { boundaryTestBundleSizeAssessor - :: BundleSizeAssessor + :: MockTokenBundleSizeAssessor , boundaryTestOutputs :: [BoundaryTestEntry] , boundaryTestUTxO @@ -1476,9 +1477,10 @@ linearCost SelectionSkeleton{inputsSkeleton, outputsSkeleton, changeSkeleton} + F.length outputsSkeleton + F.length changeSkeleton -type MakeChangeData = MakeChangeCriteria MinCoinValueFor BundleSizeAssessor +type MakeChangeData = + MakeChangeCriteria MinCoinValueFor MockTokenBundleSizeAssessor -data BundleSizeAssessor +data MockTokenBundleSizeAssessor = NoBundleSizeLimit -- ^ Indicates that there is no limit on a token bundle's size. | BundleAssetCountUpperLimit Int @@ -1487,9 +1489,8 @@ data BundleSizeAssessor deriving (Eq, Show) mkBundleSizeAssessor - :: BundleSizeAssessor - -> (TokenBundle -> TokenBundleSizeAssessment) -mkBundleSizeAssessor = \case + :: MockTokenBundleSizeAssessor -> TokenBundleSizeAssessor +mkBundleSizeAssessor m = TokenBundleSizeAssessor $ case m of NoBundleSizeLimit -> const TokenBundleSizeWithinLimit BundleAssetCountUpperLimit upperLimit -> @@ -1533,7 +1534,7 @@ makeChangeWith -> Either UnableToConstructChangeError [TokenBundle] makeChangeWith p = makeChange p { minCoinFor = mkMinCoinValueFor $ minCoinFor p - , assessBundleSize = mkBundleSizeAssessor $ assessBundleSize p + , bundleSizeAssessor = mkBundleSizeAssessor $ bundleSizeAssessor p } prop_makeChange_identity @@ -1546,7 +1547,7 @@ prop_makeChange_identity bundles = (===) { minCoinFor = const (Coin 0) , requiredCost = Coin 0 , extraCoinSource = Nothing - , assessBundleSize = mkBundleSizeAssessor NoBundleSizeLimit + , bundleSizeAssessor = mkBundleSizeAssessor NoBundleSizeLimit , inputBundles = bundles , outputBundles = bundles } @@ -1562,7 +1563,7 @@ prop_makeChange_length p = change = makeChange p { minCoinFor = noMinCoin , requiredCost = noCost - , assessBundleSize = mkBundleSizeAssessor NoBundleSizeLimit + , bundleSizeAssessor = mkBundleSizeAssessor NoBundleSizeLimit } prop_makeChange @@ -1728,13 +1729,13 @@ unit_makeChange = { minCoinFor , requiredCost , extraCoinSource - , assessBundleSize + , bundleSizeAssessor , inputBundles = i , outputBundles = o } ] where - assessBundleSize = mkBundleSizeAssessor NoBundleSizeLimit + bundleSizeAssessor = mkBundleSizeAssessor NoBundleSizeLimit matrix = -- Simple, only ada, should construct a single change output with 1 ada. [ ( noMinCoin, noCost diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index 9769fbee796..08192a05394 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/lib/core/test/unit/Cardano/WalletSpec.hs @@ -715,8 +715,8 @@ dummyTransactionLayer = TransactionLayer error "dummyTransactionLayer: calcMinimumCost not implemented" , calcMinimumCoinValue = error "dummyTransactionLayer: calcMinimumCoinValue not implemented" - , assessTokenBundleSize = - error "dummyTransactionLayer: assessTokenBundleSize not implemented" + , tokenBundleSizeAssessor = + error "dummyTransactionLayer: tokenBundleSizeAssessor not implemented" , decodeSignedTx = error "dummyTransactionLayer: decodeSignedTx not implemented" } diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index bca70beed08..a1e2daa3ab7 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -74,7 +74,7 @@ module Cardano.Wallet.Shelley.Compatibility , fromCardanoValue -- ** Assessing sizes of token bundles - , assessTokenBundleSize + , tokenBundleSizeAssessor , computeTokenBundleSerializedLengthBytes , maxTokenBundleSerializedLengthBytes @@ -1229,15 +1229,19 @@ toStakePoolDlgCert xpub (W.PoolId pid) = -- | Assesses a token bundle size in relation to the maximum size that can be -- included in a transaction output. -- -assessTokenBundleSize :: TokenBundle.TokenBundle -> W.TokenBundleSizeAssessment -assessTokenBundleSize tb - | serializedLengthBytes <= maxTokenBundleSerializedLengthBytes = - W.TokenBundleSizeWithinLimit - | otherwise = - W.TokenBundleSizeExceedsLimit +-- See 'W.TokenBundleSizeAssessor' for the expected properties of this function. +-- +tokenBundleSizeAssessor :: W.TokenBundleSizeAssessor +tokenBundleSizeAssessor = W.TokenBundleSizeAssessor {..} where - serializedLengthBytes :: Int - serializedLengthBytes = computeTokenBundleSerializedLengthBytes tb + assessTokenBundleSize tb + | serializedLengthBytes <= maxTokenBundleSerializedLengthBytes = + W.TokenBundleSizeWithinLimit + | otherwise = + W.TokenBundleSizeExceedsLimit + where + serializedLengthBytes :: Int + serializedLengthBytes = computeTokenBundleSerializedLengthBytes tb computeTokenBundleSerializedLengthBytes :: TokenBundle.TokenBundle -> Int computeTokenBundleSerializedLengthBytes = diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs index b8779a2ec2d..8d9a95a70f6 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs @@ -346,7 +346,8 @@ newTransactionLayer networkId = TransactionLayer , calcMinimumCoinValue = _calcMinimumCoinValue - , assessTokenBundleSize = Compatibility.assessTokenBundleSize + , tokenBundleSizeAssessor = + Compatibility.tokenBundleSizeAssessor , decodeSignedTx = _decodeSignedTx diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs index 3000c931a07..2e507f50f07 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs @@ -67,11 +67,10 @@ import Cardano.Wallet.Primitive.Types.TokenBundle.Gen , shrinkTokenBundleSmallRange ) import Cardano.Wallet.Primitive.Types.Tx - ( TokenBundleSizeAssessment (..) ) + ( TokenBundleSizeAssessment (..), TokenBundleSizeAssessor (..) ) import Cardano.Wallet.Shelley.Compatibility ( CardanoBlock , StandardCrypto - , assessTokenBundleSize , computeTokenBundleSerializedLengthBytes , decentralizationLevelFromPParams , fromCardanoValue @@ -83,6 +82,7 @@ import Cardano.Wallet.Shelley.Compatibility , toCardanoHash , toCardanoValue , toPoint + , tokenBundleSizeAssessor ) import Cardano.Wallet.Unsafe ( unsafeMkEntropy ) @@ -385,7 +385,7 @@ unit_assessTokenBundleSize_fixedSizeBundle , actualLengthBytes <= expectedMaxLengthBytes ] where - actualAssessment = assessTokenBundleSize bundle + actualAssessment = assessTokenBundleSize tokenBundleSizeAssessor bundle actualLengthBytes = computeTokenBundleSerializedLengthBytes bundle counterexampleText = unlines [ "Expected min length bytes:"