{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- Provides an algorithm for producing a balanced coin selection with change,
-- where the fee is paid for.
--
-- This module uses the Random-Round-Robin coin selection algorithm for
-- multi-asset UTxO sets.
--
-- See documentation for the 'performSelection' function for more details on
-- how to perform a selection.
--
module Cardano.Wallet.CoinSelection.Internal.Balance
    (
    -- * Performing a selection
      PerformSelection
    , performSelection
    , performSelectionEmpty
    , SelectionConstraints (..)
    , SelectionParams
    , SelectionParamsOf (..)
    , SelectionSkeleton (..)
    , SelectionResult
    , SelectionResultOf (..)
    , SelectionStrategy (..)
    , SelectionBalanceError (..)
    , BalanceInsufficientError (..)
    , UnableToConstructChangeError (..)

    -- * Selection limits
    , SelectionLimit
    , SelectionLimitOf (..)
    , selectionLimitExceeded
    , SelectionLimitReachedError (..)
    , reduceSelectionLimitBy

    -- * Querying selections
    , SelectionDelta (..)
    , selectionDeltaAllAssets
    , selectionDeltaCoin
    , selectionHasValidSurplus
    , selectionSurplusCoin
    , selectionMinimumCost
    , selectionMaximumCost
    , selectionSkeleton

    -- * Querying parameters
    , UTxOBalanceSufficiency (..)
    , UTxOBalanceSufficiencyInfo (..)
    , computeBalanceInOut
    , computeDeficitInOut
    , computeUTxOBalanceAvailable
    , computeUTxOBalanceRequired
    , computeUTxOBalanceSufficiency
    , computeUTxOBalanceSufficiencyInfo
    , isUTxOBalanceSufficient

    -- * Running a selection (without making change)
    , runSelection
    , runSelectionNonEmpty
    , runSelectionNonEmptyWith
    , RunSelectionParams (..)

    -- * Running a selection step
    , runSelectionStep
    , SelectionLens (..)
    , assetSelectionLens
    , coinSelectionLens

    -- * Making change
    , MakeChangeCriteria (..)
    , makeChange
    , makeChangeForCoin
    , makeChangeForUserSpecifiedAsset
    , makeChangeForNonUserSpecifiedAsset
    , makeChangeForNonUserSpecifiedAssets
    , assignCoinsToChangeMaps
    , collateNonUserSpecifiedAssetQuantities
    , addMintValueToChangeMaps
    , addMintValuesToChangeMaps
    , removeBurnValueFromChangeMaps
    , removeBurnValuesFromChangeMaps
    , reduceTokenQuantities

    -- * Splitting bundles
    , splitBundleIfAssetCountExcessive
    , splitBundlesWithExcessiveAssetCounts
    , splitBundlesWithExcessiveTokenQuantities

    -- * Grouping and ungrouping
    , groupByKey
    , ungroupByKey

    -- * Round-robin processing
    , runRoundRobin
    , runRoundRobinM

    -- * Utility classes
    , AssetCount (..)

    -- * Utility functions
    , distance
    , mapMaybe
    , balanceMissing
    ) where

import Prelude

import Algebra.PartialOrd
    ( PartialOrd (..) )
import Cardano.Numeric.Util
    ( padCoalesce )
import Cardano.Wallet.CoinSelection.Internal.Context
    ( SelectionContext (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
    ( TokenBundle (..) )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId, Lexicographic (..), TokenMap )
import Cardano.Wallet.Primitive.Types.TokenQuantity
    ( TokenQuantity (..) )
import Cardano.Wallet.Primitive.Types.Tx
    ( TokenBundleSizeAssessment (..), TokenBundleSizeAssessor (..) )
import Cardano.Wallet.Primitive.Types.UTxOIndex
    ( Asset (..), SelectionFilter (..), UTxOIndex (..) )
import Cardano.Wallet.Primitive.Types.UTxOSelection
    ( IsUTxOSelection, UTxOSelection, UTxOSelectionNonEmpty )
import Control.Monad.Extra
    ( andM )
import Control.Monad.Random.Class
    ( MonadRandom (..) )
import Data.Bifunctor
    ( first )
import Data.Either.Extra
    ( maybeToEither )
import Data.Function
    ( (&) )
import Data.Functor.Identity
    ( Identity (..) )
import Data.Generics.Internal.VL.Lens
    ( view )
import Data.Generics.Labels
    ()
import Data.IntCast
    ( intCast )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( fromMaybe )
import Data.Ord
    ( comparing )
import Data.Semigroup
    ( mtimesDefault )
import Data.Set
    ( Set )
import Fmt
    ( Buildable (..), Builder, blockMapF )
import GHC.Generics
    ( Generic )
import GHC.Stack
    ( HasCallStack )
import Numeric.Natural
    ( Natural )

import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Cardano.Wallet.Primitive.Types.TokenQuantity as TokenQuantity
import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex
import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

--------------------------------------------------------------------------------
-- Performing a selection
--------------------------------------------------------------------------------

-- | Specifies all constraints required for coin selection.
--
-- Selection constraints:
--
--    - place limits on the coin selection algorithm, enabling it to produce
--      selections that are acceptable to the ledger.
--
--    - are dependent on the current set of protocol parameters.
--
--    - are not specific to a given selection.
--
data SelectionConstraints ctx = SelectionConstraints
    { SelectionConstraints ctx
-> TokenBundle -> TokenBundleSizeAssessment
assessTokenBundleSize
        :: TokenBundle -> TokenBundleSizeAssessment
        -- ^ Assesses the size of a token bundle relative to the upper limit of
        -- what can be included in a transaction output. See documentation for
        -- the 'TokenBundleSizeAssessor' type to learn about the expected
        -- properties of this field.
    , SelectionConstraints ctx -> Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity
        :: Address ctx -> TokenMap -> Coin
        -- ^ Computes the minimum ada quantity required for a given output.
    , SelectionConstraints ctx -> SelectionSkeleton ctx -> Coin
computeMinimumCost
        :: SelectionSkeleton ctx -> Coin
        -- ^ Computes the minimum cost of a given selection skeleton.
    , SelectionConstraints ctx
-> [(Address ctx, TokenBundle)] -> SelectionLimit
computeSelectionLimit
        :: [(Address ctx, TokenBundle)] -> SelectionLimit
        -- ^ Computes an upper bound for the number of ordinary inputs to
        -- select, given a current set of outputs.
    , SelectionConstraints ctx -> Address ctx
maximumLengthChangeAddress
        :: Address ctx
    , SelectionConstraints ctx -> Coin
maximumOutputAdaQuantity
        :: Coin
        -- ^ Specifies the largest ada quantity that can appear in the token
        -- bundle of an output.
    , SelectionConstraints ctx -> TokenQuantity
maximumOutputTokenQuantity
        :: TokenQuantity
        -- ^ Specifies the largest non-ada quantity that can appear in the
        -- token bundle of an output.
    , SelectionConstraints ctx -> Address ctx
nullAddress
        :: Address ctx
    }
    deriving (forall x.
 SelectionConstraints ctx -> Rep (SelectionConstraints ctx) x)
-> (forall x.
    Rep (SelectionConstraints ctx) x -> SelectionConstraints ctx)
-> Generic (SelectionConstraints ctx)
forall x.
Rep (SelectionConstraints ctx) x -> SelectionConstraints ctx
forall x.
SelectionConstraints ctx -> Rep (SelectionConstraints ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionConstraints ctx) x -> SelectionConstraints ctx
forall ctx x.
SelectionConstraints ctx -> Rep (SelectionConstraints ctx) x
$cto :: forall ctx x.
Rep (SelectionConstraints ctx) x -> SelectionConstraints ctx
$cfrom :: forall ctx x.
SelectionConstraints ctx -> Rep (SelectionConstraints ctx) x
Generic

type SelectionParams = SelectionParamsOf []

-- | Specifies all parameters that are specific to a given selection.
--
data SelectionParamsOf f ctx = SelectionParams
    { SelectionParamsOf f ctx -> f (Address ctx, TokenBundle)
outputsToCover
        :: !(f (Address ctx, TokenBundle))
        -- ^ The complete set of outputs to be covered.
    , SelectionParamsOf f ctx -> UTxOSelection (UTxO ctx)
utxoAvailable
        :: !(UTxOSelection (UTxO ctx))
        -- ^ Specifies a set of UTxOs that are available for selection as
        -- inputs and optionally, a subset that has already been selected.
        --
        -- Further entries from this set will be selected to cover any deficit.
    , SelectionParamsOf f ctx -> Coin
extraCoinSource
        :: !Coin
        -- ^ An extra source of ada.
    , SelectionParamsOf f ctx -> Coin
extraCoinSink
        :: !Coin
        -- ^ An extra sink for ada.
    , SelectionParamsOf f ctx -> TokenMap
assetsToMint
        :: !TokenMap
        -- ^ Assets to mint: these provide input value to a transaction.
        --
        -- By minting tokens, we generally decrease the burden of the selection
        -- algorithm, allowing it to select fewer UTxO entries in order to
        -- cover the required outputs.
    , SelectionParamsOf f ctx -> TokenMap
assetsToBurn
        :: !TokenMap
        -- ^ Assets to burn: these consume output value from a transaction.
        --
        -- By burning tokens, we generally increase the burden of the selection
        -- algorithm, requiring it to select more UTxO entries in order to
        -- cover the burn.
    , SelectionParamsOf f ctx -> SelectionStrategy
selectionStrategy
        :: SelectionStrategy
        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
    }
    deriving (forall x.
 SelectionParamsOf f ctx -> Rep (SelectionParamsOf f ctx) x)
-> (forall x.
    Rep (SelectionParamsOf f ctx) x -> SelectionParamsOf f ctx)
-> Generic (SelectionParamsOf f ctx)
forall x.
Rep (SelectionParamsOf f ctx) x -> SelectionParamsOf f ctx
forall x.
SelectionParamsOf f ctx -> Rep (SelectionParamsOf f ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) ctx x.
Rep (SelectionParamsOf f ctx) x -> SelectionParamsOf f ctx
forall (f :: * -> *) ctx x.
SelectionParamsOf f ctx -> Rep (SelectionParamsOf f ctx) x
$cto :: forall (f :: * -> *) ctx x.
Rep (SelectionParamsOf f ctx) x -> SelectionParamsOf f ctx
$cfrom :: forall (f :: * -> *) ctx x.
SelectionParamsOf f ctx -> Rep (SelectionParamsOf f ctx) x
Generic

deriving instance
    (Eq (f (Address ctx, TokenBundle)), Eq (UTxO ctx)) =>
        Eq (SelectionParamsOf f ctx)

deriving instance
    (Show (f (Address ctx, TokenBundle)), Show (UTxO ctx)) =>
        Show (SelectionParamsOf f ctx)

-- | Indicates a choice of selection strategy.
--
-- A 'SelectionStrategy' determines __how much__ of each asset the selection
-- algorithm will attempt to select from the available UTxO set, relative to
-- the minimum amount necessary to make the selection balance.
--
-- The default 'SelectionStrategy' is 'SelectionStrategyOptimal', which when
-- specified will cause the selection algorithm to attempt to select around
-- __/twice/__ the minimum possible amount of each asset from the available
-- UTxO set, making it possible to generate change outputs that are roughly
-- the same sizes and shapes as the user-specified outputs.
--
-- Specifying 'SelectionStrategyMinimal' will cause the selection algorithm to
-- only select __just enough__ of each asset from the available UTxO set to
-- meet the minimum amount. The selection process will terminate as soon as
-- the minimum amount of each asset is covered.
--
-- The "optimal" strategy is recommended for most situations, as using this
-- strategy will help to ensure that a wallet's UTxO distribution can evolve
-- over time to resemble the typical distribution of payments made by the
-- wallet owner.  This increases the likelihood that future selections will
-- succeed, and lowers the amortized cost of future transactions.
--
-- The "minimal" strategy is recommended only for situations where it is not
-- possible to create a selection with the "optimal" strategy. It is advised to
-- use this strategy only when necessary, as it increases the likelihood of
-- generating change outputs that are much smaller than user-specified outputs.
-- If this strategy is used regularly, the UTxO set can evolve to a state where
-- the distribution no longer resembles the typical distribution of payments
-- made by the user. This increases the likelihood that future selections will
-- not succeed, and increases the amortized cost of future transactions.
--
data SelectionStrategy
    = SelectionStrategyMinimal
    | SelectionStrategyOptimal
    deriving (SelectionStrategy
SelectionStrategy -> SelectionStrategy -> Bounded SelectionStrategy
forall a. a -> a -> Bounded a
maxBound :: SelectionStrategy
$cmaxBound :: SelectionStrategy
minBound :: SelectionStrategy
$cminBound :: SelectionStrategy
Bounded, Int -> SelectionStrategy
SelectionStrategy -> Int
SelectionStrategy -> [SelectionStrategy]
SelectionStrategy -> SelectionStrategy
SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
SelectionStrategy
-> SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
(SelectionStrategy -> SelectionStrategy)
-> (SelectionStrategy -> SelectionStrategy)
-> (Int -> SelectionStrategy)
-> (SelectionStrategy -> Int)
-> (SelectionStrategy -> [SelectionStrategy])
-> (SelectionStrategy -> SelectionStrategy -> [SelectionStrategy])
-> (SelectionStrategy -> SelectionStrategy -> [SelectionStrategy])
-> (SelectionStrategy
    -> SelectionStrategy -> SelectionStrategy -> [SelectionStrategy])
-> Enum SelectionStrategy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SelectionStrategy
-> SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
$cenumFromThenTo :: SelectionStrategy
-> SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
enumFromTo :: SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
$cenumFromTo :: SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
enumFromThen :: SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
$cenumFromThen :: SelectionStrategy -> SelectionStrategy -> [SelectionStrategy]
enumFrom :: SelectionStrategy -> [SelectionStrategy]
$cenumFrom :: SelectionStrategy -> [SelectionStrategy]
fromEnum :: SelectionStrategy -> Int
$cfromEnum :: SelectionStrategy -> Int
toEnum :: Int -> SelectionStrategy
$ctoEnum :: Int -> SelectionStrategy
pred :: SelectionStrategy -> SelectionStrategy
$cpred :: SelectionStrategy -> SelectionStrategy
succ :: SelectionStrategy -> SelectionStrategy
$csucc :: SelectionStrategy -> SelectionStrategy
Enum, SelectionStrategy -> SelectionStrategy -> Bool
(SelectionStrategy -> SelectionStrategy -> Bool)
-> (SelectionStrategy -> SelectionStrategy -> Bool)
-> Eq SelectionStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionStrategy -> SelectionStrategy -> Bool
$c/= :: SelectionStrategy -> SelectionStrategy -> Bool
== :: SelectionStrategy -> SelectionStrategy -> Bool
$c== :: SelectionStrategy -> SelectionStrategy -> Bool
Eq, Int -> SelectionStrategy -> ShowS
[SelectionStrategy] -> ShowS
SelectionStrategy -> String
(Int -> SelectionStrategy -> ShowS)
-> (SelectionStrategy -> String)
-> ([SelectionStrategy] -> ShowS)
-> Show SelectionStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionStrategy] -> ShowS
$cshowList :: [SelectionStrategy] -> ShowS
show :: SelectionStrategy -> String
$cshow :: SelectionStrategy -> String
showsPrec :: Int -> SelectionStrategy -> ShowS
$cshowsPrec :: Int -> SelectionStrategy -> ShowS
Show)

-- | Indicates whether the balance of available UTxO entries is sufficient.
--
-- See 'computeUTxOBalanceSufficiency'.
--
data UTxOBalanceSufficiency
    = UTxOBalanceSufficient
      -- ^ Indicates that the UTxO balance is sufficient.
    | UTxOBalanceInsufficient
      -- ^ Indicates that the UTxO balance is insufficient.
    deriving (UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool
(UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool)
-> (UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool)
-> Eq UTxOBalanceSufficiency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool
$c/= :: UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool
== :: UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool
$c== :: UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool
Eq, Int -> UTxOBalanceSufficiency -> ShowS
[UTxOBalanceSufficiency] -> ShowS
UTxOBalanceSufficiency -> String
(Int -> UTxOBalanceSufficiency -> ShowS)
-> (UTxOBalanceSufficiency -> String)
-> ([UTxOBalanceSufficiency] -> ShowS)
-> Show UTxOBalanceSufficiency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOBalanceSufficiency] -> ShowS
$cshowList :: [UTxOBalanceSufficiency] -> ShowS
show :: UTxOBalanceSufficiency -> String
$cshow :: UTxOBalanceSufficiency -> String
showsPrec :: Int -> UTxOBalanceSufficiency -> ShowS
$cshowsPrec :: Int -> UTxOBalanceSufficiency -> ShowS
Show)

-- | Gives more information about UTxO balance sufficiency.
--
-- See 'computeUTxOBalanceSufficiencyInfo'.
--
data UTxOBalanceSufficiencyInfo = UTxOBalanceSufficiencyInfo
    { UTxOBalanceSufficiencyInfo -> TokenBundle
available :: TokenBundle
      -- ^ See 'computeUTxOBalanceAvailable'.
    , UTxOBalanceSufficiencyInfo -> TokenBundle
required :: TokenBundle
      -- ^ See 'computeUTxOBalanceRequired'.
    , UTxOBalanceSufficiencyInfo -> TokenBundle
difference :: TokenBundle
      -- ^ The difference between 'available' and 'required'.
    , UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiency
sufficiency :: UTxOBalanceSufficiency
      -- ^ Whether or not the balance is sufficient.
    }
    deriving (UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiencyInfo -> Bool
(UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiencyInfo -> Bool)
-> (UTxOBalanceSufficiencyInfo
    -> UTxOBalanceSufficiencyInfo -> Bool)
-> Eq UTxOBalanceSufficiencyInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiencyInfo -> Bool
$c/= :: UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiencyInfo -> Bool
== :: UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiencyInfo -> Bool
$c== :: UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiencyInfo -> Bool
Eq, (forall x.
 UTxOBalanceSufficiencyInfo -> Rep UTxOBalanceSufficiencyInfo x)
-> (forall x.
    Rep UTxOBalanceSufficiencyInfo x -> UTxOBalanceSufficiencyInfo)
-> Generic UTxOBalanceSufficiencyInfo
forall x.
Rep UTxOBalanceSufficiencyInfo x -> UTxOBalanceSufficiencyInfo
forall x.
UTxOBalanceSufficiencyInfo -> Rep UTxOBalanceSufficiencyInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UTxOBalanceSufficiencyInfo x -> UTxOBalanceSufficiencyInfo
$cfrom :: forall x.
UTxOBalanceSufficiencyInfo -> Rep UTxOBalanceSufficiencyInfo x
Generic, Int -> UTxOBalanceSufficiencyInfo -> ShowS
[UTxOBalanceSufficiencyInfo] -> ShowS
UTxOBalanceSufficiencyInfo -> String
(Int -> UTxOBalanceSufficiencyInfo -> ShowS)
-> (UTxOBalanceSufficiencyInfo -> String)
-> ([UTxOBalanceSufficiencyInfo] -> ShowS)
-> Show UTxOBalanceSufficiencyInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOBalanceSufficiencyInfo] -> ShowS
$cshowList :: [UTxOBalanceSufficiencyInfo] -> ShowS
show :: UTxOBalanceSufficiencyInfo -> String
$cshow :: UTxOBalanceSufficiencyInfo -> String
showsPrec :: Int -> UTxOBalanceSufficiencyInfo -> ShowS
$cshowsPrec :: Int -> UTxOBalanceSufficiencyInfo -> ShowS
Show)

-- | Computes the balance of UTxO entries available for selection.
--
computeUTxOBalanceAvailable
    :: SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceAvailable :: SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceAvailable =
    UTxOSelection (UTxO ctx) -> TokenBundle
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> TokenBundle
UTxOSelection.availableBalance (UTxOSelection (UTxO ctx) -> TokenBundle)
-> (SelectionParamsOf f ctx -> UTxOSelection (UTxO ctx))
-> SelectionParamsOf f ctx
-> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UTxOSelection (UTxO ctx)
  -> Const (UTxOSelection (UTxO ctx)) (UTxOSelection (UTxO ctx)))
 -> SelectionParamsOf f ctx
 -> Const (UTxOSelection (UTxO ctx)) (SelectionParamsOf f ctx))
-> SelectionParamsOf f ctx -> UTxOSelection (UTxO ctx)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "utxoAvailable"
  ((UTxOSelection (UTxO ctx)
    -> Const (UTxOSelection (UTxO ctx)) (UTxOSelection (UTxO ctx)))
   -> SelectionParamsOf f ctx
   -> Const (UTxOSelection (UTxO ctx)) (SelectionParamsOf f ctx))
(UTxOSelection (UTxO ctx)
 -> Const (UTxOSelection (UTxO ctx)) (UTxOSelection (UTxO ctx)))
-> SelectionParamsOf f ctx
-> Const (UTxOSelection (UTxO ctx)) (SelectionParamsOf f ctx)
#utxoAvailable

-- | Computes the balance of UTxO entries required to be selected.
--
computeUTxOBalanceRequired
    :: Foldable f => SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceRequired :: SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceRequired = (TokenBundle, TokenBundle) -> TokenBundle
forall a b. (a, b) -> a
fst ((TokenBundle, TokenBundle) -> TokenBundle)
-> (SelectionParamsOf f ctx -> (TokenBundle, TokenBundle))
-> SelectionParamsOf f ctx
-> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
computeDeficitInOut

computeBalanceInOut
    :: Foldable f => SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
computeBalanceInOut :: SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
computeBalanceInOut SelectionParamsOf f ctx
params =
    (TokenBundle
balanceIn, TokenBundle
balanceOut)
  where
    balanceIn :: TokenBundle
balanceIn =
        TokenMap -> TokenBundle
TokenBundle.fromTokenMap (((TokenMap -> Const TokenMap TokenMap)
 -> SelectionParamsOf f ctx
 -> Const TokenMap (SelectionParamsOf f ctx))
-> SelectionParamsOf f ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToMint"
  ((TokenMap -> Const TokenMap TokenMap)
   -> SelectionParamsOf f ctx
   -> Const TokenMap (SelectionParamsOf f ctx))
(TokenMap -> Const TokenMap TokenMap)
-> SelectionParamsOf f ctx
-> Const TokenMap (SelectionParamsOf f ctx)
#assetsToMint SelectionParamsOf f ctx
params)
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        Coin -> TokenBundle
TokenBundle.fromCoin (((Coin -> Const Coin Coin)
 -> SelectionParamsOf f ctx -> Const Coin (SelectionParamsOf f ctx))
-> SelectionParamsOf f ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSource"
  ((Coin -> Const Coin Coin)
   -> SelectionParamsOf f ctx -> Const Coin (SelectionParamsOf f ctx))
(Coin -> Const Coin Coin)
-> SelectionParamsOf f ctx -> Const Coin (SelectionParamsOf f ctx)
#extraCoinSource SelectionParamsOf f ctx
params)
    balanceOut :: TokenBundle
balanceOut =
        TokenMap -> TokenBundle
TokenBundle.fromTokenMap (((TokenMap -> Const TokenMap TokenMap)
 -> SelectionParamsOf f ctx
 -> Const TokenMap (SelectionParamsOf f ctx))
-> SelectionParamsOf f ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToBurn"
  ((TokenMap -> Const TokenMap TokenMap)
   -> SelectionParamsOf f ctx
   -> Const TokenMap (SelectionParamsOf f ctx))
(TokenMap -> Const TokenMap TokenMap)
-> SelectionParamsOf f ctx
-> Const TokenMap (SelectionParamsOf f ctx)
#assetsToBurn SelectionParamsOf f ctx
params)
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        Coin -> TokenBundle
TokenBundle.fromCoin (((Coin -> Const Coin Coin)
 -> SelectionParamsOf f ctx -> Const Coin (SelectionParamsOf f ctx))
-> SelectionParamsOf f ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSink"
  ((Coin -> Const Coin Coin)
   -> SelectionParamsOf f ctx -> Const Coin (SelectionParamsOf f ctx))
(Coin -> Const Coin Coin)
-> SelectionParamsOf f ctx -> Const Coin (SelectionParamsOf f ctx)
#extraCoinSink SelectionParamsOf f ctx
params)
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        ((Address ctx, TokenBundle) -> TokenBundle)
-> f (Address ctx, TokenBundle) -> TokenBundle
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (((f (Address ctx, TokenBundle)
  -> Const
       (f (Address ctx, TokenBundle)) (f (Address ctx, TokenBundle)))
 -> SelectionParamsOf f ctx
 -> Const (f (Address ctx, TokenBundle)) (SelectionParamsOf f ctx))
-> SelectionParamsOf f ctx -> f (Address ctx, TokenBundle)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputsToCover"
  ((f (Address ctx, TokenBundle)
    -> Const
         (f (Address ctx, TokenBundle)) (f (Address ctx, TokenBundle)))
   -> SelectionParamsOf f ctx
   -> Const (f (Address ctx, TokenBundle)) (SelectionParamsOf f ctx))
(f (Address ctx, TokenBundle)
 -> Const
      (f (Address ctx, TokenBundle)) (f (Address ctx, TokenBundle)))
-> SelectionParamsOf f ctx
-> Const (f (Address ctx, TokenBundle)) (SelectionParamsOf f ctx)
#outputsToCover SelectionParamsOf f ctx
params)

computeDeficitInOut
    :: Foldable f => SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
computeDeficitInOut :: SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
computeDeficitInOut SelectionParamsOf f ctx
params =
    (TokenBundle
deficitIn, TokenBundle
deficitOut)
  where
    deficitIn :: TokenBundle
deficitIn =
        TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.difference TokenBundle
balanceOut TokenBundle
balanceIn
    deficitOut :: TokenBundle
deficitOut =
        TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.difference TokenBundle
balanceIn TokenBundle
balanceOut
    (TokenBundle
balanceIn, TokenBundle
balanceOut) =
        SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> (TokenBundle, TokenBundle)
computeBalanceInOut SelectionParamsOf f ctx
params

-- | Computes the UTxO balance sufficiency.
--
-- See 'UTxOBalanceSufficiency'.
--
computeUTxOBalanceSufficiency
    :: Foldable f => SelectionParamsOf f ctx -> UTxOBalanceSufficiency
