diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs index 2a80696cbee..a211fb0b66c 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} @@ -311,29 +310,24 @@ _estimateMaxNumberOfInputs -> Word8 -- ^ Number of outputs in transaction -> Word8 -_estimateMaxNumberOfInputs networkId (Quantity maxSize) md nOuts = - fromIntegral $ bisect (lowerBound, upperBound) +_estimateMaxNumberOfInputs networkId txMaxSize md nOuts = + findLargestUntil ((> maxSize) . txSizeGivenInputs) 0 where - bisect (!inf, !sup) - | middle == inf && isTooBig sup = inf - | middle == inf = sup - | isTooBig middle = bisect (inf, middle) - | otherwise = bisect (middle, sup) - where - middle = inf + ((sup - inf) `div` 2) - - growingFactor = 2 - - lowerBound = upperBound `div` growingFactor - upperBound = upperBound_ 1 - where - upperBound_ !n | isTooBig n = n - | otherwise = upperBound_ (n*growingFactor) - - isTooBig nInps = size > fromIntegral maxSize + -- | 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 isTxTooLarge inf + | inf == maxBound = maxBound + | isTxTooLarge (inf + 1) = inf + | otherwise = findLargestUntil isTxTooLarge (inf + 1) + + maxSize = fromIntegral (getQuantity txMaxSize) + + txSizeGivenInputs nInps = size where size = computeTxSize networkId (txWitnessTagFor @k) md Nothing sel - sel = dummyCoinSel nInps (fromIntegral nOuts) + sel = dummyCoinSel (fromIntegral nInps) (fromIntegral nOuts) dummyCoinSel :: Int -> Int -> CoinSelection dummyCoinSel nInps nOuts = mempty diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index fc252ce5380..467cbc51f5a 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -33,10 +35,14 @@ import Cardano.Wallet.Primitive.AddressDerivation , PassphraseScheme (..) , preparePassphrase ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Icarus + ( IcarusKey ) import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey ) import Cardano.Wallet.Primitive.CoinSelection - ( CoinSelection (withdrawal), CoinSelectionOptions ) + ( CoinSelection, CoinSelectionOptions ) import Cardano.Wallet.Primitive.Fee ( Fee (..), FeeOptions (..), FeePolicy (..), adjustForFee ) import Cardano.Wallet.Primitive.Types @@ -53,7 +59,8 @@ import Cardano.Wallet.Primitive.Types import Cardano.Wallet.Shelley.Compatibility ( Shelley, sealShelleyTx ) import Cardano.Wallet.Shelley.Transaction - ( mkByronWitness + ( TxWitnessTagFor + , mkByronWitness , mkShelleyWitness , mkUnsignedTx , newTransactionLayer @@ -63,7 +70,7 @@ import Cardano.Wallet.Shelley.Transaction import Cardano.Wallet.Transaction ( TransactionLayer (..) ) import Control.Monad - ( replicateM ) + ( forM_, replicateM ) import Control.Monad.Trans.Except ( catchE, runExceptT, withExceptT ) import Data.Function @@ -72,6 +79,8 @@ import Data.Proxy ( Proxy (..) ) import Data.Quantity ( Quantity (..) ) +import Data.Typeable + ( Typeable, typeRep ) import Data.Word ( Word16, Word8 ) import Ouroboros.Network.Block @@ -93,6 +102,7 @@ import Test.QuickCheck , scale , vectorOf , withMaxSuccess + , within , (===) , (==>) ) @@ -115,8 +125,20 @@ spec = do prop "roundtrip for Shelley witnesses" prop_decodeSignedShelleyTxRoundtrip prop "roundtrip for Byron witnesses" prop_decodeSignedByronTxRoundtrip - estimateMaxInputsTests Cardano.Mainnet - estimateMaxInputsTests (Cardano.Testnet (Cardano.NetworkMagic 0)) + estimateMaxInputsTests @ShelleyKey Cardano.Mainnet + [(1,23),(10,16),(20,9),(30,2)] + estimateMaxInputsTests @ShelleyKey (Cardano.Testnet (Cardano.NetworkMagic 0)) + [(1,23),(10,16),(20,9),(30,2)] + + estimateMaxInputsTests @ByronKey Cardano.Mainnet + [(1,19),(10,12),(20,6),(30,0)] + estimateMaxInputsTests @ByronKey (Cardano.Testnet (Cardano.NetworkMagic 0)) + [(1,18),(10,12),(20,5),(30,0)] + + estimateMaxInputsTests @IcarusKey Cardano.Mainnet + [(1,19),(10,14),(20,9),(30,4)] + estimateMaxInputsTests @IcarusKey (Cardano.Testnet (Cardano.NetworkMagic 0)) + [(1,18),(10,13),(20,8),(30,2)] describe "fee calculations" $ do let policy :: FeePolicy @@ -128,7 +150,7 @@ spec = do it "withdrawals incur fees" $ property $ \withdrawal -> let - costWith = minFee Nothing (mempty { withdrawal }) + costWith = minFee Nothing (mempty { CS.withdrawal = withdrawal }) costWithout = minFee Nothing mempty marginalCost :: Integer @@ -177,24 +199,31 @@ spec = do res `shouldBe` Right (FeeEstimation 165413 165413) +newtype GivenNumOutputs = GivenNumOutputs Word8 deriving Num +newtype ExpectedNumInputs = ExpectedNumInputs Word8 deriving Num + +-- | Set of tests related to `estimateMaxNumberOfInputs` from the transaction +-- layer. estimateMaxInputsTests - :: Cardano.NetworkId + :: forall k. (TxWitnessTagFor k, Typeable k) + => Cardano.NetworkId + -> [(GivenNumOutputs, ExpectedNumInputs)] -> SpecWith () -estimateMaxInputsTests net = - describe ("estimateMaxNumberOfInputs for networkId="<> show net) $ do - - it "order of magnitude, nOuts = 1" $ - _estimateMaxNumberOfInputs @ShelleyKey net (Quantity 4096) Nothing 1 `shouldBe` 23 - it "order of magnitude, nOuts = 10" $ - _estimateMaxNumberOfInputs @ShelleyKey net (Quantity 4096) Nothing 10 `shouldBe` 16 - it "order of magnitude, nOuts = 20" $ - _estimateMaxNumberOfInputs @ShelleyKey net (Quantity 4096) Nothing 20 `shouldBe` 9 - it "order of magnitude, nOuts = 30" $ - _estimateMaxNumberOfInputs @ShelleyKey net (Quantity 4096) Nothing 30 `shouldBe` 2 - - prop "more outputs ==> less inputs" (prop_moreOutputsMeansLessInputs net) - prop "less outputs ==> more inputs" (prop_lessOutputsMeansMoreInputs net) - prop "bigger size ==> more inputs" (prop_biggerMaxSizeMeansMoreInputs net) +estimateMaxInputsTests net cases = do + let k = show $ typeRep (Proxy @k) + describe ("estimateMaxNumberOfInputs for "<>k<>" on "<>show net) $ 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 net (Quantity 4096) Nothing nOuts + `shouldBe` nInps + + prop "more outputs ==> less inputs" + (prop_moreOutputsMeansLessInputs @k net) + prop "less outputs ==> more inputs" + (prop_lessOutputsMeansMoreInputs @k net) + prop "bigger size ==> more inputs" + (prop_biggerMaxSizeMeansMoreInputs @k net) prop_decodeSignedShelleyTxRoundtrip :: DecodeShelleySetup @@ -227,39 +256,48 @@ prop_decodeSignedByronTxRoundtrip (DecodeByronSetup utxo outs slotNo network pai -- | Increasing the number of outputs reduces the number of inputs. prop_moreOutputsMeansLessInputs - :: Cardano.NetworkId + :: forall k. TxWitnessTagFor k + => Cardano.NetworkId -> Quantity "byte" Word16 -> Word8 -> Property -prop_moreOutputsMeansLessInputs net size nOuts = withMaxSuccess 1000 $ - nOuts < maxBound ==> - _estimateMaxNumberOfInputs @ShelleyKey net size Nothing nOuts +prop_moreOutputsMeansLessInputs net size nOuts + = withMaxSuccess 1000 + $ within 100000 + $ nOuts < maxBound ==> + _estimateMaxNumberOfInputs @k net size Nothing nOuts >= - _estimateMaxNumberOfInputs @ShelleyKey net size Nothing (nOuts + 1) + _estimateMaxNumberOfInputs @k net size Nothing (nOuts + 1) -- | Reducing the number of outputs increases the number of inputs. prop_lessOutputsMeansMoreInputs - :: Cardano.NetworkId + :: forall k. TxWitnessTagFor k + => Cardano.NetworkId -> Quantity "byte" Word16 -> Word8 -> Property -prop_lessOutputsMeansMoreInputs net size nOuts = withMaxSuccess 1000 $ - nOuts > minBound ==> - _estimateMaxNumberOfInputs @ShelleyKey net size Nothing (nOuts - 1) +prop_lessOutputsMeansMoreInputs net size nOuts + = withMaxSuccess 1000 + $ within 100000 + $ nOuts > minBound ==> + _estimateMaxNumberOfInputs @k net size Nothing (nOuts - 1) >= - _estimateMaxNumberOfInputs @ShelleyKey net size Nothing nOuts + _estimateMaxNumberOfInputs @k net size Nothing nOuts -- | Increasing the max size automatically increased the number of inputs prop_biggerMaxSizeMeansMoreInputs - :: Cardano.NetworkId + :: forall k. TxWitnessTagFor k + => Cardano.NetworkId -> Quantity "byte" Word16 -> Word8 -> Property -prop_biggerMaxSizeMeansMoreInputs net (Quantity size) nOuts = withMaxSuccess 1000 $ - size < maxBound `div` 2 ==> - _estimateMaxNumberOfInputs @ShelleyKey net (Quantity size) Nothing nOuts +prop_biggerMaxSizeMeansMoreInputs net (Quantity size) nOuts + = withMaxSuccess 1000 + $ within 100000 + $ size < maxBound `div` 2 ==> + _estimateMaxNumberOfInputs @k net (Quantity size) Nothing nOuts <= - _estimateMaxNumberOfInputs @ShelleyKey net (Quantity (size * 2)) Nothing nOuts + _estimateMaxNumberOfInputs @k net (Quantity (size * 2)) Nothing nOuts testCoinSelOpts :: CoinSelectionOptions () testCoinSelOpts = coinSelOpts testTxLayer (Quantity 4096) Nothing