make 'estimateMaxNumberOfInputs' aware of multi-assets outputs.

  And adjust unit tests accordingly.

lib/core/src/Cardano/Wallet/Transaction.hs

@@ -56,12 +56,8 @@ import Data.ByteString
     ( ByteString )
 import Data.List.NonEmpty
     ( NonEmpty )
-import Data.Quantity
-    ( Quantity )
 import Data.Text
     ( Text )
-import Data.Word
-    ( Word16, Word8 )
 import GHC.Generics
     ( Generic )
 
@@ -119,16 +115,6 @@ data TransactionLayer k = TransactionLayer
         -> Coin
         -- ^ The minimum ada value needed in a UTxO carrying the asset bundle
 
-    , estimateMaxNumberOfInputs
-        :: Quantity "byte" Word16
-         -- Transaction max size in bytes
-        -> Maybe TxMetadata
-         -- Metadata associated with the transaction.
-        -> Word8
-        -- Number of outputs in transaction
-        -> Word8
-        -- ^ Approximate maximum number of inputs.
-
     , decodeSignedTx
         :: AnyCardanoEra
         -> ByteString

lib/core/test/unit/Cardano/WalletSpec.hs

@@ -645,8 +645,6 @@ dummyTransactionLayer = TransactionLayer
         error "dummyTransactionLayer: calcMinimumCost not implemented"
     , calcMinimumCoinValue =
         error "dummyTransactionLayer: calcMinimumCoinValue not implemented"
-    , estimateMaxNumberOfInputs =
-        error "dummyTransactionLayer: estimateMaxNumberOfInputs not implemented"
     , decodeSignedTx =
         error "dummyTransactionLayer: decodeSignedTx not implemented"
     }

lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -85,7 +86,7 @@ import Cardano.Wallet.Primitive.Types.TokenMap
 import Cardano.Wallet.Primitive.Types.TokenPolicy
     ( TokenName (..) )
 import Cardano.Wallet.Primitive.Types.Tx
-    ( SealedTx (..), Tx (..), TxIn (..), TxMetadata, TxOut (..), txOutCoin )
+    ( SealedTx (..), Tx (..), TxIn (..), TxOut (..), txOutCoin )
 import Cardano.Wallet.Shelley.Compatibility
     ( AllegraEra
     , CardanoEra (MaryEra)
@@ -113,7 +114,6 @@ import Cardano.Wallet.Transaction
     , ErrMkTx (..)
     , TransactionCtx (..)
     , TransactionLayer (..)
-    , defaultTransactionCtx
     , withdrawalToCoin
     )
 import Control.Arrow
@@ -122,12 +122,16 @@ import Control.Monad
     ( forM )
 import Data.ByteString
     ( ByteString )
+import Data.Generics.Internal.VL.Lens
+    ( view )
+import Data.Generics.Labels
+    ()
 import Data.Quantity
     ( Quantity (..) )
 import Data.Type.Equality
     ( type (==) )
 import Data.Word
-    ( Word16, Word8 )
+    ( Word16 )
 import Fmt
     ( Buildable, pretty )
 import GHC.Stack
@@ -149,7 +153,6 @@ import qualified Codec.CBOR.Write as CBOR
 import qualified Data.ByteString as BS
 import qualified Data.Foldable as F
 import qualified Data.List.NonEmpty as NE
-import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Shelley.Spec.Ledger.Address.Bootstrap as SL
 
@@ -304,11 +307,11 @@ newTransactionLayer networkId = TransactionLayer
 
     , initSelectionCriteria = \pp ctx utxoAvailable outputsUnprepared ->
         let
