Merge pull request #196 from input-output-hk/KtorZ/coin-selection-bet…

…ter-coverage

Coin Selection Better Coverage + Fix Fee Calculation

src/Cardano/Wallet/CoinSelection/Fee.hs

@@ -52,8 +52,6 @@ import Crypto.Random.Types
     ( MonadRandom )
 import Data.Bifunctor
     ( bimap )
-import Data.Digest.CRC32
-    ( crc32 )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Word
@@ -421,10 +419,7 @@ estimateFee policy (CoinSelection inps outs chngs) =
     --  | word64                      -- 1|2|3|5|9
     sizeOfTxOut :: TxOut -> Int
     sizeOfTxOut (TxOut (Address bytes) c) =
-        6
-        + BS.length bytes
-        + sizeOf (CBOR.encodeWord32 $ crc32 bytes)
-        + sizeOfCoin c
+        1 + BS.length bytes + sizeOfCoin c
 
     -- Compute the size of a coin
     sizeOfCoin :: Coin -> Int

src/Cardano/Wallet/CoinSelection/Policy/Random.hs

@@ -211,7 +211,7 @@ mkChange (TxOut _ (Coin out)) inps =
         selected = invariant
             "mkChange: output is smaller than selected inputs!"
             (balance' inps)
-            (> out)
+            (>= out)
         Coin maxCoinValue = maxBound
     in
         case selected - out of

test/unit/Cardano/Wallet/CoinSelection/FeeSpec.hs

@@ -81,6 +81,7 @@ import Test.QuickCheck
     , scale
     , vectorOf
     , withMaxSuccess
+    , (===)
     , (==>)
     )
 import Test.QuickCheck.Monadic
@@ -285,6 +286,36 @@ spec = do
             , csChngs = [3,3]
             })
 
+        -- Change created when there was no change before
+        feeUnitTest (FeeFixture
+            { fInps = [1]
+            , fOuts = [1]
+            , fChngs = []
+            , fUtxo = [2]
+            , fFee = 1
+            , fDust = 0
+            }) (Right $ FeeOutput
+            { csInps = [1,2]
+            , csOuts = [1]
+            , csChngs = [1]
+            })
+
+        let c = getCoin maxBound
+
+        -- New BIG inputs selected causes change to overflow
+        feeUnitTest (FeeFixture
+            { fInps = [c-1, c-1]
+            , fOuts = [c-1]
+            , fChngs = [c-1]
+            , fUtxo = [c]
+            , fFee = c
+            , fDust = 0
+            }) (Right $ FeeOutput
+            { csInps = [c-1, c-1, c]
+            , csOuts = [c-1]
+            , csChngs = [c `div` 2 - 1, c `div` 2]
+            })
+
     describe "Fee Calculation: Generators" $ do
         it "Arbitrary CoinSelection" $ property $ \(ShowFmt cs) ->
             property $ isValidSelection cs
@@ -299,7 +330,7 @@ spec = do
 
     describe "Fee Estimation properties" $ do
         it "Estimated fee is the same as taken by encodeSignedTx"