computeUTxOBalanceSufficiency :: SelectionParamsOf f ctx -> UTxOBalanceSufficiency
computeUTxOBalanceSufficiency = UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiency
sufficiency (UTxOBalanceSufficiencyInfo -> UTxOBalanceSufficiency)
-> (SelectionParamsOf f ctx -> UTxOBalanceSufficiencyInfo)
-> SelectionParamsOf f ctx
-> UTxOBalanceSufficiency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionParamsOf f ctx -> UTxOBalanceSufficiencyInfo
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> UTxOBalanceSufficiencyInfo
computeUTxOBalanceSufficiencyInfo

-- | Computes information about the UTxO balance sufficiency.
--
-- See 'UTxOBalanceSufficiencyInfo'.
--
computeUTxOBalanceSufficiencyInfo
    :: Foldable f => SelectionParamsOf f ctx -> UTxOBalanceSufficiencyInfo
computeUTxOBalanceSufficiencyInfo :: SelectionParamsOf f ctx -> UTxOBalanceSufficiencyInfo
computeUTxOBalanceSufficiencyInfo SelectionParamsOf f ctx
params =
    UTxOBalanceSufficiencyInfo :: TokenBundle
-> TokenBundle
-> TokenBundle
-> UTxOBalanceSufficiency
-> UTxOBalanceSufficiencyInfo
UTxOBalanceSufficiencyInfo {TokenBundle
available :: TokenBundle
$sel:available:UTxOBalanceSufficiencyInfo :: TokenBundle
available, TokenBundle
required :: TokenBundle
$sel:required:UTxOBalanceSufficiencyInfo :: TokenBundle
required, TokenBundle
difference :: TokenBundle
$sel:difference:UTxOBalanceSufficiencyInfo :: TokenBundle
difference, UTxOBalanceSufficiency
sufficiency :: UTxOBalanceSufficiency
$sel:sufficiency:UTxOBalanceSufficiencyInfo :: UTxOBalanceSufficiency
sufficiency}
  where
    available :: TokenBundle
available = SelectionParamsOf f ctx -> TokenBundle
forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceAvailable SelectionParamsOf f ctx
params
    required :: TokenBundle
required = SelectionParamsOf f ctx -> TokenBundle
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceRequired SelectionParamsOf f ctx
params
    sufficiency :: UTxOBalanceSufficiency
sufficiency =
        if TokenBundle
required TokenBundle -> TokenBundle -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenBundle
available
        then UTxOBalanceSufficiency
UTxOBalanceSufficient
        else UTxOBalanceSufficiency
UTxOBalanceInsufficient
    difference :: TokenBundle
difference =
        if UTxOBalanceSufficiency
sufficiency UTxOBalanceSufficiency -> UTxOBalanceSufficiency -> Bool
forall a. Eq a => a -> a -> Bool
== UTxOBalanceSufficiency
UTxOBalanceSufficient
        then TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.difference TokenBundle
available TokenBundle
required
        else TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.difference TokenBundle
required TokenBundle
available

-- | Indicates whether or not the UTxO balance is sufficient.
--
-- The balance of available UTxO entries is sufficient if (and only if) it
-- is greater than or equal to the required balance.
--
isUTxOBalanceSufficient
    :: Foldable f => SelectionParamsOf f ctx -> Bool
isUTxOBalanceSufficient :: SelectionParamsOf f ctx -> Bool
isUTxOBalanceSufficient SelectionParamsOf f ctx
params =
    case SelectionParamsOf f ctx -> UTxOBalanceSufficiency
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> UTxOBalanceSufficiency
computeUTxOBalanceSufficiency SelectionParamsOf f ctx
params of
        UTxOBalanceSufficiency
UTxOBalanceSufficient   -> Bool
True
        UTxOBalanceSufficiency
UTxOBalanceInsufficient -> Bool
False

-- | A skeleton selection that can be used to estimate the cost of a final
--   selection.
--
-- Change outputs are deliberately stripped of their asset quantities, as the
-- fee estimation function must be agnostic to the magnitudes of these
-- quantities.
--
-- Increasing or decreasing the quantity of a particular asset in a change
-- output must not change the estimated cost of a selection.
--
data SelectionSkeleton ctx = SelectionSkeleton
    { SelectionSkeleton ctx -> Int
skeletonInputCount
        :: !Int
    , SelectionSkeleton ctx -> [(Address ctx, TokenBundle)]
skeletonOutputs
        :: ![(Address ctx, TokenBundle)]
    , SelectionSkeleton ctx -> [Set AssetId]
skeletonChange
        :: ![Set AssetId]
    }
    deriving (forall x. SelectionSkeleton ctx -> Rep (SelectionSkeleton ctx) x)
-> (forall x.
    Rep (SelectionSkeleton ctx) x -> SelectionSkeleton ctx)
-> Generic (SelectionSkeleton ctx)
forall x. Rep (SelectionSkeleton ctx) x -> SelectionSkeleton ctx
forall x. SelectionSkeleton ctx -> Rep (SelectionSkeleton ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionSkeleton ctx) x -> SelectionSkeleton ctx
forall ctx x.
SelectionSkeleton ctx -> Rep (SelectionSkeleton ctx) x
$cto :: forall ctx x.
Rep (SelectionSkeleton ctx) x -> SelectionSkeleton ctx
$cfrom :: forall ctx x.
SelectionSkeleton ctx -> Rep (SelectionSkeleton ctx) x
Generic

deriving instance SelectionContext ctx => Eq (SelectionSkeleton ctx)
deriving instance SelectionContext ctx => Show (SelectionSkeleton ctx)

-- | Specifies a limit to adhere to when performing a selection.
--
type SelectionLimit = SelectionLimitOf Int

data SelectionLimitOf a
    = NoLimit
      -- ^ Indicates that there is no limit.
    | MaximumInputLimit a
      -- ^ Indicates a maximum limit on the number of inputs to select.
    deriving (SelectionLimitOf a -> SelectionLimitOf a -> Bool
(SelectionLimitOf a -> SelectionLimitOf a -> Bool)
-> (SelectionLimitOf a -> SelectionLimitOf a -> Bool)
-> Eq (SelectionLimitOf a)
forall a. Eq a => SelectionLimitOf a -> SelectionLimitOf a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionLimitOf a -> SelectionLimitOf a -> Bool
$c/= :: forall a. Eq a => SelectionLimitOf a -> SelectionLimitOf a -> Bool
== :: SelectionLimitOf a -> SelectionLimitOf a -> Bool
$c== :: forall a. Eq a => SelectionLimitOf a -> SelectionLimitOf a -> Bool
Eq, a -> SelectionLimitOf b -> SelectionLimitOf a
(a -> b) -> SelectionLimitOf a -> SelectionLimitOf b
(forall a b. (a -> b) -> SelectionLimitOf a -> SelectionLimitOf b)
-> (forall a b. a -> SelectionLimitOf b -> SelectionLimitOf a)
-> Functor SelectionLimitOf
forall a b. a -> SelectionLimitOf b -> SelectionLimitOf a
forall a b. (a -> b) -> SelectionLimitOf a -> SelectionLimitOf b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SelectionLimitOf b -> SelectionLimitOf a
$c<$ :: forall a b. a -> SelectionLimitOf b -> SelectionLimitOf a
fmap :: (a -> b) -> SelectionLimitOf a -> SelectionLimitOf b
$cfmap :: forall a b. (a -> b) -> SelectionLimitOf a -> SelectionLimitOf b
Functor, Int -> SelectionLimitOf a -> ShowS
[SelectionLimitOf a] -> ShowS
SelectionLimitOf a -> String
(Int -> SelectionLimitOf a -> ShowS)
-> (SelectionLimitOf a -> String)
-> ([SelectionLimitOf a] -> ShowS)
-> Show (SelectionLimitOf a)
forall a. Show a => Int -> SelectionLimitOf a -> ShowS
forall a. Show a => [SelectionLimitOf a] -> ShowS
forall a. Show a => SelectionLimitOf a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionLimitOf a] -> ShowS
$cshowList :: forall a. Show a => [SelectionLimitOf a] -> ShowS
show :: SelectionLimitOf a -> String
$cshow :: forall a. Show a => SelectionLimitOf a -> String
showsPrec :: Int -> SelectionLimitOf a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SelectionLimitOf a -> ShowS
Show)

instance Ord a => Ord (SelectionLimitOf a) where
    compare :: SelectionLimitOf a -> SelectionLimitOf a -> Ordering
compare SelectionLimitOf a
a SelectionLimitOf a
b = case (SelectionLimitOf a
a, SelectionLimitOf a
b) of
        (SelectionLimitOf a
NoLimit            , SelectionLimitOf a
NoLimit            ) -> Ordering
EQ
        (MaximumInputLimit a
_, SelectionLimitOf a
NoLimit            ) -> Ordering
LT
        (SelectionLimitOf a
NoLimit            , MaximumInputLimit a
_) -> Ordering
GT
        (MaximumInputLimit a
x, MaximumInputLimit a
y) -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y

-- | Indicates whether or not the given selection limit has been exceeded.
--
selectionLimitExceeded :: IsUTxOSelection s u => s u -> SelectionLimit -> Bool
selectionLimitExceeded :: s u -> SelectionLimit -> Bool
selectionLimitExceeded s u
s = \case
    SelectionLimit
NoLimit -> Bool
False
    MaximumInputLimit Int
n -> s u -> Int
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Int
UTxOSelection.selectedSize s u
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n

-- | Reduces a selection limit by a given reduction amount.
--
-- If the given reduction amount is positive, then this function will reduce
-- the selection limit by that amount.
--
-- If the given reduction amount is zero or negative, then this function will
-- return the original limit unchanged.
--
reduceSelectionLimitBy :: SelectionLimit -> Int -> SelectionLimit
reduceSelectionLimitBy :: SelectionLimit -> Int -> SelectionLimit
reduceSelectionLimitBy SelectionLimit
limit Int
reduction
    | Int
reduction Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 =
        SelectionLimit
limit
    | Bool
otherwise =
        Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
reduction (Int -> Int) -> SelectionLimit -> SelectionLimit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionLimit
limit

type SelectionResult = SelectionResultOf []

-- | The result of performing a successful selection.
--
data SelectionResultOf f ctx = SelectionResult
    { SelectionResultOf f ctx -> NonEmpty (UTxO ctx, TokenBundle)
inputsSelected
        :: !(NonEmpty (UTxO ctx, TokenBundle))
        -- ^ A (non-empty) list of inputs selected from 'utxoAvailable'.
    , SelectionResultOf f ctx -> Coin
extraCoinSource
        :: !Coin
        -- ^ An extra source of ada.
    , SelectionResultOf f ctx -> Coin
extraCoinSink
        :: !Coin
        -- ^ An extra sink for ada.
    , SelectionResultOf f ctx -> f (Address ctx, TokenBundle)
outputsCovered
        :: !(f (Address ctx, TokenBundle))
        -- ^ A list of outputs covered.
    , SelectionResultOf f ctx -> [TokenBundle]
changeGenerated
        :: ![TokenBundle]
        -- ^ A list of generated change outputs.
    , SelectionResultOf f ctx -> TokenMap
assetsToMint
        :: !TokenMap
        -- ^ The assets to mint.
    , SelectionResultOf f ctx -> TokenMap
assetsToBurn
        :: !TokenMap
        -- ^ The assets to burn.
    }
    deriving (forall x.
 SelectionResultOf f ctx -> Rep (SelectionResultOf f ctx) x)
-> (forall x.
    Rep (SelectionResultOf f ctx) x -> SelectionResultOf f ctx)
-> Generic (SelectionResultOf f ctx)
forall x.
Rep (SelectionResultOf f ctx) x -> SelectionResultOf f ctx
forall x.
SelectionResultOf f ctx -> Rep (SelectionResultOf f ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) ctx x.
Rep (SelectionResultOf f ctx) x -> SelectionResultOf f ctx
forall (f :: * -> *) ctx x.
SelectionResultOf f ctx -> Rep (SelectionResultOf f ctx) x
$cto :: forall (f :: * -> *) ctx x.
Rep (SelectionResultOf f ctx) x -> SelectionResultOf f ctx
$cfrom :: forall (f :: * -> *) ctx x.
SelectionResultOf f ctx -> Rep (SelectionResultOf f ctx) x
Generic

deriving instance
    (Eq (f (Address ctx, TokenBundle)), Eq (UTxO ctx)) =>
        Eq (SelectionResultOf f ctx)
deriving instance
    (Show (f (Address ctx, TokenBundle)), Show (UTxO ctx)) =>
        Show (SelectionResultOf f ctx)

-- | Indicates the difference between total input value and total output value
--   of a 'SelectionResult'.
--
-- There are two possibilities:
--
--  - 'SelectionSurplus'
--
--    Indicates a surplus, when the total input value is greater than or equal
--    to the total output value.
--
--  - 'SelectionDeficit'
--
--    Indicates a deficit, when the total input value is NOT greater than or
--    equal to the total output value.
--
data SelectionDelta a
    = SelectionSurplus a
    | SelectionDeficit a
    deriving (SelectionDelta a -> SelectionDelta a -> Bool
(SelectionDelta a -> SelectionDelta a -> Bool)
-> (SelectionDelta a -> SelectionDelta a -> Bool)
-> Eq (SelectionDelta a)
forall a. Eq a => SelectionDelta a -> SelectionDelta a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionDelta a -> SelectionDelta a -> Bool
$c/= :: forall a. Eq a => SelectionDelta a -> SelectionDelta a -> Bool
== :: SelectionDelta a -> SelectionDelta a -> Bool
$c== :: forall a. Eq a => SelectionDelta a -> SelectionDelta a -> Bool
Eq, a -> SelectionDelta b -> SelectionDelta a
(a -> b) -> SelectionDelta a -> SelectionDelta b
(forall a b. (a -> b) -> SelectionDelta a -> SelectionDelta b)
-> (forall a b. a -> SelectionDelta b -> SelectionDelta a)
-> Functor SelectionDelta
forall a b. a -> SelectionDelta b -> SelectionDelta a
forall a b. (a -> b) -> SelectionDelta a -> SelectionDelta b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SelectionDelta b -> SelectionDelta a
$c<$ :: forall a b. a -> SelectionDelta b -> SelectionDelta a
fmap :: (a -> b) -> SelectionDelta a -> SelectionDelta b
$cfmap :: forall a b. (a -> b) -> SelectionDelta a -> SelectionDelta b
Functor, Int -> SelectionDelta a -> ShowS
[SelectionDelta a] -> ShowS
SelectionDelta a -> String
(Int -> SelectionDelta a -> ShowS)
-> (SelectionDelta a -> String)
-> ([SelectionDelta a] -> ShowS)
-> Show (SelectionDelta a)
forall a. Show a => Int -> SelectionDelta a -> ShowS
forall a. Show a => [SelectionDelta a] -> ShowS
forall a. Show a => SelectionDelta a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionDelta a] -> ShowS
$cshowList :: forall a. Show a => [SelectionDelta a] -> ShowS
show :: SelectionDelta a -> String
$cshow :: forall a. Show a => SelectionDelta a -> String
showsPrec :: Int -> SelectionDelta a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SelectionDelta a -> ShowS
Show)

instance Buildable a => Buildable (SelectionDelta a) where
    build :: SelectionDelta a -> Builder
build SelectionDelta a
d = case SelectionDelta a
d of
        SelectionSurplus a
surplus -> [(String, Builder)] -> Builder
buildMap [(String
"surplus", a -> Builder
forall p. Buildable p => p -> Builder
build a
surplus)]
        SelectionDeficit a
deficit -> [(String, Builder)] -> Builder
buildMap [(String
"deficit", a -> Builder
forall p. Buildable p => p -> Builder
build a
deficit)]
      where
        buildMap :: [(String, Builder)] -> Builder
        buildMap :: [(String, Builder)] -> Builder
buildMap = [(String, Builder)] -> Builder
forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
blockMapF ([(String, Builder)] -> Builder)
-> ([(String, Builder)] -> [(String, Builder)])
-> [(String, Builder)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Builder) -> (String, Builder))
-> [(String, Builder)] -> [(String, Builder)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> (String, Builder) -> (String, Builder)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ShowS -> (String, Builder) -> (String, Builder))
-> ShowS -> (String, Builder) -> (String, Builder)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. a -> a
id @String)

-- | Calculates the selection delta for all assets.
--
-- See 'SelectionDelta'.
--
selectionDeltaAllAssets
    :: Foldable f => SelectionResultOf f ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets :: SelectionResultOf f ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets SelectionResultOf f ctx
result
    | TokenBundle
balanceOut TokenBundle -> TokenBundle -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenBundle
balanceIn =
        TokenBundle -> SelectionDelta TokenBundle
forall a. a -> SelectionDelta a
SelectionSurplus (TokenBundle -> SelectionDelta TokenBundle)
-> TokenBundle -> SelectionDelta TokenBundle
forall a b. (a -> b) -> a -> b
$ TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.difference TokenBundle
balanceIn TokenBundle
balanceOut
    | Bool
otherwise =
        TokenBundle -> SelectionDelta TokenBundle
forall a. a -> SelectionDelta a
SelectionDeficit (TokenBundle -> SelectionDelta TokenBundle)
-> TokenBundle -> SelectionDelta TokenBundle
forall a b. (a -> b) -> a -> b
$ TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.difference TokenBundle
balanceOut TokenBundle
balanceIn
  where
    balanceIn :: TokenBundle
balanceIn =
        TokenMap -> TokenBundle
