diff --git a/src/internal/Internal/Coin.hs b/src/internal/Internal/Coin.hs index 96b6f16d2..2c4e4aa1d 100644 --- a/src/internal/Internal/Coin.hs +++ b/src/internal/Internal/Coin.hs @@ -59,6 +59,7 @@ import qualified Prelude -- -- Use 'coinToNatural' to convert a coin into a natural number. -- +-- @since 1.0.0 newtype Coin = Coin { unCoin :: Natural } deriving stock (Eq, Generic, Ord) deriving Show via (Quiet Coin) @@ -74,6 +75,7 @@ coinFromIntegral i -- | Creates a coin from a natural number. -- +-- @since 1.0.0 coinFromNatural :: Natural -> Coin coinFromNatural = Coin @@ -84,6 +86,7 @@ coinToIntegral (Coin i) = Prelude.fromIntegral i -- | Converts the given coin into a natural number. -- +-- @since 1.0.0 coinToNatural :: Coin -> Natural coinToNatural = unCoin diff --git a/src/library/Cardano/CoinSelection.hs b/src/library/Cardano/CoinSelection.hs index 02067cb24..4339ea9b3 100644 --- a/src/library/Cardano/CoinSelection.hs +++ b/src/library/Cardano/CoinSelection.hs @@ -103,6 +103,7 @@ import qualified Data.Map.Strict as Map -- -- The total value of a 'CoinMap' is given by the 'coinMapValue' function. -- +-- @since 1.0.0 newtype CoinMap a = CoinMap { unCoinMap :: Map a Coin } deriving (Eq, Generic) deriving Show via (Quiet (CoinMap a)) @@ -118,6 +119,7 @@ instance Ord a => Semigroup (CoinMap a) where -- | An entry for a 'CoinMap'. -- +-- @since 1.0.0 data CoinMapEntry a = CoinMapEntry { entryKey :: a @@ -131,6 +133,7 @@ data CoinMapEntry a = CoinMapEntry -- -- See 'CoinMapEntry'. -- +-- @since 1.0.0 coinMapFromList :: Ord a => [CoinMapEntry a] -> CoinMap a coinMapFromList = CoinMap . Map.fromListWith (<>) @@ -140,11 +143,13 @@ coinMapFromList = CoinMap -- -- See 'CoinMapEntry'. -- +-- @since 1.0.0 coinMapToList :: CoinMap a -> [CoinMapEntry a] coinMapToList = fmap (uncurry CoinMapEntry) . Map.toList . unCoinMap -- | Calculates the total coin value associated with a 'CoinMap'. -- +-- @since 1.0.0 coinMapValue :: CoinMap a -> Coin coinMapValue = mconcat . fmap entryValue . coinMapToList @@ -159,6 +164,7 @@ coinMapValue = mconcat . fmap entryValue . coinMapToList -- /outputs/), will generate a 'CoinSelectionResult' (with /remaining inputs/ -- and a /coin selection/). -- +-- @since 1.0.0 newtype CoinSelectionAlgorithm i o m = CoinSelectionAlgorithm { selectCoins :: CoinSelectionParameters i o @@ -197,6 +203,7 @@ newtype CoinSelectionAlgorithm i o m = CoinSelectionAlgorithm -- the total value of 'outputsRequested', as given by the 'coinMapValue' -- function. -- +-- @since 1.0.0 data CoinSelectionParameters i o = CoinSelectionParameters { inputsAvailable :: CoinMap i -- ^ The set of inputs available for selection. @@ -211,6 +218,7 @@ data CoinSelectionParameters i o = CoinSelectionParameters -- -- See 'CoinSelectionAlgorithm'. -- +-- @since 1.0.0 data CoinSelectionResult i o = CoinSelectionResult { coinSelection :: CoinSelection i o -- ^ The generated coin selection. @@ -240,6 +248,7 @@ data CoinSelectionResult i o = CoinSelectionResult -- The 'CoinSelectionAlgorithm' type provides a common interface for generating -- coin selections. -- +-- @since 1.0.0 data CoinSelection i o = CoinSelection { inputs :: CoinMap i -- ^ The set of inputs. @@ -261,20 +270,27 @@ instance (Ord i, Ord o) => Monoid (CoinSelection i o) where mempty = CoinSelection mempty mempty mempty -- | Calculate the total sum of all 'inputs' for the given 'CoinSelection'. +-- +-- @since 1.0.0 sumInputs :: CoinSelection i o -> Coin sumInputs = coinMapValue . inputs -- | Calculate the total sum of all 'outputs' for the given 'CoinSelection'. +-- +-- @since 1.0.0 sumOutputs :: CoinSelection i o -> Coin sumOutputs = coinMapValue . outputs -- | Calculate the total sum of all 'change' for the given 'CoinSelection'. +-- +-- @since 1.0.0 sumChange :: CoinSelection i o -> Coin sumChange = mconcat . change -- | Defines an __inclusive upper bound__ on the /number/ of inputs that -- a 'CoinSelectionAlgorithm' is allowed to select. -- +-- @since 1.0.0 newtype CoinSelectionLimit = CoinSelectionLimit { calculateLimit :: Word16 -> Word16 @@ -287,6 +303,7 @@ newtype CoinSelectionLimit = CoinSelectionLimit -- -- See 'selectCoins'. -- +-- @since 1.0.0 data CoinSelectionError = InputValueInsufficient InputValueInsufficientError @@ -302,6 +319,7 @@ data CoinSelectionError -- value of 'outputsRequested', making it /impossible/ to cover all payments, -- /regardless/ of which algorithm is chosen. -- +-- @since 1.0.0 data InputValueInsufficientError = InputValueInsufficientError { inputValueAvailable :: Coin @@ -315,6 +333,7 @@ data InputValueInsufficientError = -- /than/ required by the algorithm. The number required depends on the -- particular algorithm implementation. -- +-- @since 1.0.0 data InputCountInsufficientError = InputCountInsufficientError { inputCountAvailable :: Natural @@ -331,6 +350,7 @@ data InputCountInsufficientError = -- greater than or equal to the total value of 'outputsRequested', due to -- differences in the way that algorithms select inputs. -- +-- @since 1.0.0 data InputsExhaustedError = InputsExhaustedError deriving (Eq, Show) @@ -341,6 +361,7 @@ data InputsExhaustedError = -- -- See 'calculateLimit'. -- +-- @since 1.0.0 newtype InputLimitExceededError = InputLimitExceededError { calculatedInputLimit :: Word16 } diff --git a/src/library/Cardano/CoinSelection/Algorithm/LargestFirst.hs b/src/library/Cardano/CoinSelection/Algorithm/LargestFirst.hs index 6d2900e63..a9e0ee927 100644 --- a/src/library/Cardano/CoinSelection/Algorithm/LargestFirst.hs +++ b/src/library/Cardano/CoinSelection/Algorithm/LargestFirst.hs @@ -176,6 +176,7 @@ import qualified Internal.Coin as C -- -- See: __'InputLimitExceededError'__. -- +-- @since 1.0.0 largestFirst :: (Ord i, Ord o, Monad m) => CoinSelectionAlgorithm i o m diff --git a/src/library/Cardano/CoinSelection/Algorithm/Migration.hs b/src/library/Cardano/CoinSelection/Algorithm/Migration.hs index c77d5eb15..f5c5ef22a 100644 --- a/src/library/Cardano/CoinSelection/Algorithm/Migration.hs +++ b/src/library/Cardano/CoinSelection/Algorithm/Migration.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -10,40 +11,17 @@ -- Copyright: © 2018-2020 IOHK -- License: Apache-2.0 -- --- This module contains an algorithm to select coins for migration from legacy --- wallets to newer wallets. +-- This module contains an algorithm for migrating all funds from one wallet +-- to another. -- --- We want users to be able to migrate their funds from a legacy random wallet --- to a new sequential wallet. To do this, we have to move funds from a wallet --- to another by making transactions. Funds are ultimately a sum of many coins --- (a.k.a UTxOs). In a transaction, we can select a few coins, and send them to --- addresses, effectively creating new coins / UTxOs doing this. +-- See 'selectCoins'. -- --- There are some limitations regarding the number of coins that can be selected --- at once in a single transaction (theoretically 255 coins, in practice ~170) --- because there's a transaction max size (in bytes) enforced by the network. --- Also, there's a direct relationship between the maximum number of inputs we --- can select, and the maximum number of outputs we can produce (increasing one --- will decrease the other, and vice-versa). --- --- When making a transaction, coins used as inputs for a transaction becomes --- unavailable for a while, until the transaction is inserted into the ledger --- and, make some new coins available as change (very much like when paying --- with bank notes to a shop, if we give a 20 EUR note to pay for 3 EUR, we --- can't spend the remaining 17 EUR before we have received the change!). --- So, a wallet with a small number of UTxO will not be able to make many --- transactions in parallel and will have to make them sequentially, waiting --- for the previous ones to be inserted before making new ones (we also say --- that a wallet is not "fragmented enough"). - module Cardano.CoinSelection.Algorithm.Migration ( -- * Coin Selection for Migration selectCoins - - -- # Internal Functions + , BatchSize (..) , idealBatchSize - ) where import Prelude @@ -73,6 +51,8 @@ import Data.Maybe ( fromMaybe, mapMaybe ) import Data.Word ( Word16 ) +import GHC.Generics + ( Generic ) import Internal.Coin ( Coin, coinFromIntegral, coinToIntegral ) @@ -82,28 +62,42 @@ import qualified Internal.Coin as C -- Coin Selection for Migration -------------------------------------------------------------------------------- --- | Construct a list of coin selections / transactions to transfer the totality --- of a user's wallet. The resulting 'CoinSelection' do not contain any --- 'outputs', but only change coins (so there's no restriction about how --- addresses are generated). +-- | Creates a __series__ of coin selections that, when published as +-- transactions, will have the effect of migrating all funds from one +-- wallet to another. +-- +-- Since UTxO-based blockchains typically impose limits on the sizes of +-- individual transactions, and since individual UTxO sets can contain +-- /arbitrarily/ many entries, migrating all funds from one wallet to another +-- may require the creation of /several/ transactions. +-- +-- This function therefore /partitions/ the given set of inputs into multiple +-- /batches/ of up to __/b/__ inputs, where __/b/__ is specified by the given +-- 'BatchSize' parameter. (See 'idealBatchSize' for an automatic way to +-- calculate a suitable batch size.) -- --- It tries to fit as many inputs as possible in a single transaction (fixed by --- the 'Word16' maximum number of inputs given as argument. +-- For each batch of inputs, this function creates a separate 'CoinSelection' +-- with the given 'inputs' /and/ a generated 'change' set, where the 'change' +-- set represents the value to be transferred to the target wallet, carefully +-- adjusted to deduct a fee in accordance with the given 'FeeOptions' +-- parameter. The set of 'outputs' for each coin selection is /purposefully/ +-- left empty, as /all/ value is captured in the 'change' set. -- --- The fee options are used to balance the coin selections and fix a threshold --- for dust that is removed from the selections. +-- @since 1.0.0 selectCoins :: forall i o . (Ord i, Ord o) => FeeOptions i o - -- ^ Fee computation and threshold definition - -> Word16 - -- ^ Maximum number of inputs we can select per transaction + -- ^ The fee options. + -> BatchSize + -- ^ The maximum number of inputs to include in each selection. -> CoinMap i - -- ^ UTxO to deplete + -- ^ The UTxO set to migrate. -> [CoinSelection i o] -selectCoins FeeOptions{dustThreshold,feeEstimator,feeBalancingPolicy} batchSize utxo = +selectCoins options (BatchSize batchSize) utxo = evalState migrate (coinMapToList utxo) where + FeeOptions {dustThreshold, feeEstimator, feeBalancingPolicy} = options + migrate :: State [CoinMapEntry i] [CoinSelection i o] migrate = do batch <- getNextBatch @@ -222,14 +216,18 @@ selectCoins FeeOptions{dustThreshold,feeEstimator,feeBalancingPolicy} batchSize put rest pure batch --------------------------------------------------------------------------------- --- Internal Functions --------------------------------------------------------------------------------- +-- | An upper limit for the number of 'inputs' to include in each coin selection +-- generated by 'selectCoins'. +-- +-- @since 1.0.0 +newtype BatchSize = BatchSize Word16 + deriving (Eq, Generic, Ord, Show) --- Try to find a fixed "ideal" number of input transactions that would generate --- relatively balanced transactions. -idealBatchSize :: CoinSelectionLimit -> Word16 -idealBatchSize coinselOpts = fixPoint 1 +-- | Calculate an ideal batch size based on the given coin selection limit. +-- +-- @since 1.0.0 +idealBatchSize :: CoinSelectionLimit -> BatchSize +idealBatchSize coinselOpts = BatchSize $ fixPoint 1 where fixPoint :: Word16 -> Word16 fixPoint !n diff --git a/src/library/Cardano/CoinSelection/Algorithm/RandomImprove.hs b/src/library/Cardano/CoinSelection/Algorithm/RandomImprove.hs index 200901592..59dbc8b48 100644 --- a/src/library/Cardano/CoinSelection/Algorithm/RandomImprove.hs +++ b/src/library/Cardano/CoinSelection/Algorithm/RandomImprove.hs @@ -206,6 +206,7 @@ import qualified Internal.Coin as C -- entries that it is less likely for a randomly-chosen UTxO entry to push the -- total above the upper bound. -- +-- @since 1.0.0 randomImprove :: (Ord i, Ord o, MonadRandom m) => CoinSelectionAlgorithm i o m diff --git a/src/library/Cardano/CoinSelection/Fee.hs b/src/library/Cardano/CoinSelection/Fee.hs index f36fbbb4b..1c14485bd 100644 --- a/src/library/Cardano/CoinSelection/Fee.hs +++ b/src/library/Cardano/CoinSelection/Fee.hs @@ -93,6 +93,7 @@ import qualified Internal.Coin as C -- | Represents a non-negative fee to be paid on a transaction. -- +-- @since 1.0.0 newtype Fee = Fee { unFee :: Coin } deriving newtype (Monoid, Semigroup) deriving stock (Eq, Generic, Ord) @@ -113,6 +114,7 @@ newtype Fee = Fee { unFee :: Coin } -- -- See 'coalesceDust'. -- +-- @since 1.0.0 newtype DustThreshold = DustThreshold { unDustThreshold :: Coin } deriving stock (Eq, Generic, Ord) deriving Show via (Quiet DustThreshold) @@ -134,6 +136,7 @@ newtype DustThreshold = DustThreshold { unDustThreshold :: Coin } -- fees are generally paid for by /adjusting/ a given selection to make a /new/ -- selection. See 'adjustForFee' for more details of this process. -- +-- @since 1.0.0 newtype FeeEstimator i o = FeeEstimator { estimateFee :: CoinSelection i o -> Fee } deriving Generic @@ -144,6 +147,7 @@ newtype FeeEstimator i o = FeeEstimator -- | Provides options for fee adjustment. -- +-- @since 1.0.0 data FeeOptions i o = FeeOptions { feeEstimator :: FeeEstimator i o @@ -300,6 +304,7 @@ data FeeAdjustmentError i o -- -- See 'FeeBalancingPolicy' for more details. -- +-- @since 1.0.0 adjustForFee :: (Ord i, MonadRandom m) => FeeOptions i o diff --git a/src/test/Cardano/CoinSelection/Algorithm/MigrationSpec.hs b/src/test/Cardano/CoinSelection/Algorithm/MigrationSpec.hs index 583df35bf..e1a816799 100644 --- a/src/test/Cardano/CoinSelection/Algorithm/MigrationSpec.hs +++ b/src/test/Cardano/CoinSelection/Algorithm/MigrationSpec.hs @@ -23,7 +23,7 @@ import Cardano.CoinSelection , sumInputs ) import Cardano.CoinSelection.Algorithm.Migration - ( idealBatchSize, selectCoins ) + ( BatchSize (..), idealBatchSize, selectCoins ) import Cardano.CoinSelection.Fee ( DustThreshold (..) , Fee (..) @@ -47,8 +47,6 @@ import Data.ByteString ( ByteString ) import Data.Function ( (&) ) -import Data.Word - ( Word16 ) import Internal.Coin ( Coin, coinToIntegral ) import Numeric.Natural @@ -59,6 +57,7 @@ import Test.QuickCheck ( Arbitrary (..) , Gen , Property + , arbitrarySizedIntegral , choose , conjoin , counterexample @@ -150,7 +149,7 @@ spec = do $ 5 * (length (inputs s) + length (outputs s)) , feeBalancingPolicy = RequireBalancedFee } - let batchSize = 1 + let batchSize = BatchSize 1 let utxo = CoinMap $ Map.fromList [ ( TxIn { txinId = Hash "|\243^\SUBg\242\231\&1\213\203" @@ -170,7 +169,7 @@ spec = do prop_onlyChangeOutputs :: forall i o . (Ord i, Ord o, Show o) => FeeOptions i o - -> Word16 + -> BatchSize -> CoinMap i -> Property prop_onlyChangeOutputs feeOpts batchSize utxo = do @@ -182,7 +181,7 @@ prop_onlyChangeOutputs feeOpts batchSize utxo = do prop_noLessThanThreshold :: forall i o . (Ord i, Ord o) => FeeOptions i o - -> Word16 + -> BatchSize -> CoinMap i -> Property prop_noLessThanThreshold feeOpts batchSize utxo = do @@ -198,7 +197,7 @@ prop_noLessThanThreshold feeOpts batchSize utxo = do prop_inputsGreaterThanOutputs :: forall i o . (Ord i, Ord o, Show i, Show o) => FeeOptions i o - -> Word16 + -> BatchSize -> CoinMap i -> Property prop_inputsGreaterThanOutputs feeOpts batchSize utxo = do @@ -214,7 +213,7 @@ prop_inputsGreaterThanOutputs feeOpts batchSize utxo = do prop_inputsAreUnique :: forall i o . (Ord i, Ord o) => FeeOptions i o - -> Word16 + -> BatchSize -> CoinMap i -> Property prop_inputsAreUnique feeOpts batchSize utxo = do @@ -228,7 +227,7 @@ prop_inputsAreUnique feeOpts batchSize utxo = do prop_inputsStillInUTxO :: forall i o . (Ord i, Ord o) => FeeOptions i o - -> Word16 + -> BatchSize -> CoinMap i -> Property prop_inputsStillInUTxO feeOpts batchSize utxo = do @@ -243,7 +242,7 @@ prop_inputsStillInUTxO feeOpts batchSize utxo = do prop_wellBalanced :: forall i o . (Ord i, Ord o, Show i, Show o) => FeeParameters i o - -> Word16 + -> BatchSize -> CoinMap i -> Property prop_wellBalanced feeParams batchSize utxo = do @@ -287,12 +286,16 @@ instance Arbitrary (Wrapped TxIn) where instance Arbitrary (Wrapped (Hash "Tx")) where arbitrary = Wrapped . Hash <$> (BS.pack <$> vectorOf 32 arbitrary) +instance Arbitrary BatchSize where + arbitrary = BatchSize <$> arbitrarySizedIntegral + shrink (BatchSize s) = BatchSize <$> shrink s + -------------------------------------------------------------------------------- -- Generators -------------------------------------------------------------------------------- -genBatchSize :: Gen Word16 -genBatchSize = choose (50, 150) +genBatchSize :: Gen BatchSize +genBatchSize = BatchSize <$> choose (50, 150) genFeeOptions :: Coin -> Gen (FeeOptions TxIn Address) genFeeOptions dust = do