-            (withMaxSuccess 1000 $ property propFeeEstimation)
+            (withMaxSuccess 2500 $ property propFeeEstimation)
 
 {-------------------------------------------------------------------------------
                          Fee Adjustment - Properties
@@ -377,15 +408,17 @@ propFeeEstimation (ShowFmt sel, InfiniteList chngAddrs _) =
         (Fee calcFee) = estimateFee cardanoPolicy sel
         (TxSizeLinear (Quantity a) (Quantity b)) = cardanoPolicy
         tx = fromCoinSelection sel
-        size = BL.length $ toLazyByteString $ encodeSignedTx tx
+        encodedTx = toLazyByteString $ encodeSignedTx tx
+        size = BL.length encodedTx
         -- We always go for the higher bound for change address payload's size,
         -- so, we may end up with up to 4 extra bytes per change address in our
         -- estimation.
         margin = 4 * fromIntegral (length $ CS.change sel)
         realFeeSup = ceiling (a + b*(fromIntegral size + margin))
         realFeeInf = ceiling (a + b*(fromIntegral size))
     in
-        property (calcFee >= realFeeInf && calcFee <= realFeeSup)
+        (calcFee >= realFeeInf && calcFee <= realFeeSup, encodedTx)
+            === (True, encodedTx)
   where
     dummyWitness = PublicKeyWitness
         "\130X@\226E\220\252\DLE\170\216\210\164\155\182mm$ePG\252\186\195\225_\b=\v\241=\255 \208\147[\239\RS\170|\214\202\247\169\229\205\187O_)\221\175\155?e\198\248\170\157-K\155\169z\144\174\ENQhX@\193\151*,\NULz\205\234\&1tL@\211\&2\165\129S\STXP\164C\176 Xvf\160|;\CANs{\SYN\204<N\207\154\130\225\229\t\172mbC\139\US\159\246\168x\163Mq\248\145)\160|\139\207-\SI"
@@ -412,8 +445,8 @@ feeOptions
     -> Word64
     -> FeeOptions
 feeOptions fee dust = FeeOptions
-    { estimate = \_num _outs ->
-        Fee fee
+    { estimate = \nInps outs ->
+        nInps `seq` outs `seq` Fee fee
     , dustThreshold =
         Coin dust
     }
@@ -524,8 +557,8 @@ instance Arbitrary Address where
 instance {-# OVERLAPS #-} Arbitrary (Network -> Address) where
     shrink _ = []
     arbitrary = do
-        mainnetA <- genAddress (39, 43)
-        testnetA <- genAddress (46, 50)
+        mainnetA <- genAddress (33, 33)
+        testnetA <- genAddress (40, 40)
         return $ \case
             Mainnet -> mainnetA
             Staging -> mainnetA

test/unit/Cardano/Wallet/CoinSelection/Policy/LargestFirstSpec.hs

@@ -13,7 +13,11 @@ import Cardano.Wallet.CoinSelection
 import Cardano.Wallet.CoinSelection.Policy.LargestFirst
     ( largestFirst )
 import Cardano.Wallet.CoinSelectionSpec
-    ( CoinSelProp (..), CoinSelectionFixture (..), coinSelectionUnitTest )
+    ( CoinSelProp (..)
+    , CoinSelectionFixture (..)
+    , CoinSelectionResult (..)
+    , coinSelectionUnitTest
+    )
 import Cardano.Wallet.Primitive.Types
     ( Coin (..), TxOut (..), UTxO (..), excluding )
 import Control.Monad
@@ -39,35 +43,65 @@ import qualified Data.Set as Set
 spec :: Spec
 spec = do
     describe "Coin selection : LargestFirst algorithm unit tests" $ do
-        coinSelectionUnitTest largestFirst "" (Right [17]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [10,10,17]
-            , txOutputs = 17 :| []
-            }
-
-        coinSelectionUnitTest largestFirst "" (Right [17]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [12,10,17]
-            , txOutputs = 1 :| []
-            }
-
-        coinSelectionUnitTest largestFirst "" (Right [12, 17]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [12,10,17]
-            , txOutputs = 18 :| []
-            }
-
-        coinSelectionUnitTest largestFirst "" (Right [10, 12, 17]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [12,10,17]
-            , txOutputs = 30 :| []
-            }
-
-        coinSelectionUnitTest largestFirst "" (Right [6,10,5]) $ CoinSelectionFixture
-            { maxNumOfInputs = 3
-            , utxoInputs = [1,2,10,6,5]
-            , txOutputs = 11 :| [1]
-            }
+        coinSelectionUnitTest largestFirst ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [17]
+                , rsChange = []
+                , rsOutputs = [17]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [10,10,17]
+                , txOutputs = 17 :| []
+                })
+
+        coinSelectionUnitTest largestFirst ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [17]
+                , rsChange = [16]
+                , rsOutputs = [1]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [12,10,17]
+                , txOutputs = 1 :| []
+                })
+
+        coinSelectionUnitTest largestFirst ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [12, 17]
+                , rsChange = [11]
+                , rsOutputs = [18]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [12,10,17]
+                , txOutputs = 18 :| []
+                })
+
+        coinSelectionUnitTest largestFirst ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [10, 12, 17]
+                , rsChange = [9]
+                , rsOutputs = [30]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [12,10,17]
+                , txOutputs = 30 :| []
+                })
+
+        coinSelectionUnitTest largestFirst ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [6,10,5]
+                , rsChange = [5,4]
+                , rsOutputs = [11,1]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 3
+                , utxoInputs = [1,2,10,6,5]
+                , txOutputs = 11 :| [1]
+                })
 
         coinSelectionUnitTest
             largestFirst