TokenBundle.fromTokenMap TokenMap
assetsToMint
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        Coin -> TokenBundle
TokenBundle.fromCoin Coin
extraCoinSource
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        ((UTxO ctx, TokenBundle) -> TokenBundle)
-> NonEmpty (UTxO ctx, TokenBundle) -> TokenBundle
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (UTxO ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd NonEmpty (UTxO ctx, TokenBundle)
inputsSelected
    balanceOut :: TokenBundle
balanceOut =
        TokenMap -> TokenBundle
TokenBundle.fromTokenMap TokenMap
assetsToBurn
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        Coin -> TokenBundle
TokenBundle.fromCoin Coin
extraCoinSink
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        ((Address ctx, TokenBundle) -> TokenBundle)
-> f (Address ctx, TokenBundle) -> TokenBundle
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd f (Address ctx, TokenBundle)
outputsCovered
        TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add`
        [TokenBundle] -> TokenBundle
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold [TokenBundle]
changeGenerated
    SelectionResult
        { TokenMap
assetsToMint :: TokenMap
$sel:assetsToMint:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> TokenMap
assetsToMint
        , TokenMap
assetsToBurn :: TokenMap
$sel:assetsToBurn:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> TokenMap
assetsToBurn
        , Coin
extraCoinSource :: Coin
$sel:extraCoinSource:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> Coin
extraCoinSource
        , Coin
extraCoinSink :: Coin
$sel:extraCoinSink:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> Coin
extraCoinSink
        , NonEmpty (UTxO ctx, TokenBundle)
inputsSelected :: NonEmpty (UTxO ctx, TokenBundle)
$sel:inputsSelected:SelectionResult :: forall (f :: * -> *) ctx.
SelectionResultOf f ctx -> NonEmpty (UTxO ctx, TokenBundle)
inputsSelected
        , f (Address ctx, TokenBundle)
outputsCovered :: f (Address ctx, TokenBundle)
$sel:outputsCovered:SelectionResult :: forall (f :: * -> *) ctx.
SelectionResultOf f ctx -> f (Address ctx, TokenBundle)
outputsCovered
        , [TokenBundle]
changeGenerated :: [TokenBundle]
$sel:changeGenerated:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> [TokenBundle]
changeGenerated
        } = SelectionResultOf f ctx
result

-- | Calculates the ada selection delta.
--
-- See 'SelectionDelta'.
--
selectionDeltaCoin
    :: Foldable f => SelectionResultOf f ctx -> SelectionDelta Coin
selectionDeltaCoin :: SelectionResultOf f ctx -> SelectionDelta Coin
selectionDeltaCoin = (TokenBundle -> Coin)
-> SelectionDelta TokenBundle -> SelectionDelta Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TokenBundle -> Coin
TokenBundle.getCoin (SelectionDelta TokenBundle -> SelectionDelta Coin)
-> (SelectionResultOf f ctx -> SelectionDelta TokenBundle)
-> SelectionResultOf f ctx
-> SelectionDelta Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionResultOf f ctx -> SelectionDelta TokenBundle
forall (f :: * -> *) ctx.
Foldable f =>
SelectionResultOf f ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets

-- | Indicates whether or not a selection result has a valid surplus.
--
selectionHasValidSurplus
    :: Foldable f => SelectionConstraints ctx -> SelectionResultOf f ctx -> Bool
selectionHasValidSurplus :: SelectionConstraints ctx -> SelectionResultOf f ctx -> Bool
selectionHasValidSurplus SelectionConstraints ctx
constraints SelectionResultOf f ctx
selection =
    case SelectionResultOf f ctx -> SelectionDelta TokenBundle
forall (f :: * -> *) ctx.
Foldable f =>
SelectionResultOf f ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets SelectionResultOf f ctx
selection of
        SelectionSurplus TokenBundle
s -> TokenBundle -> Bool
surplusIsValid TokenBundle
s
        SelectionDeficit TokenBundle
_ -> Bool
False
  where
    surplusIsValid :: TokenBundle -> Bool
    surplusIsValid :: TokenBundle -> Bool
surplusIsValid = [TokenBundle -> Bool] -> TokenBundle -> Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM
        [ Item [TokenBundle -> Bool]
TokenBundle -> Bool
surplusHasNoNonAdaAssets
        , Item [TokenBundle -> Bool]
TokenBundle -> Bool
surplusNotBelowMinimumCost
        , Item [TokenBundle -> Bool]
TokenBundle -> Bool
surplusNotAboveMaximumCost
        ]

    -- None of the non-ada assets can have a surplus.
    surplusHasNoNonAdaAssets :: TokenBundle -> Bool
    surplusHasNoNonAdaAssets :: TokenBundle -> Bool
surplusHasNoNonAdaAssets TokenBundle
surplus =
        ((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens TokenBundle
surplus TokenMap -> TokenMap -> Bool
forall a. Eq a => a -> a -> Bool
== TokenMap
TokenMap.empty

    -- The surplus must not be less than the minimum cost.
    surplusNotBelowMinimumCost :: TokenBundle -> Bool
    surplusNotBelowMinimumCost :: TokenBundle -> Bool
surplusNotBelowMinimumCost TokenBundle
surplus =
        ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin TokenBundle
surplus Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
selectionMinimumCost SelectionConstraints ctx
constraints SelectionResultOf f ctx
selection

    -- The surplus must not be greater than the maximum cost.
    surplusNotAboveMaximumCost :: TokenBundle -> Bool
    surplusNotAboveMaximumCost :: TokenBundle -> Bool
surplusNotAboveMaximumCost TokenBundle
surplus =
        ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin TokenBundle
surplus Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
selectionMaximumCost SelectionConstraints ctx
constraints SelectionResultOf f ctx
selection

-- | Calculates the ada selection surplus, assuming there is a surplus.
--
-- If there is a surplus, then this function returns that surplus.
-- If there is a deficit, then this function returns zero.
--
-- Use 'selectionDeltaCoin' if you wish to handle the case where there is
-- a deficit.
--
selectionSurplusCoin :: Foldable f => SelectionResultOf f ctx -> Coin
selectionSurplusCoin :: SelectionResultOf f ctx -> Coin
selectionSurplusCoin SelectionResultOf f ctx
result =
    case SelectionResultOf f ctx -> SelectionDelta Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionResultOf f ctx -> SelectionDelta Coin
selectionDeltaCoin SelectionResultOf f ctx
result of
        SelectionSurplus Coin
surplus -> Coin
surplus
        SelectionDeficit Coin
_       -> Natural -> Coin
Coin Natural
0

-- | Converts a selection into a skeleton.
--
selectionSkeleton
    :: Foldable f => SelectionResultOf f ctx -> SelectionSkeleton ctx
selectionSkeleton :: SelectionResultOf f ctx -> SelectionSkeleton ctx
selectionSkeleton SelectionResultOf f ctx
s = SelectionSkeleton :: forall ctx.
Int
-> [(Address ctx, TokenBundle)]
-> [Set AssetId]
-> SelectionSkeleton ctx
SelectionSkeleton
    { $sel:skeletonInputCount:SelectionSkeleton :: Int
skeletonInputCount = NonEmpty (UTxO ctx, TokenBundle) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length (((NonEmpty (UTxO ctx, TokenBundle)
  -> Const
       (NonEmpty (UTxO ctx, TokenBundle))
       (NonEmpty (UTxO ctx, TokenBundle)))
 -> SelectionResultOf f ctx
 -> Const
      (NonEmpty (UTxO ctx, TokenBundle)) (SelectionResultOf f ctx))
-> SelectionResultOf f ctx -> NonEmpty (UTxO ctx, TokenBundle)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputsSelected"
  ((NonEmpty (UTxO ctx, TokenBundle)
    -> Const
         (NonEmpty (UTxO ctx, TokenBundle))
         (NonEmpty (UTxO ctx, TokenBundle)))
   -> SelectionResultOf f ctx
   -> Const
        (NonEmpty (UTxO ctx, TokenBundle)) (SelectionResultOf f ctx))
(NonEmpty (UTxO ctx, TokenBundle)
 -> Const
      (NonEmpty (UTxO ctx, TokenBundle))
      (NonEmpty (UTxO ctx, TokenBundle)))
-> SelectionResultOf f ctx
-> Const
     (NonEmpty (UTxO ctx, TokenBundle)) (SelectionResultOf f ctx)
#inputsSelected SelectionResultOf f ctx
s)
    , $sel:skeletonOutputs:SelectionSkeleton :: [(Address ctx, TokenBundle)]
skeletonOutputs = f (Address ctx, TokenBundle) -> [(Address ctx, TokenBundle)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (((f (Address ctx, TokenBundle)
  -> Const
       (f (Address ctx, TokenBundle)) (f (Address ctx, TokenBundle)))
 -> SelectionResultOf f ctx
 -> Const (f (Address ctx, TokenBundle)) (SelectionResultOf f ctx))
-> SelectionResultOf f ctx -> f (Address ctx, TokenBundle)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputsCovered"
  ((f (Address ctx, TokenBundle)
    -> Const
         (f (Address ctx, TokenBundle)) (f (Address ctx, TokenBundle)))
   -> SelectionResultOf f ctx
   -> Const (f (Address ctx, TokenBundle)) (SelectionResultOf f ctx))
(f (Address ctx, TokenBundle)
 -> Const
      (f (Address ctx, TokenBundle)) (f (Address ctx, TokenBundle)))
-> SelectionResultOf f ctx
-> Const (f (Address ctx, TokenBundle)) (SelectionResultOf f ctx)
#outputsCovered SelectionResultOf f ctx
s)
    , $sel:skeletonChange:SelectionSkeleton :: [Set AssetId]
skeletonChange = TokenBundle -> Set AssetId
TokenBundle.getAssets (TokenBundle -> Set AssetId) -> [TokenBundle] -> [Set AssetId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
 -> SelectionResultOf f ctx
 -> Const [TokenBundle] (SelectionResultOf f ctx))
-> SelectionResultOf f ctx -> [TokenBundle]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "changeGenerated"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> SelectionResultOf f ctx
   -> Const [TokenBundle] (SelectionResultOf f ctx))
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> SelectionResultOf f ctx
-> Const [TokenBundle] (SelectionResultOf f ctx)
#changeGenerated SelectionResultOf f ctx
s
    }

-- | Computes the minimum required cost of a selection.
--
selectionMinimumCost
    :: Foldable f => SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
selectionMinimumCost :: SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
selectionMinimumCost SelectionConstraints ctx
c = (((SelectionSkeleton ctx -> Coin)
  -> Const
       (SelectionSkeleton ctx -> Coin) (SelectionSkeleton ctx -> Coin))
 -> SelectionConstraints ctx
 -> Const
      (SelectionSkeleton ctx -> Coin) (SelectionConstraints ctx))
-> SelectionConstraints ctx -> SelectionSkeleton ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "computeMinimumCost"
  (((SelectionSkeleton ctx -> Coin)
    -> Const
         (SelectionSkeleton ctx -> Coin) (SelectionSkeleton ctx -> Coin))
   -> SelectionConstraints ctx
   -> Const
        (SelectionSkeleton ctx -> Coin) (SelectionConstraints ctx))
((SelectionSkeleton ctx -> Coin)
 -> Const
      (SelectionSkeleton ctx -> Coin) (SelectionSkeleton ctx -> Coin))
-> SelectionConstraints ctx
-> Const (SelectionSkeleton ctx -> Coin) (SelectionConstraints ctx)
#computeMinimumCost SelectionConstraints ctx
c (SelectionSkeleton ctx -> Coin)
-> (SelectionResultOf f ctx -> SelectionSkeleton ctx)
-> SelectionResultOf f ctx
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionResultOf f ctx -> SelectionSkeleton ctx
forall (f :: * -> *) ctx.
Foldable f =>
SelectionResultOf f ctx -> SelectionSkeleton ctx
selectionSkeleton

-- | Computes the maximum acceptable cost of a selection.
--
-- This function acts as a safety limit to ensure that fees of selections
-- produced by 'performSelection' are not excessively high.
--
-- Ideally, we'd always be able to generate selections with fees that are
-- precisely equal to 'selectionMinimumCost'. However, in some situations
-- it may be necessary to exceed this cost very slightly.
--
-- This function provides a conservative upper bound to a selection cost
-- that we can reference from within property tests.
--
-- See 'selectionHasValidSurplus'.
--
selectionMaximumCost
    :: Foldable f => SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
selectionMaximumCost :: SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
selectionMaximumCost SelectionConstraints ctx
c = Int -> Coin -> Coin
forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault (Int
2 :: Int) (Coin -> Coin)
-> (SelectionResultOf f ctx -> Coin)
-> SelectionResultOf f ctx
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
selectionMinimumCost SelectionConstraints ctx
c

-- | Represents the set of errors that may occur while performing a selection.
--
data SelectionBalanceError ctx
    = BalanceInsufficient
        BalanceInsufficientError
    | SelectionLimitReached
        (SelectionLimitReachedError ctx)
    | UnableToConstructChange
        UnableToConstructChangeError
    | EmptyUTxO
    deriving (forall x.
 SelectionBalanceError ctx -> Rep (SelectionBalanceError ctx) x)
-> (forall x.
    Rep (SelectionBalanceError ctx) x -> SelectionBalanceError ctx)
-> Generic (SelectionBalanceError ctx)
forall x.
Rep (SelectionBalanceError ctx) x -> SelectionBalanceError ctx
forall x.
SelectionBalanceError ctx -> Rep (SelectionBalanceError ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionBalanceError ctx) x -> SelectionBalanceError ctx
forall ctx x.
SelectionBalanceError ctx -> Rep (SelectionBalanceError ctx) x
$cto :: forall ctx x.
Rep (SelectionBalanceError ctx) x -> SelectionBalanceError ctx
$cfrom :: forall ctx x.
SelectionBalanceError ctx -> Rep (SelectionBalanceError ctx) x
Generic

deriving instance SelectionContext ctx => Eq (SelectionBalanceError ctx)
deriving instance SelectionContext ctx => Show (SelectionBalanceError ctx)

-- | Indicates that the balance of selected UTxO entries was insufficient to
--   cover the balance required while remaining within the selection limit.
--
data SelectionLimitReachedError ctx = SelectionLimitReachedError
    { SelectionLimitReachedError ctx -> TokenBundle
utxoBalanceRequired
        :: !TokenBundle
      -- ^ The UTXO balance required.
    , SelectionLimitReachedError ctx -> [(UTxO ctx, TokenBundle)]
inputsSelected
        :: ![(UTxO ctx, TokenBundle)]
      -- ^ The inputs that could be selected while satisfying the
      -- 'selectionLimit'.
    , SelectionLimitReachedError ctx
-> NonEmpty (Address ctx, TokenBundle)
outputsToCover
        :: !(NonEmpty (Address ctx, TokenBundle))
    } deriving (forall x.
 SelectionLimitReachedError ctx
 -> Rep (SelectionLimitReachedError ctx) x)
-> (forall x.
    Rep (SelectionLimitReachedError ctx) x
    -> SelectionLimitReachedError ctx)
-> Generic (SelectionLimitReachedError ctx)
forall x.
Rep (SelectionLimitReachedError ctx) x
-> SelectionLimitReachedError ctx
forall x.
SelectionLimitReachedError ctx
-> Rep (SelectionLimitReachedError ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionLimitReachedError ctx) x
-> SelectionLimitReachedError ctx
forall ctx x.
SelectionLimitReachedError ctx
-> Rep (SelectionLimitReachedError ctx) x
$cto :: forall ctx x.
Rep (SelectionLimitReachedError ctx) x
-> SelectionLimitReachedError ctx
$cfrom :: forall ctx x.
SelectionLimitReachedError ctx
-> Rep (SelectionLimitReachedError ctx) x
Generic

deriving instance SelectionContext ctx => Eq (SelectionLimitReachedError ctx)
deriving instance SelectionContext ctx => Show (SelectionLimitReachedError ctx)

-- | Indicates that the balance of available UTxO entries is insufficient to
--   cover the balance required.
--
-- See 'computeUTxOBalanceSufficiency'.
--
data BalanceInsufficientError = BalanceInsufficientError
    { BalanceInsufficientError -> TokenBundle
utxoBalanceAvailable
        :: !TokenBundle
      -- ^ The balance of 'utxoAvailable'.
    , BalanceInsufficientError -> TokenBundle
utxoBalanceRequired
        :: !TokenBundle
      -- ^ The balance of 'outputsToCover'.
    } deriving ((forall x.
 BalanceInsufficientError -> Rep BalanceInsufficientError x)
-> (forall x.
    Rep BalanceInsufficientError x -> BalanceInsufficientError)
-> Generic BalanceInsufficientError
forall x.
Rep BalanceInsufficientError x -> BalanceInsufficientError
forall x.
BalanceInsufficientError -> Rep BalanceInsufficientError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BalanceInsufficientError x -> BalanceInsufficientError
$cfrom :: forall x.
BalanceInsufficientError -> Rep BalanceInsufficientError x
Generic, BalanceInsufficientError -> BalanceInsufficientError -> Bool
(BalanceInsufficientError -> BalanceInsufficientError -> Bool)
-> (BalanceInsufficientError -> BalanceInsufficientError -> Bool)
-> Eq BalanceInsufficientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BalanceInsufficientError -> BalanceInsufficientError -> Bool
$c/= :: BalanceInsufficientError -> BalanceInsufficientError -> Bool
== :: BalanceInsufficientError -> BalanceInsufficientError -> Bool
$c== :: BalanceInsufficientError -> BalanceInsufficientError -> Bool
Eq, Int -> BalanceInsufficientError -> ShowS
[BalanceInsufficientError] -> ShowS
BalanceInsufficientError -> String
(Int -> BalanceInsufficientError -> ShowS)
-> (BalanceInsufficientError -> String)
-> ([BalanceInsufficientError] -> ShowS)
-> Show BalanceInsufficientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalanceInsufficientError] -> ShowS
$cshowList :: [BalanceInsufficientError] -> ShowS
show :: BalanceInsufficientError -> String
$cshow :: BalanceInsufficientError -> String
showsPrec :: Int -> BalanceInsufficientError -> ShowS
$cshowsPrec :: Int -> BalanceInsufficientError -> ShowS
Show)

-- | Calculate the missing balance from a @BalanceInsufficientError@.
balanceMissing :: BalanceInsufficientError -> TokenBundle
balanceMissing :: BalanceInsufficientError -> TokenBundle
balanceMissing (BalanceInsufficientError TokenBundle
available TokenBundle
required) =
    TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.difference TokenBundle
required TokenBundle
available

data UnableToConstructChangeError = UnableToConstructChangeError
    { UnableToConstructChangeError -> Coin
requiredCost
        :: !Coin
        -- ^ The minimal required cost needed for the transaction to be
        -- considered valid. This does not include min Ada values.
    , UnableToConstructChangeError -> Coin
shortfall
        :: !Coin
        -- ^ The additional coin quantity that would be required to cover the
        -- selection cost and minimum coin quantity of each change output.
    } deriving ((forall x.
 UnableToConstructChangeError -> Rep UnableToConstructChangeError x)
-> (forall x.
    Rep UnableToConstructChangeError x -> UnableToConstructChangeError)
-> Generic UnableToConstructChangeError
forall x.
Rep UnableToConstructChangeError x -> UnableToConstructChangeError
forall x.
UnableToConstructChangeError -> Rep UnableToConstructChangeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UnableToConstructChangeError x -> UnableToConstructChangeError
$cfrom :: forall x.
UnableToConstructChangeError -> Rep UnableToConstructChangeError x
Generic, UnableToConstructChangeError
-> UnableToConstructChangeError -> Bool
(UnableToConstructChangeError
 -> UnableToConstructChangeError -> Bool)
-> (UnableToConstructChangeError
    -> UnableToConstructChangeError -> Bool)
-> Eq UnableToConstructChangeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnableToConstructChangeError
-> UnableToConstructChangeError -> Bool
$c/= :: UnableToConstructChangeError
-> UnableToConstructChangeError -> Bool
== :: UnableToConstructChangeError
-> UnableToConstructChangeError -> Bool
$c== :: UnableToConstructChangeError
-> UnableToConstructChangeError -> Bool
Eq, Int -> UnableToConstructChangeError -> ShowS
[UnableToConstructChangeError] -> ShowS
UnableToConstructChangeError -> String
(Int -> UnableToConstructChangeError -> ShowS)
-> (UnableToConstructChangeError -> String)
-> ([UnableToConstructChangeError] -> ShowS)
-> Show UnableToConstructChangeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnableToConstructChangeError] -> ShowS
$cshowList :: [UnableToConstructChangeError] -> ShowS
show :: UnableToConstructChangeError -> String
$cshow :: UnableToConstructChangeError -> String
showsPrec :: Int -> UnableToConstructChangeError -> ShowS
$cshowsPrec :: Int -> UnableToConstructChangeError -> ShowS
Show)

type PerformSelection m f ctx =
    SelectionConstraints ctx ->
    SelectionParamsOf f ctx ->
    m (Either (SelectionBalanceError ctx) (SelectionResultOf f ctx))

-- | Performs a coin selection and generates change bundles in one step.
--
-- Provided that 'isUTxOBalanceSufficient' returns 'True' for the given
-- selection criteria, this function guarantees to return a 'SelectionResult'
-- for which 'selectionHasValidSurplus' returns 'True'.
--
performSelection
    :: forall m ctx. (HasCallStack, MonadRandom m, SelectionContext ctx)
    => PerformSelection m [] ctx
performSelection :: PerformSelection m [] ctx
performSelection = PerformSelection m NonEmpty ctx -> PerformSelection m [] ctx
forall (m :: * -> *) ctx.
Functor m =>
PerformSelection m NonEmpty ctx -> PerformSelection m [] ctx
performSelectionEmpty PerformSelection m NonEmpty ctx
forall (m :: * -> *) ctx.
(HasCallStack, MonadRandom m, SelectionContext ctx) =>
PerformSelection m NonEmpty ctx
performSelectionNonEmpty

-- | Transforms a coin selection function that requires a non-empty list of
--   outputs into a function that accepts an empty list of outputs.
--
-- If the original list is already non-empty, this function does not alter the
-- parameters or the result in any way, such that:
--
--    params == transformParams params
--    result == transformResult result
--
-- If the original list is empty, this function:
--
--   1. applies a balance-preserving transformation to the parameters, adding
--      a single minimal ada-only output to act as a change generation target,
--      such that:
--
--          computeUTxOBalanceSufficiencyInfo params ==
--          computeUTxOBalanceSufficiencyInfo (transformParams params)
--
--   2. applies an inverse transformation to the result, removing the output,
--      such that:
--
--          selectionSurplus result ==
--          selectionSurplus (transformResult result)
--
--          selectionHasValidSurplus constraints result ==>
--          selectionHasValidSurplus constraints (transformResult result)
--
performSelectionEmpty
    :: forall m ctx. (Functor m)
    => PerformSelection m NonEmpty ctx
    -> PerformSelection m []       ctx
performSelectionEmpty :: PerformSelection m NonEmpty ctx -> PerformSelection m [] ctx
performSelectionEmpty PerformSelection m NonEmpty ctx
performSelectionFn SelectionConstraints ctx
constraints SelectionParamsOf [] ctx
params =
    (SelectionResultOf NonEmpty ctx -> SelectionResultOf [] ctx)
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> Either (SelectionBalanceError ctx) (SelectionResultOf [] ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectionResultOf NonEmpty ctx -> SelectionResultOf [] ctx
transformResult (Either
   (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
 -> Either (SelectionBalanceError ctx) (SelectionResultOf [] ctx))
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf [] ctx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    PerformSelection m NonEmpty ctx
performSelectionFn SelectionConstraints ctx
constraints (SelectionParamsOf [] ctx -> SelectionParamsOf NonEmpty ctx
transformParams SelectionParamsOf [] ctx
params)
  where
    transformParams
        :: SelectionParamsOf []       ctx
        -> SelectionParamsOf NonEmpty ctx
    transformParams :: SelectionParamsOf [] ctx -> SelectionParamsOf NonEmpty ctx
transformParams p :: SelectionParamsOf [] ctx
p@SelectionParams {[(Address ctx, TokenBundle)]
TokenMap
Coin
UTxOSelection (UTxO ctx)
SelectionStrategy
selectionStrategy :: SelectionStrategy
assetsToBurn :: TokenMap
assetsToMint :: TokenMap
extraCoinSink :: Coin
extraCoinSource :: Coin
utxoAvailable :: UTxOSelection (UTxO ctx)
outputsToCover :: [(Address ctx, TokenBundle)]
$sel:selectionStrategy:SelectionParams :: forall (f :: * -> *) ctx.
SelectionParamsOf f ctx -> SelectionStrategy
$sel:assetsToBurn:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> TokenMap
$sel:assetsToMint:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> TokenMap
$sel:extraCoinSink:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> Coin
$sel:extraCoinSource:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> Coin
$sel:utxoAvailable:SelectionParams :: forall (f :: * -> *) ctx.
SelectionParamsOf f ctx -> UTxOSelection (UTxO ctx)
$sel:outputsToCover:SelectionParams :: forall (f :: * -> *) ctx.
SelectionParamsOf f ctx -> f (Address ctx, TokenBundle)
..} = SelectionParamsOf [] ctx
p
        { $sel:extraCoinSource:SelectionParams :: Coin
extraCoinSource =
            (Coin -> Coin)
-> (NonEmpty (Address ctx, TokenBundle) -> Coin -> Coin)
-> Coin
-> Coin
forall a. a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a
transform (Coin -> Coin -> Coin
`Coin.add` Coin
dummyCoin) ((Coin -> Coin)
-> NonEmpty (Address ctx, TokenBundle) -> Coin -> Coin
forall a b. a -> b -> a
const Coin -> Coin
forall a. a -> a
id) Coin
extraCoinSource
        , $sel:outputsToCover:SelectionParams :: NonEmpty (Address ctx, TokenBundle)
outputsToCover =
            ([(Address ctx, TokenBundle)]
 -> NonEmpty (Address ctx, TokenBundle))
-> (NonEmpty (Address ctx, TokenBundle)
    -> [(Address ctx, TokenBundle)]
    -> NonEmpty (Address ctx, TokenBundle))
-> [(Address ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
forall a. a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a
transform (NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
forall a b. a -> b -> a
const ((Address ctx, TokenBundle)
dummyOutput (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
forall a. a -> [a] -> NonEmpty a
:| [])) (NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
forall a b. a -> b -> a
const (NonEmpty (Address ctx, TokenBundle)
 -> [(Address ctx, TokenBundle)]
 -> NonEmpty (Address ctx, TokenBundle))
-> (NonEmpty (Address ctx, TokenBundle)
    -> NonEmpty (Address ctx, TokenBundle))
-> NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Address ctx, TokenBundle)
-> NonEmpty (Address ctx, TokenBundle)
forall a. a -> a
id) [(Address ctx, TokenBundle)]
outputsToCover
        }

    transformResult
        :: SelectionResultOf NonEmpty ctx
        -> SelectionResultOf []       ctx
    transformResult :: SelectionResultOf NonEmpty ctx -> SelectionResultOf [] ctx
transformResult r :: SelectionResultOf NonEmpty ctx
r@SelectionResult {[TokenBundle]
NonEmpty (Address ctx, TokenBundle)
NonEmpty (UTxO ctx, TokenBundle)
TokenMap
Coin
assetsToBurn :: TokenMap
assetsToMint :: TokenMap
changeGenerated :: [TokenBundle]
outputsCovered :: NonEmpty (Address ctx, TokenBundle)
extraCoinSink :: Coin
extraCoinSource :: Coin
inputsSelected :: NonEmpty (UTxO ctx, TokenBundle)
$sel:assetsToBurn:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> TokenMap
$sel:assetsToMint:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> TokenMap
$sel:changeGenerated:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> [TokenBundle]
$sel:outputsCovered:SelectionResult :: forall (f :: * -> *) ctx.
SelectionResultOf f ctx -> f (Address ctx, TokenBundle)
$sel:extraCoinSink:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> Coin
$sel:extraCoinSource:SelectionResult :: forall (f :: * -> *) ctx. SelectionResultOf f ctx -> Coin
$sel:inputsSelected:SelectionResult :: forall (f :: * -> *) ctx.
SelectionResultOf f ctx -> NonEmpty (UTxO ctx, TokenBundle)
..} = SelectionResultOf NonEmpty ctx
r
        { $sel:extraCoinSource:SelectionResult :: Coin
extraCoinSource =
            (Coin -> Coin)
-> (NonEmpty (Address ctx, TokenBundle) -> Coin -> Coin)
-> Coin
-> Coin
forall a. a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a
transform (Coin -> Coin -> Coin
`Coin.difference` Coin
dummyCoin) ((Coin -> Coin)
-> NonEmpty (Address ctx, TokenBundle) -> Coin -> Coin
forall a b. a -> b -> a
const Coin -> Coin
forall a. a -> a
id) Coin
extraCoinSource
        , $sel:outputsCovered:SelectionResult :: [(Address ctx, TokenBundle)]
outputsCovered =
            (NonEmpty (Address ctx, TokenBundle)
 -> [(Address ctx, TokenBundle)])
-> (NonEmpty (Address ctx, TokenBundle)
    -> NonEmpty (Address ctx, TokenBundle)
    -> [(Address ctx, TokenBundle)])
-> NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
forall a. a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a
transform ([(Address ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
forall a b. a -> b -> a
const []) ([(Address ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
forall a b. a -> b -> a
const ([(Address ctx, TokenBundle)]
 -> NonEmpty (Address ctx, TokenBundle)
 -> [(Address ctx, TokenBundle)])
-> (NonEmpty (Address ctx, TokenBundle)
    -> [(Address ctx, TokenBundle)])
-> NonEmpty (Address ctx, TokenBundle)
-> NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Address ctx, TokenBundle) -> [(Address ctx, TokenBundle)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList) NonEmpty (Address ctx, TokenBundle)
outputsCovered
        }

    transform :: a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a
    transform :: a -> (NonEmpty (Address ctx, TokenBundle) -> a) -> a
transform a
x NonEmpty (Address ctx, TokenBundle) -> a
y = a
-> (NonEmpty (Address ctx, TokenBundle) -> a)
-> Maybe (NonEmpty (Address ctx, TokenBundle))
-> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x NonEmpty (Address ctx, TokenBundle) -> a
y (Maybe (NonEmpty (Address ctx, TokenBundle)) -> a)
-> Maybe (NonEmpty (Address ctx, TokenBundle)) -> a
forall a b. (a -> b) -> a -> b
$ [(Address ctx, TokenBundle)]
-> Maybe (NonEmpty (Address ctx, TokenBundle))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([(Address ctx, TokenBundle)]
 -> Maybe (NonEmpty (Address ctx, TokenBundle)))
-> [(Address ctx, TokenBundle)]
-> Maybe (NonEmpty (Address ctx, TokenBundle))
forall a b. (a -> b) -> a -> b
$ (([(Address ctx, TokenBundle)]
  -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
 -> SelectionParamsOf [] ctx
 -> Const [(Address ctx, TokenBundle)] (SelectionParamsOf [] ctx))
-> SelectionParamsOf [] ctx -> [(Address ctx, TokenBundle)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputsToCover"
  (([(Address ctx, TokenBundle)]
    -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
   -> SelectionParamsOf [] ctx
   -> Const [(Address ctx, TokenBundle)] (SelectionParamsOf [] ctx))
([(Address ctx, TokenBundle)]
 -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
-> SelectionParamsOf [] ctx
-> Const [(Address ctx, TokenBundle)] (SelectionParamsOf [] ctx)
#outputsToCover SelectionParamsOf [] ctx
params

    -- A dummy output that is added before calling 'performSelectionNonEmpty'
    -- and removed immediately after selection is complete.
    --
    dummyOutput :: (Address ctx, TokenBundle)
    dummyOutput :: (Address ctx, TokenBundle)
dummyOutput = (Address ctx
dummyAddress, Coin -> TokenBundle
TokenBundle.fromCoin Coin
dummyCoin)

    -- A dummy 'Address' value for the dummy output.
    --
    -- We can use a null address here, as 'performSelectionNonEmpty' does not
    -- verify the minimum ada quantities of user-specified outputs, and hence
    -- we do not need to provide a valid address.
    --
    -- Using a null address allows us to minimize any overestimation in cost
    -- resulting from the use of a dummy output.
    --
    dummyAddress :: Address ctx
dummyAddress = SelectionConstraints ctx -> Address ctx
forall ctx. SelectionConstraints ctx -> Address ctx
nullAddress SelectionConstraints ctx
constraints

    -- A dummy 'Coin' value for the dummy output.
    --
    -- This value is chosen to be as small as possible in order to minimize
    -- any overestimation in cost resulting from the use of a dummy output.
    --
    -- However, we cannot choose a value of zero, since the change generation
    -- algorithm requires that the total ada balance of all outputs is
    -- non-zero, so instead we specify the smallest possible non-zero value.
    --
    dummyCoin :: Coin
    dummyCoin :: Coin
dummyCoin = Natural -> Coin
Coin Natural
1

performSelectionNonEmpty
    :: forall m ctx. (HasCallStack, MonadRandom m, SelectionContext ctx)
    => PerformSelection m NonEmpty ctx
performSelectionNonEmpty :: PerformSelection m NonEmpty ctx
performSelectionNonEmpty SelectionConstraints ctx
constraints SelectionParamsOf NonEmpty ctx
params
    -- Is the total available UTXO balance sufficient?
    | Bool -> Bool
not Bool
utxoBalanceSufficient =
        Either (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
 -> m (Either
         (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a b. (a -> b) -> a -> b
$ SelectionBalanceError ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. a -> Either a b
Left (SelectionBalanceError ctx
 -> Either
      (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
-> SelectionBalanceError ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. (a -> b) -> a -> b
$ BalanceInsufficientError -> SelectionBalanceError ctx
forall ctx. BalanceInsufficientError -> SelectionBalanceError ctx
BalanceInsufficient (BalanceInsufficientError -> SelectionBalanceError ctx)
-> BalanceInsufficientError -> SelectionBalanceError ctx
forall a b. (a -> b) -> a -> b
$ BalanceInsufficientError :: TokenBundle -> TokenBundle -> BalanceInsufficientError
BalanceInsufficientError
            {TokenBundle
utxoBalanceAvailable :: TokenBundle
$sel:utxoBalanceAvailable:BalanceInsufficientError :: TokenBundle
utxoBalanceAvailable, TokenBundle
utxoBalanceRequired :: TokenBundle
$sel:utxoBalanceRequired:BalanceInsufficientError :: TokenBundle
utxoBalanceRequired}

    | Bool
otherwise = do
        Maybe (UTxOSelectionNonEmpty (UTxO ctx))
maybeSelection <- RunSelectionParams (UTxO ctx)
-> m (Maybe (UTxOSelectionNonEmpty (UTxO ctx)))
forall (m :: * -> *) u.
(MonadRandom m, Ord u) =>
RunSelectionParams u -> m (Maybe (UTxOSelectionNonEmpty u))
runSelectionNonEmpty RunSelectionParams :: forall u.
SelectionLimit
-> UTxOSelection u
-> TokenBundle
-> SelectionStrategy
-> RunSelectionParams u
RunSelectionParams
            { SelectionLimit
$sel:selectionLimit:RunSelectionParams :: SelectionLimit
selectionLimit :: SelectionLimit
selectionLimit
            , UTxOSelection (UTxO ctx)
$sel:utxoAvailable:RunSelectionParams :: UTxOSelection (UTxO ctx)
utxoAvailable :: UTxOSelection (UTxO ctx)
utxoAvailable
            , $sel:minimumBalance:RunSelectionParams :: TokenBundle
minimumBalance = TokenBundle
utxoBalanceRequired
            , SelectionStrategy
$sel:selectionStrategy:RunSelectionParams :: SelectionStrategy
selectionStrategy :: SelectionStrategy
selectionStrategy
            }
        case Maybe (UTxOSelectionNonEmpty (UTxO ctx))
maybeSelection of
            Maybe (UTxOSelectionNonEmpty (UTxO ctx))
Nothing | UTxOSelection (UTxO ctx)
utxoAvailable UTxOSelection (UTxO ctx) -> UTxOSelection (UTxO ctx) -> Bool
forall a. Eq a => a -> a -> Bool
== UTxOSelection (UTxO ctx)
forall u. UTxOSelection u
UTxOSelection.empty ->
                Either (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
 -> m (Either
         (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a b. (a -> b) -> a -> b
$ SelectionBalanceError ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. a -> Either a b
Left SelectionBalanceError ctx
forall ctx. SelectionBalanceError ctx
EmptyUTxO
            Maybe (UTxOSelectionNonEmpty (UTxO ctx))
Nothing ->
                [(UTxO ctx, TokenBundle)]
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a.
[(UTxO ctx, TokenBundle)]
-> m (Either (SelectionBalanceError ctx) a)
selectionLimitReachedError []
            Just UTxOSelectionNonEmpty (UTxO ctx)
selection | UTxOSelectionNonEmpty (UTxO ctx) -> SelectionLimit -> Bool
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> SelectionLimit -> Bool
selectionLimitExceeded UTxOSelectionNonEmpty (UTxO ctx)
selection SelectionLimit
selectionLimit ->
                [(UTxO ctx, TokenBundle)]
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a.
[(UTxO ctx, TokenBundle)]
-> m (Either (SelectionBalanceError ctx) a)
selectionLimitReachedError ([(UTxO ctx, TokenBundle)]
 -> m (Either
         (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> [(UTxO ctx, TokenBundle)]
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a b. (a -> b) -> a -> b
$ NonEmpty (UTxO ctx, TokenBundle) -> [(UTxO ctx, TokenBundle)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty (UTxO ctx, TokenBundle) -> [(UTxO ctx, TokenBundle)])
-> NonEmpty (UTxO ctx, TokenBundle) -> [(UTxO ctx, TokenBundle)]
forall a b. (a -> b) -> a -> b
$
                    UTxOSelectionNonEmpty (UTxO ctx)
-> SelectedList UTxOSelectionNonEmpty (UTxO ctx)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> SelectedList s u
UTxOSelection.selectedList UTxOSelectionNonEmpty (UTxO ctx)
selection
            Just UTxOSelectionNonEmpty (UTxO ctx)
selection -> do
                let utxoSelected :: UTxOIndex (UTxO ctx)
utxoSelected = UTxOSelectionNonEmpty (UTxO ctx) -> UTxOIndex (UTxO ctx)
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
UTxOSelection.selectedIndex UTxOSelectionNonEmpty (UTxO ctx)
selection
                let utxoBalanceSelected :: TokenBundle
utxoBalanceSelected = UTxOIndex (UTxO ctx) -> TokenBundle
forall u. UTxOIndex u -> TokenBundle
UTxOIndex.balance UTxOIndex (UTxO ctx)
utxoSelected
                if TokenBundle
utxoBalanceRequired TokenBundle -> TokenBundle -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenBundle
utxoBalanceSelected
                then UTxOSelectionNonEmpty (UTxO ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
makeChangeRepeatedly UTxOSelectionNonEmpty (UTxO ctx)
selection
                else [(UTxO ctx, TokenBundle)]
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a.
[(UTxO ctx, TokenBundle)]
-> m (Either (SelectionBalanceError ctx) a)
selectionLimitReachedError (UTxOIndex (UTxO ctx) -> [(UTxO ctx, TokenBundle)]
forall u. UTxOIndex u -> [(u, TokenBundle)]
UTxOIndex.toList UTxOIndex (UTxO ctx)
utxoSelected)
  where
    SelectionConstraints
        { TokenBundle -> TokenBundleSizeAssessment
assessTokenBundleSize :: TokenBundle -> TokenBundleSizeAssessment
$sel:assessTokenBundleSize:SelectionConstraints :: forall ctx.
SelectionConstraints ctx
-> TokenBundle -> TokenBundleSizeAssessment
assessTokenBundleSize
        , Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity :: Address ctx -> TokenMap -> Coin
$sel:computeMinimumAdaQuantity:SelectionConstraints :: forall ctx.
SelectionConstraints ctx -> Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity
        , SelectionSkeleton ctx -> Coin
computeMinimumCost :: SelectionSkeleton ctx -> Coin
$sel:computeMinimumCost:SelectionConstraints :: forall ctx.
SelectionConstraints ctx -> SelectionSkeleton ctx -> Coin
computeMinimumCost
        , [(Address ctx, TokenBundle)] -> SelectionLimit
computeSelectionLimit :: [(Address ctx, TokenBundle)] -> SelectionLimit
$sel:computeSelectionLimit:SelectionConstraints :: forall ctx.
SelectionConstraints ctx
-> [(Address ctx, TokenBundle)] -> SelectionLimit
computeSelectionLimit
        , Coin
maximumOutputAdaQuantity :: Coin
$sel:maximumOutputAdaQuantity:SelectionConstraints :: forall ctx. SelectionConstraints ctx -> Coin
maximumOutputAdaQuantity
        , TokenQuantity
maximumOutputTokenQuantity :: TokenQuantity
$sel:maximumOutputTokenQuantity:SelectionConstraints :: forall ctx. SelectionConstraints ctx -> TokenQuantity
maximumOutputTokenQuantity
        , Address ctx
maximumLengthChangeAddress :: Address ctx
$sel:maximumLengthChangeAddress:SelectionConstraints :: forall ctx. SelectionConstraints ctx -> Address ctx
maximumLengthChangeAddress
        } = SelectionConstraints ctx
constraints
    SelectionParams
        { NonEmpty (Address ctx, TokenBundle)
outputsToCover :: NonEmpty (Address ctx, TokenBundle)
$sel:outputsToCover:SelectionParams :: forall (f :: * -> *) ctx.
SelectionParamsOf f ctx -> f (Address ctx, TokenBundle)
outputsToCover
        , UTxOSelection (UTxO ctx)
utxoAvailable :: UTxOSelection (UTxO ctx)
$sel:utxoAvailable:SelectionParams :: forall (f :: * -> *) ctx.
SelectionParamsOf f ctx -> UTxOSelection (UTxO ctx)
utxoAvailable
        , Coin
extraCoinSource :: Coin
$sel:extraCoinSource:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> Coin
extraCoinSource
        , Coin
extraCoinSink :: Coin
$sel:extraCoinSink:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> Coin
extraCoinSink
        , TokenMap
assetsToMint :: TokenMap
$sel:assetsToMint:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> TokenMap
assetsToMint
        , TokenMap
assetsToBurn :: TokenMap
$sel:assetsToBurn:SelectionParams :: forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> TokenMap
assetsToBurn
        , SelectionStrategy
selectionStrategy :: SelectionStrategy
$sel:selectionStrategy:SelectionParams :: forall (f :: * -> *) ctx.
SelectionParamsOf f ctx -> SelectionStrategy
selectionStrategy
        } = SelectionParamsOf NonEmpty ctx
params

    selectionLimitReachedError
        :: [(UTxO ctx, TokenBundle)] -> m (Either (SelectionBalanceError ctx) a)
    selectionLimitReachedError :: [(UTxO ctx, TokenBundle)]
-> m (Either (SelectionBalanceError ctx) a)
selectionLimitReachedError [(UTxO ctx, TokenBundle)]
inputsSelected =
        Either (SelectionBalanceError ctx) a
-> m (Either (SelectionBalanceError ctx) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (SelectionBalanceError ctx) a
 -> m (Either (SelectionBalanceError ctx) a))
-> Either (SelectionBalanceError ctx) a
-> m (Either (SelectionBalanceError ctx) a)
forall a b. (a -> b) -> a -> b
$ SelectionBalanceError ctx -> Either (SelectionBalanceError ctx) a
forall a b. a -> Either a b
Left (SelectionBalanceError ctx -> Either (SelectionBalanceError ctx) a)
-> SelectionBalanceError ctx
-> Either (SelectionBalanceError ctx) a
forall a b. (a -> b) -> a -> b
$ SelectionLimitReachedError ctx -> SelectionBalanceError ctx
forall ctx.
SelectionLimitReachedError ctx -> SelectionBalanceError ctx
SelectionLimitReached (SelectionLimitReachedError ctx -> SelectionBalanceError ctx)
-> SelectionLimitReachedError ctx -> SelectionBalanceError ctx
forall a b. (a -> b) -> a -> b
$ SelectionLimitReachedError :: forall ctx.
TokenBundle
-> [(UTxO ctx, TokenBundle)]
-> NonEmpty (Address ctx, TokenBundle)
-> SelectionLimitReachedError ctx
SelectionLimitReachedError
            { [(UTxO ctx, TokenBundle)]
inputsSelected :: [(UTxO ctx, TokenBundle)]
$sel:inputsSelected:SelectionLimitReachedError :: [(UTxO ctx, TokenBundle)]
inputsSelected
            , TokenBundle
utxoBalanceRequired :: TokenBundle
$sel:utxoBalanceRequired:SelectionLimitReachedError :: TokenBundle
utxoBalanceRequired
            , NonEmpty (Address ctx, TokenBundle)
outputsToCover :: NonEmpty (Address ctx, TokenBundle)
$sel:outputsToCover:SelectionLimitReachedError :: NonEmpty (Address ctx, TokenBundle)
outputsToCover
            }

    selectionLimit :: SelectionLimit
    selectionLimit :: SelectionLimit
selectionLimit = [(Address ctx, TokenBundle)] -> SelectionLimit
computeSelectionLimit ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)] -> SelectionLimit
forall a b. (a -> b) -> a -> b
$ NonEmpty (Address ctx, TokenBundle) -> [(Address ctx, TokenBundle)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty (Address ctx, TokenBundle)
outputsToCover

    utxoBalanceAvailable :: TokenBundle
    utxoBalanceAvailable :: TokenBundle
utxoBalanceAvailable = SelectionParamsOf NonEmpty ctx -> TokenBundle
forall (f :: * -> *) ctx. SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceAvailable SelectionParamsOf NonEmpty ctx
params

    utxoBalanceRequired :: TokenBundle
    utxoBalanceRequired :: TokenBundle
utxoBalanceRequired = SelectionParamsOf NonEmpty ctx -> TokenBundle
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> TokenBundle
computeUTxOBalanceRequired SelectionParamsOf NonEmpty ctx
params

    utxoBalanceSufficient :: Bool
    utxoBalanceSufficient :: Bool
utxoBalanceSufficient = SelectionParamsOf NonEmpty ctx -> Bool
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> Bool
isUTxOBalanceSufficient SelectionParamsOf NonEmpty ctx
params

    -- Given a UTxO index that corresponds to a valid selection covering
    -- 'outputsToCover', 'predictChange' yields a non-empty list of assets
    -- expected for change outputs.
    --
    -- There's a chicken-and-egg situation when it comes to calculating
    -- transaction fees. On the one hand, we need to know the shape of the
    -- final transaction to calculate its cost. But in order to construct the
    -- transaction, we need to know what its cost is.
    --
    -- So, in order to not duplicate the logic from 'makeChange', we first
    -- calculate a pre-selection considering the case where we have no fees to
    -- pay, and no minimum value. This is *guaranteed to succeed* and will
    -- yield a selection with change outputs in the final shape (modulo
    -- amounts).
    --
    -- The result of calling 'predictChange' with a valid input selection
    -- should satisfy:
    --
    --     length predictedChange === length outputsToCover
    --
    --     flat predictChange `isSubsetOf` assets selectedInputs
    --
    --     ∃ params. / isRight (performSelection params) =>
    --         Right predictedChange === assets <$> performSelection params
    --
    --     (That is, the predicted change is necessarily equal to the change
    --     assets of the final resulting selection).
    --
    predictChange :: UTxOSelectionNonEmpty (UTxO ctx) -> [Set AssetId]
    predictChange :: UTxOSelectionNonEmpty (UTxO ctx) -> [Set AssetId]
predictChange UTxOSelectionNonEmpty (UTxO ctx)
s = (UnableToConstructChangeError -> [Set AssetId])
-> ([TokenBundle] -> [Set AssetId])
-> Either UnableToConstructChangeError [TokenBundle]
-> [Set AssetId]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        ([Set AssetId] -> UnableToConstructChangeError -> [Set AssetId]
forall a b. a -> b -> a
const ([Set AssetId] -> UnableToConstructChangeError -> [Set AssetId])
-> [Set AssetId] -> UnableToConstructChangeError -> [Set AssetId]
forall a b. (a -> b) -> a -> b
$ UTxOIndex (UTxO ctx) -> [Set AssetId]
invariantResultWithNoCost (UTxOIndex (UTxO ctx) -> [Set AssetId])
-> UTxOIndex (UTxO ctx) -> [Set AssetId]
forall a b. (a -> b) -> a -> b
$ UTxOSelectionNonEmpty (UTxO ctx) -> UTxOIndex (UTxO ctx)
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
UTxOSelection.selectedIndex UTxOSelectionNonEmpty (UTxO ctx)
s)
        ((TokenBundle -> Set AssetId) -> [TokenBundle] -> [Set AssetId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenMap -> Set AssetId
TokenMap.getAssets (TokenMap -> Set AssetId)
-> (TokenBundle -> TokenMap) -> TokenBundle -> Set AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens))
        (MakeChangeCriteria (TokenMap -> Coin) TokenBundleSizeAssessor
-> Either UnableToConstructChangeError [TokenBundle]
makeChange MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
minCoinFor
-> bundleSizeAssessor
-> Coin
-> Coin
-> Coin
-> NonEmpty TokenBundle
-> NonEmpty TokenBundle
-> TokenMap
-> TokenMap
-> Coin
-> TokenQuantity
-> MakeChangeCriteria minCoinFor bundleSizeAssessor
MakeChangeCriteria
            { $sel:minCoinFor:MakeChangeCriteria :: TokenMap -> Coin
minCoinFor = TokenMap -> Coin
noMinimumCoin
            , $sel:bundleSizeAssessor:MakeChangeCriteria :: TokenBundleSizeAssessor
bundleSizeAssessor = (TokenBundle -> TokenBundleSizeAssessment)
-> TokenBundleSizeAssessor
TokenBundleSizeAssessor TokenBundle -> TokenBundleSizeAssessment
assessTokenBundleSize
            , $sel:requiredCost:MakeChangeCriteria :: Coin
requiredCost = Coin
noCost
            , Coin
$sel:extraCoinSource:MakeChangeCriteria :: Coin
extraCoinSource :: Coin
extraCoinSource
            , Coin
$sel:extraCoinSink:MakeChangeCriteria :: Coin
extraCoinSink :: Coin
extraCoinSink
            , NonEmpty TokenBundle
$sel:inputBundles:MakeChangeCriteria :: NonEmpty TokenBundle
inputBundles :: NonEmpty TokenBundle
inputBundles
            , NonEmpty TokenBundle
$sel:outputBundles:MakeChangeCriteria :: NonEmpty TokenBundle
outputBundles :: NonEmpty TokenBundle
outputBundles
            , TokenMap
$sel:assetsToMint:MakeChangeCriteria :: TokenMap
assetsToMint :: TokenMap
assetsToMint
            , TokenMap
$sel:assetsToBurn:MakeChangeCriteria :: TokenMap
assetsToBurn :: TokenMap
assetsToBurn
            , Coin
$sel:maximumOutputAdaQuantity:MakeChangeCriteria :: Coin
maximumOutputAdaQuantity :: Coin
maximumOutputAdaQuantity
            , TokenQuantity
$sel:maximumOutputTokenQuantity:MakeChangeCriteria :: TokenQuantity
maximumOutputTokenQuantity :: TokenQuantity
maximumOutputTokenQuantity
            }
        )
      where
        inputBundles :: NonEmpty TokenBundle
inputBundles = (UTxO ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd ((UTxO ctx, TokenBundle) -> TokenBundle)
-> NonEmpty (UTxO ctx, TokenBundle) -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOSelectionNonEmpty (UTxO ctx)
-> SelectedList UTxOSelectionNonEmpty (UTxO ctx)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> SelectedList s u
UTxOSelection.selectedList UTxOSelectionNonEmpty (UTxO ctx)
s
        outputBundles :: NonEmpty TokenBundle
outputBundles = (Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd ((Address ctx, TokenBundle) -> TokenBundle)
-> NonEmpty (Address ctx, TokenBundle) -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Address ctx, TokenBundle)
outputsToCover

        noMinimumCoin :: TokenMap -> Coin
        noMinimumCoin :: TokenMap -> Coin
noMinimumCoin = Coin -> TokenMap -> Coin
forall a b. a -> b -> a
const (Natural -> Coin
Coin Natural
0)

        noCost :: Coin
        noCost :: Coin
noCost = Natural -> Coin
Coin Natural
0

    -- This function takes the given selection skeleton as a way to evaluate
    -- the cost of a final selection, and then calls 'makeChange' repeatedly
    -- until it succeeds.
    --
    -- Between each call, it selects an extra ada-only input to inject
    -- additional ada to construct change outputs.
    --
    -- Eventually it returns just a final selection, or 'Nothing' if no more
    -- ada-only inputs are available.
    --
    -- This function also takes a set of tokens that are to be burned, and
    -- hence although one or more inputs will be consumed for them, this
    -- function won't make associated outputs for them.
    --
    makeChangeRepeatedly
        :: UTxOSelectionNonEmpty (UTxO ctx)
        -> m (Either
                (SelectionBalanceError ctx)
                (SelectionResultOf NonEmpty ctx))
    makeChangeRepeatedly :: UTxOSelectionNonEmpty (UTxO ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
makeChangeRepeatedly UTxOSelectionNonEmpty (UTxO ctx)
s = case Either UnableToConstructChangeError [TokenBundle]
mChangeGenerated of

        Right [TokenBundle]
change | [TokenBundle] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TokenBundle]
change Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= NonEmpty (Address ctx, TokenBundle) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Address ctx, TokenBundle)
outputsToCover ->
            -- We've succeeded in making at least the optimal number of change
            -- outputs, and can terminate here.
            --
            -- Note that we can't use an exact length equality check here, as
            -- the 'makeChange' function will split up change outputs if they
            -- are oversized in any way. (See 'splitOversizedMaps'.)
            --
            -- It is therefore possible for 'makeChange' to generate more change
            -- outputs than the number of user-specified outputs.
            --
            Either (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
 -> m (Either
         (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a b. (a -> b) -> a -> b
$ SelectionResultOf NonEmpty ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. b -> Either a b
Right (SelectionResultOf NonEmpty ctx
 -> Either
      (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
-> SelectionResultOf NonEmpty ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. (a -> b) -> a -> b
$ [TokenBundle] -> SelectionResultOf NonEmpty ctx
mkSelectionResult [TokenBundle]
change

        Right [TokenBundle]
change ->
            -- We've succeeded in making change outputs, but the number of
            -- change outputs is fewer than optimal, because the supply of ada
            -- was insufficient. Try again with more ada to see if it leads to
            -- an improvement:
            UTxOSelectionNonEmpty (UTxO ctx)
-> m (Maybe (UTxOSelectionNonEmpty (UTxO ctx)))
selectOneEntry UTxOSelectionNonEmpty (UTxO ctx)
s m (Maybe (UTxOSelectionNonEmpty (UTxO ctx)))
-> (Maybe (UTxOSelectionNonEmpty (UTxO ctx))
    -> m (Either
            (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just UTxOSelectionNonEmpty (UTxO ctx)
s' ->
                    UTxOSelectionNonEmpty (UTxO ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
makeChangeRepeatedly UTxOSelectionNonEmpty (UTxO ctx)
s'
                Maybe (UTxOSelectionNonEmpty (UTxO ctx))
Nothing ->
                    -- There is no more ada available. Terminate with a
                    -- less-than-optimal number of change outputs.
                    Either (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
 -> m (Either
         (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a b. (a -> b) -> a -> b
$ SelectionResultOf NonEmpty ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. b -> Either a b
Right (SelectionResultOf NonEmpty ctx
 -> Either
      (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
-> SelectionResultOf NonEmpty ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. (a -> b) -> a -> b
$ [TokenBundle] -> SelectionResultOf NonEmpty ctx
mkSelectionResult [TokenBundle]
change

        Left UnableToConstructChangeError
changeErr ->
            -- We've failed to make any change outputs, because the supply of
            -- ada was insufficient. Try again with more ada.
            UTxOSelectionNonEmpty (UTxO ctx)
-> m (Maybe (UTxOSelectionNonEmpty (UTxO ctx)))
selectOneEntry UTxOSelectionNonEmpty (UTxO ctx)
s m (Maybe (UTxOSelectionNonEmpty (UTxO ctx)))
-> (Maybe (UTxOSelectionNonEmpty (UTxO ctx))
    -> m (Either
            (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just UTxOSelectionNonEmpty (UTxO ctx)
s' ->
                    UTxOSelectionNonEmpty (UTxO ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
makeChangeRepeatedly UTxOSelectionNonEmpty (UTxO ctx)
s'
                Maybe (UTxOSelectionNonEmpty (UTxO ctx))
Nothing ->
                    -- There is no more ada available, and we were unable to
                    -- make any change. At this point we must simply give up.
                    Either (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
 -> m (Either
         (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)))
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
-> m (Either
        (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
forall a b. (a -> b) -> a -> b
$ SelectionBalanceError ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. a -> Either a b
Left (SelectionBalanceError ctx
 -> Either
      (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx))
-> SelectionBalanceError ctx
-> Either
     (SelectionBalanceError ctx) (SelectionResultOf NonEmpty ctx)
forall a b. (a -> b) -> a -> b
$ UnableToConstructChangeError -> SelectionBalanceError ctx
forall ctx.
UnableToConstructChangeError -> SelectionBalanceError ctx
UnableToConstructChange UnableToConstructChangeError
changeErr
      where
        mChangeGenerated :: Either UnableToConstructChangeError [TokenBundle]
        mChangeGenerated :: Either UnableToConstructChangeError [TokenBundle]
mChangeGenerated = MakeChangeCriteria (TokenMap -> Coin) TokenBundleSizeAssessor
-> Either UnableToConstructChangeError [TokenBundle]
makeChange MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
minCoinFor
-> bundleSizeAssessor
-> Coin
-> Coin
-> Coin
-> NonEmpty TokenBundle
-> NonEmpty TokenBundle
-> TokenMap
-> TokenMap
-> Coin
-> TokenQuantity
-> MakeChangeCriteria minCoinFor bundleSizeAssessor
MakeChangeCriteria
            { $sel:minCoinFor:MakeChangeCriteria :: TokenMap -> Coin
minCoinFor = Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity Address ctx
maximumLengthChangeAddress
            , $sel:bundleSizeAssessor:MakeChangeCriteria :: TokenBundleSizeAssessor
bundleSizeAssessor = (TokenBundle -> TokenBundleSizeAssessment)
-> TokenBundleSizeAssessor
TokenBundleSizeAssessor TokenBundle -> TokenBundleSizeAssessment
assessTokenBundleSize
            , Coin
requiredCost :: Coin
$sel:requiredCost:MakeChangeCriteria :: Coin
requiredCost
            , Coin
$sel:extraCoinSource:MakeChangeCriteria :: Coin
extraCoinSource :: Coin
extraCoinSource
            , Coin
$sel:extraCoinSink:MakeChangeCriteria :: Coin
extraCoinSink :: Coin
extraCoinSink
            , $sel:inputBundles:MakeChangeCriteria :: NonEmpty TokenBundle
inputBundles = (UTxO ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd ((UTxO ctx, TokenBundle) -> TokenBundle)
-> NonEmpty (UTxO ctx, TokenBundle) -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (UTxO ctx, TokenBundle)
SelectedList UTxOSelectionNonEmpty (UTxO ctx)
inputsSelected
            , $sel:outputBundles:MakeChangeCriteria :: NonEmpty TokenBundle
outputBundles = (Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd ((Address ctx, TokenBundle) -> TokenBundle)
-> NonEmpty (Address ctx, TokenBundle) -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Address ctx, TokenBundle)
outputsToCover
            , TokenMap
$sel:assetsToMint:MakeChangeCriteria :: TokenMap
assetsToMint :: TokenMap
assetsToMint
            , TokenMap
$sel:assetsToBurn:MakeChangeCriteria :: TokenMap
assetsToBurn :: TokenMap
assetsToBurn
            , Coin
$sel:maximumOutputAdaQuantity:MakeChangeCriteria :: Coin
maximumOutputAdaQuantity :: Coin
maximumOutputAdaQuantity
            , TokenQuantity
$sel:maximumOutputTokenQuantity:MakeChangeCriteria :: TokenQuantity
maximumOutputTokenQuantity :: TokenQuantity
maximumOutputTokenQuantity
            }

        mkSelectionResult :: [TokenBundle] -> SelectionResultOf NonEmpty ctx
        mkSelectionResult :: [TokenBundle] -> SelectionResultOf NonEmpty ctx
mkSelectionResult [TokenBundle]
changeGenerated = SelectionResult :: forall (f :: * -> *) ctx.
NonEmpty (UTxO ctx, TokenBundle)
-> Coin
-> Coin
-> f (Address ctx, TokenBundle)
-> [TokenBundle]
-> TokenMap
-> TokenMap
-> SelectionResultOf f ctx
SelectionResult
            { NonEmpty (UTxO ctx, TokenBundle)
SelectedList UTxOSelectionNonEmpty (UTxO ctx)
inputsSelected :: SelectedList UTxOSelectionNonEmpty (UTxO ctx)
$sel:inputsSelected:SelectionResult :: NonEmpty (UTxO ctx, TokenBundle)
inputsSelected
            , Coin
extraCoinSource :: Coin
$sel:extraCoinSource:SelectionResult :: Coin
extraCoinSource
            , Coin
extraCoinSink :: Coin
$sel:extraCoinSink:SelectionResult :: Coin
extraCoinSink
            , $sel:changeGenerated:SelectionResult :: [TokenBundle]
changeGenerated = [TokenBundle]
changeGenerated
            , $sel:outputsCovered:SelectionResult :: NonEmpty (Address ctx, TokenBundle)
outputsCovered = NonEmpty (Address ctx, TokenBundle)
outputsToCover
            , TokenMap
assetsToMint :: TokenMap
$sel:assetsToMint:SelectionResult :: TokenMap
assetsToMint
            , TokenMap
assetsToBurn :: TokenMap
$sel:assetsToBurn:SelectionResult :: TokenMap
assetsToBurn
            }

        selectOneEntry :: UTxOSelectionNonEmpty (UTxO ctx)
-> m (Maybe (UTxOSelectionNonEmpty (UTxO ctx)))
selectOneEntry = Asset
-> SelectionLimit
-> UTxOSelectionNonEmpty (UTxO ctx)
-> m (Maybe (UTxOSelectionNonEmpty (UTxO ctx)))
forall (m :: * -> *) u (utxoSelection :: * -> *).
(MonadRandom m, Ord u, IsUTxOSelection utxoSelection u) =>
Asset
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantityOf Asset
AssetLovelace SelectionLimit
selectionLimit

        requiredCost :: Coin
requiredCost = SelectionSkeleton ctx -> Coin
computeMinimumCost SelectionSkeleton :: forall ctx.
Int
-> [(Address ctx, TokenBundle)]
-> [Set AssetId]
-> SelectionSkeleton ctx
SelectionSkeleton
            { $sel:skeletonInputCount:SelectionSkeleton :: Int
skeletonInputCount = UTxOSelectionNonEmpty (UTxO ctx) -> Int
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Int
UTxOSelection.selectedSize UTxOSelectionNonEmpty (UTxO ctx)
s
            , $sel:skeletonOutputs:SelectionSkeleton :: [(Address ctx, TokenBundle)]
skeletonOutputs = NonEmpty (Address ctx, TokenBundle) -> [(Address ctx, TokenBundle)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Address ctx, TokenBundle)
outputsToCover
            , [Set AssetId]
skeletonChange :: [Set AssetId]
$sel:skeletonChange:SelectionSkeleton :: [Set AssetId]
skeletonChange
            }

        skeletonChange :: [Set AssetId]
skeletonChange = UTxOSelectionNonEmpty (UTxO ctx) -> [Set AssetId]
predictChange UTxOSelectionNonEmpty (UTxO ctx)
s
        inputsSelected :: SelectedList UTxOSelectionNonEmpty (UTxO ctx)
inputsSelected = UTxOSelectionNonEmpty (UTxO ctx)
-> SelectedList UTxOSelectionNonEmpty (UTxO ctx)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> SelectedList s u
UTxOSelection.selectedList UTxOSelectionNonEmpty (UTxO ctx)
s

    invariantResultWithNoCost :: UTxOIndex (UTxO ctx) -> [Set AssetId]
invariantResultWithNoCost UTxOIndex (UTxO ctx)
inputs_ = String -> [Set AssetId]
forall a. HasCallStack => String -> a
error (String -> [Set AssetId]) -> String -> [Set AssetId]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        -- This should be impossible, as the 'makeChange' function should
        -- always succeed if there's no extra cost or minimum value to assign.
        -- This is because it is called with the result of 'runSelection',
        -- which only terminates successfully if the target was satisfied.
        [ Item [String]
"performSelection: couldn't construct change for a selection with no "
        , Item [String]
"minimum coin value and no cost!"
        , String
"inputs: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTxOIndex (UTxO ctx) -> String
forall a. Show a => a -> String
show UTxOIndex (UTxO ctx)
inputs_
        , String
"extra coin source: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show Coin
extraCoinSource
        , String
"extra coin sink: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show Coin
extraCoinSink
        , String
"outputs: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Address ctx, TokenBundle) -> String
forall a. Show a => a -> String
show NonEmpty (Address ctx, TokenBundle)
outputsToCover
        ]

--------------------------------------------------------------------------------
-- Running a selection (without making change)
--------------------------------------------------------------------------------

-- | Parameters for 'runSelection'.
--
data RunSelectionParams u = RunSelectionParams
    { RunSelectionParams u -> SelectionLimit
selectionLimit :: SelectionLimit
        -- ^ A limit to adhere to when performing a selection.
    , RunSelectionParams u -> UTxOSelection u
utxoAvailable :: (UTxOSelection u)
        -- ^ UTxO entries available for selection.
    , RunSelectionParams u -> TokenBundle
minimumBalance :: TokenBundle
        -- ^ Minimum balance to cover.
    , RunSelectionParams u -> SelectionStrategy
selectionStrategy :: SelectionStrategy
        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
    }
    deriving (RunSelectionParams u -> RunSelectionParams u -> Bool
(RunSelectionParams u -> RunSelectionParams u -> Bool)
-> (RunSelectionParams u -> RunSelectionParams u -> Bool)
-> Eq (RunSelectionParams u)
forall u.
Eq u =>
RunSelectionParams u -> RunSelectionParams u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunSelectionParams u -> RunSelectionParams u -> Bool
$c/= :: forall u.
Eq u =>
RunSelectionParams u -> RunSelectionParams u -> Bool
== :: RunSelectionParams u -> RunSelectionParams u -> Bool
$c== :: forall u.
Eq u =>
RunSelectionParams u -> RunSelectionParams u -> Bool
Eq, (forall x. RunSelectionParams u -> Rep (RunSelectionParams u) x)
-> (forall x. Rep (RunSelectionParams u) x -> RunSelectionParams u)
-> Generic (RunSelectionParams u)
forall x. Rep (RunSelectionParams u) x -> RunSelectionParams u
forall x. RunSelectionParams u -> Rep (RunSelectionParams u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x. Rep (RunSelectionParams u) x -> RunSelectionParams u
forall u x. RunSelectionParams u -> Rep (RunSelectionParams u) x
$cto :: forall u x. Rep (RunSelectionParams u) x -> RunSelectionParams u
$cfrom :: forall u x. RunSelectionParams u -> Rep (RunSelectionParams u) x
Generic, Int -> RunSelectionParams u -> ShowS
[RunSelectionParams u] -> ShowS
RunSelectionParams u -> String
(Int -> RunSelectionParams u -> ShowS)
-> (RunSelectionParams u -> String)
-> ([RunSelectionParams u] -> ShowS)
-> Show (RunSelectionParams u)
forall u. Show u => Int -> RunSelectionParams u -> ShowS
forall u. Show u => [RunSelectionParams u] -> ShowS
forall u. Show u => RunSelectionParams u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunSelectionParams u] -> ShowS
$cshowList :: forall u. Show u => [RunSelectionParams u] -> ShowS
show :: RunSelectionParams u -> String
$cshow :: forall u. Show u => RunSelectionParams u -> String
showsPrec :: Int -> RunSelectionParams u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> RunSelectionParams u -> ShowS
Show)

runSelectionNonEmpty
    :: (MonadRandom m, Ord u)
    => RunSelectionParams u
    -> m (Maybe (UTxOSelectionNonEmpty u))
runSelectionNonEmpty :: RunSelectionParams u -> m (Maybe (UTxOSelectionNonEmpty u))
runSelectionNonEmpty = (UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> m (UTxOSelection u) -> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<)
    ((UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
 -> m (UTxOSelection u) -> m (Maybe (UTxOSelectionNonEmpty u)))
-> (RunSelectionParams u
    -> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> RunSelectionParams u
-> m (UTxOSelection u)
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) u.
Monad m =>
(UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
runSelectionNonEmptyWith
        ((UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
 -> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> (RunSelectionParams u
    -> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> RunSelectionParams u
-> UTxOSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Asset
-> SelectionLimit
-> UTxOSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) u (utxoSelection :: * -> *).
(MonadRandom m, Ord u, IsUTxOSelection utxoSelection u) =>
Asset
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantityOf Asset
AssetLovelace
        (SelectionLimit
 -> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> (RunSelectionParams u -> SelectionLimit)
-> RunSelectionParams u
-> UTxOSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SelectionLimit -> Const SelectionLimit SelectionLimit)
 -> RunSelectionParams u
 -> Const SelectionLimit (RunSelectionParams u))
-> RunSelectionParams u -> SelectionLimit
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "selectionLimit"
  ((SelectionLimit -> Const SelectionLimit SelectionLimit)
   -> RunSelectionParams u
   -> Const SelectionLimit (RunSelectionParams u))
(SelectionLimit -> Const SelectionLimit SelectionLimit)
-> RunSelectionParams u
-> Const SelectionLimit (RunSelectionParams u)
#selectionLimit
    (RunSelectionParams u
 -> m (UTxOSelection u) -> m (Maybe (UTxOSelectionNonEmpty u)))
-> (RunSelectionParams u -> m (UTxOSelection u))
-> RunSelectionParams u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RunSelectionParams u -> m (UTxOSelection u)
forall (m :: * -> *) u.
(MonadRandom m, Ord u) =>
RunSelectionParams u -> m (UTxOSelection u)
runSelection

runSelectionNonEmptyWith
    :: Monad m
    => (UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
    -> UTxOSelection u
    -> m (Maybe (UTxOSelectionNonEmpty u))
runSelectionNonEmptyWith :: (UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
runSelectionNonEmptyWith UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
selectSingleEntry UTxOSelection u
result =
    UTxOSelection u -> Maybe (UTxOSelectionNonEmpty u)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Maybe (UTxOSelectionNonEmpty u)
UTxOSelection.toNonEmpty UTxOSelection u
result Maybe (UTxOSelectionNonEmpty u)
-> (Maybe (UTxOSelectionNonEmpty u)
    -> m (Maybe (UTxOSelectionNonEmpty u)))
-> m (Maybe (UTxOSelectionNonEmpty u))
forall a b. a -> (a -> b) -> b
& m (Maybe (UTxOSelectionNonEmpty u))
-> (UTxOSelectionNonEmpty u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> Maybe (UTxOSelectionNonEmpty u)
-> m (Maybe (UTxOSelectionNonEmpty u))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (UTxOSelection u
result UTxOSelection u
-> (UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> m (Maybe (UTxOSelectionNonEmpty u))
forall a b. a -> (a -> b) -> b
& UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
selectSingleEntry)
        (Maybe (UTxOSelectionNonEmpty u)
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (UTxOSelectionNonEmpty u)
 -> m (Maybe (UTxOSelectionNonEmpty u)))
-> (UTxOSelectionNonEmpty u -> Maybe (UTxOSelectionNonEmpty u))
-> UTxOSelectionNonEmpty u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOSelectionNonEmpty u -> Maybe (UTxOSelectionNonEmpty u)
forall a. a -> Maybe a
Just)

runSelection
    :: forall m u. (MonadRandom m, Ord u)
    => RunSelectionParams u
    -> m (UTxOSelection u)
runSelection :: RunSelectionParams u -> m (UTxOSelection u)
runSelection RunSelectionParams u
params =
    UTxOSelection u
-> (UTxOSelectionNonEmpty u -> UTxOSelection u)
-> [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
-> m (UTxOSelection u)
forall (m :: * -> *) s s'.
Monad m =>
s -> (s' -> s) -> [s -> m (Maybe s')] -> m s
runRoundRobinM UTxOSelection u
utxoAvailable UTxOSelectionNonEmpty u -> UTxOSelection u
forall u. UTxOSelectionNonEmpty u -> UTxOSelection u
UTxOSelection.fromNonEmpty [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
selectors
  where
    RunSelectionParams
        { SelectionLimit
selectionLimit :: SelectionLimit
$sel:selectionLimit:RunSelectionParams :: forall u. RunSelectionParams u -> SelectionLimit
selectionLimit
        , UTxOSelection u
utxoAvailable :: UTxOSelection u
$sel:utxoAvailable:RunSelectionParams :: forall u. RunSelectionParams u -> UTxOSelection u
utxoAvailable
        , TokenBundle
minimumBalance :: TokenBundle
$sel:minimumBalance:RunSelectionParams :: forall u. RunSelectionParams u -> TokenBundle
minimumBalance
        , SelectionStrategy
selectionStrategy :: SelectionStrategy
$sel:selectionStrategy:RunSelectionParams :: forall u. RunSelectionParams u -> SelectionStrategy
selectionStrategy
        } = RunSelectionParams u
params

    -- NOTE: We run the 'coinSelector' last, because we know that every input
    -- necessarily has a non-zero ada amount. By running the other selectors
    -- first, we increase the probability that the coin selector will be able
    -- to terminate without needing to select an additional coin.
    selectors :: [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
    selectors :: [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
selectors =
        [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
-> [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
forall a. [a] -> [a]
reverse (UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
coinSelector (UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
-> [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
forall a. a -> [a] -> [a]
: ((AssetId, TokenQuantity)
 -> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> [(AssetId, TokenQuantity)]
-> [UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AssetId, TokenQuantity)
-> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
assetSelector [(AssetId, TokenQuantity)]
minimumAssetQuantities)
      where
        assetSelector :: (AssetId, TokenQuantity)
-> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
assetSelector = SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
-> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) state state'.
Monad m =>
SelectionLens m state state' -> state -> m (Maybe state')
runSelectionStep (SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
 -> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> ((AssetId, TokenQuantity)
    -> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u))
-> (AssetId, TokenQuantity)
-> UTxOSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            SelectionLimit
-> SelectionStrategy
-> (AssetId, TokenQuantity)
-> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
forall (m :: * -> *) u.
(MonadRandom m, Ord u) =>
SelectionLimit
-> SelectionStrategy
-> (AssetId, TokenQuantity)
-> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
assetSelectionLens SelectionLimit
selectionLimit SelectionStrategy
selectionStrategy
        coinSelector :: UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
coinSelector = SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
-> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) state state'.
Monad m =>
SelectionLens m state state' -> state -> m (Maybe state')
runSelectionStep (SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
 -> UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u)))
-> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
-> UTxOSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall a b. (a -> b) -> a -> b
$
            SelectionLimit
-> SelectionStrategy
-> Coin
-> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
forall (m :: * -> *) u.
(MonadRandom m, Ord u) =>
SelectionLimit
-> SelectionStrategy
-> Coin
-> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
coinSelectionLens SelectionLimit
selectionLimit SelectionStrategy
selectionStrategy
            Coin
minimumCoinQuantity

    (Coin
minimumCoinQuantity, [(AssetId, TokenQuantity)]
minimumAssetQuantities) =
        TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
TokenBundle.toFlatList TokenBundle
minimumBalance

assetSelectionLens
    :: (MonadRandom m, Ord u)
    => SelectionLimit
    -> SelectionStrategy
    -> (AssetId, TokenQuantity)
    -> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
assetSelectionLens :: SelectionLimit
-> SelectionStrategy
-> (AssetId, TokenQuantity)
-> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
assetSelectionLens SelectionLimit
limit SelectionStrategy
strategy (AssetId
asset, TokenQuantity
minimumAssetQuantity) = SelectionLens :: forall (m :: * -> *) state state'.
(state -> Natural)
-> (state' -> Natural)
-> (state -> m (Maybe state'))
-> Natural
-> SelectionStrategy
-> SelectionLens m state state'
SelectionLens
    { $sel:currentQuantity:SelectionLens :: UTxOSelection u -> Natural
currentQuantity = AssetId -> UTxOSelection u -> Natural
forall (s :: * -> *) u.
IsUTxOSelection s u =>
AssetId -> s u -> Natural
selectedAssetQuantity AssetId
asset
    , $sel:updatedQuantity:SelectionLens :: UTxOSelectionNonEmpty u -> Natural
updatedQuantity = AssetId -> UTxOSelectionNonEmpty u -> Natural
forall (s :: * -> *) u.
IsUTxOSelection s u =>
AssetId -> s u -> Natural
selectedAssetQuantity AssetId
asset
    , $sel:minimumQuantity:SelectionLens :: Natural
minimumQuantity = TokenQuantity -> Natural
unTokenQuantity TokenQuantity
minimumAssetQuantity
    , $sel:selectQuantity:SelectionLens :: UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantity = Asset
-> SelectionLimit
-> UTxOSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) u (utxoSelection :: * -> *).
(MonadRandom m, Ord u, IsUTxOSelection utxoSelection u) =>
Asset
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantityOf (AssetId -> Asset
Asset AssetId
asset) SelectionLimit
limit
    , $sel:selectionStrategy:SelectionLens :: SelectionStrategy
selectionStrategy = SelectionStrategy
strategy
    }

coinSelectionLens
    :: (MonadRandom m, Ord u)
    => SelectionLimit
    -> SelectionStrategy
    -> Coin
    -- ^ Minimum coin quantity.
    -> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
coinSelectionLens :: SelectionLimit
-> SelectionStrategy
-> Coin
-> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
coinSelectionLens SelectionLimit
limit SelectionStrategy
strategy Coin
minimumCoinQuantity = SelectionLens :: forall (m :: * -> *) state state'.
(state -> Natural)
-> (state' -> Natural)
-> (state -> m (Maybe state'))
-> Natural
-> SelectionStrategy
-> SelectionLens m state state'
SelectionLens
    { $sel:currentQuantity:SelectionLens :: UTxOSelection u -> Natural
currentQuantity = UTxOSelection u -> Natural
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Natural
selectedCoinQuantity
    , $sel:updatedQuantity:SelectionLens :: UTxOSelectionNonEmpty u -> Natural
updatedQuantity = UTxOSelectionNonEmpty u -> Natural
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Natural
selectedCoinQuantity
    , $sel:minimumQuantity:SelectionLens :: Natural
minimumQuantity = Natural -> Natural
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ Coin -> Natural
unCoin Coin
minimumCoinQuantity
    , $sel:selectQuantity:SelectionLens :: UTxOSelection u -> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantity  = Asset
-> SelectionLimit
-> UTxOSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) u (utxoSelection :: * -> *).
(MonadRandom m, Ord u, IsUTxOSelection utxoSelection u) =>
Asset
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantityOf Asset
AssetLovelace SelectionLimit
limit
    , $sel:selectionStrategy:SelectionLens :: SelectionStrategy
selectionStrategy = SelectionStrategy
strategy
    }

selectQuantityOf
    :: (MonadRandom m, Ord u)
    => IsUTxOSelection utxoSelection u
    => Asset
    -> SelectionLimit
    -> utxoSelection u
    -> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantityOf :: Asset
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
selectQuantityOf Asset
a = NonEmpty (SelectionFilter Asset)
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (m :: * -> *) (utxoSelection :: * -> *) u.
(MonadRandom m, Ord u, IsUTxOSelection utxoSelection u) =>
NonEmpty (SelectionFilter Asset)
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
selectMatchingQuantity
    [ Asset -> SelectionFilter Asset
forall asset. asset -> SelectionFilter asset
SelectSingleton Asset
a
    , Asset -> SelectionFilter Asset
forall asset. asset -> SelectionFilter asset
SelectPairWith Asset
a
    , Asset -> SelectionFilter Asset
forall asset. asset -> SelectionFilter asset
SelectAnyWith Asset
a
    ]

-- | Selects a UTxO entry that matches one of the specified filters.
--
-- This function traverses the specified list of filters from left to right, in
-- descending order of priority.
--
-- When considering a particular filter:
--
--    - if the function is able to select a UTxO entry that matches, it
--      terminates with an updated selection state that includes the entry.
--
--    - if the function is not able to select a UTxO entry that matches, it
--      traverses to the next filter available.
--
-- This function returns 'Nothing' if (and only if) it traverses the entire
-- list of filters without successfully selecting a UTxO entry.
--
selectMatchingQuantity
    :: forall m utxoSelection u. (MonadRandom m, Ord u)
    => IsUTxOSelection utxoSelection u
    => NonEmpty (SelectionFilter Asset)
        -- ^ A list of selection filters to be traversed from left-to-right,
        -- in descending order of priority.
    -> SelectionLimit
        -- ^ A limit to adhere to when selecting entries.
    -> utxoSelection u
        -- ^ The current selection state.
    -> m (Maybe (UTxOSelectionNonEmpty u))
        -- ^ An updated selection state that includes a matching UTxO entry,
        -- or 'Nothing' if no such entry could be found.
selectMatchingQuantity :: NonEmpty (SelectionFilter Asset)
-> SelectionLimit
-> utxoSelection u
-> m (Maybe (UTxOSelectionNonEmpty u))
selectMatchingQuantity NonEmpty (SelectionFilter Asset)
filters SelectionLimit
limit utxoSelection u
s
    | Bool
limitReached =
        Maybe (UTxOSelectionNonEmpty u)
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UTxOSelectionNonEmpty u)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        (((u, TokenBundle), UTxOIndex u) -> Maybe (UTxOSelectionNonEmpty u)
updateState (((u, TokenBundle), UTxOIndex u)
 -> Maybe (UTxOSelectionNonEmpty u))
-> Maybe ((u, TokenBundle), UTxOIndex u)
-> Maybe (UTxOSelectionNonEmpty u)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe ((u, TokenBundle), UTxOIndex u)
 -> Maybe (UTxOSelectionNonEmpty u))
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
-> m (Maybe (UTxOSelectionNonEmpty u))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOIndex u
-> NonEmpty (SelectionFilter Asset)
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
forall (m :: * -> *) u.
(MonadRandom m, Ord u) =>
UTxOIndex u
-> NonEmpty (SelectionFilter Asset)
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
UTxOIndex.selectRandomWithPriority
            (utxoSelection u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
UTxOSelection.leftoverIndex utxoSelection u
s) NonEmpty (SelectionFilter Asset)
filters
  where
    limitReached :: Bool
limitReached = case SelectionLimit
limit of
        MaximumInputLimit Int
m -> utxoSelection u -> Int
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Int
UTxOSelection.selectedSize utxoSelection u
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m
        SelectionLimit
NoLimit -> Bool
False

    updateState
        :: ((u, TokenBundle), UTxOIndex u) -> Maybe (UTxOSelectionNonEmpty u)
    updateState :: ((u, TokenBundle), UTxOIndex u) -> Maybe (UTxOSelectionNonEmpty u)
updateState ((u
i, TokenBundle
_b), UTxOIndex u
_remaining) = u -> utxoSelection u -> Maybe (UTxOSelectionNonEmpty u)
forall (s :: * -> *) u.
(IsUTxOSelection s u, Ord u) =>
u -> s u -> Maybe (UTxOSelectionNonEmpty u)
UTxOSelection.select u
i utxoSelection u
s

--------------------------------------------------------------------------------
-- Running a selection step
--------------------------------------------------------------------------------

-- | Provides a lens on the current selection state.
--
-- A 'SelectionLens' gives 'runSelectionStep' just the information it needs to
-- make a decision, and no more.
--
data SelectionLens m state state' = SelectionLens
    { SelectionLens m state state' -> state -> Natural
currentQuantity
        :: state -> Natural
    , SelectionLens m state state' -> state' -> Natural
updatedQuantity
        :: state' -> Natural
    , SelectionLens m state state' -> state -> m (Maybe state')
selectQuantity
        :: state -> m (Maybe state')
    , SelectionLens m state state' -> Natural
minimumQuantity
        :: Natural
    , SelectionLens m state state' -> SelectionStrategy
selectionStrategy
        :: SelectionStrategy
    }

-- | Runs just a single step of a coin selection.
--
-- It returns an updated state if (and only if) the updated selection
-- represents an improvement over the selection in the previous state.
--
-- An improvement, for a given token quantity, is defined in the following way:
--
--    - If the total selected token quantity of the previous selection had
--      not yet reached 100% of the output token quantity, any additional
--      selection is considered to be an improvement.
--
--    - If the total selected token quantity of the previous selection had
--      already reached or surpassed 100% of the output token quantity, any
--      additional selection is considered to be an improvement if and only
--      if it takens the total selected token quantity closer to the target
--      token quantity, but not further away.
--
runSelectionStep
    :: forall m state state'. Monad m
    => SelectionLens m state state'
    -> state
    -> m (Maybe state')
runSelectionStep :: SelectionLens m state state' -> state -> m (Maybe state')
runSelectionStep SelectionLens m state state'
lens state
s
    | state -> Natural
currentQuantity state
s Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
minimumQuantity =
        state -> m (Maybe state')
selectQuantity state
s
    | Bool
otherwise =
        (state' -> Maybe state'
requireImprovement (state' -> Maybe state') -> Maybe state' -> Maybe state'
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe state' -> Maybe state')
-> m (Maybe state') -> m (Maybe state')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> state -> m (Maybe state')
selectQuantity state
s
  where
    SelectionLens
        { state -> Natural
currentQuantity :: state -> Natural
$sel:currentQuantity:SelectionLens :: forall (m :: * -> *) state state'.
SelectionLens m state state' -> state -> Natural
currentQuantity
        , state' -> Natural
updatedQuantity :: state' -> Natural
$sel:updatedQuantity:SelectionLens :: forall (m :: * -> *) state state'.
SelectionLens m state state' -> state' -> Natural
updatedQuantity
        , Natural
minimumQuantity :: Natural
$sel:minimumQuantity:SelectionLens :: forall (m :: * -> *) state state'.
SelectionLens m state state' -> Natural
minimumQuantity
        , state -> m (Maybe state')
selectQuantity :: state -> m (Maybe state')
$sel:selectQuantity:SelectionLens :: forall (m :: * -> *) state state'.
SelectionLens m state state' -> state -> m (Maybe state')
selectQuantity
        , SelectionStrategy
selectionStrategy :: SelectionStrategy
$sel:selectionStrategy:SelectionLens :: forall (m :: * -> *) state state'.
SelectionLens m state state' -> SelectionStrategy
selectionStrategy
        } = SelectionLens m state state'
lens

    requireImprovement :: state' -> Maybe state'
    requireImprovement :: state' -> Maybe state'
requireImprovement state'
s'
        | state' -> Natural
updatedDistanceFromTarget state'
s' Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< state -> Natural
currentDistanceFromTarget state
s = state' -> Maybe state'
forall a. a -> Maybe a
Just state'
s'
        | Bool
otherwise = Maybe state'
forall a. Maybe a
Nothing

    currentDistanceFromTarget :: state -> Natural
    currentDistanceFromTarget :: state -> Natural
currentDistanceFromTarget = Natural -> Natural -> Natural
distance Natural
targetQuantity (Natural -> Natural) -> (state -> Natural) -> state -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. state -> Natural
currentQuantity

    updatedDistanceFromTarget :: state' -> Natural
    updatedDistanceFromTarget :: state' -> Natural
updatedDistanceFromTarget = Natural -> Natural -> Natural
distance Natural
targetQuantity (Natural -> Natural) -> (state' -> Natural) -> state' -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. state' -> Natural
updatedQuantity

    targetMultiplier :: Natural
    targetMultiplier :: Natural
targetMultiplier = case SelectionStrategy
selectionStrategy of
        SelectionStrategy
SelectionStrategyMinimal -> Natural
1
        SelectionStrategy
SelectionStrategyOptimal -> Natural
2

    targetQuantity :: Natural
    targetQuantity :: Natural
targetQuantity = Natural
minimumQuantity Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
targetMultiplier

--------------------------------------------------------------------------------
-- Making change
--------------------------------------------------------------------------------

-- | Criteria for the 'makeChange' function.
--
data MakeChangeCriteria minCoinFor bundleSizeAssessor = MakeChangeCriteria
    { MakeChangeCriteria minCoinFor bundleSizeAssessor -> minCoinFor
minCoinFor :: minCoinFor
      -- ^ A function that computes the minimum required ada quantity for a
      -- particular output.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor
-> bundleSizeAssessor
bundleSizeAssessor :: bundleSizeAssessor
        -- ^ A function to assess the size of a token bundle.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
requiredCost :: Coin
      -- ^ The minimal (and optimal) delta between the total ada balance
      -- of all input bundles and the total ada balance of all output and
      -- change bundles, where:
      --
      --    delta = getCoin (fold inputBundles)
      --          - getCoin (fold outputBundles)
      --          - getCoin (fold changeBundles)
      --
      -- This typically captures fees plus key deposits.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
extraCoinSource :: Coin
        -- ^ An extra source of ada.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
extraCoinSink :: Coin
        -- ^ An extra sink for ada.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor
-> NonEmpty TokenBundle
inputBundles :: NonEmpty TokenBundle
        -- ^ Token bundles of selected inputs.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor
-> NonEmpty TokenBundle
outputBundles :: NonEmpty TokenBundle
        -- ^ Token bundles of original outputs.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor -> TokenMap
assetsToMint :: TokenMap
        -- ^ Assets to mint: these provide input value to a transaction.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor -> TokenMap
assetsToBurn :: TokenMap
        -- ^ Assets to burn: these consume output value from a transaction.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
maximumOutputAdaQuantity
        :: Coin
        -- ^ Specifies the largest ada quantity that can appear in the token
        -- bundle of an output.
    , MakeChangeCriteria minCoinFor bundleSizeAssessor -> TokenQuantity
maximumOutputTokenQuantity
        :: TokenQuantity
        -- ^ Specifies the largest non-ada quantity that can appear in the
        -- token bundle of an output.
    } deriving (MakeChangeCriteria minCoinFor bundleSizeAssessor
-> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool
(MakeChangeCriteria minCoinFor bundleSizeAssessor
 -> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool)
-> (MakeChangeCriteria minCoinFor bundleSizeAssessor
    -> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool)
-> Eq (MakeChangeCriteria minCoinFor bundleSizeAssessor)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall minCoinFor bundleSizeAssessor.
(Eq minCoinFor, Eq bundleSizeAssessor) =>
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool
/= :: MakeChangeCriteria minCoinFor bundleSizeAssessor
-> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool
$c/= :: forall minCoinFor bundleSizeAssessor.
(Eq minCoinFor, Eq bundleSizeAssessor) =>
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool
== :: MakeChangeCriteria minCoinFor bundleSizeAssessor
-> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool
$c== :: forall minCoinFor bundleSizeAssessor.
(Eq minCoinFor, Eq bundleSizeAssessor) =>
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> MakeChangeCriteria minCoinFor bundleSizeAssessor -> Bool
Eq, (forall x.
 MakeChangeCriteria minCoinFor bundleSizeAssessor
 -> Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x)
-> (forall x.
    Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x
    -> MakeChangeCriteria minCoinFor bundleSizeAssessor)
-> Generic (MakeChangeCriteria minCoinFor bundleSizeAssessor)
forall x.
Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x
-> MakeChangeCriteria minCoinFor bundleSizeAssessor
forall x.
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall minCoinFor bundleSizeAssessor x.
Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x
-> MakeChangeCriteria minCoinFor bundleSizeAssessor
forall minCoinFor bundleSizeAssessor x.
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x
$cto :: forall minCoinFor bundleSizeAssessor x.
Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x
-> MakeChangeCriteria minCoinFor bundleSizeAssessor
$cfrom :: forall minCoinFor bundleSizeAssessor x.
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> Rep (MakeChangeCriteria minCoinFor bundleSizeAssessor) x
Generic, Int -> MakeChangeCriteria minCoinFor bundleSizeAssessor -> ShowS
[MakeChangeCriteria minCoinFor bundleSizeAssessor] -> ShowS
MakeChangeCriteria minCoinFor bundleSizeAssessor -> String
(Int -> MakeChangeCriteria minCoinFor bundleSizeAssessor -> ShowS)
-> (MakeChangeCriteria minCoinFor bundleSizeAssessor -> String)
-> ([MakeChangeCriteria minCoinFor bundleSizeAssessor] -> ShowS)
-> Show (MakeChangeCriteria minCoinFor bundleSizeAssessor)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall minCoinFor bundleSizeAssessor.
(Show minCoinFor, Show bundleSizeAssessor) =>
Int -> MakeChangeCriteria minCoinFor bundleSizeAssessor -> ShowS
forall minCoinFor bundleSizeAssessor.
(Show minCoinFor, Show bundleSizeAssessor) =>
[MakeChangeCriteria minCoinFor bundleSizeAssessor] -> ShowS
forall minCoinFor bundleSizeAssessor.
(Show minCoinFor, Show bundleSizeAssessor) =>
MakeChangeCriteria minCoinFor bundleSizeAssessor -> String
showList :: [MakeChangeCriteria minCoinFor bundleSizeAssessor] -> ShowS
$cshowList :: forall minCoinFor bundleSizeAssessor.
(Show minCoinFor, Show bundleSizeAssessor) =>
[MakeChangeCriteria minCoinFor bundleSizeAssessor] -> ShowS
show :: MakeChangeCriteria minCoinFor bundleSizeAssessor -> String
$cshow :: forall minCoinFor bundleSizeAssessor.
(Show minCoinFor, Show bundleSizeAssessor) =>
MakeChangeCriteria minCoinFor bundleSizeAssessor -> String
showsPrec :: Int -> MakeChangeCriteria minCoinFor bundleSizeAssessor -> ShowS
$cshowsPrec :: forall minCoinFor bundleSizeAssessor.
(Show minCoinFor, Show bundleSizeAssessor) =>
Int -> MakeChangeCriteria minCoinFor bundleSizeAssessor -> ShowS
Show)

-- | Indicates 'True' if and only if a token bundle exceeds the maximum size
--   that can be included in a transaction output.
--
tokenBundleSizeExceedsLimit :: TokenBundleSizeAssessor -> TokenBundle -> Bool
tokenBundleSizeExceedsLimit :: TokenBundleSizeAssessor -> TokenBundle -> Bool
tokenBundleSizeExceedsLimit (TokenBundleSizeAssessor TokenBundle -> TokenBundleSizeAssessment
assess) TokenBundle
b =
    case TokenBundle -> TokenBundleSizeAssessment
assess TokenBundle
b of
        TokenBundleSizeAssessment
TokenBundleSizeWithinLimit->
            Bool
False
        TokenBundleSizeAssessment
TokenBundleSizeExceedsLimit ->
            Bool
True

-- | Constructs change bundles for a set of selected inputs and outputs.
--
-- Returns 'Nothing' if the specified inputs do not provide enough ada to
-- satisfy the minimum delta and minimum ada quantities of the change bundles
-- generated.
--
-- This function will generate runtime errors if:
--
--    1.  The total balance of all outputs is not less than or equal to the
--        total balance of all inputs.
--
--    2.  The total ada balance of all outputs is zero.
--
-- Pre-condition (1) should be satisfied by any result produced by the
-- 'runSelection' function.
--
-- Pre-condition (2) should be satisfied by assigning a minimum ada quantity
-- to every output token bundle.
--
makeChange
    :: MakeChangeCriteria (TokenMap -> Coin) TokenBundleSizeAssessor
        -- ^ Criteria for making change.
    -> Either UnableToConstructChangeError [TokenBundle]
        -- ^ Generated change bundles.
makeChange :: MakeChangeCriteria (TokenMap -> Coin) TokenBundleSizeAssessor
-> Either UnableToConstructChangeError [TokenBundle]
makeChange MakeChangeCriteria (TokenMap -> Coin) TokenBundleSizeAssessor
criteria
    | Bool -> Bool
not (TokenBundle
totalOutputValue TokenBundle -> TokenBundle -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenBundle
totalInputValue) =
        Either UnableToConstructChangeError [TokenBundle]
forall a. a
totalInputValueInsufficient
    | TokenBundle -> Coin
TokenBundle.getCoin TokenBundle
totalOutputValue Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> Coin
Coin Natural
0 =
        Either UnableToConstructChangeError [TokenBundle]
forall a. a
totalOutputCoinValueIsZero
    | Bool
otherwise =
        (Coin -> UnableToConstructChangeError)
-> Either Coin [TokenBundle]
-> Either UnableToConstructChangeError [TokenBundle]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Coin -> UnableToConstructChangeError
mkUnableToConstructChangeError (Either Coin [TokenBundle]
 -> Either UnableToConstructChangeError [TokenBundle])
-> Either Coin [TokenBundle]
-> Either UnableToConstructChangeError [TokenBundle]
forall a b. (a -> b) -> a -> b
$ do
            Coin
adaAvailable <- Coin -> Maybe Coin -> Either Coin Coin
forall a b. a -> Maybe b -> Either a b
maybeToEither
                (Coin
requiredCost Coin -> Coin -> Coin
`Coin.difference` Coin
excessCoin)
                (Coin
excessCoin Coin -> Coin -> Maybe Coin
`Coin.subtract` Coin
requiredCost)
            HasCallStack =>
Coin
-> (TokenMap -> Coin)
-> NonEmpty (TokenMap, Coin)
-> Either Coin [TokenBundle]
Coin
-> (TokenMap -> Coin)
-> NonEmpty (TokenMap, Coin)
-> Either Coin [TokenBundle]
assignCoinsToChangeMaps
                Coin
adaAvailable TokenMap -> Coin
minCoinFor NonEmpty (TokenMap, Coin)
changeMapOutputCoinPairs
  where
    MakeChangeCriteria
        { TokenMap -> Coin
minCoinFor :: TokenMap -> Coin
$sel:minCoinFor:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> minCoinFor
minCoinFor
        , TokenBundleSizeAssessor
bundleSizeAssessor :: TokenBundleSizeAssessor
$sel:bundleSizeAssessor:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> bundleSizeAssessor
bundleSizeAssessor
        , Coin
requiredCost :: Coin
$sel:requiredCost:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
requiredCost
        , Coin
extraCoinSource :: Coin
$sel:extraCoinSource:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
extraCoinSource
        , Coin
extraCoinSink :: Coin
$sel:extraCoinSink:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
extraCoinSink
        , NonEmpty TokenBundle
inputBundles :: NonEmpty TokenBundle
$sel:inputBundles:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> NonEmpty TokenBundle
inputBundles
        , NonEmpty TokenBundle
outputBundles :: NonEmpty TokenBundle
$sel:outputBundles:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor
-> NonEmpty TokenBundle
outputBundles
        , TokenMap
assetsToMint :: TokenMap
$sel:assetsToMint:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> TokenMap
assetsToMint
        , TokenMap
assetsToBurn :: TokenMap
$sel:assetsToBurn:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> TokenMap
assetsToBurn
        , Coin
maximumOutputAdaQuantity :: Coin
$sel:maximumOutputAdaQuantity:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> Coin
maximumOutputAdaQuantity
        , TokenQuantity
maximumOutputTokenQuantity :: TokenQuantity
$sel:maximumOutputTokenQuantity:MakeChangeCriteria :: forall minCoinFor bundleSizeAssessor.
MakeChangeCriteria minCoinFor bundleSizeAssessor -> TokenQuantity
maximumOutputTokenQuantity
        } = MakeChangeCriteria (TokenMap -> Coin) TokenBundleSizeAssessor
criteria

    -- The following subtraction is safe, as we have already checked
    -- that the total input value is greater than the total output
    -- value:
    excess :: TokenBundle
    excess :: TokenBundle
excess = TokenBundle
totalInputValue TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.unsafeSubtract` TokenBundle
totalOutputValue

    (Coin
excessCoin, [(AssetId, TokenQuantity)]
excessAssets) = TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
TokenBundle.toFlatList TokenBundle
excess

    -- Change maps for all assets, where each change map is paired with a
    -- corresponding coin from the original outputs.
    --
    -- When combining change maps from user-specified assets and non-user-
    -- specified assets, we arrange that any empty maps in either list are
    -- combined together if possible, so as to give 'assignCoinsToChangeMaps'
    -- the greatest chance of success.
    --
    -- This list is sorted into ascending order of asset count, where empty
    -- change maps are all located at the start of the list.
    --
    changeMapOutputCoinPairs :: NonEmpty (TokenMap, Coin)
    changeMapOutputCoinPairs :: NonEmpty (TokenMap, Coin)
changeMapOutputCoinPairs = NonEmpty Coin
outputCoins
        -- First, combine the original output coins with the change maps for
        -- user-specified assets. We must pair these together right at the
        -- start in order to retain proportionality with the original outputs.
        NonEmpty Coin
-> (NonEmpty Coin -> NonEmpty (TokenMap, Coin))
-> NonEmpty (TokenMap, Coin)
forall a b. a -> (a -> b) -> b
& NonEmpty TokenMap -> NonEmpty Coin -> NonEmpty (TokenMap, Coin)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty TokenMap
changeForUserSpecifiedAssets
        -- Next, sort the list into ascending order of asset count, which moves
        -- any empty maps to the start of the list:
        NonEmpty (TokenMap, Coin)
-> (NonEmpty (TokenMap, Coin) -> NonEmpty (TokenMap, Coin))
-> NonEmpty (TokenMap, Coin)
forall a b. a -> (a -> b) -> b
& ((TokenMap, Coin) -> AssetCount TokenMap)
-> NonEmpty (TokenMap, Coin) -> NonEmpty (TokenMap, Coin)
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NE.sortWith (TokenMap -> AssetCount TokenMap
forall a. a -> AssetCount a
AssetCount (TokenMap -> AssetCount TokenMap)
-> ((TokenMap, Coin) -> TokenMap)
-> (TokenMap, Coin)
-> AssetCount TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenMap, Coin) -> TokenMap
forall a b. (a, b) -> a
fst)
        -- Next, combine the existing list with the change maps for non-user
        -- specified assets, which are already sorted into ascending order of
        -- asset count:
        NonEmpty (TokenMap, Coin)
