simplify implementation of 'estimateMaxNumberOfInputs' & increase coverage

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

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

@@ -1,7 +1,8 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -33,10 +34,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 +58,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 +69,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 +78,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 +101,7 @@ import Test.QuickCheck
     , scale
     , vectorOf
     , withMaxSuccess
+    , within
     , (===)
     , (==>)
     )
@@ -115,8 +124,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 +149,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 +198,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
@@ -212,7 +240,7 @@ prop_decodeSignedShelleyTxRoundtrip (DecodeShelleySetup utxo outs md slotNo pair
 prop_decodeSignedByronTxRoundtrip
     :: DecodeByronSetup
     -> Property
-prop_decodeSignedByronTxRoundtrip (DecodeByronSetup utxo outs slotNo network pairs) = do
+prop_decodeSignedByronTxRoundtrip (DecodeByronSetup utxo outs slotNo ntwrk pairs) = do
     let inps = Map.toList $ getUTxO utxo
     let cs = mempty { CS.inputs = inps, CS.outputs = outs }
     let unsigned = mkUnsignedTx slotNo cs Nothing mempty []
@@ -223,43 +251,52 @@ prop_decodeSignedByronTxRoundtrip (DecodeByronSetup utxo outs slotNo network pai
         === Right (sealShelleyTx ledgerTx)
   where
     mkByronWitness' unsigned (_, (TxOut addr _)) =
-        mkByronWitness unsigned network addr
+        mkByronWitness unsigned ntwrk addr
 
 -- | 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