test/unit/Cardano/Wallet/CoinSelection/Policy/RandomSpec.hs

@@ -15,7 +15,11 @@ import Cardano.Wallet.CoinSelection.Policy.LargestFirst
 import Cardano.Wallet.CoinSelection.Policy.Random
     ( random )
 import Cardano.Wallet.CoinSelectionSpec
-    ( CoinSelProp (..), CoinSelectionFixture (..), coinSelectionUnitTest )
+    ( CoinSelProp (..)
+    , CoinSelectionFixture (..)
+    , CoinSelectionResult (..)
+    , coinSelectionUnitTest
+    )
 import Control.Monad.Trans.Except
     ( runExceptT )
 import Crypto.Random
@@ -39,48 +43,90 @@ import qualified Data.List as L
 spec :: Spec
 spec = do
     describe "Unit tests" $ do
-        coinSelectionUnitTest random "" (Right [1,1,1,1]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [1,1,1,1,1,1]
-            , txOutputs = 2 :| []
-            }
-
-        coinSelectionUnitTest random "" (Right [1,1,1,1,1,1]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [1,1,1,1,1,1]
-            , txOutputs = 2 :| [1]
-            }
-
-        coinSelectionUnitTest random "" (Right [1,1,1,1,1]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [1,1,1,1,1]
-            , txOutputs = 2 :| [1]
-            }
-
-        coinSelectionUnitTest random "with fallback" (Right [1,1,1]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [1,1,1,1]
-            , txOutputs = 2 :| [1]
-            }
-
-        coinSelectionUnitTest random "" (Right [5]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [5,5,5]
-            , txOutputs = 2 :| []
-            }
-
-        coinSelectionUnitTest random "" (Right [10,10]) $ CoinSelectionFixture
-            { maxNumOfInputs = 100
-            , utxoInputs = [10,10,10]
-            , txOutputs = 2 :| [2]
-            }
+        coinSelectionUnitTest random ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [1,1,1,1]
+                , rsChange = [2]
+                , rsOutputs = [2]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [1,1,1,1,1,1]
+                , txOutputs = 2 :| []
+                })
+
+        coinSelectionUnitTest random ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [1,1,1,1,1,1]
+                , rsChange = [2,1]
+                , rsOutputs = [2,1]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [1,1,1,1,1,1]
+                , txOutputs = 2 :| [1]
+                })
+
+        coinSelectionUnitTest random ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [1,1,1,1,1]
+                , rsChange = [2]
+                , rsOutputs = [2,1]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [1,1,1,1,1]
+                , txOutputs = 2 :| [1]
+                })
+
+        coinSelectionUnitTest random "with fallback"
+            (Right $ CoinSelectionResult
+                { rsInputs = [1,1,1]
+                , rsChange = []
+                , rsOutputs = [2,1]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [1,1,1,1]
+                , txOutputs = 2 :| [1]
+                })
+
+        coinSelectionUnitTest random ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [5]
+                , rsChange = [3]
+                , rsOutputs = [2]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [5,5,5]
+                , txOutputs = 2 :| []
+                })
+
+        coinSelectionUnitTest random ""
+            (Right $ CoinSelectionResult
+                { rsInputs = [10,10]
+                , rsChange = [8,8]
+                , rsOutputs = [2,2]
+                }
+            )
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , utxoInputs = [10,10,10]
+                , txOutputs = 2 :| [2]
+                })
 
         coinSelectionUnitTest random "cannot cover aim, but only min"
-            (Right [1,1,1,1]) $ CoinSelectionFixture
-            { maxNumOfInputs = 4
-            , utxoInputs = [1,1,1,1,1,1]
-            , txOutputs = 3 :| []
-            }
+            (Right $ CoinSelectionResult
+                { rsInputs = [1,1,1,1]
+                , rsChange = [1]
+                , rsOutputs = [3]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 4
+                , utxoInputs = [1,1,1,1,1,1]
+                , txOutputs = 3 :| []
+                })
 
         coinSelectionUnitTest random "" (Left $ MaximumInputsReached 2) $ CoinSelectionFixture
             { maxNumOfInputs = 2