-> (NonEmpty (TokenMap, Coin) -> NonEmpty (TokenMap, Coin))
-> NonEmpty (TokenMap, Coin)
forall a b. a -> (a -> b) -> b
& (TokenMap -> (TokenMap, Coin) -> (TokenMap, Coin))
-> NonEmpty TokenMap
-> NonEmpty (TokenMap, Coin)
-> NonEmpty (TokenMap, Coin)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\TokenMap
m1 (TokenMap
m2, Coin
c) -> (TokenMap
m1 TokenMap -> TokenMap -> TokenMap
forall a. Semigroup a => a -> a -> a
<> TokenMap
m2, Coin
c))
            NonEmpty TokenMap
changeForNonUserSpecifiedAssets
        -- Finally, if there are any maps that are oversized (in any way), then
        -- split these maps up along with their corresponding output coins:
        NonEmpty (TokenMap, Coin)
-> (NonEmpty (TokenMap, Coin) -> NonEmpty (TokenMap, Coin))
-> NonEmpty (TokenMap, Coin)
forall a b. a -> (a -> b) -> b
& NonEmpty (TokenMap, Coin) -> NonEmpty (TokenMap, Coin)
splitOversizedMaps
      where
        splitOversizedMaps
            :: NonEmpty (TokenMap, Coin) -> NonEmpty (TokenMap, Coin)
        splitOversizedMaps :: NonEmpty (TokenMap, Coin) -> NonEmpty (TokenMap, Coin)
