Skip to content
This repository has been archived by the owner on Aug 18, 2020. It is now read-only.

[RCD-45] & [RCD-44] Review fee calculation entirely #3861

Merged
merged 3 commits into from
Nov 19, 2018
Merged

[RCD-45] & [RCD-44] Review fee calculation entirely #3861

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
01c16c7
[RCD-45] & [RCD-44] Review fee calculation
KtorZ Nov 16, 2018
b6c7208
fixup: Review comments & adjust estimateCardanoFee
KtorZ Nov 19, 2018
132e63d
Filter out dust change when reducing them
KtorZ Nov 19, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
56 changes: 7 additions & 49 deletions wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

splitChange ranked higher up in the abstraction, so we need a way to divide Value dom into k pieces.


instance CoinSelDom Cardano where
type Input Cardano = Core.TxIn
Expand Down Expand Up @@ -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]
}
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Moved one level higher in the abstraction as CoinSelFinalResult dom


-- | Run coin selection
--
-- NOTE: Final UTxO is /not/ returned: coin selection runs /outside/ any wallet
Expand All @@ -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:
--
Expand All @@ -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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Checked moved inside adjustForFees

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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Moved in Generic/Fee and is now part of the senderPaysFee algorithm.


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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
6 changes: 6 additions & 0 deletions wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ module Cardano.Wallet.Kernel.CoinSelection.Generic (
, mapCoinSelErr
, mapCoinSelUtxo
, unwrapCoinSelT
, evalCoinSelT
, wrapCoinSelT
-- * Errors
, CoinSelHardErr(..)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
Loading