-            selectionLimit = MaximumInputLimit $ fromIntegral $
-                _estimateMaxNumberOfInputs @k
-                    (getTxMaxSize $ txParameters pp)
-                    (txMetadata ctx)
-                    (fromIntegral $ NE.length outputsToCover)
+            txMaxSize =
+                getTxMaxSize $ txParameters pp
+
+            selectionLimit = MaximumInputLimit $
+                _estimateMaxNumberOfInputs @k txMaxSize ctx (NE.toList outputsToCover)
 
             extraCoinSource = Just $ addCoin
                 (withdrawalToCoin $ txWithdrawal ctx)
@@ -342,9 +345,6 @@ newTransactionLayer networkId = TransactionLayer
     , calcMinimumCoinValue =
         _calcMinimumCoinValue
 
-    , estimateMaxNumberOfInputs =
-        _estimateMaxNumberOfInputs @k
-
     , decodeSignedTx =
         _decodeSignedTx
     }
@@ -384,58 +384,62 @@ _calcMinimumCoinValue
 _calcMinimumCoinValue pp =
     computeMinimumAdaQuantity (minimumUTxOvalue pp)
 
+-- NOTE / FIXME: This is an 'estimation' because it is actually quite hard to
+-- estimate what would be the cost of a selecting a particular input. Indeed, an
+-- input may contain any arbitrary assets, which has a direct impact on the
+-- shape of change outputs. In practice, this should work out pretty well
+-- because of other approximations done along the way which should compensate
+-- for possible extra assets in inputs not counted as part of this estimation.
+--
+-- Worse that may happen here is the wallet generating a transaction that is
+-- slightly too big, For a better user experience, we could detect that earlier
+-- before submitting the transaction and return a more user-friendly error.
+--
+-- Or... to be even better, the 'SelectionLimit' from the RoundRobin module
+-- could be a function of the 'SelectionState' already selected. With this
+-- information and the shape of the requested output, we can get down to a
+-- pretty accurate result.
 _estimateMaxNumberOfInputs
     :: forall k. TxWitnessTagFor k
     => Quantity "byte" Word16
      -- ^ Transaction max size in bytes
-    -> Maybe TxMetadata
-     -- ^ Metadata associated with the transaction.
-    -> Word8
-    -- ^ Number of outputs in transaction
-    -> Word8
-_estimateMaxNumberOfInputs txMaxSize txMetadata nOuts =
-    findLargestUntil ((> maxSize) . txSizeGivenInputs) 0
+    -> TransactionCtx
+     -- ^ An additional transaction context
+    -> [TxOut]
+     -- ^ A list of outputs being considered.
+    -> Int
+_estimateMaxNumberOfInputs txMaxSize ctx outs =
+    fromIntegral $ findLargestUntil ((> maxSize) . txSizeGivenInputs) 0
   where
     -- | Find the largest amount of inputs that doesn't make the tx too big.
     -- Tries in sequence from 0 and upward (up to 255, but smaller than 50 in
     -- practice because of the max transaction size).
-    findLargestUntil :: (Word8 -> Bool) -> Word8 -> Word8
+    findLargestUntil :: (Integer -> Bool) -> Integer -> Integer
     findLargestUntil isTxTooLarge inf
-        | inf == maxBound        = maxBound
+        | inf == maxNInps        = maxNInps
         | isTxTooLarge (inf + 1) = inf
         | otherwise              = findLargestUntil isTxTooLarge (inf + 1)
 
-    maxSize = fromIntegral (getQuantity txMaxSize)
+    maxSize  = toInteger (getQuantity txMaxSize)
+    maxNInps = 255 -- Arbitrary, but large enough.
 
     txSizeGivenInputs nInps = size
       where
         size = estimateTxSize (txWitnessTagFor @k) ctx sel