splitOversizedMaps =
            -- For the sake of convenience when splitting up change maps and
            -- output coins (which are treated as weights), treat each change
            -- map and its corresponding output coin as a token bundle.
            (TokenBundle -> (TokenMap, Coin))
-> NonEmpty TokenBundle -> NonEmpty (TokenMap, Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TokenBundle -> (TokenMap, Coin)
unbundle (NonEmpty TokenBundle -> NonEmpty (TokenMap, Coin))
-> (NonEmpty (TokenMap, Coin) -> NonEmpty TokenBundle)
-> NonEmpty (TokenMap, Coin)
-> NonEmpty (TokenMap, Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TokenBundle -> NonEmpty TokenBundle
split (NonEmpty TokenBundle -> NonEmpty TokenBundle)
-> (NonEmpty (TokenMap, Coin) -> NonEmpty TokenBundle)
-> NonEmpty (TokenMap, Coin)
-> NonEmpty TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenMap, Coin) -> TokenBundle)
-> NonEmpty (TokenMap, Coin) -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenMap, Coin) -> TokenBundle
bundle
          where
            bundle :: (TokenMap, Coin) -> TokenBundle
bundle (TokenMap
m, Coin
c) = Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c TokenMap
m
            unbundle :: TokenBundle -> (TokenMap, Coin)
