{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_HADDOCK prune #-}
-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Provides general functions and types relating to coin selection.
--
-- The 'CoinSelection' type represents a __coin selection__, the basis for a
-- /transaction/ in a UTxO-based blockchain.
--
-- The 'CoinSelectionAlgorithm' type provides a __common interface__ to
-- algorithms that generate coin selections.
--
-- For a guide to __algorithms provided by this library__, see the
-- "Cardano.CoinSelection.Algorithm" module.
--
-- To adjust coin selections in order to __pay for transaction fees__, see
-- the "Cardano.CoinSelection.Fee" module.
--
module Cardano.CoinSelection
(
-- * Coin Selections
CoinSelection (..)
, sumInputs
, sumOutputs
, sumChange
-- * Coin Selection Algorithms
, CoinSelectionAlgorithm (..)
, CoinSelectionParameters (..)
, CoinSelectionResult (..)
, CoinSelectionLimit (..)
-- * Coins
, Coin
, coinFromNatural
, coinToNatural
-- * Coin Maps
, CoinMap (..)
, CoinMapEntry (..)
, coinMapFromList
, coinMapToList
, coinMapValue
-- * Coin Selection Errors
, CoinSelectionError (..)
, InputValueInsufficientError (..)
, InputCountInsufficientError (..)
, InputLimitExceededError (..)
, InputsExhaustedError (..)
-- # Internal Functions
, coinMapRandomEntry
) where
import Prelude
import Control.Arrow
( (&&&) )
import Control.Monad.Trans.Except
( ExceptT (..) )
import Crypto.Number.Generate
( generateBetween )
import Crypto.Random.Types
( MonadRandom )
import Data.Map.Strict
( Map )
import Data.Word
( Word16 )
import GHC.Generics
( Generic )
import Internal.Coin
( Coin, coinFromNatural, coinToNatural )
import Numeric.Natural
( Natural )
import Quiet
( Quiet (Quiet) )
import qualified Data.Foldable as F
import qualified Data.Map.Strict as Map
--------------------------------------------------------------------------------
-- Coin Map
--------------------------------------------------------------------------------
-- | A mapping from unique keys to associated 'Coin' values.
--
-- A 'CoinMap' can be used to represent:
--
-- * a UTxO set, where each key within the map refers to an unspent output
-- from a previous transaction.
--
-- * a set of 'inputs' to a 'CoinSelection', where each input is an entry
-- selected from a UTxO set by a 'CoinSelectionAlgorithm'.
--
-- * a set of 'outputs' for a 'CoinSelection', where each key within the map
-- refers to the address of a payment recipient.
--
-- A 'CoinMap' can be constructed with the 'coinMapFromList' function.
--
-- 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))
instance Foldable CoinMap where
foldMap f = F.fold . fmap (f . entryKey) . coinMapToList
instance Ord a => Monoid (CoinMap a) where
mempty = CoinMap mempty
instance Ord a => Semigroup (CoinMap a) where
CoinMap a <> CoinMap b = CoinMap $ Map.unionWith (<>) a b
-- | An entry for a 'CoinMap'.
--
-- @since 1.0.0
data CoinMapEntry a = CoinMapEntry
{ entryKey
:: a
-- ^ The unique key associated with this entry.
, entryValue
:: Coin
-- ^ The coin value associated with this entry.
} deriving (Eq, Generic, Ord, Show)
-- | Constructs a 'CoinMap' from a list of entries.
--
-- See 'CoinMapEntry'.
--
-- @since 1.0.0
coinMapFromList :: Ord a => [CoinMapEntry a] -> CoinMap a
coinMapFromList = CoinMap
. Map.fromListWith (<>)
. fmap (entryKey &&& entryValue)
-- | Converts a 'CoinMap' to a list of entries.
--
-- 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
--------------------------------------------------------------------------------
-- Coin Selection
--------------------------------------------------------------------------------
-- | Provides a __common interface__ for coin selection algorithms.
--
-- The function 'selectCoins', when applied to the given
-- 'CoinSelectionParameters' object (with /available inputs/ and /requested/
-- /outputs/), will generate a 'CoinSelectionResult' (with /remaining inputs/
-- and a /coin selection/).
--
-- For implementations provided by this library, see
-- "Cardano.CoinSelection.Algorithm".
--
-- @since 1.0.0
newtype CoinSelectionAlgorithm i o m = CoinSelectionAlgorithm
{ selectCoins
:: CoinSelectionParameters i o
-> ExceptT CoinSelectionError m (CoinSelectionResult i o)
}
-- | The complete set of parameters required for a 'CoinSelectionAlgorithm'.
--
-- The 'inputsAvailable' and 'outputsRequested' fields are both maps of unique
-- keys to associated 'Coin' values, where:
--
-- * Each key-value pair in the 'inputsAvailable' map corresponds to an
-- __unspent output__ from a previous transaction that is /available/
-- /for selection as an input/ by the coin selection algorithm. The /key/
-- is a unique reference to that output, and the /value/ is the amount of
-- unspent value associated with it.
--
-- * Each key-value pair in the 'outputsRequested' map corresponds to a
-- __payment__ whose value is /to be paid for/ by the coin selection
-- algorithm. The /key/ is a unique reference to a payment recipient,
-- and the /value/ is the amount of money to pay to that recipient.
--
-- A coin selection algorithm will select a __subset__ of inputs from
-- 'inputsAvailable' in order to pay for __all__ the outputs in
-- 'outputsRequested', where:
--
-- * Inputs __selected__ by the algorithm are included in the 'inputs'
-- set of the generated 'CoinSelection'.
--
-- * Inputs __not__ selected by the algorithm are included in the
-- 'inputsRemaining' set of the 'CoinSelectionResult'.
--
-- The number of inputs that can selected is limited by 'limit'.
--
-- The total value of 'inputsAvailable' must be /greater than or equal to/
-- 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.
, outputsRequested :: CoinMap o
-- ^ The set of outputs requested for payment.
, limit :: CoinSelectionLimit
-- ^ A limit on the number of inputs that can be selected.
}
deriving Generic
-- | Represents the __result__ of running a coin selection algorithm.
--
-- See 'CoinSelectionAlgorithm'.
--
-- @since 1.0.0
data CoinSelectionResult i o = CoinSelectionResult
{ coinSelection :: CoinSelection i o
-- ^ The generated coin selection.
, inputsRemaining :: CoinMap i
-- ^ The set of inputs that were __not__ selected.
} deriving (Eq, Show)
-- | A __coin selection__ is the basis for a /transaction/.
--
-- It consists of a selection of 'inputs', 'outputs', and 'change'.
--
-- The 'inputs' and 'outputs' fields are both maps of unique keys to associated
-- 'Coin' values, where:
--
-- * Each key-value pair in the 'inputs' map corresponds to an
-- __unspent output__ from a previous transaction (also known as a UTxO).
-- The /key/ is a unique reference to that output, and the /value/ is the
-- amount of unspent value associated with it.
--
-- * Each key-value pair in the 'outputs' map corresponds to a __payment__.
-- The /key/ is a unique reference to a payment recipient, and the /value/
-- is the amount of money to pay to that recipient.
--
-- The 'change' field is a set of coins to be returned to the originator of the
-- transaction.
--
-- 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.
, outputs :: CoinMap o
-- ^ The set of outputs.
, change :: [Coin]
-- ^ The set of change.
}
deriving (Generic, Show, Eq)
instance (Ord i, Ord o) => Semigroup (CoinSelection i o) where
a <> b = CoinSelection
{ inputs = inputs a <> inputs b
, outputs = outputs a <> outputs b
, change = change a <> change b
}
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
-- ^ Calculate the maximum number of inputs allowed for a given
-- number of outputs.
} deriving Generic
-- | Represents the set of possible failures that can occur when attempting
-- to produce a 'CoinSelection' with a 'CoinSelectionAlgorithm'.
--
-- See 'selectCoins'.
--
-- @since 1.0.0
data CoinSelectionError
= InputValueInsufficient
InputValueInsufficientError
| InputCountInsufficient
InputCountInsufficientError
| InputLimitExceeded
InputLimitExceededError
| InputsExhausted
InputsExhaustedError
deriving (Eq, Show)
-- | Indicates that the total value of 'inputsAvailable' is less than the total
-- 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
-- ^ The total value of 'inputsAvailable'.
, inputValueRequired :: Coin
-- ^ The total value of 'outputsRequested'.
}
deriving (Eq, Show)
-- | Indicates that the total count of entries in 'inputsAvailable' is /fewer/
-- /than/ required by the algorithm. The number required depends on the
-- particular algorithm implementation.
--
-- @since 1.0.0
data InputCountInsufficientError =
InputCountInsufficientError
{ inputCountAvailable :: Natural
-- ^ The number of entries in 'inputsAvailable'.
, inputCountRequired :: Natural
-- ^ The number of entries required.
}
deriving (Eq, Show)
-- | Indicates that all available entries in 'inputsAvailable' were depleted
-- /before/ all the payments in 'outputsRequested' could be paid for.
--
-- This condition can occur /even if/ the total value of 'inputsAvailable' is
-- 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)
-- | Indicates that the coin selection algorithm is unable to cover the total
-- value of 'outputsRequested' without exceeding the maximum number of inputs
-- defined by 'limit'.
--
-- See 'calculateLimit'.
--
-- @since 1.0.0
newtype InputLimitExceededError =
InputLimitExceededError
{ calculatedInputLimit :: Word16 }
deriving (Eq, Show)
--------------------------------------------------------------------------------
-- Internal Functions
--------------------------------------------------------------------------------
-- Selects an entry at random from a 'CoinMap', returning both the selected
-- entry and the map with the entry removed.
--
-- If the given map is empty, this function returns 'Nothing'.
--
coinMapRandomEntry
:: MonadRandom m
=> CoinMap a
-> m (Maybe (CoinMapEntry a), CoinMap a)
coinMapRandomEntry (CoinMap m)
| Map.null m =
return (Nothing, CoinMap m)
| otherwise = do
ix <- fromEnum <$> generateBetween 0 (toEnum (Map.size m - 1))
let entry = uncurry CoinMapEntry $ Map.elemAt ix m
let remainder = CoinMap $ Map.deleteAt ix m
return (Just entry, remainder)