diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs index 86ad64323f7..74addd72985 100644 --- a/lib/core/src/Cardano/Wallet/Transaction.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index e9777dd372f..334b7f6ebda 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/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" } diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs index 23f17693e88..d1630ae1d6f 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/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 diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 215fde2a76d..7bc146ea53a 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/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