-        sel  = dummySkeleton (fromIntegral nInps) (fromIntegral nOuts)
-        ctx  = defaultTransactionCtx { txMetadata }
-
--- FIXME: This dummy skeleton does not account for multi-asset outputs. So
--- the final estimation can end up being much larger than it should in
--- practice. With the introduction of multi-assets, it is no longer possible
--- to accurately estimate the maximum number of inputs from a number of
--- outputs only. We have to know also the shape of outputs.
---
--- Yet, this function will still yield a relevant number that can gives us a
--- way to cap the selection to a given limit (which is known to be higher
--- than the real value). So it suffices to check the result of a selection
--- to see whether it has grown too large or not.
-dummySkeleton :: Int -> Int -> SelectionSkeleton
-dummySkeleton nInps nOuts = SelectionSkeleton
+        sel  = dummySkeleton (fromIntegral nInps) outs
+
+dummySkeleton :: Int -> [TxOut] -> SelectionSkeleton
+dummySkeleton nInps outs = SelectionSkeleton
     { inputsSkeleton = UTxOIndex.fromSequence $
         map (\ix -> (dummyTxIn ix, dummyTxOut)) [0..nInps-1]
     , outputsSkeleton =
-        replicate nOuts dummyTxOut
+        outs
     , changeSkeleton =
-        replicate nOuts Set.empty
+        TokenBundle.getAssets . view #tokens <$> outs
     }
   where
     dummyTxIn  = TxIn (Hash $ BS.pack (1:replicate 64 0)) . fromIntegral
-    dummyTxOut = TxOut dummyAddr (TokenBundle.fromCoin $ Coin 1)
-    dummyAddr  = Address $ BS.pack (1:replicate 64 0)
+    dummyTxOut = TxOut (Address "") TokenBundle.empty
 
 _decodeSignedTx
     :: AnyCardanoEra

lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs

@@ -111,6 +111,7 @@ import Test.Hspec.QuickCheck
 import Test.QuickCheck
     ( Arbitrary (..)
     , InfiniteList (..)
+    , NonEmptyList (..)
     , Property
     , arbitraryPrintableChar
     , choose
@@ -125,6 +126,10 @@ import Test.QuickCheck
     , (===)
     , (==>)
     )
+import Test.QuickCheck.Gen
+    ( Gen (..) )
+import Test.QuickCheck.Random
+    ( mkQCGen )
 
 import qualified Cardano.Api.Typed as Cardano
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
@@ -147,11 +152,11 @@ spec = do
         prop "roundtrip for Byron witnesses" prop_decodeSignedByronTxRoundtrip
 
     estimateMaxInputsTests @ShelleyKey
-        [(1,27),(10,19),(20,10),(30,1)]
+        [(1,27),(5,17),(10,12),(20,0),(50,0)]
     estimateMaxInputsTests @ByronKey
-        [(1,17),(10,11),(20,4),(30,0)]
+        [(1,17),(5,10),(10,6),(20,0),(50,0)]
     estimateMaxInputsTests @IcarusKey
-        [(1,17),(10,11),(20,4),(30,0)]
+        [(1,17),(5,10),(10,6),(20,0),(50,0)]
 
     describe "fee calculations" $ do
         let pp :: ProtocolParameters
@@ -402,8 +407,8 @@ spec = do
                 \58200000000000000000000000000000000000000000000000000000000000\
                 \00000044a1024100f6"
 
-newtype GivenNumOutputs = GivenNumOutputs Word8 deriving Num
-newtype ExpectedNumInputs = ExpectedNumInputs Word8 deriving Num
+newtype GivenNumOutputs = GivenNumOutputs Int deriving Num
+newtype ExpectedNumInputs = ExpectedNumInputs Int deriving Num
 
 -- | Set of tests related to `estimateMaxNumberOfInputs` from the transaction
 -- layer.
@@ -416,14 +421,14 @@ estimateMaxInputsTests cases = do
     describe ("estimateMaxNumberOfInputs for "<>k) $ do
         forM_ cases $ \(GivenNumOutputs nOuts, ExpectedNumInputs nInps) -> do
             let (o,i) = (show nOuts, show nInps)
