{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}

{-# OPTIONS_HADDOCK prune #-}

-- |
-- Copyright: © 2018-2024 Intersect MBO
-- 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 { forall a. CoinMap a -> Map a Coin
unCoinMap :: Map a Coin }
    deriving (CoinMap a -> CoinMap a -> Bool
(CoinMap a -> CoinMap a -> Bool)
-> (CoinMap a -> CoinMap a -> Bool) -> Eq (CoinMap a)
forall a. Eq a => CoinMap a -> CoinMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CoinMap a -> CoinMap a -> Bool
== :: CoinMap a -> CoinMap a -> Bool
$c/= :: forall a. Eq a => CoinMap a -> CoinMap a -> Bool
/= :: CoinMap a -> CoinMap a -> Bool
Eq, (forall x. CoinMap a -> Rep (CoinMap a) x)
-> (forall x. Rep (CoinMap a) x -> CoinMap a)
-> Generic (CoinMap a)
forall x. Rep (CoinMap a) x -> CoinMap a
forall x. CoinMap a -> Rep (CoinMap a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CoinMap a) x -> CoinMap a
forall a x. CoinMap a -> Rep (CoinMap a) x
$cfrom :: forall a x. CoinMap a -> Rep (CoinMap a) x
from :: forall x. CoinMap a -> Rep (CoinMap a) x
$cto :: forall a x. Rep (CoinMap a) x -> CoinMap a
to :: forall x. Rep (CoinMap a) x -> CoinMap a
Generic)
    deriving Int -> CoinMap a -> ShowS
[CoinMap a] -> ShowS
CoinMap a -> String
(Int -> CoinMap a -> ShowS)
-> (CoinMap a -> String)
-> ([CoinMap a] -> ShowS)
-> Show (CoinMap a)
forall a. Show a => Int -> CoinMap a -> ShowS
forall a. Show a => [CoinMap a] -> ShowS
forall a. Show a => CoinMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CoinMap a -> ShowS
showsPrec :: Int -> CoinMap a -> ShowS
$cshow :: forall a. Show a => CoinMap a -> String
show :: CoinMap a -> String
$cshowList :: forall a. Show a => [CoinMap a] -> ShowS
showList :: [CoinMap a] -> ShowS
Show via (Quiet (CoinMap a))

instance Foldable CoinMap where
    foldMap :: forall m a. Monoid m => (a -> m) -> CoinMap a -> m
foldMap a -> m
f = [m] -> m
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold ([m] -> m) -> (CoinMap a -> [m]) -> CoinMap a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoinMapEntry a -> m) -> [CoinMapEntry a] -> [m]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> m
f (a -> m) -> (CoinMapEntry a -> a) -> CoinMapEntry a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinMapEntry a -> a
forall a. CoinMapEntry a -> a
entryKey) ([CoinMapEntry a] -> [m])
-> (CoinMap a -> [CoinMapEntry a]) -> CoinMap a -> [m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinMap a -> [CoinMapEntry a]
forall a. CoinMap a -> [CoinMapEntry a]
coinMapToList

instance Ord a => Monoid (CoinMap a) where
    mempty :: CoinMap a
mempty = Map a Coin -> CoinMap a
forall a. Map a Coin -> CoinMap a
CoinMap Map a Coin
forall a. Monoid a => a
mempty

instance Ord a => Semigroup (CoinMap a) where
    CoinMap Map a Coin
a <> :: CoinMap a -> CoinMap a -> CoinMap a
<> CoinMap Map a Coin
b = Map a Coin -> CoinMap a
forall a. Map a Coin -> CoinMap a
CoinMap (Map a Coin -> CoinMap a) -> Map a Coin -> CoinMap a
forall a b. (a -> b) -> a -> b
$ (Coin -> Coin -> Coin) -> Map a Coin -> Map a Coin -> Map a Coin
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Map a Coin
a Map a Coin
b

-- | An entry for a 'CoinMap'.
--
-- @since 1.0.0
data CoinMapEntry a = CoinMapEntry
    { forall a. CoinMapEntry a -> a
entryKey
        :: a
        -- ^ The unique key associated with this entry.
    , forall a. CoinMapEntry a -> Coin
entryValue
        :: Coin
        -- ^ The coin value associated with this entry.
    } deriving (CoinMapEntry a -> CoinMapEntry a -> Bool
(CoinMapEntry a -> CoinMapEntry a -> Bool)
-> (CoinMapEntry a -> CoinMapEntry a -> Bool)
-> Eq (CoinMapEntry a)
forall a. Eq a => CoinMapEntry a -> CoinMapEntry a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CoinMapEntry a -> CoinMapEntry a -> Bool
== :: CoinMapEntry a -> CoinMapEntry a -> Bool
$c/= :: forall a. Eq a => CoinMapEntry a -> CoinMapEntry a -> Bool
/= :: CoinMapEntry a -> CoinMapEntry a -> Bool
Eq, (forall x. CoinMapEntry a -> Rep (CoinMapEntry a) x)
-> (forall x. Rep (CoinMapEntry a) x -> CoinMapEntry a)
-> Generic (CoinMapEntry a)
forall x. Rep (CoinMapEntry a) x -> CoinMapEntry a
forall x. CoinMapEntry a -> Rep (CoinMapEntry a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CoinMapEntry a) x -> CoinMapEntry a
forall a x. CoinMapEntry a -> Rep (CoinMapEntry a) x
$cfrom :: forall a x. CoinMapEntry a -> Rep (CoinMapEntry a) x
from :: forall x. CoinMapEntry a -> Rep (CoinMapEntry a) x
$cto :: forall a x. Rep (CoinMapEntry a) x -> CoinMapEntry a
to :: forall x. Rep (CoinMapEntry a) x -> CoinMapEntry a
Generic, Eq (CoinMapEntry a)
Eq (CoinMapEntry a) =>
(CoinMapEntry a -> CoinMapEntry a -> Ordering)
-> (CoinMapEntry a -> CoinMapEntry a -> Bool)
-> (CoinMapEntry a -> CoinMapEntry a -> Bool)
-> (CoinMapEntry a -> CoinMapEntry a -> Bool)
-> (CoinMapEntry a -> CoinMapEntry a -> Bool)
-> (CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a)
-> (CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a)
-> Ord (CoinMapEntry a)
CoinMapEntry a -> CoinMapEntry a -> Bool
CoinMapEntry a -> CoinMapEntry a -> Ordering
CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (CoinMapEntry a)
forall a. Ord a => CoinMapEntry a -> CoinMapEntry a -> Bool
forall a. Ord a => CoinMapEntry a -> CoinMapEntry a -> Ordering
forall a.
Ord a =>
CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a
$ccompare :: forall a. Ord a => CoinMapEntry a -> CoinMapEntry a -> Ordering
compare :: CoinMapEntry a -> CoinMapEntry a -> Ordering
$c< :: forall a. Ord a => CoinMapEntry a -> CoinMapEntry a -> Bool
< :: CoinMapEntry a -> CoinMapEntry a -> Bool
$c<= :: forall a. Ord a => CoinMapEntry a -> CoinMapEntry a -> Bool
<= :: CoinMapEntry a -> CoinMapEntry a -> Bool
$c> :: forall a. Ord a => CoinMapEntry a -> CoinMapEntry a -> Bool
> :: CoinMapEntry a -> CoinMapEntry a -> Bool
$c>= :: forall a. Ord a => CoinMapEntry a -> CoinMapEntry a -> Bool
>= :: CoinMapEntry a -> CoinMapEntry a -> Bool
$cmax :: forall a.
Ord a =>
CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a
max :: CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a
$cmin :: forall a.
Ord a =>
CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a
min :: CoinMapEntry a -> CoinMapEntry a -> CoinMapEntry a
Ord, Int -> CoinMapEntry a -> ShowS
[CoinMapEntry a] -> ShowS
CoinMapEntry a -> String
(Int -> CoinMapEntry a -> ShowS)
-> (CoinMapEntry a -> String)
-> ([CoinMapEntry a] -> ShowS)
-> Show (CoinMapEntry a)
forall a. Show a => Int -> CoinMapEntry a -> ShowS
forall a. Show a => [CoinMapEntry a] -> ShowS
forall a. Show a => CoinMapEntry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CoinMapEntry a -> ShowS
showsPrec :: Int -> CoinMapEntry a -> ShowS
$cshow :: forall a. Show a => CoinMapEntry a -> String
show :: CoinMapEntry a -> String
$cshowList :: forall a. Show a => [CoinMapEntry a] -> ShowS
showList :: [CoinMapEntry a] -> ShowS
Show)

-- | Constructs a 'CoinMap' from a list of entries.
--
-- See 'CoinMapEntry'.
--
-- @since 1.0.0
coinMapFromList :: Ord a => [CoinMapEntry a] -> CoinMap a
coinMapFromList :: forall a. Ord a => [CoinMapEntry a] -> CoinMap a
coinMapFromList = Map a Coin -> CoinMap a
forall a. Map a Coin -> CoinMap a
CoinMap
    (Map a Coin -> CoinMap a)
-> ([CoinMapEntry a] -> Map a Coin)
-> [CoinMapEntry a]
-> CoinMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Coin -> Coin) -> [(a, Coin)] -> Map a Coin
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>)
    ([(a, Coin)] -> Map a Coin)
