[RCD-45] & [RCD-44] Review fee calculation

So, basically, by conflating a bit the selected entries and changes, a
lot of things become easier.  At the price of one thing: fairness.

The previous code was splitting fee across change proportionally to
inputs.  So here, I just split the fee across all changes, regardless of
the input. So everyone's got to pay the same part of for the
transaction.

One could see it as another type of fairness 🙃 ...  But
that's also a lot simpler to handle, because we can just manipulate all
inputs and all changes directly and compute fee for those directly.

Author: KtorZ

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
@@ -191,14 +192,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 +208,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 +226,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 +304,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 +319,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

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