-            it ("order of magnitude, nOuts = " <> o <> " => nInps = " <> i) $
-                _estimateMaxNumberOfInputs @k (Quantity 4096) Nothing nOuts
+            it ("order of magnitude, nOuts = " <> o <> " => nInps = " <> i) $ do
+                let outs = [ generatePure r arbitrary | r <- [ 1 .. nOuts ] ]
+                length outs `shouldBe` nOuts
+                _estimateMaxNumberOfInputs @k (Quantity 4096) defaultTransactionCtx outs
                     `shouldBe` nInps
 
         prop "more outputs ==> less inputs"
             (prop_moreOutputsMeansLessInputs @k)
-        prop "less outputs ==> more inputs"
-            (prop_lessOutputsMeansMoreInputs @k)
         prop "bigger size  ==> more inputs"
             (prop_biggerMaxSizeMeansMoreInputs @k)
 
@@ -486,43 +491,28 @@ prop_decodeSignedByronTxRoundtrip (DecodeByronSetup utxo outs slotNo ntwrk pairs
 prop_moreOutputsMeansLessInputs
     :: forall k. TxWitnessTagFor k
     => Quantity "byte" Word16
-    -> Word8
+    -> NonEmptyList TxOut
     -> Property
-prop_moreOutputsMeansLessInputs size nOuts
+prop_moreOutputsMeansLessInputs size (NonEmpty xs)
     = withMaxSuccess 1000
     $ within 300000
-    $ nOuts < maxBound ==>
-        _estimateMaxNumberOfInputs @k size Nothing nOuts
-        >=
-        _estimateMaxNumberOfInputs @k size Nothing (nOuts + 1)
-
--- | Reducing the number of outputs increases the number of inputs.
-prop_lessOutputsMeansMoreInputs
-    :: forall k. TxWitnessTagFor k
-    => Quantity "byte" Word16
-    -> Word8
-    -> Property
-prop_lessOutputsMeansMoreInputs size nOuts
-    = withMaxSuccess 1000
-    $ within 300000
-    $ nOuts > minBound ==>
-        _estimateMaxNumberOfInputs @k size Nothing (nOuts - 1)
-        >=
-        _estimateMaxNumberOfInputs @k size Nothing nOuts
+    $ _estimateMaxNumberOfInputs @k size defaultTransactionCtx (tail xs)
+      >=
+      _estimateMaxNumberOfInputs @k size defaultTransactionCtx xs
 
 -- | Increasing the max size automatically increased the number of inputs
 prop_biggerMaxSizeMeansMoreInputs
     :: forall k. TxWitnessTagFor k
     => Quantity "byte" Word16
-    -> Word8
+    -> [TxOut]
     -> Property
-prop_biggerMaxSizeMeansMoreInputs (Quantity size) nOuts
+prop_biggerMaxSizeMeansMoreInputs size outs
     = withMaxSuccess 1000
     $ within 300000
-    $ size < maxBound `div` 2 ==>
-        _estimateMaxNumberOfInputs @k (Quantity size) Nothing nOuts
+    $ getQuantity size < maxBound `div` 2 ==>
+        _estimateMaxNumberOfInputs @k size defaultTransactionCtx outs
         <=
-        _estimateMaxNumberOfInputs @k (Quantity (size * 2)) Nothing nOuts
+        _estimateMaxNumberOfInputs @k ((*2) <$> size ) defaultTransactionCtx outs
 
 testTxLayer :: TransactionLayer ShelleyKey
 testTxLayer = newTransactionLayer @ShelleyKey Cardano.Mainnet
@@ -697,3 +687,8 @@ dummyProtocolParameters = ProtocolParameters
     , hardforkEpochNo =
         error "dummyProtocolParameters: hardforkEpochNo"
     }
+
+-- | Like generate, but the random generate is fixed to a particular seed so
+-- that it generates always the same values.
+generatePure :: Int -> Gen a -> a
+generatePure seed (MkGen r) = r (mkQCGen seed) 30