-> ([CoinMapEntry a] -> [(a, Coin)])
-> [CoinMapEntry a]
-> Map a Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoinMapEntry a -> (a, Coin)) -> [CoinMapEntry a] -> [(a, Coin)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CoinMapEntry a -> a
forall a. CoinMapEntry a -> a
entryKey (CoinMapEntry a -> a)
-> (CoinMapEntry a -> Coin) -> CoinMapEntry a -> (a, Coin)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CoinMapEntry a -> Coin
forall a. CoinMapEntry a -> Coin
entryValue)

-- | Converts a 'CoinMap' to a list of entries.
--
-- See 'CoinMapEntry'.
--
-- @since 1.0.0
coinMapToList :: CoinMap a -> [CoinMapEntry a]
coinMapToList :: forall a. CoinMap a -> [CoinMapEntry a]
coinMapToList = ((a, Coin) -> CoinMapEntry a) -> [(a, Coin)] -> [CoinMapEntry a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Coin -> CoinMapEntry a) -> (a, Coin) -> CoinMapEntry a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Coin -> CoinMapEntry a
forall a. a -> Coin -> CoinMapEntry a
CoinMapEntry) ([(a, Coin)] -> [CoinMapEntry a])
-> (CoinMap a -> [(a, Coin)]) -> CoinMap a -> [CoinMapEntry a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Coin -> [(a, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a Coin -> [(a, Coin)])
-> (CoinMap a -> Map a Coin) -> CoinMap a -> [(a, Coin)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinMap a -> Map a Coin
forall a. CoinMap a -> Map a Coin
unCoinMap

-- | Calculates the total coin value associated with a 'CoinMap'.
--
-- @since 1.0.0
coinMapValue :: CoinMap a -> Coin
coinMapValue :: forall a. CoinMap a -> Coin
coinMapValue = [Coin] -> Coin
forall m. Monoid m => [m] -> m
mconcat ([Coin] -> Coin) -> (CoinMap a -> [Coin]) -> CoinMap a -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoinMapEntry a -> Coin) -> [CoinMapEntry a] -> [Coin]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CoinMapEntry a -> Coin
forall a. CoinMapEntry a -> Coin
entryValue ([CoinMapEntry a] -> [Coin])
-> (CoinMap a -> [CoinMapEntry a]) -> CoinMap a -> [Coin]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinMap a -> [CoinMapEntry a]
forall a. CoinMap a -> [CoinMapEntry a]
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
    { forall i o (m :: * -> *).
CoinSelectionAlgorithm i o m
-> CoinSelectionParameters i o
-> ExceptT CoinSelectionError m (CoinSelectionResult i o)
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
    { forall i o. CoinSelectionParameters i o -> CoinMap i
inputsAvailable :: CoinMap i
        -- ^ The set of inputs available for selection.
    , forall i o. CoinSelectionParameters i o -> CoinMap o
outputsRequested :: CoinMap o
        -- ^ The set of outputs requested for payment.
    , forall i o. CoinSelectionParameters i o -> CoinSelectionLimit
limit :: CoinSelectionLimit
        -- ^ A limit on the number of inputs that can be selected.
    }
    deriving (forall x.
 CoinSelectionParameters i o -> Rep (CoinSelectionParameters i o) x)
-> (forall x.
    Rep (CoinSelectionParameters i o) x -> CoinSelectionParameters i o)
-> Generic (CoinSelectionParameters i o)
forall x.
Rep (CoinSelectionParameters i o) x -> CoinSelectionParameters i o
forall x.
CoinSelectionParameters i o -> Rep (CoinSelectionParameters i o) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i o x.
Rep (CoinSelectionParameters i o) x -> CoinSelectionParameters i o
forall i o x.
CoinSelectionParameters i o -> Rep (CoinSelectionParameters i o) x
$cfrom :: forall i o x.
CoinSelectionParameters i o -> Rep (CoinSelectionParameters i o) x
from :: forall x.
CoinSelectionParameters i o -> Rep (CoinSelectionParameters i o) x
$cto :: forall i o x.
Rep (CoinSelectionParameters i o) x -> CoinSelectionParameters i o
to :: forall x.
Rep (CoinSelectionParameters i o) x -> CoinSelectionParameters i o
Generic

-- | Represents the __result__ of running a coin selection algorithm.
--
-- See 'CoinSelectionAlgorithm'.
--
-- @since 1.0.0
data CoinSelectionResult i o = CoinSelectionResult
    { forall i o. CoinSelectionResult i o -> CoinSelection i o
coinSelection :: CoinSelection i o
        -- ^ The generated coin selection.
    , forall i o. CoinSelectionResult i o -> CoinMap i
inputsRemaining :: CoinMap i
        -- ^ The set of inputs that were __not__ selected.
    } deriving (CoinSelectionResult i o -> CoinSelectionResult i o -> Bool
(CoinSelectionResult i o -> CoinSelectionResult i o -> Bool)
-> (CoinSelectionResult i o -> CoinSelectionResult i o -> Bool)
-> Eq (CoinSelectionResult i o)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i o.
(Eq i, Eq o) =>
CoinSelectionResult i o -> CoinSelectionResult i o -> Bool
$c== :: forall i o.
(Eq i, Eq o) =>
CoinSelectionResult i o -> CoinSelectionResult i o -> Bool
== :: CoinSelectionResult i o -> CoinSelectionResult i o -> Bool
$c/= :: forall i o.
(Eq i, Eq o) =>
CoinSelectionResult i o -> CoinSelectionResult i o -> Bool
/= :: CoinSelectionResult i o -> CoinSelectionResult i o -> Bool
Eq, Int -> CoinSelectionResult i o -> ShowS
[CoinSelectionResult i o] -> ShowS
CoinSelectionResult i o -> String
(Int -> CoinSelectionResult i o -> ShowS)
-> (CoinSelectionResult i o -> String)
-> ([CoinSelectionResult i o] -> ShowS)
-> Show (CoinSelectionResult i o)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i o.
(Show i, Show o) =>
Int -> CoinSelectionResult i o -> ShowS
forall i o. (Show i, Show o) => [CoinSelectionResult i o] -> ShowS
forall i o. (Show i, Show o) => CoinSelectionResult i o -> String
$cshowsPrec :: forall i o.
(Show i, Show o) =>
Int -> CoinSelectionResult i o -> ShowS
showsPrec :: Int -> CoinSelectionResult i o -> ShowS
$cshow :: forall i o. (Show i, Show o) => CoinSelectionResult i o -> String
show :: CoinSelectionResult i o -> String
$cshowList :: forall i o. (Show i, Show o) => [CoinSelectionResult i o] -> ShowS
showList :: [CoinSelectionResult i o] -> ShowS
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
    { forall i o. CoinSelection i o -> CoinMap i
inputs :: CoinMap i
      -- ^ The set of inputs.
    , forall i o. CoinSelection i o -> CoinMap o
outputs :: CoinMap o
      -- ^ The set of outputs.
    , forall i o. CoinSelection i o -> [Coin]
change :: [Coin]
      -- ^ The set of change.
    }
    deriving ((forall x. CoinSelection i o -> Rep (CoinSelection i o) x)
-> (forall x. Rep (CoinSelection i o) x -> CoinSelection i o)
-> Generic (CoinSelection i o)
forall x. Rep (CoinSelection i o) x -> CoinSelection i o
forall x. CoinSelection i o -> Rep (CoinSelection i o) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i o x. Rep (CoinSelection i o) x -> CoinSelection i o
forall i o x. CoinSelection i o -> Rep (CoinSelection i o) x
$cfrom :: forall i o x. CoinSelection i o -> Rep (CoinSelection i o) x
from :: forall x. CoinSelection i o -> Rep (CoinSelection i o) x
$cto :: forall i o x. Rep (CoinSelection i o) x -> CoinSelection i o
to :: forall x. Rep (CoinSelection i o) x -> CoinSelection i o
Generic, Int -> CoinSelection i o -> ShowS
[CoinSelection i o] -> ShowS
CoinSelection i o -> String
(Int -> CoinSelection i o -> ShowS)
-> (CoinSelection i o -> String)
-> ([CoinSelection i o] -> ShowS)
-> Show (CoinSelection i o)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i o. (Show i, Show o) => Int -> CoinSelection i o -> ShowS
forall i o. (Show i, Show o) => [CoinSelection i o] -> ShowS
forall i o. (Show i, Show o) => CoinSelection i o -> String
$cshowsPrec :: forall i o. (Show i, Show o) => Int -> CoinSelection i o -> ShowS
showsPrec :: Int -> CoinSelection i o -> ShowS
$cshow :: forall i o. (Show i, Show o) => CoinSelection i o -> String
show :: CoinSelection i o -> String
$cshowList :: forall i o. (Show i, Show o) => [CoinSelection i o] -> ShowS
showList :: [CoinSelection i o] -> ShowS
Show, CoinSelection i o -> CoinSelection i o -> Bool
(CoinSelection i o -> CoinSelection i o -> Bool)
-> (CoinSelection i o -> CoinSelection i o -> Bool)
-> Eq (CoinSelection i o)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i o.
(Eq i, Eq o) =>
CoinSelection i o -> CoinSelection i o -> Bool
$c== :: forall i o.
(Eq i, Eq o) =>
CoinSelection i o -> CoinSelection i o -> Bool
== :: CoinSelection i o -> CoinSelection i o -> Bool
$c/= :: forall i o.
(Eq i, Eq o) =>
CoinSelection i o -> CoinSelection i o -> Bool
/= :: CoinSelection i o -> CoinSelection i o -> Bool
Eq)

instance (Ord i, Ord o) => Semigroup (CoinSelection i o) where
    CoinSelection i o
a <> :: CoinSelection i o -> CoinSelection i o -> CoinSelection i o
<> CoinSelection i o
b = CoinSelection
        { inputs :: CoinMap i
inputs = CoinSelection i o -> CoinMap i
forall i o. CoinSelection i o -> CoinMap i
inputs CoinSelection i o
a CoinMap i -> CoinMap i -> CoinMap i
forall a. Semigroup a => a -> a -> a
<> CoinSelection i o -> CoinMap i
forall i o. CoinSelection i o -> CoinMap i
inputs CoinSelection i o
b
        , outputs :: CoinMap o
outputs = CoinSelection i o -> CoinMap o
forall i o. CoinSelection i o -> CoinMap o
outputs CoinSelection i o
a CoinMap o -> CoinMap o -> CoinMap o
forall a. Semigroup a => a -> a -> a
<> CoinSelection i o -> CoinMap o
forall i o. CoinSelection i o -> CoinMap o
outputs CoinSelection i o
b
        , change :: [Coin]
change = CoinSelection i o -> [Coin]
forall i o. CoinSelection i o -> [Coin]
change CoinSelection i o
a [Coin] -> [Coin] -> [Coin]
forall a. Semigroup a => a -> a -> a
<> CoinSelection i o -> [Coin]
forall i o. CoinSelection i o -> [Coin]
change CoinSelection i o
b
        }

instance (Ord i, Ord o) => Monoid (CoinSelection i o) where
    mempty :: CoinSelection i o
mempty = CoinMap i -> CoinMap o -> [Coin] -> CoinSelection i o
forall i o. CoinMap i -> CoinMap o -> [Coin] -> CoinSelection i o
CoinSelection CoinMap i
forall a. Monoid a => a
mempty CoinMap o
forall a. Monoid a => a
mempty [Coin]
forall a. Monoid a => a
mempty

-- | Calculate the total sum of all 'inputs' for the given 'CoinSelection'.
--
-- @since 1.0.0
sumInputs :: CoinSelection i o -> Coin
sumInputs :: forall i o. CoinSelection i o -> Coin
sumInputs = CoinMap i -> Coin
forall a. CoinMap a -> Coin
coinMapValue (CoinMap i -> Coin)
-> (CoinSelection i o -> CoinMap i) -> CoinSelection i o -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinSelection i o -> CoinMap i
forall i o. CoinSelection i o -> CoinMap i
inputs

-- | Calculate the total sum of all 'outputs' for the given 'CoinSelection'.
--
-- @since 1.0.0
sumOutputs :: CoinSelection i o -> Coin
sumOutputs :: forall i o. CoinSelection i o -> Coin
sumOutputs =  CoinMap o -> Coin
forall a. CoinMap a -> Coin
coinMapValue (CoinMap o -> Coin)
-> (CoinSelection i o -> CoinMap o) -> CoinSelection i o -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinSelection i o -> CoinMap o
forall i o. CoinSelection i o -> CoinMap o
outputs

-- | Calculate the total sum of all 'change' for the given 'CoinSelection'.
--
-- @since 1.0.0
sumChange :: CoinSelection i o -> Coin
sumChange :: forall i o. CoinSelection i o -> Coin
sumChange = [Coin] -> Coin
forall m. Monoid m => [m] -> m
mconcat ([Coin] -> Coin)
-> (CoinSelection i o -> [Coin]) -> CoinSelection i o -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinSelection i o -> [Coin]
forall i o. CoinSelection i o -> [Coin]
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
    { CoinSelectionLimit -> Word16 -> Word16
calculateLimit
        :: Word16 -> Word16
            -- ^ Calculate the maximum number of inputs allowed for a given
            -- number of outputs.
    } deriving (forall x. CoinSelectionLimit -> Rep CoinSelectionLimit x)
-> (forall x. Rep CoinSelectionLimit x -> CoinSelectionLimit)
-> Generic CoinSelectionLimit
forall x. Rep CoinSelectionLimit x -> CoinSelectionLimit
forall x. CoinSelectionLimit -> Rep CoinSelectionLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CoinSelectionLimit -> Rep CoinSelectionLimit x
from :: forall x. CoinSelectionLimit -> Rep CoinSelectionLimit x
$cto :: forall x. Rep CoinSelectionLimit x -> CoinSelectionLimit
to :: forall x. Rep CoinSelectionLimit x -> CoinSelectionLimit
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 (CoinSelectionError -> CoinSelectionError -> Bool
(CoinSelectionError -> CoinSelectionError -> Bool)
-> (CoinSelectionError -> CoinSelectionError -> Bool)
-> Eq CoinSelectionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CoinSelectionError -> CoinSelectionError -> Bool
== :: CoinSelectionError -> CoinSelectionError -> Bool
$c/= :: CoinSelectionError -> CoinSelectionError -> Bool
/= :: CoinSelectionError -> CoinSelectionError -> Bool
Eq, Int -> CoinSelectionError -> ShowS
[CoinSelectionError] -> ShowS
CoinSelectionError -> String
(Int -> CoinSelectionError -> ShowS)
-> (CoinSelectionError -> String)
-> ([CoinSelectionError] -> ShowS)
-> Show CoinSelectionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CoinSelectionError -> ShowS
showsPrec :: Int -> CoinSelectionError -> ShowS
$cshow :: CoinSelectionError -> String
show :: CoinSelectionError -> String
$cshowList :: [CoinSelectionError] -> ShowS
showList :: [CoinSelectionError] -> ShowS
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
    { InputValueInsufficientError -> Coin
inputValueAvailable :: Coin
        -- ^ The total value of 'inputsAvailable'.
    , InputValueInsufficientError -> Coin
inputValueRequired :: Coin
        -- ^ The total value of 'outputsRequested'.
    }
    deriving (InputValueInsufficientError -> InputValueInsufficientError -> Bool
(InputValueInsufficientError
 -> InputValueInsufficientError -> Bool)
-> (InputValueInsufficientError
    -> InputValueInsufficientError -> Bool)
-> Eq InputValueInsufficientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputValueInsufficientError -> InputValueInsufficientError -> Bool
== :: InputValueInsufficientError -> InputValueInsufficientError -> Bool
$c/= :: InputValueInsufficientError -> InputValueInsufficientError -> Bool
/= :: InputValueInsufficientError -> InputValueInsufficientError -> Bool
Eq, Int -> InputValueInsufficientError -> ShowS
[InputValueInsufficientError] -> ShowS
InputValueInsufficientError -> String
(Int -> InputValueInsufficientError -> ShowS)
-> (InputValueInsufficientError -> String)
-> ([InputValueInsufficientError] -> ShowS)
-> Show InputValueInsufficientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputValueInsufficientError -> ShowS
showsPrec :: Int -> InputValueInsufficientError -> ShowS
$cshow :: InputValueInsufficientError -> String
show :: InputValueInsufficientError -> String
$cshowList :: [InputValueInsufficientError] -> ShowS
showList :: [InputValueInsufficientError] -> ShowS
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
    { InputCountInsufficientError -> Natural
inputCountAvailable :: Natural
        -- ^ The number of entries in 'inputsAvailable'.
    , InputCountInsufficientError -> Natural
inputCountRequired :: Natural
        -- ^ The number of entries required.
    }
    deriving (InputCountInsufficientError -> InputCountInsufficientError -> Bool
(InputCountInsufficientError
 -> InputCountInsufficientError -> Bool)
-> (InputCountInsufficientError
    -> InputCountInsufficientError -> Bool)
-> Eq InputCountInsufficientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputCountInsufficientError -> InputCountInsufficientError -> Bool
== :: InputCountInsufficientError -> InputCountInsufficientError -> Bool
$c/= :: InputCountInsufficientError -> InputCountInsufficientError -> Bool
/= :: InputCountInsufficientError -> InputCountInsufficientError -> Bool
Eq, Int -> InputCountInsufficientError -> ShowS
[InputCountInsufficientError] -> ShowS
InputCountInsufficientError -> String
(Int -> InputCountInsufficientError -> ShowS)
-> (InputCountInsufficientError -> String)
-> ([InputCountInsufficientError] -> ShowS)
-> Show InputCountInsufficientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputCountInsufficientError -> ShowS
showsPrec :: Int -> InputCountInsufficientError -> ShowS
$cshow :: InputCountInsufficientError -> String
show :: InputCountInsufficientError -> String
$cshowList :: [InputCountInsufficientError] -> ShowS
showList :: [InputCountInsufficientError] -> ShowS
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 (InputsExhaustedError -> InputsExhaustedError -> Bool
(InputsExhaustedError -> InputsExhaustedError -> Bool)
-> (InputsExhaustedError -> InputsExhaustedError -> Bool)
-> Eq InputsExhaustedError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputsExhaustedError -> InputsExhaustedError -> Bool
== :: InputsExhaustedError -> InputsExhaustedError -> Bool
$c/= :: InputsExhaustedError -> InputsExhaustedError -> Bool
/= :: InputsExhaustedError -> InputsExhaustedError -> Bool
Eq, Int -> InputsExhaustedError -> ShowS
[InputsExhaustedError] -> ShowS
InputsExhaustedError -> String
(Int -> InputsExhaustedError -> ShowS)
-> (InputsExhaustedError -> String)
-> ([InputsExhaustedError] -> ShowS)
-> Show InputsExhaustedError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputsExhaustedError -> ShowS
showsPrec :: Int -> InputsExhaustedError -> ShowS
$cshow :: InputsExhaustedError -> String
show :: InputsExhaustedError -> String
$cshowList :: [InputsExhaustedError] -> ShowS
showList :: [InputsExhaustedError] -> ShowS
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
    { InputLimitExceededError -> Word16
calculatedInputLimit :: Word16 }
    deriving (InputLimitExceededError -> InputLimitExceededError -> Bool
(InputLimitExceededError -> InputLimitExceededError -> Bool)
-> (InputLimitExceededError -> InputLimitExceededError -> Bool)
-> Eq InputLimitExceededError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputLimitExceededError -> InputLimitExceededError -> Bool
== :: InputLimitExceededError -> InputLimitExceededError -> Bool
$c/= :: InputLimitExceededError -> InputLimitExceededError -> Bool
/= :: InputLimitExceededError -> InputLimitExceededError -> Bool
Eq, Int -> InputLimitExceededError -> ShowS
[InputLimitExceededError] -> ShowS
InputLimitExceededError -> String
(Int -> InputLimitExceededError -> ShowS)
-> (InputLimitExceededError -> String)
-> ([InputLimitExceededError] -> ShowS)
-> Show InputLimitExceededError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputLimitExceededError -> ShowS
showsPrec :: Int -> InputLimitExceededError -> ShowS
$cshow :: InputLimitExceededError -> String
show :: InputLimitExceededError -> String
$cshowList :: [InputLimitExceededError] -> ShowS
showList :: [InputLimitExceededError] -> ShowS
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 :: forall (m :: * -> *) a.
MonadRandom m =>
CoinMap a -> m (Maybe (CoinMapEntry a, CoinMap a))
coinMapRandomEntry (CoinMap Map a Coin
m)
    | Map a Coin -> Bool
forall k a. Map k a -> Bool
Map.null Map a Coin
m =
        Maybe (CoinMapEntry a, CoinMap a)
-> m (Maybe (CoinMapEntry a, CoinMap a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CoinMapEntry a, CoinMap a)
forall a. Maybe a
Nothing
    | Bool
otherwise = (CoinMapEntry a, CoinMap a) -> Maybe (CoinMapEntry a, CoinMap a)
forall a. a -> Maybe a
Just ((CoinMapEntry a, CoinMap a) -> Maybe (CoinMapEntry a, CoinMap a))
-> m (CoinMapEntry a, CoinMap a)
-> m (Maybe (CoinMapEntry a, CoinMap a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Int
ix <- Integer -> Int
forall a. Enum a => a -> Int
fromEnum (Integer -> Int) -> m Integer -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
generateBetween Integer
0 (Int -> Integer
forall a. Enum a => Int -> a
toEnum (Map a Coin -> Int
forall k a. Map k a -> Int
Map.size Map a Coin
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        let entry :: CoinMapEntry a
entry = (a -> Coin -> CoinMapEntry a) -> (a, Coin) -> CoinMapEntry a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Coin -> CoinMapEntry a
forall a. a -> Coin -> CoinMapEntry a
CoinMapEntry ((a, Coin) -> CoinMapEntry a) -> (a, Coin) -> CoinMapEntry a
forall a b. (a -> b) -> a -> b
$ Int -> Map a Coin -> (a, Coin)
forall k a. Int -> Map k a -> (k, a)
Map.elemAt Int
ix Map a Coin
m
        let remainder :: CoinMap a
remainder = Map a Coin -> CoinMap a
forall a. Map a Coin -> CoinMap a
CoinMap (Map a Coin -> CoinMap a) -> Map a Coin -> CoinMap a
forall a b. (a -> b) -> a -> b
$ Int -> Map a Coin -> Map a Coin
forall k a. Int -> Map k a -> Map k a
Map.deleteAt Int
ix Map a Coin
m
        (CoinMapEntry a, CoinMap a) -> m (CoinMapEntry a, CoinMap a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoinMapEntry a
entry, CoinMap a
remainder)