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:

#2552 (comment)

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 $

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').

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.
 --

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

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

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"
     }

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 =

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

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:"