[RCD-44] & [RCD-45] & [RCD-46] - Review fee calculation and Fix prefiltering not ignoring inputs' ids [develop]

wallet-new/integration/TransactionSpecs.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase    #-}
 {-# LANGUAGE RankNTypes    #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -162,19 +163,19 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
                         <> show err
 
         randomTest "fails if you don't have any money" 1 $ run $ do
-            (wallet, account) <- fixtureWallet Nothing
+            (wallet, account) <- fixtureWallet []
             resp <- makePayment (Core.mkCoin 14) (wallet, account) =<< getRandomAddress
             let err = NotEnoughMoney (ErrAvailableBalanceIsInsufficient 0)
             expectFailure (ClientWalletError err) resp
 
         randomTest "fails if you spend more money than your available balance" 1 $ run $ do
-            (wallet, account) <- fixtureWallet (Just $ Core.mkCoin 42)
+            (wallet, account) <- fixtureWallet (Core.mkCoin <$> [42])
             resp <- makePayment (Core.mkCoin 10000) (wallet, account) =<< getRandomAddress
             let err = NotEnoughMoney (ErrAvailableBalanceIsInsufficient 42)
             expectFailure (ClientWalletError err) resp
 
         randomTest "fails if you can't cover fee with a transaction" 1 $ run $ do
-            (wallet, account) <- fixtureWallet (Just $ Core.mkCoin 42)
+            (wallet, account) <- fixtureWallet (Core.mkCoin <$> [42])
             resp <- makePayment (Core.mkCoin 42) (wallet, account) =<< getRandomAddress
             let err = NotEnoughMoney ErrCannotCoverFee
             expectFailure (ClientWalletError err) resp
@@ -222,6 +223,66 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
             let utxoStatisticsExpected = computeUtxoStatistics log10 utxos
             liftIO $ utxoStatistics `shouldBe` utxoStatisticsExpected
 
+        -- NOTE:
+        -- Cases where we have to increase the number of change outputs are hard
+        -- to test in practice. We either need:
+        --
+        -- - A BIG change to cause an overflow (but even with all the genesis
+        --   wallets, we don't have enough funds)
+        --
+        -- - A selection that will have no change such that a new one will be
+        --   created for the change. However, the coin selection tends to always
+        --   generate a change output.
+
+
+        -- Initial Selection:      Final Selection:
+        --   inputs : [200000]       inputs : [200000]
+        --   outputs: [1]            outputs: [1]
+        --   changes: [199999]       changes: [28094]
+        --   fee+   : 171905         fee+   : 171817
+        --
+        --           Actual fee: 171905 (+88)
+        randomTest "fee calculation: no extra inputs, no extra change" 1 $ run $ do
+            source <- fixtureWallet (Core.mkCoin <$> [200000])
+            resp <- makePayment (Core.mkCoin 1) source =<< getRandomAddress
+            expectConfirmation source resp
+
+        -- Initial Selection:      Final Selection:
+        --   inputs : [171906]       inputs : [171906]
+        --   outputs: [1]            outputs: [1]
+        --   changes: [171905]       changes: []
+        --   fee+   : 171905         fee+   : 167862
+        --
+        --           Actual fee: 167862 (+4043)
+        randomTest "fee calculation: empty a wallet" 1 $ run $ do
+            source <- fixtureWallet (Core.mkCoin <$> [171906])
+            resp <- makePayment (Core.mkCoin 1) source =<< getRandomAddress
+            expectConfirmation source resp
+
+        -- Initial Selection:      Final Selection:
+        --   inputs : [100000]       inputs : [100000, 100000]
+        --   outputs: [1]            outputs: [1]
+        --   changes: [99999]        changes: [19964]
+        --   fee+   : 171905         fee+   : 179947
+        --
+        --           Actual fee: 180035 (+88)
+        randomTest "fee calculation: needs extra input, no extra change" 1 $ run $ do
+            source <- fixtureWallet (Core.mkCoin <$> [100000, 100000])
+            resp <- makePayment (Core.mkCoin 1) source =<< getRandomAddress
+            expectConfirmation source resp
+
+        -- Initial Selection:      Final Selection:
+        --   inputs : [30000]        inputs : [30000, 30000, 30000, 30000,
+        --                                     30000, 30000, 30000, 30000]
+        --   outputs: [42]           outputs: [42]
+        --   changes: [29958]        changes: [11055]
+        --   fee+   : 171905         fee+   : 228815
+        --
+        --           Actual fee: 228903 (+88)
+        randomTest "fee calculation: needs many extra inputs" 1 $ run $ do
+            source <- fixtureWallet (replicate 8 (Core.mkCoin 30000))
+            resp <- makePayment (Core.mkCoin 42) source =<< getRandomAddress
+            expectConfirmation source resp
   where
     makePayment amount (sourceW, sourceA) destination
        = fmap (fmap wrData) $ Util.makePayment wc amount (sourceW, sourceA) destination
@@ -234,18 +295,18 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
         return (unV1 $ addrId toAddr)
 
     fixtureWallet
-        :: Maybe Core.Coin
+        :: [Core.Coin]
         -> IO (Wallet, Account)
-    fixtureWallet mcoin = do
+    fixtureWallet coins = do
         genesis <- genesisWallet wc
         (genesisAccount, _) <- firstAccountAndId wc genesis
         wallet <- randomWallet CreateWallet >>= createWalletCheck wc
-        (account, address) <- firstAccountAndId wc wallet
-        case mcoin of
-            Nothing   -> return ()
-            Just coin -> do
-                txn <- makePayment coin (genesis, genesisAccount) (unV1 $ addrId address) >>= shouldPrismFlipped _Right
-                pollTransactions wc (walId wallet) (accIndex account) (txId txn)
+        (account, _) <- firstAccountAndId wc wallet
+        forM_ coins $ \coin -> do
+            -- Make transaction to different addresses to cope with input selection grouping.
+            addr <- createAddress wc (wallet, account)
+            txn <- makePayment coin (genesis, genesisAccount) (unV1 $ addrId addr) >>= shouldPrismFlipped _Right
+            pollTransactions wc (walId wallet) (accIndex account) (txId txn)
         return (wallet, account)
 
     expectFailure
@@ -257,6 +318,16 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
         resp <- eresp `shouldPrism` _Left
         resp `shouldBe` want
 
+    expectConfirmation
+        :: (Wallet, Account)
+        -> Either ClientError Transaction
+        -> IO ()
+    expectConfirmation (wallet, account) = \case
+        Left err ->
+            fail $ "Expected transcation confirmation, but got a ClientError: " <> show err
+        Right txn ->
+            pollTransactions wc (walId wallet) (accIndex account) (txId txn)
+
     shouldBeConfirmed
         :: Transaction
         -> [Transaction]

wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs

@@ -70,6 +70,7 @@ instance IsValue Core.Coin where
                                    else a `Core.unsafeSubCoin` b
   valueRatio  = \  a b -> coinToDouble a / coinToDouble b
   valueAdjust = \r d a -> coinFromDouble r (d * coinToDouble a)
+  valueDiv    = divCoin
 
 instance CoinSelDom Cardano where
   type    Input     Cardano = Core.TxIn
@@ -171,8 +172,9 @@ newOptions estimateFee check = CoinSelectionOptions {
     }
 
 feeOptions :: CoinSelectionOptions -> FeeOptions Cardano
-feeOptions CoinSelectionOptions{..} = FeeOptions{
-      foExpenseRegulation = csoExpenseRegulation
+feeOptions CoinSelectionOptions{..} = FeeOptions
+    { foExpenseRegulation = csoExpenseRegulation
+    , foDustThreshold = csoDustThreshold
     , foEstimate = \numInputs outputs ->
                       case outputs of
                         []   -> error "feeOptions: empty list"
@@ -191,14 +193,6 @@ feeOptions CoinSelectionOptions{..} = FeeOptions{
 type PickUtxo m = forall e. Core.Coin  -- ^ Fee to still cover
                -> CoinSelT Core.Utxo e m (Maybe (Core.TxIn, Core.TxOutAux))
 
-data CoinSelFinalResult = CoinSelFinalResult {
-      csrInputs  :: NonEmpty (Core.TxIn, Core.TxOutAux)
-      -- ^ Picked inputs
-    , csrOutputs :: NonEmpty Core.TxOutAux
-      -- ^ Picked outputs
-    , csrChange  :: [Core.Coin]
-    }
-
 -- | Run coin selection
 --
 -- NOTE: Final UTxO is /not/ returned: coin selection runs /outside/ any wallet
@@ -215,8 +209,8 @@ runCoinSelT :: forall m. Monad m
             -> (forall utxo. PickFromUtxo utxo
                   => NonEmpty (Output (Dom utxo))
                   -> CoinSelT utxo CoinSelHardErr m [CoinSelResult (Dom utxo)])
-            -> CoinSelPolicy Core.Utxo m CoinSelFinalResult
-runCoinSelT opts pickUtxo policy (NE.sortBy (flip (comparing outVal)) -> request) utxo = do
+            -> CoinSelPolicy Core.Utxo m (CoinSelFinalResult Cardano)
+runCoinSelT opts pickUtxo policy (NE.sortBy (flip (comparing outVal)) -> request) =
     -- NOTE: we sort the payees by output value, to maximise our chances of succees.
     -- In particular, let's consider a scenario where:
     --
@@ -233,44 +227,9 @@ runCoinSelT opts pickUtxo policy (NE.sortBy (flip (comparing outVal)) -> request
     --
     -- Therefore, just always considering them in order from large to small
     -- is probably a good idea.
-    mSelection <- unwrapCoinSelT policy' utxo
-    case mSelection of
-      Left err -> return (Left err)
-      Right ((css, additionalUtxo, additionalChange), _utxo') -> do
-        let inps = concatMap selectedEntries
-                     (additionalUtxo : map coinSelInputs css)
-            outs = map coinSelOutput css
-            changesWithDust = splitChange additionalChange $ concatMap coinSelChange css
-        let allInps = case inps of
-                        []   -> error "runCoinSelT: empty list of inputs"
-                        i:is -> i :| is
-            originalOuts = case outs of
-                               []   -> error "runCoinSelT: empty list of outputs"
-                               o:os -> o :| os
-            changes = changesRemoveDust (csoDustThreshold opts) changesWithDust
-        return . Right $ CoinSelFinalResult allInps
-                                            originalOuts
-                                            changes
+    evalCoinSelT policy'
   where
-    -- we should have (x + (sum ls) = sum result), but this check could overflow.
-    splitChange :: Value Cardano -> [Value Cardano] -> [Value Cardano]
-    splitChange = go
-        where
-          go remaining [] = [remaining]
-              -- we only create new change if for whatever reason there is none already
-              -- or if is some overflow happens when we try to add.
-          go remaining [a] = case valueAdd remaining a of
-              Just newChange -> [newChange]
-              Nothing        -> [a, remaining]
-          go remaining ls@(a : as) =
-            let piece = divCoin remaining (length ls)
-                newRemaining = unsafeValueSub remaining piece -- unsafe because of div.
-            in case valueAdd piece a of
-                Just newChange -> newChange : go newRemaining as
-                Nothing        -> a : go remaining as
-
-    policy' :: CoinSelT Core.Utxo CoinSelHardErr m
-                 ([CoinSelResult Cardano], SelectedUtxo Cardano, Value Cardano)
+    policy' :: CoinSelT Core.Utxo CoinSelHardErr m (CoinSelFinalResult Cardano)
     policy' = do
         mapM_ validateOutput request
         css <- intInputGrouping (csoInputGrouping opts)
@@ -346,7 +305,7 @@ validateOutput out =
 random :: forall m. MonadRandom m
        => CoinSelectionOptions
        -> Word64          -- ^ Maximum number of inputs
-       -> CoinSelPolicy Core.Utxo m CoinSelFinalResult
+       -> CoinSelPolicy Core.Utxo m (CoinSelFinalResult Cardano)
 random opts maxInps =
       runCoinSelT opts pickUtxo
     $ Random.random Random.PrivacyModeOn maxInps . NE.toList
@@ -361,7 +320,7 @@ random opts maxInps =
 largestFirst :: forall m. Monad m
              => CoinSelectionOptions
              -> Word64
-             -> CoinSelPolicy Core.Utxo m CoinSelFinalResult
+             -> CoinSelPolicy Core.Utxo m (CoinSelFinalResult Cardano)
 largestFirst opts maxInps =
       runCoinSelT opts pickUtxo
     $ LargestFirst.largestFirst maxInps . NE.toList
@@ -434,8 +393,8 @@ estimateSize saa sta ins outs =
 --         here with some (hopefully) realistic values.
 estimateCardanoFee :: TxSizeLinear -> Int -> [Word64] -> Word64
 estimateCardanoFee linearFeePolicy ins outs
-    = round $ calculateTxSizeLinear linearFeePolicy
-            $ hi $ estimateSize boundAddrAttrSize boundTxAttrSize ins outs
+    = ceiling $ calculateTxSizeLinear linearFeePolicy
+              $ hi $ estimateSize boundAddrAttrSize boundTxAttrSize ins outs
 
 checkCardanoFeeSanity :: TxSizeLinear -> Coin -> Bool
 checkCardanoFeeSanity linearFeePolicy fees =

wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs

@@ -28,6 +28,7 @@ module Cardano.Wallet.Kernel.CoinSelection.Generic (
   , mapCoinSelErr
   , mapCoinSelUtxo
   , unwrapCoinSelT
+  , evalCoinSelT
   , wrapCoinSelT
     -- * Errors
   , CoinSelHardErr(..)
@@ -91,6 +92,7 @@ class Ord v => IsValue v where
   valueDist   :: v -> v -> v                         -- ^ @|a - b|@
   valueRatio  :: v -> v -> Double                    -- ^ @a / b@
   valueAdjust :: Rounding -> Double -> v -> Maybe v  -- ^ @a * b@
+  valueDiv    :: v -> Int -> v                       -- ^ @a / k@
 
 class ( Ord (Input dom)
       , IsValue (Value dom)
@@ -246,6 +248,10 @@ mapCoinSelUtxo inj proj act = wrapCoinSelT $ \st ->
 unwrapCoinSelT :: CoinSelT utxo e m a -> utxo -> m (Either e (a, utxo))
 unwrapCoinSelT act = runExceptT . runStrictStateT (unCoinSelT act)
 
+-- | Unwrap the 'CoinSelT' stack, only getting the resulting selection
+evalCoinSelT :: Monad m => CoinSelT utxo e m a -> utxo -> m (Either e a)
+evalCoinSelT act = runExceptT . evalStrictStateT (unCoinSelT act)
+
 -- | Inverse of 'unwrapCoinSelT'
 wrapCoinSelT :: Monad m
              => (utxo -> m (Either e (a, utxo))) -> CoinSelT utxo e m a