unbundle (TokenBundle Coin
c TokenMap
m) = (TokenMap
m, Coin
c)
            split :: NonEmpty TokenBundle -> NonEmpty TokenBundle
split NonEmpty TokenBundle
b = NonEmpty TokenBundle
b
                NonEmpty TokenBundle
-> (NonEmpty TokenBundle -> NonEmpty TokenBundle)
-> NonEmpty TokenBundle
forall a b. a -> (a -> b) -> b
& (NonEmpty TokenBundle
 -> (TokenBundle -> Bool) -> NonEmpty TokenBundle)
-> (TokenBundle -> Bool)
-> NonEmpty TokenBundle
-> NonEmpty TokenBundle
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmpty TokenBundle
-> (TokenBundle -> Bool) -> NonEmpty TokenBundle
splitBundlesWithExcessiveAssetCounts
                    (TokenBundleSizeAssessor -> TokenBundle -> Bool
tokenBundleSizeExceedsLimit TokenBundleSizeAssessor
assessBundleSizeWithMaxCoin)
                NonEmpty TokenBundle
-> (NonEmpty TokenBundle -> NonEmpty TokenBundle)
-> NonEmpty TokenBundle
forall a b. a -> (a -> b) -> b
& (NonEmpty TokenBundle -> TokenQuantity -> NonEmpty TokenBundle)
-> TokenQuantity -> NonEmpty TokenBundle -> NonEmpty TokenBundle
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmpty TokenBundle -> TokenQuantity -> NonEmpty TokenBundle
splitBundlesWithExcessiveTokenQuantities
                    TokenQuantity
maximumOutputTokenQuantity

            -- When assessing the size of a change map to determine if it is
            -- excessively large, we don't yet know how large the associated
            -- ada quantity will be, since ada quantities are assigned at a
            -- later stage (in 'assignCoinsToChangeMaps').
            --
            -- Therefore, we err on the side of caution, and assess the size
            -- of a change map combined with the maximum possible ada quantity.
            --
            -- This means that when presented with a very large change map, we
            -- have a small chance of splitting the map even if that map would
            -- be within the limit when combined with its final ada quantity.
            --
            -- However, oversplitting a change map is preferable to creating
            -- a bundle that is marginally over the limit, which would cause
            -- the resultant transaction to be rejected.
            --
            assessBundleSizeWithMaxCoin :: TokenBundleSizeAssessor
            assessBundleSizeWithMaxCoin :: TokenBundleSizeAssessor
assessBundleSizeWithMaxCoin = (TokenBundle -> TokenBundleSizeAssessment)
-> TokenBundleSizeAssessor
TokenBundleSizeAssessor
                ((TokenBundle -> TokenBundleSizeAssessment)
 -> TokenBundleSizeAssessor)
-> (TokenBundle -> TokenBundleSizeAssessment)
-> TokenBundleSizeAssessor
forall a b. (a -> b) -> a -> b
$ (((TokenBundle -> TokenBundleSizeAssessment)
  -> Const
       (TokenBundle -> TokenBundleSizeAssessment)
       (TokenBundle -> TokenBundleSizeAssessment))
 -> TokenBundleSizeAssessor
 -> Const
      (TokenBundle -> TokenBundleSizeAssessment) TokenBundleSizeAssessor)
-> TokenBundleSizeAssessor
-> TokenBundle
-> TokenBundleSizeAssessment
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assessTokenBundleSize"
  (((TokenBundle -> TokenBundleSizeAssessment)
    -> Const
         (TokenBundle -> TokenBundleSizeAssessment)
         (TokenBundle -> TokenBundleSizeAssessment))
   -> TokenBundleSizeAssessor
   -> Const
        (TokenBundle -> TokenBundleSizeAssessment) TokenBundleSizeAssessor)
((TokenBundle -> TokenBundleSizeAssessment)
 -> Const
      (TokenBundle -> TokenBundleSizeAssessment)
      (TokenBundle -> TokenBundleSizeAssessment))
-> TokenBundleSizeAssessor
-> Const
     (TokenBundle -> TokenBundleSizeAssessment) TokenBundleSizeAssessor
#assessTokenBundleSize TokenBundleSizeAssessor
bundleSizeAssessor
                (TokenBundle -> TokenBundleSizeAssessment)
-> (TokenBundle -> TokenBundle)
-> TokenBundle
-> TokenBundleSizeAssessment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenBundle -> Coin -> TokenBundle)
-> Coin -> TokenBundle -> TokenBundle
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenBundle -> Coin -> TokenBundle
TokenBundle.setCoin Coin
maximumOutputAdaQuantity

    -- Change for user-specified assets: assets that were present in the
    -- original set of user-specified outputs ('outputsToCover').
    changeForUserSpecifiedAssets :: NonEmpty TokenMap
    changeForUserSpecifiedAssets :: NonEmpty TokenMap
changeForUserSpecifiedAssets = ((AssetId, TokenQuantity)
 -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> NonEmpty TokenMap
-> [(AssetId, TokenQuantity)]
-> NonEmpty TokenMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr
        ((TokenMap -> TokenMap -> TokenMap)
-> NonEmpty TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith TokenMap -> TokenMap -> TokenMap
forall a. Semigroup a => a -> a -> a
(<>)
            (NonEmpty TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> ((AssetId, TokenQuantity) -> NonEmpty TokenMap)
-> (AssetId, TokenQuantity)
-> NonEmpty TokenMap
-> NonEmpty TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TokenMap -> (AssetId, TokenQuantity) -> NonEmpty TokenMap
makeChangeForUserSpecifiedAsset NonEmpty TokenMap
outputMaps)
        (TokenMap
TokenMap.empty TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NonEmpty TokenMap
outputMaps)
        [(AssetId, TokenQuantity)]
excessAssets

    -- Change for non-user-specified assets: assets that were not present
    -- in the original set of user-specified outputs ('outputsToCover').
    changeForNonUserSpecifiedAssets :: NonEmpty TokenMap
    changeForNonUserSpecifiedAssets :: NonEmpty TokenMap
changeForNonUserSpecifiedAssets =
        NonEmpty TokenMap
-> Map AssetId (NonEmpty TokenQuantity) -> NonEmpty TokenMap
forall a.
NonEmpty a
-> Map AssetId (NonEmpty TokenQuantity) -> NonEmpty TokenMap
makeChangeForNonUserSpecifiedAssets
            NonEmpty TokenMap
outputMaps
            Map AssetId (NonEmpty TokenQuantity)
nonUserSpecifiedAssetQuantities
        NonEmpty TokenMap
-> (NonEmpty TokenMap -> NonEmpty TokenMap) -> NonEmpty TokenMap
forall a b. a -> (a -> b) -> b
& TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
addMintValuesToChangeMaps
            (TokenMap -> TokenMap
removeUserSpecifiedAssetIds TokenMap
assetsToMint)
        NonEmpty TokenMap
-> (NonEmpty TokenMap -> NonEmpty TokenMap) -> NonEmpty TokenMap
forall a b. a -> (a -> b) -> b
& TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
removeBurnValuesFromChangeMaps
            (TokenMap -> TokenMap
removeUserSpecifiedAssetIds TokenMap
assetsToBurn)
      where
        removeUserSpecifiedAssetIds :: TokenMap -> TokenMap
        removeUserSpecifiedAssetIds :: TokenMap -> TokenMap
removeUserSpecifiedAssetIds =
            (AssetId -> Bool) -> TokenMap -> TokenMap
TokenMap.filter (AssetId -> Set AssetId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set AssetId
userSpecifiedAssetIds)

    totalInputValueInsufficient :: a
totalInputValueInsufficient = String -> a
forall a. HasCallStack => String -> a
error
        String
"makeChange: not (totalOutputValue <= totalInputValue)"
    totalOutputCoinValueIsZero :: a
totalOutputCoinValueIsZero = String -> a
forall a. HasCallStack => String -> a
error
        String
"makeChange: not (totalOutputCoinValue > 0)"

    mkUnableToConstructChangeError :: Coin -> UnableToConstructChangeError
    mkUnableToConstructChangeError :: Coin -> UnableToConstructChangeError
mkUnableToConstructChangeError Coin
shortfall = UnableToConstructChangeError :: Coin -> Coin -> UnableToConstructChangeError
UnableToConstructChangeError
        { Coin
requiredCost :: Coin
$sel:requiredCost:UnableToConstructChangeError :: Coin
requiredCost
        , Coin
shortfall :: Coin
$sel:shortfall:UnableToConstructChangeError :: Coin
shortfall
        }

    outputMaps :: NonEmpty TokenMap
    outputMaps :: NonEmpty TokenMap
outputMaps = ((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens (TokenBundle -> TokenMap)
-> NonEmpty TokenBundle -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TokenBundle
outputBundles

    outputCoins :: NonEmpty Coin
    outputCoins :: NonEmpty Coin
outputCoins = ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin (TokenBundle -> Coin) -> NonEmpty TokenBundle -> NonEmpty Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TokenBundle
outputBundles

    totalInputValue :: TokenBundle
    totalInputValue :: TokenBundle
totalInputValue =
        NonEmpty TokenBundle -> TokenBundle
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold NonEmpty TokenBundle
inputBundles
            TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> Coin -> TokenBundle
TokenBundle.fromCoin Coin
extraCoinSource
            -- Mints represent extra inputs from "the void"
            TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> TokenMap -> TokenBundle
TokenBundle.fromTokenMap TokenMap
assetsToMint

    totalOutputValue :: TokenBundle
    totalOutputValue :: TokenBundle
totalOutputValue =
        NonEmpty TokenBundle -> TokenBundle
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold NonEmpty TokenBundle
outputBundles
            TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> Coin -> TokenBundle
TokenBundle.fromCoin Coin
extraCoinSink
            -- Burns represent extra outputs to "the void"
            TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> TokenMap -> TokenBundle
TokenBundle.fromTokenMap TokenMap
assetsToBurn

    -- Identifiers of all user-specified assets: assets that were included in
    -- the original set of outputs.
    userSpecifiedAssetIds :: Set AssetId
    userSpecifiedAssetIds :: Set AssetId
userSpecifiedAssetIds = TokenBundle -> Set AssetId
TokenBundle.getAssets (NonEmpty TokenBundle -> TokenBundle
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold NonEmpty TokenBundle
outputBundles)

    -- Identifiers and quantities of all non-user-specified assets: assets that
    -- were not included in the original set of outputs, but that were
    -- nevertheless selected during the selection process.
    --
    -- Each asset is paired with the complete list of quantities of that asset
    -- present in the selected inputs.
    nonUserSpecifiedAssetQuantities :: Map AssetId (NonEmpty TokenQuantity)
    nonUserSpecifiedAssetQuantities :: Map AssetId (NonEmpty TokenQuantity)
nonUserSpecifiedAssetQuantities =
        NonEmpty TokenMap
-> Set AssetId -> Map AssetId (NonEmpty TokenQuantity)
collateNonUserSpecifiedAssetQuantities
            (((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens (TokenBundle -> TokenMap)
-> NonEmpty TokenBundle -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TokenBundle
inputBundles) Set AssetId
userSpecifiedAssetIds

-- | Generates a map of all non-user-specified assets and their quantities.
--
-- Each key in the resulting map corresponds to an asset that was NOT included
-- in the original set of user-specified outputs, but that was nevertheless
-- selected during the selection process.
--
-- The value associated with each key corresponds to the complete list of all
-- discrete non-zero quantities of that asset present in the selected inputs.
--
collateNonUserSpecifiedAssetQuantities
    :: NonEmpty TokenMap
      -- ^ Token maps of all selected inputs.
    -> Set AssetId
      -- ^ Set of all assets in user-specified outputs.
    -> Map AssetId (NonEmpty TokenQuantity)
collateNonUserSpecifiedAssetQuantities :: NonEmpty TokenMap
-> Set AssetId -> Map AssetId (NonEmpty TokenQuantity)
collateNonUserSpecifiedAssetQuantities NonEmpty TokenMap
inputMaps Set AssetId
userSpecifiedAssetIds =
    (TokenMap
 -> Map AssetId (NonEmpty TokenQuantity)
 -> Map AssetId (NonEmpty TokenQuantity))
-> Map AssetId (NonEmpty TokenQuantity)
-> NonEmpty TokenMap
-> Map AssetId (NonEmpty TokenQuantity)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr TokenMap
-> Map AssetId (NonEmpty TokenQuantity)
-> Map AssetId (NonEmpty TokenQuantity)
discardUserSpecifiedAssets Map AssetId (NonEmpty TokenQuantity)
forall a. Monoid a => a
mempty NonEmpty TokenMap
inputMaps
  where
    discardUserSpecifiedAssets
        :: TokenMap
        -> Map AssetId (NonEmpty TokenQuantity)
        -> Map AssetId (NonEmpty TokenQuantity)
    discardUserSpecifiedAssets :: TokenMap
-> Map AssetId (NonEmpty TokenQuantity)
-> Map AssetId (NonEmpty TokenQuantity)
discardUserSpecifiedAssets TokenMap
tokens Map AssetId (NonEmpty TokenQuantity)
m =
        ((AssetId, TokenQuantity)
 -> Map AssetId (NonEmpty TokenQuantity)
 -> Map AssetId (NonEmpty TokenQuantity))
-> Map AssetId (NonEmpty TokenQuantity)
-> [(AssetId, TokenQuantity)]
-> Map AssetId (NonEmpty TokenQuantity)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(AssetId
k, TokenQuantity
v) -> (NonEmpty TokenQuantity
 -> NonEmpty TokenQuantity -> NonEmpty TokenQuantity)
-> AssetId
-> NonEmpty TokenQuantity
-> Map AssetId (NonEmpty TokenQuantity)
-> Map AssetId (NonEmpty TokenQuantity)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NonEmpty TokenQuantity
-> NonEmpty TokenQuantity -> NonEmpty TokenQuantity
forall a. Semigroup a => a -> a -> a
(<>) AssetId
k (TokenQuantity
v TokenQuantity -> [TokenQuantity] -> NonEmpty TokenQuantity
forall a. a -> [a] -> NonEmpty a
:| [])) Map AssetId (NonEmpty TokenQuantity)
m [(AssetId, TokenQuantity)]
filtered
      where
        filtered :: [(AssetId, TokenQuantity)]
filtered = ((AssetId, TokenQuantity) -> Bool)
-> [(AssetId, TokenQuantity)] -> [(AssetId, TokenQuantity)]
forall a. (a -> Bool) -> [a] -> [a]
filter
            ((AssetId -> Set AssetId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set AssetId
userSpecifiedAssetIds) (AssetId -> Bool)
-> ((AssetId, TokenQuantity) -> AssetId)
-> (AssetId, TokenQuantity)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetId, TokenQuantity) -> AssetId
forall a b. (a, b) -> a
fst)
            (TokenMap -> [(AssetId, TokenQuantity)]
TokenMap.toFlatList TokenMap
tokens)

-- | Assigns coin quantities to a list of pre-computed asset change maps.
--
-- Each pre-computed asset change map must be paired with the original coin
-- value of its corresponding output.
--
-- This function:
--
--    - expects the list of pre-computed asset change maps to be sorted in an
--      order that ensures all empty token maps are at the start of the list.
--
--    - attempts to assign a minimum ada quantity to every change map, but
--      iteratively drops empty change maps from the start of the list if the
--      amount of ada is insufficient to cover them all.
--
--    - continues dropping empty change maps from the start of the list until
--      it is possible to assign a minimum ada value to all remaining entries.
--
--    - returns a list that is identical in length to the input list if (and
--      only if) it was possible to assign a minimum ada quantity to all change
--      maps.
--
--    - returns a list that is shorter than the input list if it was only
--      possible to assign a minimum ada quantity to a suffix of the given
--      list.
--
--    - fails if (and only if) there was not enough ada available to assign the
--      minimum ada quantity to all non-empty change maps.
--
assignCoinsToChangeMaps
    :: HasCallStack
    => Coin
    -- ^ The total quantity of ada available, including any extra source of ada.
    -> (TokenMap -> Coin)
    -- ^ A function to calculate the minimum required ada quantity for any
    -- token map.
    -> NonEmpty (TokenMap, Coin)
    -- ^ A list of pre-computed asset change maps paired with original output
    -- coins, sorted into an order that ensures all empty token maps are at the
    -- start of the list.
    -> Either Coin [TokenBundle]
    -- ^ Resulting change bundles, or the shortfall quantity if there was not
    -- enough ada available to assign a minimum ada quantity to all non-empty
    -- token maps.
assignCoinsToChangeMaps :: Coin
-> (TokenMap -> Coin)
-> NonEmpty (TokenMap, Coin)
-> Either Coin [TokenBundle]
assignCoinsToChangeMaps Coin
adaAvailable TokenMap -> Coin
minCoinFor NonEmpty (TokenMap, Coin)
pairsAtStart
    | Bool -> Bool
not Bool
changeMapsCorrectlyOrdered =
        Either Coin [TokenBundle]
forall a. a
changeMapsNotCorrectlyOrderedError
    | Bool
otherwise =
        Coin -> NonEmpty (TokenMap, Coin) -> Either Coin [TokenBundle]
loop Coin
adaRequiredAtStart NonEmpty (TokenMap, Coin)
pairsAtStart
  where
    loop :: Coin -> NonEmpty (TokenMap, Coin) -> Either Coin [TokenBundle]
loop !Coin
adaRequired !NonEmpty (TokenMap, Coin)
pairsNonEmpty = case NonEmpty (TokenMap, Coin)
pairsNonEmpty of

        (TokenMap, Coin)
pair :| [(TokenMap, Coin)]
pairs | Coin
adaAvailable Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
adaRequired ->
            -- We have enough ada available to pay for the minimum required
            -- amount of every asset map that remains in our list:
            let assetMapsRemaining :: NonEmpty TokenMap
assetMapsRemaining = (TokenMap, Coin) -> TokenMap
forall a b. (a, b) -> a
fst ((TokenMap, Coin) -> TokenMap)
-> NonEmpty (TokenMap, Coin) -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TokenMap, Coin)
pair (TokenMap, Coin) -> [(TokenMap, Coin)] -> NonEmpty (TokenMap, Coin)
forall a. a -> [a] -> NonEmpty a
:| [(TokenMap, Coin)]
pairs) in
            let bundlesForAssetsWithMinimumCoins :: NonEmpty TokenBundle
bundlesForAssetsWithMinimumCoins =
                    (TokenMap -> Coin) -> TokenMap -> TokenBundle
assignMinimumCoin TokenMap -> Coin
minCoinFor (TokenMap -> TokenBundle)
-> NonEmpty TokenMap -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TokenMap
assetMapsRemaining in
            -- Calculate the amount of ada that remains after assigning the
            -- minimum amount to each map. This should be safe, as we have
            -- already determined that we have enough ada available:
            let adaRemaining :: Coin
adaRemaining = Coin
adaAvailable Coin -> Coin -> Coin
`Coin.distance` Coin
adaRequired in
            -- Partition any remaining ada according to the weighted
            -- distribution of output coins that remain in our list:
            let outputCoinsRemaining :: NonEmpty Coin
outputCoinsRemaining = (TokenMap, Coin) -> Coin
forall a b. (a, b) -> b
snd ((TokenMap, Coin) -> Coin)
-> NonEmpty (TokenMap, Coin) -> NonEmpty Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TokenMap, Coin)
pair (TokenMap, Coin) -> [(TokenMap, Coin)] -> NonEmpty (TokenMap, Coin)
forall a. a -> [a] -> NonEmpty a
:| [(TokenMap, Coin)]
pairs) in
            let bundlesForOutputCoins :: NonEmpty TokenBundle
bundlesForOutputCoins = Coin -> TokenBundle
TokenBundle.fromCoin (Coin -> TokenBundle) -> NonEmpty Coin -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    HasCallStack => NonEmpty Coin -> Coin -> NonEmpty Coin
NonEmpty Coin -> Coin -> NonEmpty Coin
makeChangeForCoin NonEmpty Coin
outputCoinsRemaining Coin
adaRemaining in
            -- Finally, combine the minimal coin asset bundles with the
            -- bundles obtained by partitioning the remaining ada amount:
            [TokenBundle] -> Either Coin [TokenBundle]
forall a b. b -> Either a b
Right ([TokenBundle] -> Either Coin [TokenBundle])
-> [TokenBundle] -> Either Coin [TokenBundle]
forall a b. (a -> b) -> a -> b
$ NonEmpty TokenBundle -> [TokenBundle]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty TokenBundle -> [TokenBundle])
-> NonEmpty TokenBundle -> [TokenBundle]
forall a b. (a -> b) -> a -> b
$ (TokenBundle -> TokenBundle -> TokenBundle)
-> NonEmpty TokenBundle
-> NonEmpty TokenBundle
-> NonEmpty TokenBundle
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
(<>)
                NonEmpty TokenBundle
bundlesForAssetsWithMinimumCoins
                NonEmpty TokenBundle
bundlesForOutputCoins

        (TokenMap
m, Coin
_) :| ((TokenMap, Coin)
p : [(TokenMap, Coin)]
ps) | TokenMap -> Bool
TokenMap.isEmpty TokenMap
m Bool -> Bool -> Bool
&& Coin
adaAvailable Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
adaRequired ->
            -- We don't have enough ada available to pay for the minimum
            -- required amount of every asset map, but we do have an empty
            -- asset map that is safe to drop. This will reduce the amount of
            -- ada required by a small amount:
            let adaRequired' :: Coin
adaRequired' = Coin
adaRequired Coin -> Coin -> Coin
`Coin.distance` TokenMap -> Coin
minCoinFor TokenMap
m in
            Coin -> NonEmpty (TokenMap, Coin) -> Either Coin [TokenBundle]
loop Coin
adaRequired' ((TokenMap, Coin)
p (TokenMap, Coin) -> [(TokenMap, Coin)] -> NonEmpty (TokenMap, Coin)
forall a. a -> [a] -> NonEmpty a
:| [(TokenMap, Coin)]
ps)

        (TokenMap
m, Coin
_) :| [] | TokenMap -> Bool
TokenMap.isEmpty TokenMap
m Bool -> Bool -> Bool
&& Coin
adaAvailable Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
adaRequired ->
            -- We didn't have any non-ada assets at all in our change, and we
            -- also don't have enough ada available to pay even for a single
            -- change output. We just burn the available ada amount (which
            -- will be small), returning no change.
            [TokenBundle] -> Either Coin [TokenBundle]
forall a b. b -> Either a b
Right []

        NonEmpty (TokenMap, Coin)
_ ->
            -- We don't have enough ada available, and there are no empty token
            -- maps available to drop. We have to give up at this point.
            Coin -> Either Coin [TokenBundle]
forall a b. a -> Either a b
Left (Coin
adaRequired Coin -> Coin -> Coin
`Coin.difference` Coin
adaAvailable)

    adaRequiredAtStart :: Coin
adaRequiredAtStart = NonEmpty Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (NonEmpty Coin -> Coin) -> NonEmpty Coin -> Coin
forall a b. (a -> b) -> a -> b
$ TokenMap -> Coin
minCoinFor (TokenMap -> Coin)
-> ((TokenMap, Coin) -> TokenMap) -> (TokenMap, Coin) -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenMap, Coin) -> TokenMap
forall a b. (a, b) -> a
fst ((TokenMap, Coin) -> Coin)
-> NonEmpty (TokenMap, Coin) -> NonEmpty Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TokenMap, Coin)
pairsAtStart

    changeMaps :: NonEmpty TokenMap
changeMaps = (TokenMap, Coin) -> TokenMap
forall a b. (a, b) -> a
fst ((TokenMap, Coin) -> TokenMap)
-> NonEmpty (TokenMap, Coin) -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TokenMap, Coin)
pairsAtStart

    -- Indicates whether or not the given change maps are correctly ordered,
    -- so that all empty maps are located at the start of the list.
    changeMapsCorrectlyOrdered :: Bool
changeMapsCorrectlyOrdered = [TokenMap] -> [TokenMap] -> Bool
forall a. Eq a => a -> a -> Bool
(==)
        ((TokenMap -> Bool) -> NonEmpty TokenMap -> [TokenMap]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.takeWhile TokenMap -> Bool
TokenMap.isEmpty NonEmpty TokenMap
changeMaps)
        ((TokenMap -> Bool) -> NonEmpty TokenMap -> [TokenMap]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter TokenMap -> Bool
TokenMap.isEmpty NonEmpty TokenMap
changeMaps)

    changeMapsNotCorrectlyOrderedError :: a
changeMapsNotCorrectlyOrderedError =
        String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ Item [String]
"assignCoinsToChangeMaps: pre-computed asset change maps must be"
            , Item [String]
"arranged in an order where all empty maps are at the start of"
            , Item [String]
"the list."
            ]

-- | Assigns the minimum required ada quantity to a token map.
--
assignMinimumCoin :: (TokenMap -> Coin) -> TokenMap -> TokenBundle
assignMinimumCoin :: (TokenMap -> Coin) -> TokenMap -> TokenBundle
assignMinimumCoin TokenMap -> Coin
minCoinFor TokenMap
m = Coin -> TokenMap -> TokenBundle
TokenBundle (TokenMap -> Coin
minCoinFor TokenMap
m) TokenMap
m

-- | Constructs change outputs for a user-specified asset: an asset that was
--   present in the original set of outputs.
--
-- If the given asset does not appear in the given distribution, this function
-- returns a list of empty token maps. Otherwise, the given token quantity is
-- partitioned into a list of quantities that are proportional to the weights
-- within the given input distribution, modulo rounding.
--
-- The length of the output list is always the same as the the length of the
-- input list, and the sum of its quantities is either zero, or exactly equal
-- to the token quantity in the second argument.
--
makeChangeForUserSpecifiedAsset
    :: NonEmpty TokenMap
        -- ^ A list of weights for the distribution. Conveniently captures both
        -- the weights, and the number of elements amongst which the quantity
        -- should be distributed.
    -> (AssetId, TokenQuantity)
        -- ^ A surplus token quantity to distribute.
    -> NonEmpty TokenMap
makeChangeForUserSpecifiedAsset :: NonEmpty TokenMap -> (AssetId, TokenQuantity) -> NonEmpty TokenMap
makeChangeForUserSpecifiedAsset NonEmpty TokenMap
targets (AssetId
asset, TokenQuantity
excess) =
    AssetId -> TokenQuantity -> TokenMap
TokenMap.singleton AssetId
asset (TokenQuantity -> TokenMap)
-> NonEmpty TokenQuantity -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        NonEmpty TokenQuantity
-> Maybe (NonEmpty TokenQuantity) -> NonEmpty TokenQuantity
forall a. a -> Maybe a -> a
fromMaybe NonEmpty TokenQuantity
zeros (TokenQuantity
-> NonEmpty TokenQuantity -> Maybe (NonEmpty TokenQuantity)
TokenQuantity.partition TokenQuantity
excess NonEmpty TokenQuantity
weights)
  where
    weights :: NonEmpty TokenQuantity
    weights :: NonEmpty TokenQuantity
weights = (TokenMap -> AssetId -> TokenQuantity)
-> AssetId -> TokenMap -> TokenQuantity
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenMap -> AssetId -> TokenQuantity
TokenMap.getQuantity AssetId
asset (TokenMap -> TokenQuantity)
-> NonEmpty TokenMap -> NonEmpty TokenQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TokenMap
targets

    zeros :: NonEmpty TokenQuantity
    zeros :: NonEmpty TokenQuantity
zeros = Natural -> TokenQuantity
TokenQuantity Natural
0 TokenQuantity -> NonEmpty TokenMap -> NonEmpty TokenQuantity
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NonEmpty TokenMap
targets

-- | Constructs change outputs for a non-user-specified asset: an asset that
--   was not present in the original set of outputs.
--
-- This function constructs a list of change outputs by preserving the input
-- distribution as much as possible. Note that only the length of the first
-- argument is used.
--
-- The length of the output list is always the same as the length of the input
-- list, and the sum of its quantities is always exactly equal to the sum of
-- all token quantities given in the second argument.
--
-- The resultant list is sorted into ascending order when maps are compared
-- with the `leq` function.
--
makeChangeForNonUserSpecifiedAsset
    :: NonEmpty a
        -- ^ Determines the number of change maps to create.
    -> (AssetId, NonEmpty TokenQuantity)
        -- ^ An asset quantity to distribute.
    -> NonEmpty TokenMap
        -- ^ The resultant change maps.
makeChangeForNonUserSpecifiedAsset :: NonEmpty a
-> (AssetId, NonEmpty TokenQuantity) -> NonEmpty TokenMap
makeChangeForNonUserSpecifiedAsset NonEmpty a
n (AssetId
asset, NonEmpty TokenQuantity
quantities) =
    AssetId -> TokenQuantity -> TokenMap
TokenMap.singleton AssetId
asset (TokenQuantity -> TokenMap)
-> NonEmpty TokenQuantity -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TokenQuantity -> NonEmpty a -> NonEmpty TokenQuantity
forall m a.
(Monoid m, Ord m) =>
NonEmpty m -> NonEmpty a -> NonEmpty m
padCoalesce NonEmpty TokenQuantity
quantities NonEmpty a
n

-- | Constructs change outputs for all non-user-specified assets: assets that
--   were not present in the original set of outputs.
--
-- The resultant list is sorted into ascending order when maps are compared
-- with the `leq` function.
--
makeChangeForNonUserSpecifiedAssets
    :: NonEmpty a
        -- ^ Determines the number of change maps to create.
    -> Map AssetId (NonEmpty TokenQuantity)
        -- ^ A map of asset quantities to distribute.
    -> NonEmpty TokenMap
        -- ^ The resultant change maps.
makeChangeForNonUserSpecifiedAssets :: NonEmpty a
-> Map AssetId (NonEmpty TokenQuantity) -> NonEmpty TokenMap
makeChangeForNonUserSpecifiedAssets NonEmpty a
n Map AssetId (NonEmpty TokenQuantity)
nonUserSpecifiedAssetQuantities =
    ((AssetId, NonEmpty TokenQuantity)
 -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> NonEmpty TokenMap
-> [(AssetId, NonEmpty TokenQuantity)]
-> NonEmpty TokenMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr
        ((TokenMap -> TokenMap -> TokenMap)
-> NonEmpty TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith TokenMap -> TokenMap -> TokenMap
forall a. Semigroup a => a -> a -> a
(<>) (NonEmpty TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> ((AssetId, NonEmpty TokenQuantity) -> NonEmpty TokenMap)
-> (AssetId, NonEmpty TokenQuantity)
-> NonEmpty TokenMap
-> NonEmpty TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a
-> (AssetId, NonEmpty TokenQuantity) -> NonEmpty TokenMap
forall a.
NonEmpty a
-> (AssetId, NonEmpty TokenQuantity) -> NonEmpty TokenMap
makeChangeForNonUserSpecifiedAsset NonEmpty a
n)
        (TokenMap
TokenMap.empty TokenMap -> NonEmpty a -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NonEmpty a
n)
        (Map AssetId (NonEmpty TokenQuantity)
-> [(AssetId, NonEmpty TokenQuantity)]
forall k a. Map k a -> [(k, a)]
Map.toList Map AssetId (NonEmpty TokenQuantity)
nonUserSpecifiedAssetQuantities)

-- | Constructs a list of ada change outputs based on the given distribution.
--
-- If the sum of weights in given distribution is equal to zero, this function
-- throws a runtime error.
--
-- The length of the output list is always the same as the length of the input
-- list, and the sum of its quantities is always exactly equal to the 'Coin'
-- value given as the second argument.
--
makeChangeForCoin
    :: HasCallStack
    => NonEmpty Coin
        -- ^ A list of weights for the distribution. Conveniently captures both
        -- the weights, and the number of elements amongst which the surplus
        -- ada quantity should be distributed.
    -> Coin
        -- ^ A surplus ada quantity to be distributed.
    -> NonEmpty Coin
makeChangeForCoin :: NonEmpty Coin -> Coin -> NonEmpty Coin
makeChangeForCoin = (Coin -> NonEmpty Coin -> NonEmpty Coin)
-> NonEmpty Coin -> Coin -> NonEmpty Coin
forall a b c. (a -> b -> c) -> b -> a -> c
flip HasCallStack => Coin -> NonEmpty Coin -> NonEmpty Coin
Coin -> NonEmpty Coin -> NonEmpty Coin
Coin.unsafePartition

--------------------------------------------------------------------------------
-- Minting and burning
--------------------------------------------------------------------------------

-- Once we know how much change to give, grouping the change into bundles is a
-- somewhat complicated topic.
--
-- We want to create change outputs with, as far as possible, values that are
-- likely to be useful to the user in future, where values that more closely
-- approximate the user-specified outputs are considered more "useful".
--
-- A key property is that the number of change outputs should reflect the
-- number of outputs specified by the user. For example, if the user sends
-- value to five distinct outputs, we should create five distinct change
-- outputs.
--
-- However, we also want to mint and burn tokens. In general, minting tokens
-- requires us to add value to the change outputs and burning tokens requires
-- us to remove value from the change outputs.
--
-- It's also important to note that the change bundle calculation requires
-- that the change for user-specified and non-user-specified assets have the
-- following properties:
--
--    1. The lists share the same length;
--    2. The lists are in ascending partial order.
--
-- For example, given the following non-user-specified asset quantities:
--
--    [ ("A", [4, 1, 3, 2])
--    , ("B", [9, 1, 8, 2, 7, 3, 6, 4, 5])
--    ]
--
-- If the user requests 5 outputs in their transaction,
-- 'makeChangeForNonUserSpecifiedAssets' will generate:
--
--    [ [          ("B",  7) ]
--    [ [("A", 1), ("B",  8) ]
--    [ [("A", 2), ("B",  9) ]
--    [ [("A", 3), ("B",  9) ]
--    [ [("A", 4), ("B", 12) ]
--
-- That is to say, it generates change bundles that satisfy the following
-- properties:
--
--    1.  The number of change bundles matches the number of outputs
--        the user originally requested;
--    2.  The change bundles are split in such a way to maximize the
--        number of large change bundles.
--
-- The change function maintains the property that the change bundles are in
-- ascending partial order, such that each change bundle is a subset of the
-- next. This property is required by 'changeMapOutputCoinPairs', so it's
-- important it's maintained.
--
-- The following two functions work by modifying the change bundles for
-- non-user-specified assets.
--
-- We add minted tokens to the largest change bundle:
--
--    [ [          ("B",  7) ]
--    [ [("A", 1), ("B",  8) ]
--    [ [("A", 2), ("B",  9) ]
--    [ [("A", 3), ("B",  9) ]
--    [ [("A", 4), ("B", 12) ] <-- add minted tokens here
--
-- We remove burned tokens from the smallest change bundles, until all burned
-- tokens are removed:
--
--    [ [          ("B", 7)  ] <-- start removing burned tokens from here
--    [ [("A", 1), ("B", 8)  ] <-- if we must burn more, remove from here
--    [ [("A", 2), ("B", 9)  ] <-- if we must burn more, remove from here
--    [ [("A", 3), ("B", 9)  ] <-- and so on, until we've removed everything.
--    [ [("A", 4), ("B", 12) ]
--
-- The solution for minting maintains the properties we desire, namely:
--
--    1.  The number of change bundles matches the number of
--        "outputs to cover" (we are not changing the number of bundles).
--    2.  The change bundles are in ascending partial order (by adding to the
--        largest bundle we trivially maintain ordering).
--    3.  The change bundles are split in such a way to maximize the
--        number of large change bundles.
--
-- The solution for burning maintains the same properties:
--
--    1.  The number of change bundles is not changed, in the case we burn a
--        change bundle completely, we just leave it as an empty entry
--        (effectively "pad with zeros").
--    2.  By removing from the smallest bundle, we maintain the ascending
--        partial order of the change bundles.
--    3.  By removing from the smallest bundles, we remove the "least useful"
--        bundles, maximizing the overall usefulness of our bundles.

-- | Adds a minted asset quantity to a list of change maps.
--
-- This function always adds the given quantity to the final change map in the
-- given list.
--
-- Example:
--
-- Suppose we have the following list of change maps:
--
--    [ [          ("B",  7) ]
--    [ [("A", 1), ("B",  8) ]
--    [ [("A", 2), ("B",  9) ]
--    [ [("A", 3), ("B",  9) ]
--    [ [("A", 4), ("B", 12) ]
--
-- If we add 4 tokens of asset "A", we obtain the following result:
--
--    [ [          ("B",  7) ]
--    [ [("A", 1), ("B",  8) ]
--    [ [("A", 2), ("B",  9) ]
--    [ [("A", 3), ("B",  9) ]
--    [ [("A", 8), ("B", 12) ] -- Increased by 4
--
-- Provided that the specified change maps are in ascending partial order, this
-- function guarantees that the resulting change maps will also be in ascending
-- partial order.
--
-- The length of the given list is preserved in the output list.
--
addMintValueToChangeMaps
    :: (AssetId, TokenQuantity)
    -> NonEmpty TokenMap
    -> NonEmpty TokenMap
addMintValueToChangeMaps :: (AssetId, TokenQuantity) -> NonEmpty TokenMap -> NonEmpty TokenMap
addMintValueToChangeMaps (AssetId
assetId, TokenQuantity
assetQty) =
    -- The largest element is the last element in an ascending order list
    (TokenMap -> TokenMap) -> NonEmpty TokenMap -> NonEmpty TokenMap
forall a. (a -> a) -> NonEmpty a -> NonEmpty a
modifyLast ((TokenMap -> TokenMap) -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> (TokenMap -> TokenMap) -> NonEmpty TokenMap -> NonEmpty TokenMap
forall a b. (a -> b) -> a -> b
$ \TokenMap
m -> TokenMap -> AssetId -> (TokenQuantity -> TokenQuantity) -> TokenMap
TokenMap.adjustQuantity TokenMap
m AssetId
assetId (TokenQuantity -> TokenQuantity -> TokenQuantity
forall a. Semigroup a => a -> a -> a
<> TokenQuantity
assetQty)
  where
    modifyLast :: (a -> a) -> NonEmpty a -> NonEmpty a
modifyLast a -> a
f NonEmpty a
xs = case NonEmpty a -> NonEmpty a
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty a
xs of
        (a
y :| [a]
ys) -> NonEmpty a -> NonEmpty a
forall a. NonEmpty a -> NonEmpty a
NE.reverse (a -> a
f a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
ys)

-- | Adds minted values for multiple assets to a list of change maps.
--
-- Plural of @addMintValueToChangeMaps@.
--
addMintValuesToChangeMaps
    :: TokenMap
    -- ^ Map of minted values
    -> NonEmpty TokenMap
    -- ^ Change maps
    -> NonEmpty TokenMap
    -- ^ Change maps with minted values
addMintValuesToChangeMaps :: TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
addMintValuesToChangeMaps =
    (NonEmpty TokenMap
 -> [(AssetId, TokenQuantity)] -> NonEmpty TokenMap)
-> [(AssetId, TokenQuantity)]
-> NonEmpty TokenMap
-> NonEmpty TokenMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((AssetId, TokenQuantity)
 -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> NonEmpty TokenMap
-> [(AssetId, TokenQuantity)]
-> NonEmpty TokenMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (AssetId, TokenQuantity) -> NonEmpty TokenMap -> NonEmpty TokenMap
addMintValueToChangeMaps) ([(AssetId, TokenQuantity)]
 -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> (TokenMap -> [(AssetId, TokenQuantity)])
-> TokenMap
-> NonEmpty TokenMap
-> NonEmpty TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(AssetId, TokenQuantity)]
TokenMap.toFlatList

-- | Removes a burned asset quantity from a list of change maps.
--
-- For a given asset 'a' and reduction target 't', this function traverses the
-- given list from left to right, reducing the quantity of asset 'a' in each
-- change map until the reduction target 't' has been met, or until the list
-- is exhausted.
--
-- For each change map 'm' under consideration:
--
--    - if the quantity 'q' of asset 'a' in map 'm' is less than or equal to
--      the remaining required reduction 'r', it will be replaced with a zero
--      (effectively eliminating asset 'a' from the map).
--
--    - if the quantity 'q' of asset 'a' in map 'm' is greater than the
--      remaining required reduction 'r', it will be replaced with the
--      absolute difference between 'q' and 'r'.
--
-- If the total quantity of the given asset in the given change maps is greater
-- than the specified reduction target, the total reduction will be equal to
-- the specified reduction target. Otherwise, the given asset will be
-- completely eliminated from all change maps.
--
-- Example:
--
-- Suppose we have the following list of change maps:
--
--    [ [          ("B",  7) ]
--    [ [("A", 1), ("B",  8) ]
--    [ [("A", 2), ("B",  9) ]
--    [ [("A", 3), ("B",  9) ]
--    [ [("A", 4), ("B", 12) ]
--
-- If our target is to reduce the quantity of asset "A" by 4, then we should
-- obtain the following result:
--
--    [ [          ("B",  7) ] -- Unable to reduce (already 0)
--    [ [          ("B",  8) ] -- Reduced by 1 (and eliminated from map)
--    [ [          ("B",  9) ] -- Reduced by 2 (and eliminated from map)
--    [ [("A", 2), ("B",  9) ] -- Reduced by 1
--    [ [("A", 4), ("B", 12) ]
--
-- Provided that the specified change maps are in ascending partial order, this
-- function guarantees that the resulting change maps will also be in ascending
-- partial order.
--
-- The length of the given list is preserved in the output list.
--
removeBurnValueFromChangeMaps
    :: (AssetId, TokenQuantity)
    -- ^ Asset quantity reduction target
    -> NonEmpty TokenMap
    -- ^ Change maps with quantities of the given asset to be reduced
    -> NonEmpty TokenMap
    -- ^ Change maps with reduced quantities of the given asset
removeBurnValueFromChangeMaps :: (AssetId, TokenQuantity) -> NonEmpty TokenMap -> NonEmpty TokenMap
removeBurnValueFromChangeMaps (AssetId
assetId, TokenQuantity
assetQty) NonEmpty TokenMap
maps = NonEmpty TokenMap
maps
    NonEmpty TokenMap
-> (NonEmpty TokenMap -> NonEmpty TokenQuantity)
-> NonEmpty TokenQuantity
forall a b. a -> (a -> b) -> b
& (TokenMap -> TokenQuantity)
-> NonEmpty TokenMap -> NonEmpty TokenQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenMap -> AssetId -> TokenQuantity
`TokenMap.getQuantity` AssetId
assetId)
    NonEmpty TokenQuantity
-> (NonEmpty TokenQuantity -> NonEmpty TokenQuantity)
-> NonEmpty TokenQuantity
forall a b. a -> (a -> b) -> b
& TokenQuantity -> NonEmpty TokenQuantity -> NonEmpty TokenQuantity
reduceTokenQuantities TokenQuantity
assetQty
    NonEmpty TokenQuantity
-> (NonEmpty TokenQuantity -> NonEmpty TokenMap)
-> NonEmpty TokenMap
forall a b. a -> (a -> b) -> b
& (TokenMap -> TokenQuantity -> TokenMap)
-> NonEmpty TokenMap -> NonEmpty TokenQuantity -> NonEmpty TokenMap
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (TokenMap -> AssetId -> TokenQuantity -> TokenMap
`TokenMap.setQuantity` AssetId
assetId) NonEmpty TokenMap
maps

-- | Reduces the total value of the given list of token quantities by the given
--   reduction target.
--
-- This function traverses the given list of quantities from left to right,
-- reducing each quantity in turn until the total reduction is equal to the
-- given reduction target, or until the list is exhausted.
--
-- For each quantity 'q' under consideration:
--
--    - if 'q' is less than or equal to the remaining required reduction 'r',
--      it will be replaced with a zero.
--
--    - if 'q' is greater than the remaining required reduction 'r', it will
--      be replaced with the absolute difference between 'q' and 'r'.
--
-- If the total value in the list is less than the reduction target, the
-- result will be a list of zeros.
--
-- Provided the given list is in ascending order, the resulting list is also
-- guaranteed to be in ascending order.
--
-- The length of the given list is preserved in the output.
--
reduceTokenQuantities
    :: TokenQuantity
    -- ^ Reduction target
    -> NonEmpty TokenQuantity
    -- ^ List of quantities to reduce
    -> NonEmpty TokenQuantity
    -- ^ The list of reduced quantities
reduceTokenQuantities :: TokenQuantity -> NonEmpty TokenQuantity -> NonEmpty TokenQuantity
reduceTokenQuantities TokenQuantity
reductionTarget NonEmpty TokenQuantity
quantities =
    [TokenQuantity] -> NonEmpty TokenQuantity
forall a. [a] -> NonEmpty a
NE.fromList ([TokenQuantity] -> NonEmpty TokenQuantity)
-> [TokenQuantity] -> NonEmpty TokenQuantity
forall a b. (a -> b) -> a -> b
$ TokenQuantity
-> [TokenQuantity] -> [TokenQuantity] -> [TokenQuantity]
burn TokenQuantity
reductionTarget (NonEmpty TokenQuantity -> [TokenQuantity]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TokenQuantity
quantities) []
  where
    burn :: TokenQuantity
-> [TokenQuantity] -> [TokenQuantity] -> [TokenQuantity]
burn TokenQuantity
_ [      ] [TokenQuantity]
ys = [TokenQuantity] -> [TokenQuantity]
forall a. [a] -> [a]
reverse [TokenQuantity]
ys
    burn TokenQuantity
b (TokenQuantity
x : [TokenQuantity]
xs) [TokenQuantity]
ys
        | TokenQuantity
x TokenQuantity -> TokenQuantity -> Bool
forall a. Ord a => a -> a -> Bool
>= TokenQuantity
b = [TokenQuantity] -> [TokenQuantity]
forall a. [a] -> [a]
reverse [TokenQuantity]
ys [TokenQuantity] -> [TokenQuantity] -> [TokenQuantity]
forall a. Semigroup a => a -> a -> a
<> (TokenQuantity
x' TokenQuantity -> [TokenQuantity] -> [TokenQuantity]
forall a. a -> [a] -> [a]
: [TokenQuantity]
xs)
        | Bool
otherwise = TokenQuantity
-> [TokenQuantity] -> [TokenQuantity] -> [TokenQuantity]
burn TokenQuantity
b' [TokenQuantity]
xs (TokenQuantity
x' TokenQuantity -> [TokenQuantity] -> [TokenQuantity]
forall a. a -> [a] -> [a]
: [TokenQuantity]
ys)
      where
        b' :: TokenQuantity
b' = TokenQuantity
b TokenQuantity -> TokenQuantity -> TokenQuantity
`TokenQuantity.difference` TokenQuantity
x
        x' :: TokenQuantity
x' = TokenQuantity
x TokenQuantity -> TokenQuantity -> TokenQuantity
`TokenQuantity.difference` TokenQuantity
b

-- | Removes burned values for multiple assets from a list of change maps.
--
-- Plural of @removeBurnValueFromChangeMaps@.
--
removeBurnValuesFromChangeMaps
    :: TokenMap
    -- ^ Map of burned values
    -> NonEmpty TokenMap
    -- ^ Change maps
    -> NonEmpty TokenMap
    -- ^ Change maps with burned values removed
removeBurnValuesFromChangeMaps :: TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
removeBurnValuesFromChangeMaps =
    (NonEmpty TokenMap
 -> [(AssetId, TokenQuantity)] -> NonEmpty TokenMap)
-> [(AssetId, TokenQuantity)]
-> NonEmpty TokenMap
-> NonEmpty TokenMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((AssetId, TokenQuantity)
 -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> NonEmpty TokenMap
-> [(AssetId, TokenQuantity)]
-> NonEmpty TokenMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (AssetId, TokenQuantity) -> NonEmpty TokenMap -> NonEmpty TokenMap
removeBurnValueFromChangeMaps) ([(AssetId, TokenQuantity)]
 -> NonEmpty TokenMap -> NonEmpty TokenMap)
-> (TokenMap -> [(AssetId, TokenQuantity)])
-> TokenMap
-> NonEmpty TokenMap
-> NonEmpty TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(AssetId, TokenQuantity)]
TokenMap.toFlatList

--------------------------------------------------------------------------------
-- Splitting bundles
--------------------------------------------------------------------------------

-- | Splits a bundle into smaller bundles if its asset count is excessive when
--   measured with the given 'isExcessive' indicator function.
--
-- Returns a list of smaller bundles for which 'isExcessive' returns 'False'.
--
splitBundleIfAssetCountExcessive
    :: TokenBundle
    -- ^ The token bundle suspected to have an excessive number of assets.
    -> (TokenBundle -> Bool)
    -- ^ A function that returns 'True' if (and only if) the asset count of
    -- the given bundle is excessive.
    -> NonEmpty TokenBundle
splitBundleIfAssetCountExcessive :: TokenBundle -> (TokenBundle -> Bool) -> NonEmpty TokenBundle
splitBundleIfAssetCountExcessive TokenBundle
b TokenBundle -> Bool
isExcessive
    | TokenBundle -> Bool
isExcessive TokenBundle
b =
        TokenBundle -> NonEmpty TokenBundle
splitInHalf TokenBundle
b NonEmpty TokenBundle
-> (TokenBundle -> NonEmpty TokenBundle) -> NonEmpty TokenBundle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TokenBundle -> (TokenBundle -> Bool) -> NonEmpty TokenBundle)
-> (TokenBundle -> Bool) -> TokenBundle -> NonEmpty TokenBundle
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenBundle -> (TokenBundle -> Bool) -> NonEmpty TokenBundle
splitBundleIfAssetCountExcessive TokenBundle -> Bool
isExcessive
    | Bool
otherwise =
        TokenBundle -> NonEmpty TokenBundle
forall (f :: * -> *) a. Applicative f => a -> f a
pure TokenBundle
b
  where
    splitInHalf :: TokenBundle -> NonEmpty TokenBundle
splitInHalf = (TokenBundle -> NonEmpty () -> NonEmpty TokenBundle)
-> NonEmpty () -> TokenBundle -> NonEmpty TokenBundle
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenBundle -> NonEmpty () -> NonEmpty TokenBundle
forall a. TokenBundle -> NonEmpty a -> NonEmpty TokenBundle
TokenBundle.equipartitionAssets (() () -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:| [()])

-- | Splits bundles with excessive asset counts into smaller bundles.
--
-- Only token bundles where the 'isExcessive' indicator function returns 'True'
-- will be split.
--
-- Returns a list of smaller bundles for which 'isExcessive' returns 'False'.
--
-- If none of the bundles in the given list has an excessive asset count,
-- this function will return the original list.
--
splitBundlesWithExcessiveAssetCounts
    :: NonEmpty TokenBundle
    -- ^ Token bundles.
    -> (TokenBundle -> Bool)
    -- ^ A function that returns 'True' if (and only if) the asset count of
    -- the given bundle is excessive.
    -> NonEmpty TokenBundle
splitBundlesWithExcessiveAssetCounts :: NonEmpty TokenBundle
-> (TokenBundle -> Bool) -> NonEmpty TokenBundle
splitBundlesWithExcessiveAssetCounts NonEmpty TokenBundle
bs TokenBundle -> Bool
isExcessive =
    (TokenBundle -> (TokenBundle -> Bool) -> NonEmpty TokenBundle
`splitBundleIfAssetCountExcessive` TokenBundle -> Bool
isExcessive) (TokenBundle -> NonEmpty TokenBundle)
-> NonEmpty TokenBundle -> NonEmpty TokenBundle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NonEmpty TokenBundle
bs

-- | Splits bundles with excessive token quantities into smaller bundles.
--
-- Only token bundles containing quantities that exceed the maximum token
-- quantity will be split.
--
-- If none of the bundles in the given list contain a quantity that exceeds
-- the maximum token quantity, this function will return the original list.
--
splitBundlesWithExcessiveTokenQuantities
    :: NonEmpty TokenBundle
    -- ^ Token bundles.
    -> TokenQuantity
    -- ^ Maximum allowable token quantity.
    -> NonEmpty TokenBundle
    -- ^ The partitioned bundles.
splitBundlesWithExcessiveTokenQuantities :: NonEmpty TokenBundle -> TokenQuantity -> NonEmpty TokenBundle
splitBundlesWithExcessiveTokenQuantities NonEmpty TokenBundle
bs TokenQuantity
maxQuantity =
    (TokenBundle -> TokenQuantity -> NonEmpty TokenBundle
`TokenBundle.equipartitionQuantitiesWithUpperBound` TokenQuantity
maxQuantity) (TokenBundle -> NonEmpty TokenBundle)
-> NonEmpty TokenBundle -> NonEmpty TokenBundle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NonEmpty TokenBundle
bs

--------------------------------------------------------------------------------
-- Grouping and ungrouping
--------------------------------------------------------------------------------

groupByKey :: forall k v. Ord k => [(k, v)] -> Map k (NonEmpty v)
groupByKey :: [(k, v)] -> Map k (NonEmpty v)
groupByKey = (Map k (NonEmpty v) -> (k, v) -> Map k (NonEmpty v))
-> Map k (NonEmpty v) -> [(k, v)] -> Map k (NonEmpty v)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Map k (NonEmpty v) -> (k, v) -> Map k (NonEmpty v)
acc Map k (NonEmpty v)
forall a. Monoid a => a
mempty
  where
    acc :: Map k (NonEmpty v) -> (k, v) -> Map k (NonEmpty v)
    acc :: Map k (NonEmpty v) -> (k, v) -> Map k (NonEmpty v)
acc Map k (NonEmpty v)
m (k
k, v
v) = (Maybe (NonEmpty v) -> Maybe (NonEmpty v))
-> k -> Map k (NonEmpty v) -> Map k (NonEmpty v)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (NonEmpty v -> Maybe (NonEmpty v)
forall a. a -> Maybe a
Just (NonEmpty v -> Maybe (NonEmpty v))
-> (Maybe (NonEmpty v) -> NonEmpty v)
-> Maybe (NonEmpty v)
-> Maybe (NonEmpty v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty v
-> (NonEmpty v -> NonEmpty v) -> Maybe (NonEmpty v) -> NonEmpty v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (v
v v -> [v] -> NonEmpty v
forall a. a -> [a] -> NonEmpty a
:| []) (v -> NonEmpty v -> NonEmpty v
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons v
v)) k
k Map k (NonEmpty v)
m

ungroupByKey :: forall k v. Map k (NonEmpty v) -> [(k, v)]
ungroupByKey :: Map k (NonEmpty v) -> [(k, v)]
ungroupByKey Map k (NonEmpty v)
m = [(k
k, v
v) | (k
k, NonEmpty v
vs) <- Map k (NonEmpty v) -> [(k, NonEmpty v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k (NonEmpty v)
m, v
v <- NonEmpty v -> [v]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty v
vs]

--------------------------------------------------------------------------------
-- Round-robin processing
--------------------------------------------------------------------------------

runRoundRobin :: s -> (s' -> s) -> [(s -> Maybe s')] -> s
runRoundRobin :: s -> (s' -> s) -> [s -> Maybe s'] -> s
runRoundRobin s
state s' -> s
demote [s -> Maybe s']
processors =
    Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> Identity s -> s
forall a b. (a -> b) -> a -> b
$ s -> (s' -> s) -> [s -> Identity (Maybe s')] -> Identity s
forall (m :: * -> *) s s'.
Monad m =>
s -> (s' -> s) -> [s -> m (Maybe s')] -> m s
runRoundRobinM s
state s' -> s
demote ([s -> Identity (Maybe s')] -> Identity s)
-> [s -> Identity (Maybe s')] -> Identity s
forall a b. (a -> b) -> a -> b
$ (Maybe s' -> Identity (Maybe s'))
-> (s -> Maybe s') -> s -> Identity (Maybe s')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe s' -> Identity (Maybe s')
forall a. a -> Identity a
Identity ((s -> Maybe s') -> s -> Identity (Maybe s'))
-> [s -> Maybe s'] -> [s -> Identity (Maybe s')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [s -> Maybe s']
processors

runRoundRobinM :: Monad m => s -> (s' -> s) -> [(s -> m (Maybe s'))] -> m s
runRoundRobinM :: s -> (s' -> s) -> [s -> m (Maybe s')] -> m s
runRoundRobinM s
state s' -> s
demote [s -> m (Maybe s')]
processors = s -> [s -> m (Maybe s')] -> [s -> m (Maybe s')] -> m s
go s
state [s -> m (Maybe s')]
processors []
  where
    go :: s -> [s -> m (Maybe s')] -> [s -> m (Maybe s')] -> m s
go !s
s []        [] = s -> m s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
    go !s
s []       ![s -> m (Maybe s')]
qs = s -> [s -> m (Maybe s')] -> [s -> m (Maybe s')] -> m s
go s
s ([s -> m (Maybe s')] -> [s -> m (Maybe s')]
forall a. [a] -> [a]
L.reverse [s -> m (Maybe s')]
qs) []
    go !s
s (s -> m (Maybe s')
p : [s -> m (Maybe s')]
ps) ![s -> m (Maybe s')]
qs = s -> m (Maybe s')
p s
s m (Maybe s') -> (Maybe s' -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        \case
            Maybe s'
Nothing -> s -> [s -> m (Maybe s')] -> [s -> m (Maybe s')] -> m s
go         s
s   [s -> m (Maybe s')]
ps      [s -> m (Maybe s')]
qs
            Just s'
s' -> s -> [s -> m (Maybe s')] -> [s -> m (Maybe s')] -> m s
go (s' -> s
demote s'
s') [s -> m (Maybe s')]
ps (s -> m (Maybe s')
p (s -> m (Maybe s')) -> [s -> m (Maybe s')] -> [s -> m (Maybe s')]
forall a. a -> [a] -> [a]
: [s -> m (Maybe s')]
qs)

--------------------------------------------------------------------------------
-- Accessor functions
--------------------------------------------------------------------------------

selectedAssetQuantity :: IsUTxOSelection s u => AssetId -> s u -> Natural
selectedAssetQuantity :: AssetId -> s u -> Natural
selectedAssetQuantity AssetId
asset
    = TokenQuantity -> Natural
unTokenQuantity
    (TokenQuantity -> Natural)
-> (s u -> TokenQuantity) -> s u -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenBundle -> AssetId -> TokenQuantity)
-> AssetId -> TokenBundle -> TokenQuantity
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenBundle -> AssetId -> TokenQuantity
TokenBundle.getQuantity AssetId
asset
    (TokenBundle -> TokenQuantity)
-> (s u -> TokenBundle) -> s u -> TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> TokenBundle
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> TokenBundle
UTxOSelection.selectedBalance

selectedCoinQuantity :: IsUTxOSelection s u => s u -> Natural
selectedCoinQuantity :: s u -> Natural
selectedCoinQuantity
    = Natural -> Natural
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast
    (Natural -> Natural) -> (s u -> Natural) -> s u -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin
    (Coin -> Natural) -> (s u -> Coin) -> s u -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenBundle -> Coin
TokenBundle.getCoin
    (TokenBundle -> Coin) -> (s u -> TokenBundle) -> s u -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> TokenBundle
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> TokenBundle
UTxOSelection.selectedBalance

--------------------------------------------------------------------------------
-- Utility types
--------------------------------------------------------------------------------

-- | A total ordering on token maps based on the number of assets in each map.
--
-- If two maps have the same number of assets, then we fall back to ordinary
-- lexicographic ordering as a tie-breaker.
--
instance Ord (AssetCount TokenMap) where
    compare :: AssetCount TokenMap -> AssetCount TokenMap -> Ordering
compare = (AssetCount TokenMap -> (Int, Lexicographic TokenMap))
-> AssetCount TokenMap -> AssetCount TokenMap -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing AssetCount TokenMap -> (Int, Lexicographic TokenMap)
projection
      where
        projection :: AssetCount TokenMap -> (Int, Lexicographic TokenMap)
projection (AssetCount TokenMap
m) = (TokenMap -> Int
TokenMap.size TokenMap
m, TokenMap -> Lexicographic TokenMap
forall a. a -> Lexicographic a
Lexicographic TokenMap
m)

newtype AssetCount a = AssetCount
    { AssetCount a -> a
unAssetCount :: a }
    deriving (AssetCount a -> AssetCount a -> Bool
(AssetCount a -> AssetCount a -> Bool)
-> (AssetCount a -> AssetCount a -> Bool) -> Eq (AssetCount a)
forall a. Eq a => AssetCount a -> AssetCount a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetCount a -> AssetCount a -> Bool
$c/= :: forall a. Eq a => AssetCount a -> AssetCount a -> Bool
== :: AssetCount a -> AssetCount a -> Bool
$c== :: forall a. Eq a => AssetCount a -> AssetCount a -> Bool
Eq, Int -> AssetCount a -> ShowS
[AssetCount a] -> ShowS
AssetCount a -> String
(Int -> AssetCount a -> ShowS)
-> (AssetCount a -> String)
-> ([AssetCount a] -> ShowS)
-> Show (AssetCount a)
forall a. Show a => Int -> AssetCount a -> ShowS
forall a. Show a => [AssetCount a] -> ShowS
forall a. Show a => AssetCount a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetCount a] -> ShowS
$cshowList :: forall a. Show a => [AssetCount a] -> ShowS
show :: AssetCount a -> String
$cshow :: forall a. Show a => AssetCount a -> String
showsPrec :: Int -> AssetCount a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AssetCount a -> ShowS
Show)

--------------------------------------------------------------------------------
-- Utility functions
--------------------------------------------------------------------------------

distance :: Natural -> Natural -> Natural
distance :: Natural -> Natural -> Natural
distance Natural
a Natural
b
    | Natural
a Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
b = Natural
a Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
b
    | Natural
a Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
b = Natural
b Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
a
    | Bool
otherwise = Natural
0

mapMaybe :: (a -> Maybe b) -> NonEmpty a -> [b]
mapMaybe :: (a -> Maybe b) -> NonEmpty a -> [b]
mapMaybe a -> Maybe b
predicate (a
x :| [a]
xs) = [a] -> [b]
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
  where
    go :: [a] -> [b]
go   []   = []
    go (a
a:[a]
as) =
        case a -> Maybe b
predicate a
a of
            Just b
b  -> b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [a] -> [b]
go [a]
as
            Maybe b
Nothing -> [a] -> [b]
go [a]
as