{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: © 2022 IOHK
-- License: Apache-2.0
--
-- This module provides a wallet-specific interface for coin selection.
--
-- Coin selection handles the following responsibilities:
--
--  - selecting inputs from the UTxO set to pay for user-specified outputs;
--  - selecting inputs from the UTxO set to pay for collateral;
--  - producing change outputs to return excess value to the wallet;
--  - balancing a selection to pay for the transaction fee.
--
-- Use the 'performSelection' function to perform a coin selection.
--
module Cardano.Wallet.CoinSelection
    (
    -- * Selection contexts
      WalletSelectionContext
    , WalletUTxO (..)

    -- * Mapping between external (wallet) types and internal types
    , toExternalUTxO
    , toExternalUTxOMap
    , toInternalUTxO
    , toInternalUTxOMap

    -- * Mapping between external (wallet) selections and internal selections.
    , toExternalSelection
    , toInternalSelection

    -- * Performing selections
    , performSelection
    , Selection
    , SelectionCollateralRequirement (..)
    , SelectionConstraints (..)
    , SelectionError (..)
    , SelectionLimit
    , SelectionLimitOf (..)
    , SelectionOf (..)
    , SelectionParams (..)
    , SelectionStrategy (..)

    -- * Selection skeletons
    , SelectionSkeleton (..)
    , emptySkeleton

    -- * Selection errors
    , BalanceInsufficientError (..)
    , SelectionBalanceError (..)
    , SelectionCollateralError
    , SelectionOutputError (..)
    , SelectionOutputCoinInsufficientError (..)
    , SelectionOutputSizeExceedsLimitError (..)
    , SelectionOutputTokenQuantityExceedsLimitError (..)
    , UnableToConstructChangeError (..)

    -- * Selection reports
    , makeSelectionReportDetailed
    , makeSelectionReportSummarized
    , SelectionReportDetailed
    , SelectionReportSummarized

    -- * Selection deltas
    , balanceMissing
    , selectionDelta
    )
    where

import Cardano.Wallet.CoinSelection.Internal
    ( SelectionCollateralError
    , SelectionCollateralRequirement (..)
    , SelectionError (..)
    , SelectionOutputCoinInsufficientError (..)
    , SelectionOutputError (..)
    , SelectionOutputSizeExceedsLimitError (..)
    , SelectionOutputTokenQuantityExceedsLimitError (..)
    )
import Cardano.Wallet.CoinSelection.Internal.Balance
    ( BalanceInsufficientError (..)
    , SelectionBalanceError (..)
    , SelectionLimit
    , SelectionLimitOf (..)
    , SelectionStrategy (..)
    , UnableToConstructChangeError (..)
    , balanceMissing
    )
import Cardano.Wallet.Primitive.Collateral
    ( asCollateral )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
    ( Flat (..), TokenBundle )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId, TokenMap )
import Cardano.Wallet.Primitive.Types.Tx
    ( TokenBundleSizeAssessment
    , TxIn
    , TxOut (..)
    , txOutMaxCoin
    , txOutMaxTokenQuantity
    )
import Cardano.Wallet.Primitive.Types.UTxO
    ( UTxO (..) )
import Cardano.Wallet.Primitive.Types.UTxOSelection
    ( UTxOSelection )
import Control.Arrow
    ( (&&&) )
import Control.Monad.Random.Class
    ( MonadRandom (..) )
import Control.Monad.Trans.Except
    ( ExceptT (..) )
import Data.Generics.Internal.VL.Lens
    ( over, view )
import Data.List.NonEmpty
    ( NonEmpty )
import Data.Map.Strict
    ( Map )
import Data.Set
    ( Set )
import Fmt
    ( Buildable (..), genericF )
import GHC.Generics
    ( Generic )
import GHC.Stack
    ( HasCallStack )
import Numeric.Natural
    ( Natural )

import Prelude

import qualified Cardano.Wallet.CoinSelection.Internal as Internal
import qualified Cardano.Wallet.CoinSelection.Internal.Context as SC
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Data.Foldable as F
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

--------------------------------------------------------------------------------
-- Selection contexts
--------------------------------------------------------------------------------

-- | A selection context for the wallet.
--
data WalletSelectionContext

instance SC.SelectionContext WalletSelectionContext where
    type Address WalletSelectionContext = Address
    type UTxO WalletSelectionContext = WalletUTxO

--------------------------------------------------------------------------------
-- Mapping between external (wallet) and internal UTxO identifiers
--------------------------------------------------------------------------------

-- | A type of unique UTxO identifier for the wallet.
--
data WalletUTxO = WalletUTxO
    { WalletUTxO -> TxIn
txIn
        :: TxIn
    , WalletUTxO -> Address
address
        :: Address
    }
    deriving (WalletUTxO -> WalletUTxO -> Bool
(WalletUTxO -> WalletUTxO -> Bool)
-> (WalletUTxO -> WalletUTxO -> Bool) -> Eq WalletUTxO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletUTxO -> WalletUTxO -> Bool
$c/= :: WalletUTxO -> WalletUTxO -> Bool
== :: WalletUTxO -> WalletUTxO -> Bool
$c== :: WalletUTxO -> WalletUTxO -> Bool
Eq, (forall x. WalletUTxO -> Rep WalletUTxO x)
-> (forall x. Rep WalletUTxO x -> WalletUTxO) -> Generic WalletUTxO
forall x. Rep WalletUTxO x -> WalletUTxO
forall x. WalletUTxO -> Rep WalletUTxO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletUTxO x -> WalletUTxO
$cfrom :: forall x. WalletUTxO -> Rep WalletUTxO x
Generic, Eq WalletUTxO
Eq WalletUTxO
-> (WalletUTxO -> WalletUTxO -> Ordering)
-> (WalletUTxO -> WalletUTxO -> Bool)
-> (WalletUTxO -> WalletUTxO -> Bool)
-> (WalletUTxO -> WalletUTxO -> Bool)
-> (WalletUTxO -> WalletUTxO -> Bool)
-> (WalletUTxO -> WalletUTxO -> WalletUTxO)
-> (WalletUTxO -> WalletUTxO -> WalletUTxO)
-> Ord WalletUTxO
WalletUTxO -> WalletUTxO -> Bool
WalletUTxO -> WalletUTxO -> Ordering
WalletUTxO -> WalletUTxO -> WalletUTxO
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WalletUTxO -> WalletUTxO -> WalletUTxO
$cmin :: WalletUTxO -> WalletUTxO -> WalletUTxO
max :: WalletUTxO -> WalletUTxO -> WalletUTxO
$cmax :: WalletUTxO -> WalletUTxO -> WalletUTxO
>= :: WalletUTxO -> WalletUTxO -> Bool
$c>= :: WalletUTxO -> WalletUTxO -> Bool
> :: WalletUTxO -> WalletUTxO -> Bool
$c> :: WalletUTxO -> WalletUTxO -> Bool
<= :: WalletUTxO -> WalletUTxO -> Bool
$c<= :: WalletUTxO -> WalletUTxO -> Bool
< :: WalletUTxO -> WalletUTxO -> Bool
$c< :: WalletUTxO -> WalletUTxO -> Bool
compare :: WalletUTxO -> WalletUTxO -> Ordering
$ccompare :: WalletUTxO -> WalletUTxO -> Ordering
$cp1Ord :: Eq WalletUTxO
Ord, Int -> WalletUTxO -> ShowS
[WalletUTxO] -> ShowS
WalletUTxO -> String
(Int -> WalletUTxO -> ShowS)
-> (WalletUTxO -> String)
-> ([WalletUTxO] -> ShowS)
-> Show WalletUTxO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletUTxO] -> ShowS
$cshowList :: [WalletUTxO] -> ShowS
show :: WalletUTxO -> String
$cshow :: WalletUTxO -> String
showsPrec :: Int -> WalletUTxO -> ShowS
$cshowsPrec :: Int -> WalletUTxO -> ShowS
Show)

instance Buildable WalletUTxO where
    build :: WalletUTxO -> Builder
build (WalletUTxO TxIn
i Address
a) = TxIn -> Builder
forall p. Buildable p => p -> Builder
build TxIn
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
a

instance Buildable (WalletUTxO, TokenBundle) where
    build :: (WalletUTxO, TokenBundle) -> Builder
build (WalletUTxO
u, TokenBundle
b) = WalletUTxO -> Builder
forall p. Buildable p => p -> Builder
build WalletUTxO
u Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Flat TokenBundle -> Builder
forall p. Buildable p => p -> Builder
build (TokenBundle -> Flat TokenBundle
forall a. a -> Flat a
Flat TokenBundle
b)

toExternalUTxO :: (WalletUTxO, TokenBundle) -> (TxIn, TxOut)
toExternalUTxO :: (WalletUTxO, TokenBundle) -> (TxIn, TxOut)
toExternalUTxO = (TokenBundle -> TokenBundle)
-> (WalletUTxO, TokenBundle) -> (TxIn, TxOut)
forall b. (b -> TokenBundle) -> (WalletUTxO, b) -> (TxIn, TxOut)
toExternalUTxO' TokenBundle -> TokenBundle
forall a. a -> a
id

toExternalUTxOMap :: Map WalletUTxO TokenBundle -> UTxO
toExternalUTxOMap :: Map WalletUTxO TokenBundle -> UTxO
toExternalUTxOMap = Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO)
-> (Map WalletUTxO TokenBundle -> Map TxIn TxOut)
-> Map WalletUTxO TokenBundle
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut)] -> Map TxIn TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut)] -> Map TxIn TxOut)
-> (Map WalletUTxO TokenBundle -> [(TxIn, TxOut)])
-> Map WalletUTxO TokenBundle
-> Map TxIn TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WalletUTxO, TokenBundle) -> (TxIn, TxOut))
-> [(WalletUTxO, TokenBundle)] -> [(TxIn, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WalletUTxO, TokenBundle) -> (TxIn, TxOut)
toExternalUTxO ([(WalletUTxO, TokenBundle)] -> [(TxIn, TxOut)])
-> (Map WalletUTxO TokenBundle -> [(WalletUTxO, TokenBundle)])
-> Map WalletUTxO TokenBundle
-> [(TxIn, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WalletUTxO TokenBundle -> [(WalletUTxO, TokenBundle)]
forall k a. Map k a -> [(k, a)]
Map.toList

toInternalUTxO :: (TxIn, TxOut) -> (WalletUTxO, TokenBundle)
toInternalUTxO :: (TxIn, TxOut) -> (WalletUTxO, TokenBundle)
toInternalUTxO = (TokenBundle -> TokenBundle)
-> (TxIn, TxOut) -> (WalletUTxO, TokenBundle)
forall b. (TokenBundle -> b) -> (TxIn, TxOut) -> (WalletUTxO, b)
toInternalUTxO' TokenBundle -> TokenBundle
forall a. a -> a
id

toInternalUTxOMap :: UTxO -> Map WalletUTxO TokenBundle
toInternalUTxOMap :: UTxO -> Map WalletUTxO TokenBundle
toInternalUTxOMap = [(WalletUTxO, TokenBundle)] -> Map WalletUTxO TokenBundle
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(WalletUTxO, TokenBundle)] -> Map WalletUTxO TokenBundle)
-> (UTxO -> [(WalletUTxO, TokenBundle)])
-> UTxO
-> Map WalletUTxO TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, TxOut) -> (WalletUTxO, TokenBundle))
-> [(TxIn, TxOut)] -> [(WalletUTxO, TokenBundle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn, TxOut) -> (WalletUTxO, TokenBundle)
toInternalUTxO ([(TxIn, TxOut)] -> [(WalletUTxO, TokenBundle)])
-> (UTxO -> [(TxIn, TxOut)]) -> UTxO -> [(WalletUTxO, TokenBundle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxIn TxOut -> [(TxIn, TxOut)])
-> (UTxO -> Map TxIn TxOut) -> UTxO -> [(TxIn, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> Map TxIn TxOut
unUTxO

toExternalUTxO' :: (b -> TokenBundle) -> (WalletUTxO, b) -> (TxIn, TxOut)
toExternalUTxO' :: (b -> TokenBundle) -> (WalletUTxO, b) -> (TxIn, TxOut)
toExternalUTxO' b -> TokenBundle
f (WalletUTxO TxIn
i Address
a, b
b) = (TxIn
i, Address -> TokenBundle -> TxOut
TxOut Address
a (b -> TokenBundle
f b
b))

toInternalUTxO' :: (TokenBundle -> b) -> (TxIn, TxOut) -> (WalletUTxO, b)
toInternalUTxO' :: (TokenBundle -> b) -> (TxIn, TxOut) -> (WalletUTxO, b)
toInternalUTxO' TokenBundle -> b
f (TxIn
i, TxOut Address
a TokenBundle
b) = (TxIn -> Address -> WalletUTxO
WalletUTxO TxIn
i Address
a, TokenBundle -> b
f TokenBundle
b)

--------------------------------------------------------------------------------
-- Selection constraints
--------------------------------------------------------------------------------

-- | Specifies all constraints required for coin selection.
--
-- Selection constraints:
--
--    - are dependent on the current set of protocol parameters.
--
--    - are not specific to a given selection.
--
--    - place limits on the coin selection algorithm, enabling it to produce
--      selections that are acceptable to the ledger.
--
data SelectionConstraints = SelectionConstraints
    { SelectionConstraints -> 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 -> Coin
certificateDepositAmount
        :: Coin
        -- ^ Amount that should be taken from/returned back to the wallet for
        -- each stake key registration/de-registration in the transaction.
    , SelectionConstraints -> Address -> TokenMap -> Coin
computeMinimumAdaQuantity
        :: Address -> TokenMap -> Coin
        -- ^ Computes the minimum ada quantity required for a given output.
    , SelectionConstraints -> Address -> TokenBundle -> Bool
isBelowMinimumAdaQuantity
        :: Address -> TokenBundle -> Bool
      -- ^ Returns 'True' if the given 'TokenBundle' has a 'Coin' value that is
      -- below the minimum required.
    , SelectionConstraints -> SelectionSkeleton -> Coin
computeMinimumCost
        :: SelectionSkeleton -> Coin
        -- ^ Computes the minimum cost of a given selection skeleton.
    , SelectionConstraints -> [TxOut] -> SelectionLimit
computeSelectionLimit
        :: [TxOut] -> SelectionLimit
        -- ^ Computes an upper bound for the number of ordinary inputs to
        -- select, given a current set of outputs.
    , SelectionConstraints -> Int
maximumCollateralInputCount
        :: Int
        -- ^ Specifies an inclusive upper bound on the number of unique inputs
        -- that can be selected as collateral.
    , SelectionConstraints -> Natural
minimumCollateralPercentage
        :: Natural
        -- ^ Specifies the minimum required amount of collateral as a
        -- percentage of the total transaction fee.
    , SelectionConstraints -> Address
maximumLengthChangeAddress
        :: Address
    }
    deriving (forall x. SelectionConstraints -> Rep SelectionConstraints x)
-> (forall x. Rep SelectionConstraints x -> SelectionConstraints)
-> Generic SelectionConstraints
forall x. Rep SelectionConstraints x -> SelectionConstraints
forall x. SelectionConstraints -> Rep SelectionConstraints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectionConstraints x -> SelectionConstraints
$cfrom :: forall x. SelectionConstraints -> Rep SelectionConstraints x
Generic

toInternalSelectionConstraints
    :: SelectionConstraints
    -> Internal.SelectionConstraints WalletSelectionContext
toInternalSelectionConstraints :: SelectionConstraints -> SelectionConstraints WalletSelectionContext
toInternalSelectionConstraints SelectionConstraints {Int
Natural
Address
Coin
[TxOut] -> SelectionLimit
Address -> TokenMap -> Coin
Address -> TokenBundle -> Bool
TokenBundle -> TokenBundleSizeAssessment
SelectionSkeleton -> Coin
maximumLengthChangeAddress :: Address
minimumCollateralPercentage :: Natural
maximumCollateralInputCount :: Int
computeSelectionLimit :: [TxOut] -> SelectionLimit
computeMinimumCost :: SelectionSkeleton -> Coin
isBelowMinimumAdaQuantity :: Address -> TokenBundle -> Bool
computeMinimumAdaQuantity :: Address -> TokenMap -> Coin
certificateDepositAmount :: Coin
assessTokenBundleSize :: TokenBundle -> TokenBundleSizeAssessment
$sel:maximumLengthChangeAddress:SelectionConstraints :: SelectionConstraints -> Address
$sel:minimumCollateralPercentage:SelectionConstraints :: SelectionConstraints -> Natural
$sel:maximumCollateralInputCount:SelectionConstraints :: SelectionConstraints -> Int
$sel:computeSelectionLimit:SelectionConstraints :: SelectionConstraints -> [TxOut] -> SelectionLimit
$sel:computeMinimumCost:SelectionConstraints :: SelectionConstraints -> SelectionSkeleton -> Coin
$sel:isBelowMinimumAdaQuantity:SelectionConstraints :: SelectionConstraints -> Address -> TokenBundle -> Bool
$sel:computeMinimumAdaQuantity:SelectionConstraints :: SelectionConstraints -> Address -> TokenMap -> Coin
$sel:certificateDepositAmount:SelectionConstraints :: SelectionConstraints -> Coin
$sel:assessTokenBundleSize:SelectionConstraints :: SelectionConstraints -> TokenBundle -> TokenBundleSizeAssessment
..} =
    SelectionConstraints :: forall ctx.
(TokenBundle -> TokenBundleSizeAssessment)
-> Coin
-> (Address ctx -> TokenMap -> Coin)
-> (Address ctx -> TokenBundle -> Bool)
-> (SelectionSkeleton ctx -> Coin)
-> ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> Int
-> Natural
-> Coin
-> TokenQuantity
-> Address ctx
-> Address ctx
-> SelectionConstraints ctx
Internal.SelectionConstraints
        { $sel:computeMinimumCost:SelectionConstraints :: SelectionSkeleton WalletSelectionContext -> Coin
computeMinimumCost =
            SelectionSkeleton -> Coin
computeMinimumCost (SelectionSkeleton -> Coin)
-> (SelectionSkeleton WalletSelectionContext -> SelectionSkeleton)
-> SelectionSkeleton WalletSelectionContext
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSkeleton WalletSelectionContext -> SelectionSkeleton
toExternalSelectionSkeleton
        , $sel:computeSelectionLimit:SelectionConstraints :: [(Address WalletSelectionContext, TokenBundle)] -> SelectionLimit
computeSelectionLimit =
            [TxOut] -> SelectionLimit
computeSelectionLimit ([TxOut] -> SelectionLimit)
-> ([(Address, TokenBundle)] -> [TxOut])
-> [(Address, TokenBundle)]
-> SelectionLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, TokenBundle) -> TxOut)
-> [(Address, TokenBundle)] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Address -> TokenBundle -> TxOut)
-> (Address, TokenBundle) -> TxOut
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> TokenBundle -> TxOut
TxOut)
        , $sel:maximumOutputAdaQuantity:SelectionConstraints :: Coin
maximumOutputAdaQuantity =
            Coin
txOutMaxCoin
        , $sel:maximumOutputTokenQuantity:SelectionConstraints :: TokenQuantity
maximumOutputTokenQuantity =
            TokenQuantity
txOutMaxTokenQuantity
        , $sel:nullAddress:SelectionConstraints :: Address WalletSelectionContext
nullAddress =
            ByteString -> Address
Address ByteString
""
        , Int
Natural
Address WalletSelectionContext
Address
Coin
Address WalletSelectionContext -> TokenMap -> Coin
Address WalletSelectionContext -> TokenBundle -> Bool
Address -> TokenMap -> Coin
Address -> TokenBundle -> Bool
TokenBundle -> TokenBundleSizeAssessment
$sel:maximumLengthChangeAddress:SelectionConstraints :: Address WalletSelectionContext
$sel:minimumCollateralPercentage:SelectionConstraints :: Natural
$sel:maximumCollateralInputCount:SelectionConstraints :: Int
$sel:isBelowMinimumAdaQuantity:SelectionConstraints :: Address WalletSelectionContext -> TokenBundle -> Bool
$sel:computeMinimumAdaQuantity:SelectionConstraints :: Address WalletSelectionContext -> TokenMap -> Coin
$sel:certificateDepositAmount:SelectionConstraints :: Coin
$sel:assessTokenBundleSize:SelectionConstraints :: TokenBundle -> TokenBundleSizeAssessment
maximumLengthChangeAddress :: Address
minimumCollateralPercentage :: Natural
maximumCollateralInputCount :: Int
isBelowMinimumAdaQuantity :: Address -> TokenBundle -> Bool
computeMinimumAdaQuantity :: Address -> TokenMap -> Coin
certificateDepositAmount :: Coin
assessTokenBundleSize :: TokenBundle -> TokenBundleSizeAssessment
..
        }

--------------------------------------------------------------------------------
-- Selection parameters
--------------------------------------------------------------------------------

-- | Specifies all parameters that are specific to a given selection.
--
data SelectionParams = SelectionParams
    { SelectionParams -> TokenMap
assetsToBurn
        :: !TokenMap
        -- ^ Specifies a set of assets to burn.
    , SelectionParams -> TokenMap
assetsToMint
        :: !TokenMap
        -- ^ Specifies a set of assets to mint.
    , SelectionParams -> Coin
extraCoinIn
        :: !Coin
       -- ^ Specifies extra 'Coin' in.
    , SelectionParams -> Coin
extraCoinOut
        :: !Coin
        -- ^ Specifies extra 'Coin' out.
    , SelectionParams -> [TxOut]
outputsToCover
        :: ![TxOut]
        -- ^ Specifies a set of outputs that must be paid for.
    , SelectionParams -> Coin
rewardWithdrawal
        :: !Coin
        -- ^ Specifies the value of a withdrawal from a reward account.
    , SelectionParams -> Natural
certificateDepositsTaken
        :: !Natural
        -- ^ Number of deposits for stake key registrations.
    , SelectionParams -> Natural
certificateDepositsReturned
        :: !Natural
        -- ^ Number of deposits from stake key de-registrations.
    , SelectionParams -> SelectionCollateralRequirement
collateralRequirement
        :: !SelectionCollateralRequirement
        -- ^ Specifies the collateral requirement for this selection.
    , SelectionParams -> Map WalletUTxO TokenBundle
utxoAvailableForCollateral
        :: !(Map WalletUTxO TokenBundle)
        -- ^ Specifies a set of UTxOs that are available for selection as
        -- collateral inputs.
        --
        -- This set is allowed to intersect with 'utxoAvailableForInputs',
        -- since the ledger does not require that these sets are disjoint.
    , SelectionParams -> UTxOSelection WalletUTxO
utxoAvailableForInputs
        :: !(UTxOSelection WalletUTxO)
        -- ^ Specifies a set of UTxOs that are available for selection as
        -- ordinary inputs and optionally, a subset that has already been
        -- selected.
        --
        -- Further entries from this set will be selected to cover any deficit.
    , SelectionParams -> SelectionStrategy
selectionStrategy
        :: SelectionStrategy
        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
    }
    deriving (SelectionParams -> SelectionParams -> Bool
(SelectionParams -> SelectionParams -> Bool)
-> (SelectionParams -> SelectionParams -> Bool)
-> Eq SelectionParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionParams -> SelectionParams -> Bool
$c/= :: SelectionParams -> SelectionParams -> Bool
== :: SelectionParams -> SelectionParams -> Bool
$c== :: SelectionParams -> SelectionParams -> Bool
Eq, (forall x. SelectionParams -> Rep SelectionParams x)
-> (forall x. Rep SelectionParams x -> SelectionParams)
-> Generic SelectionParams
forall x. Rep SelectionParams x -> SelectionParams
forall x. SelectionParams -> Rep SelectionParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectionParams x -> SelectionParams
$cfrom :: forall x. SelectionParams -> Rep SelectionParams x
Generic, Int -> SelectionParams -> ShowS
[SelectionParams] -> ShowS
SelectionParams -> String
(Int -> SelectionParams -> ShowS)
-> (SelectionParams -> String)
-> ([SelectionParams] -> ShowS)
-> Show SelectionParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionParams] -> ShowS
$cshowList :: [SelectionParams] -> ShowS
show :: SelectionParams -> String
$cshow :: SelectionParams -> String
showsPrec :: Int -> SelectionParams -> ShowS
$cshowsPrec :: Int -> SelectionParams -> ShowS
Show)

toInternalSelectionParams
    :: SelectionParams
    -> Internal.SelectionParams WalletSelectionContext
toInternalSelectionParams :: SelectionParams -> SelectionParams WalletSelectionContext
toInternalSelectionParams SelectionParams {Natural
[TxOut]
Map WalletUTxO TokenBundle
TokenMap
Coin
UTxOSelection WalletUTxO
SelectionStrategy
SelectionCollateralRequirement
selectionStrategy :: SelectionStrategy
utxoAvailableForInputs :: UTxOSelection WalletUTxO
utxoAvailableForCollateral :: Map WalletUTxO TokenBundle
collateralRequirement :: SelectionCollateralRequirement
certificateDepositsReturned :: Natural
certificateDepositsTaken :: Natural
rewardWithdrawal :: Coin
outputsToCover :: [TxOut]
extraCoinOut :: Coin
extraCoinIn :: Coin
assetsToMint :: TokenMap
assetsToBurn :: TokenMap
$sel:selectionStrategy:SelectionParams :: SelectionParams -> SelectionStrategy
$sel:utxoAvailableForInputs:SelectionParams :: SelectionParams -> UTxOSelection WalletUTxO
$sel:utxoAvailableForCollateral:SelectionParams :: SelectionParams -> Map WalletUTxO TokenBundle
$sel:collateralRequirement:SelectionParams :: SelectionParams -> SelectionCollateralRequirement
$sel:certificateDepositsReturned:SelectionParams :: SelectionParams -> Natural
$sel:certificateDepositsTaken:SelectionParams :: SelectionParams -> Natural
$sel:rewardWithdrawal:SelectionParams :: SelectionParams -> Coin
$sel:outputsToCover:SelectionParams :: SelectionParams -> [TxOut]
$sel:extraCoinOut:SelectionParams :: SelectionParams -> Coin
$sel:extraCoinIn:SelectionParams :: SelectionParams -> Coin
$sel:assetsToMint:SelectionParams :: SelectionParams -> TokenMap
$sel:assetsToBurn:SelectionParams :: SelectionParams -> TokenMap
..} =
    SelectionParams :: forall ctx.
TokenMap
-> TokenMap
-> Coin
-> Coin
-> [(Address ctx, TokenBundle)]
-> Coin
-> Natural
-> Natural
-> SelectionCollateralRequirement
-> Map (UTxO ctx) Coin
-> UTxOSelection (UTxO ctx)
-> SelectionStrategy
-> SelectionParams ctx
Internal.SelectionParams
        { $sel:utxoAvailableForCollateral:SelectionParams :: Map (UTxO WalletSelectionContext) Coin
utxoAvailableForCollateral =
            (WalletUTxO -> TokenBundle -> Maybe Coin)
-> Map WalletUTxO TokenBundle -> Map WalletUTxO Coin
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey WalletUTxO -> TokenBundle -> Maybe Coin
identifyCollateral Map WalletUTxO TokenBundle
utxoAvailableForCollateral
        , $sel:outputsToCover:SelectionParams :: [(Address WalletSelectionContext, TokenBundle)]
outputsToCover =
            (((Address -> Const Address Address)
 -> TxOut -> Const Address TxOut)
-> TxOut -> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "address"
  ((Address -> Const Address Address)
   -> TxOut -> Const Address TxOut)
(Address -> Const Address Address) -> TxOut -> Const Address TxOut
#address (TxOut -> Address)
-> (TxOut -> TokenBundle) -> TxOut -> (Address, TokenBundle)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((TokenBundle -> Const TokenBundle TokenBundle)
 -> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens) (TxOut -> (Address, TokenBundle))
-> [TxOut] -> [(Address, TokenBundle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut]
outputsToCover
        , Natural
TokenMap
Coin
UTxOSelection (UTxO WalletSelectionContext)
UTxOSelection WalletUTxO
SelectionStrategy
SelectionCollateralRequirement
$sel:selectionStrategy:SelectionParams :: SelectionStrategy
$sel:utxoAvailableForInputs:SelectionParams :: UTxOSelection (UTxO WalletSelectionContext)
$sel:collateralRequirement:SelectionParams :: SelectionCollateralRequirement
$sel:certificateDepositsReturned:SelectionParams :: Natural
$sel:certificateDepositsTaken:SelectionParams :: Natural
$sel:rewardWithdrawal:SelectionParams :: Coin
$sel:extraCoinOut:SelectionParams :: Coin
$sel:extraCoinIn:SelectionParams :: Coin
$sel:assetsToMint:SelectionParams :: TokenMap
$sel:assetsToBurn:SelectionParams :: TokenMap
selectionStrategy :: SelectionStrategy
utxoAvailableForInputs :: UTxOSelection WalletUTxO
collateralRequirement :: SelectionCollateralRequirement
certificateDepositsReturned :: Natural
certificateDepositsTaken :: Natural
rewardWithdrawal :: Coin
extraCoinOut :: Coin
extraCoinIn :: Coin
assetsToMint :: TokenMap
assetsToBurn :: TokenMap
..
        }
  where
    identifyCollateral :: WalletUTxO -> TokenBundle -> Maybe Coin
    identifyCollateral :: WalletUTxO -> TokenBundle -> Maybe Coin
identifyCollateral (WalletUTxO TxIn
_ Address
a) TokenBundle
b = TxOut -> Maybe Coin
asCollateral (Address -> TokenBundle -> TxOut
TxOut Address
a TokenBundle
b)

--------------------------------------------------------------------------------
-- Selection skeletons
--------------------------------------------------------------------------------

-- | 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 = SelectionSkeleton
    { SelectionSkeleton -> Int
skeletonInputCount
        :: !Int
    , SelectionSkeleton -> [TxOut]
skeletonOutputs
        :: ![TxOut]
    , SelectionSkeleton -> [Set AssetId]
skeletonChange
        :: ![Set AssetId]
    }
    deriving (SelectionSkeleton -> SelectionSkeleton -> Bool
(SelectionSkeleton -> SelectionSkeleton -> Bool)
-> (SelectionSkeleton -> SelectionSkeleton -> Bool)
-> Eq SelectionSkeleton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionSkeleton -> SelectionSkeleton -> Bool
$c/= :: SelectionSkeleton -> SelectionSkeleton -> Bool
== :: SelectionSkeleton -> SelectionSkeleton -> Bool
$c== :: SelectionSkeleton -> SelectionSkeleton -> Bool
Eq, (forall x. SelectionSkeleton -> Rep SelectionSkeleton x)
-> (forall x. Rep SelectionSkeleton x -> SelectionSkeleton)
-> Generic SelectionSkeleton
forall x. Rep SelectionSkeleton x -> SelectionSkeleton
forall x. SelectionSkeleton -> Rep SelectionSkeleton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectionSkeleton x -> SelectionSkeleton
$cfrom :: forall x. SelectionSkeleton -> Rep SelectionSkeleton x
Generic, Int -> SelectionSkeleton -> ShowS
[SelectionSkeleton] -> ShowS
SelectionSkeleton -> String
(Int -> SelectionSkeleton -> ShowS)
-> (SelectionSkeleton -> String)
-> ([SelectionSkeleton] -> ShowS)
-> Show SelectionSkeleton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionSkeleton] -> ShowS
$cshowList :: [SelectionSkeleton] -> ShowS
show :: SelectionSkeleton -> String
$cshow :: SelectionSkeleton -> String
showsPrec :: Int -> SelectionSkeleton -> ShowS
$cshowsPrec :: Int -> SelectionSkeleton -> ShowS
Show)

-- | Creates an empty 'SelectionSkeleton'.
--
emptySkeleton :: SelectionSkeleton
emptySkeleton :: SelectionSkeleton
emptySkeleton = SelectionSkeleton :: Int -> [TxOut] -> [Set AssetId] -> SelectionSkeleton
SelectionSkeleton
    { $sel:skeletonInputCount:SelectionSkeleton :: Int
skeletonInputCount = Int
0
    , $sel:skeletonOutputs:SelectionSkeleton :: [TxOut]
skeletonOutputs = [TxOut]
forall a. Monoid a => a
mempty
    , $sel:skeletonChange:SelectionSkeleton :: [Set AssetId]
skeletonChange = [Set AssetId]
forall a. Monoid a => a
mempty
    }

toExternalSelectionSkeleton
    :: Internal.SelectionSkeleton WalletSelectionContext
    -> SelectionSkeleton
toExternalSelectionSkeleton :: SelectionSkeleton WalletSelectionContext -> SelectionSkeleton
toExternalSelectionSkeleton Internal.SelectionSkeleton {Int
[(Address WalletSelectionContext, TokenBundle)]
[Set AssetId]
$sel:skeletonChange:SelectionSkeleton :: forall ctx. SelectionSkeleton ctx -> [Set AssetId]
$sel:skeletonOutputs:SelectionSkeleton :: forall ctx. SelectionSkeleton ctx -> [(Address ctx, TokenBundle)]
$sel:skeletonInputCount:SelectionSkeleton :: forall ctx. SelectionSkeleton ctx -> Int
skeletonChange :: [Set AssetId]
skeletonOutputs :: [(Address WalletSelectionContext, TokenBundle)]
skeletonInputCount :: Int
..} =
    SelectionSkeleton :: Int -> [TxOut] -> [Set AssetId] -> SelectionSkeleton
SelectionSkeleton
        { $sel:skeletonOutputs:SelectionSkeleton :: [TxOut]
skeletonOutputs =
            (Address -> TokenBundle -> TxOut)
-> (Address, TokenBundle) -> TxOut
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> TokenBundle -> TxOut
TxOut ((Address, TokenBundle) -> TxOut)
-> [(Address, TokenBundle)] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Address WalletSelectionContext, TokenBundle)]
[(Address, TokenBundle)]
skeletonOutputs
        , Int
[Set AssetId]
skeletonChange :: [Set AssetId]
skeletonInputCount :: Int
$sel:skeletonChange:SelectionSkeleton :: [Set AssetId]
$sel:skeletonInputCount:SelectionSkeleton :: Int
..
        }

--------------------------------------------------------------------------------
-- Selections
--------------------------------------------------------------------------------

-- | Represents a balanced selection.
--
data SelectionOf change = Selection
    { SelectionOf change -> NonEmpty (TxIn, TxOut)
inputs
        :: !(NonEmpty (TxIn, TxOut))
        -- ^ Selected inputs.
    , SelectionOf change -> [(TxIn, TxOut)]
collateral
        :: ![(TxIn, TxOut)]
        -- ^ Selected collateral inputs.
    , SelectionOf change -> [TxOut]
outputs
        :: ![TxOut]
        -- ^ User-specified outputs
    , SelectionOf change -> [change]
change
        :: ![change]
        -- ^ Generated change outputs.
    , SelectionOf change -> TokenMap
assetsToMint
        :: !TokenMap
        -- ^ Assets to mint.
    , SelectionOf change -> TokenMap
assetsToBurn
        :: !TokenMap
        -- ^ Assets to burn.
    , SelectionOf change -> Coin
extraCoinSource
        :: !Coin
        -- ^ An extra source of ada.
    , SelectionOf change -> Coin
extraCoinSink
        :: !Coin
        -- ^ An extra sink for ada.
    }
    deriving ((forall x. SelectionOf change -> Rep (SelectionOf change) x)
-> (forall x. Rep (SelectionOf change) x -> SelectionOf change)
-> Generic (SelectionOf change)
forall x. Rep (SelectionOf change) x -> SelectionOf change
forall x. SelectionOf change -> Rep (SelectionOf change) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall change x. Rep (SelectionOf change) x -> SelectionOf change
forall change x. SelectionOf change -> Rep (SelectionOf change) x
$cto :: forall change x. Rep (SelectionOf change) x -> SelectionOf change
$cfrom :: forall change x. SelectionOf change -> Rep (SelectionOf change) x
Generic, SelectionOf change -> SelectionOf change -> Bool
(SelectionOf change -> SelectionOf change -> Bool)
-> (SelectionOf change -> SelectionOf change -> Bool)
-> Eq (SelectionOf change)
forall change.
Eq change =>
SelectionOf change -> SelectionOf change -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionOf change -> SelectionOf change -> Bool
$c/= :: forall change.
Eq change =>
SelectionOf change -> SelectionOf change -> Bool
== :: SelectionOf change -> SelectionOf change -> Bool
$c== :: forall change.
Eq change =>
SelectionOf change -> SelectionOf change -> Bool
Eq, Int -> SelectionOf change -> ShowS
[SelectionOf change] -> ShowS
SelectionOf change -> String
(Int -> SelectionOf change -> ShowS)
-> (SelectionOf change -> String)
-> ([SelectionOf change] -> ShowS)
-> Show (SelectionOf change)
forall change. Show change => Int -> SelectionOf change -> ShowS
forall change. Show change => [SelectionOf change] -> ShowS
forall change. Show change => SelectionOf change -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionOf change] -> ShowS
$cshowList :: forall change. Show change => [SelectionOf change] -> ShowS
show :: SelectionOf change -> String
$cshow :: forall change. Show change => SelectionOf change -> String
showsPrec :: Int -> SelectionOf change -> ShowS
$cshowsPrec :: forall change. Show change => Int -> SelectionOf change -> ShowS
Show)

-- | The default type of selection.
--
-- In this type of selection, change values do not have addresses assigned.
--
type Selection = SelectionOf TokenBundle

toExternalSelection :: Internal.Selection WalletSelectionContext -> Selection
toExternalSelection :: Selection WalletSelectionContext -> Selection
toExternalSelection Internal.Selection {[(Address WalletSelectionContext, TokenBundle)]
[(UTxO WalletSelectionContext, Coin)]
[TokenBundle]
NonEmpty (UTxO WalletSelectionContext, TokenBundle)
TokenMap
Coin
$sel:extraCoinSink:Selection :: forall ctx. Selection ctx -> Coin
$sel:extraCoinSource:Selection :: forall ctx. Selection ctx -> Coin
$sel:assetsToBurn:Selection :: forall ctx. Selection ctx -> TokenMap
$sel:assetsToMint:Selection :: forall ctx. Selection ctx -> TokenMap
$sel:change:Selection :: forall ctx. Selection ctx -> [TokenBundle]
$sel:outputs:Selection :: forall ctx. Selection ctx -> [(Address ctx, TokenBundle)]
$sel:collateral:Selection :: forall ctx. Selection ctx -> [(UTxO ctx, Coin)]
$sel:inputs:Selection :: forall ctx. Selection ctx -> NonEmpty (UTxO ctx, TokenBundle)
extraCoinSink :: Coin
extraCoinSource :: Coin
assetsToBurn :: TokenMap
assetsToMint :: TokenMap
change :: [TokenBundle]
outputs :: [(Address WalletSelectionContext, TokenBundle)]
collateral :: [(UTxO WalletSelectionContext, Coin)]
inputs :: NonEmpty (UTxO WalletSelectionContext, TokenBundle)
..} =
    Selection :: forall change.
NonEmpty (TxIn, TxOut)
-> [(TxIn, TxOut)]
-> [TxOut]
-> [change]
-> TokenMap
-> TokenMap
-> Coin
-> Coin
-> SelectionOf change
Selection
        { $sel:collateral:Selection :: [(TxIn, TxOut)]
collateral = (Coin -> TokenBundle) -> (WalletUTxO, Coin) -> (TxIn, TxOut)
forall b. (b -> TokenBundle) -> (WalletUTxO, b) -> (TxIn, TxOut)
toExternalUTxO' Coin -> TokenBundle
TokenBundle.fromCoin
            ((WalletUTxO, Coin) -> (TxIn, TxOut))
-> [(WalletUTxO, Coin)] -> [(TxIn, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTxO WalletSelectionContext, Coin)]
[(WalletUTxO, Coin)]
collateral
        , $sel:inputs:Selection :: NonEmpty (TxIn, TxOut)
inputs = (WalletUTxO, TokenBundle) -> (TxIn, TxOut)
toExternalUTxO
            ((WalletUTxO, TokenBundle) -> (TxIn, TxOut))
-> NonEmpty (WalletUTxO, TokenBundle) -> NonEmpty (TxIn, TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (UTxO WalletSelectionContext, TokenBundle)
NonEmpty (WalletUTxO, TokenBundle)
inputs
        , $sel:outputs:Selection :: [TxOut]
outputs = (Address -> TokenBundle -> TxOut)
-> (Address, TokenBundle) -> TxOut
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> TokenBundle -> TxOut
TxOut
            ((Address, TokenBundle) -> TxOut)
-> [(Address, TokenBundle)] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Address WalletSelectionContext, TokenBundle)]
[(Address, TokenBundle)]
outputs
        , [TokenBundle]
TokenMap
Coin
extraCoinSink :: Coin
extraCoinSource :: Coin
assetsToBurn :: TokenMap
assetsToMint :: TokenMap
change :: [TokenBundle]
$sel:extraCoinSink:Selection :: Coin
$sel:extraCoinSource:Selection :: Coin
$sel:assetsToBurn:Selection :: TokenMap
$sel:assetsToMint:Selection :: TokenMap
$sel:change:Selection :: [TokenBundle]
..
        }

toInternalSelection
    :: (change -> TokenBundle)
    -> SelectionOf change
    -> Internal.Selection WalletSelectionContext
toInternalSelection :: (change -> TokenBundle)
-> SelectionOf change -> Selection WalletSelectionContext
toInternalSelection change -> TokenBundle
getChangeBundle Selection {[change]
[(TxIn, TxOut)]
[TxOut]
NonEmpty (TxIn, TxOut)
TokenMap
Coin
extraCoinSink :: Coin
extraCoinSource :: Coin
assetsToBurn :: TokenMap
assetsToMint :: TokenMap
change :: [change]
outputs :: [TxOut]
collateral :: [(TxIn, TxOut)]
inputs :: NonEmpty (TxIn, TxOut)
$sel:extraCoinSink:Selection :: forall change. SelectionOf change -> Coin
$sel:extraCoinSource:Selection :: forall change. SelectionOf change -> Coin
$sel:assetsToBurn:Selection :: forall change. SelectionOf change -> TokenMap
$sel:assetsToMint:Selection :: forall change. SelectionOf change -> TokenMap
$sel:change:Selection :: forall change. SelectionOf change -> [change]
$sel:outputs:Selection :: forall change. SelectionOf change -> [TxOut]
$sel:collateral:Selection :: forall change. SelectionOf change -> [(TxIn, TxOut)]
$sel:inputs:Selection :: forall change. SelectionOf change -> NonEmpty (TxIn, TxOut)
..} =
    Selection :: forall ctx.
NonEmpty (UTxO ctx, TokenBundle)
-> [(UTxO ctx, Coin)]
-> [(Address ctx, TokenBundle)]
-> [TokenBundle]
-> TokenMap
-> TokenMap
-> Coin
-> Coin
-> Selection ctx
Internal.Selection
        { $sel:change:Selection :: [TokenBundle]
change = change -> TokenBundle
getChangeBundle
            (change -> TokenBundle) -> [change] -> [TokenBundle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [change]
change
        , $sel:collateral:Selection :: [(UTxO WalletSelectionContext, Coin)]
collateral = (TokenBundle -> Coin) -> (TxIn, TxOut) -> (WalletUTxO, Coin)
forall b. (TokenBundle -> b) -> (TxIn, TxOut) -> (WalletUTxO, b)
toInternalUTxO' TokenBundle -> Coin
TokenBundle.getCoin
            ((TxIn, TxOut) -> (WalletUTxO, Coin))
-> [(TxIn, TxOut)] -> [(WalletUTxO, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, TxOut)]
collateral
        , $sel:inputs:Selection :: NonEmpty (UTxO WalletSelectionContext, TokenBundle)
inputs = (TxIn, TxOut) -> (WalletUTxO, TokenBundle)
toInternalUTxO
            ((TxIn, TxOut) -> (WalletUTxO, TokenBundle))
-> NonEmpty (TxIn, TxOut) -> NonEmpty (WalletUTxO, TokenBundle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TxIn, TxOut)
inputs
        , $sel:outputs:Selection :: [(Address WalletSelectionContext, TokenBundle)]
outputs = (((Address -> Const Address Address)
 -> TxOut -> Const Address TxOut)
-> TxOut -> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "address"
  ((Address -> Const Address Address)
   -> TxOut -> Const Address TxOut)
(Address -> Const Address Address) -> TxOut -> Const Address TxOut
#address (TxOut -> Address)
-> (TxOut -> TokenBundle) -> TxOut -> (Address, TokenBundle)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((TokenBundle -> Const TokenBundle TokenBundle)
 -> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens)
            (TxOut -> (Address, TokenBundle))
-> [TxOut] -> [(Address, TokenBundle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut]
outputs
        , TokenMap
Coin
extraCoinSink :: Coin
extraCoinSource :: Coin
assetsToBurn :: TokenMap
assetsToMint :: TokenMap
$sel:extraCoinSink:Selection :: Coin
$sel:extraCoinSource:Selection :: Coin
$sel:assetsToBurn:Selection :: TokenMap
$sel:assetsToMint:Selection :: TokenMap
..
        }

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

-- | Performs a coin selection.
--
-- This function has the following responsibilities:
--
--  - selecting inputs from the UTxO set to pay for user-specified outputs;
--  - selecting inputs from the UTxO set to pay for collateral;
--  - producing change outputs to return excess value to the wallet;
--  - balancing a selection to pay for the transaction fee.
--
-- See 'Internal.performSelection' for more details.
--
performSelection
    :: forall m. (HasCallStack, MonadRandom m)
    => SelectionConstraints
    -> SelectionParams
    -> ExceptT (SelectionError WalletSelectionContext) m Selection
performSelection :: SelectionConstraints
-> SelectionParams
-> ExceptT (SelectionError WalletSelectionContext) m Selection
performSelection SelectionConstraints
cs SelectionParams
ps =
    Selection WalletSelectionContext -> Selection
toExternalSelection (Selection WalletSelectionContext -> Selection)
-> ExceptT
     (SelectionError WalletSelectionContext)
     m
     (Selection WalletSelectionContext)
-> ExceptT (SelectionError WalletSelectionContext) m Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    PerformSelection
  m WalletSelectionContext (Selection WalletSelectionContext)
forall (m :: * -> *) ctx.
(HasCallStack, MonadRandom m, SelectionContext ctx) =>
PerformSelection m ctx (Selection ctx)
Internal.performSelection @m @WalletSelectionContext
        (SelectionConstraints -> SelectionConstraints WalletSelectionContext
toInternalSelectionConstraints SelectionConstraints
cs)
        (SelectionParams -> SelectionParams WalletSelectionContext
toInternalSelectionParams SelectionParams
ps)

--------------------------------------------------------------------------------
-- Selection deltas
--------------------------------------------------------------------------------

-- | Computes the ada surplus of a selection, assuming there is a surplus.
--
selectionDelta
    :: (change -> Coin)
    -- ^ A function to extract the coin value from a change value.
    -> SelectionOf change
    -> Coin
selectionDelta :: (change -> Coin) -> SelectionOf change -> Coin
selectionDelta change -> Coin
getChangeCoin
    = Selection WalletSelectionContext -> Coin
forall ctx. Selection ctx -> Coin
Internal.selectionSurplusCoin
    (Selection WalletSelectionContext -> Coin)
-> (SelectionOf change -> Selection WalletSelectionContext)
-> SelectionOf change
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (change -> TokenBundle)
-> SelectionOf change -> Selection WalletSelectionContext
forall change.
(change -> TokenBundle)
-> SelectionOf change -> Selection WalletSelectionContext
toInternalSelection (Coin -> TokenBundle
TokenBundle.fromCoin (Coin -> TokenBundle) -> (change -> Coin) -> change -> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. change -> Coin
getChangeCoin)

--------------------------------------------------------------------------------
-- Reporting
--------------------------------------------------------------------------------

-- | Includes both summarized and detailed information about a selection.
--
data SelectionReport = SelectionReport
    { SelectionReport -> SelectionReportSummarized
summary :: SelectionReportSummarized
    , SelectionReport -> SelectionReportDetailed
detail :: SelectionReportDetailed
    }
    deriving (SelectionReport -> SelectionReport -> Bool
(SelectionReport -> SelectionReport -> Bool)
-> (SelectionReport -> SelectionReport -> Bool)
-> Eq SelectionReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionReport -> SelectionReport -> Bool
$c/= :: SelectionReport -> SelectionReport -> Bool
== :: SelectionReport -> SelectionReport -> Bool
$c== :: SelectionReport -> SelectionReport -> Bool
Eq, (forall x. SelectionReport -> Rep SelectionReport x)
-> (forall x. Rep SelectionReport x -> SelectionReport)
-> Generic SelectionReport
forall x. Rep SelectionReport x -> SelectionReport
forall x. SelectionReport -> Rep SelectionReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectionReport x -> SelectionReport
$cfrom :: forall x. SelectionReport -> Rep SelectionReport x
Generic, Int -> SelectionReport -> ShowS
[SelectionReport] -> ShowS
SelectionReport -> String
(Int -> SelectionReport -> ShowS)
-> (SelectionReport -> String)
-> ([SelectionReport] -> ShowS)
-> Show SelectionReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionReport] -> ShowS
$cshowList :: [SelectionReport] -> ShowS
show :: SelectionReport -> String
$cshow :: SelectionReport -> String
showsPrec :: Int -> SelectionReport -> ShowS
$cshowsPrec :: Int -> SelectionReport -> ShowS
Show)

-- | Includes summarized information about a selection.
--
-- Each data point can be serialized as a single line of text.
--
data SelectionReportSummarized = SelectionReportSummarized
    { SelectionReportSummarized -> Coin
computedFee :: Coin
    , SelectionReportSummarized -> Coin
adaBalanceOfSelectedInputs :: Coin
    , SelectionReportSummarized -> Coin
adaBalanceOfExtraCoinSource :: Coin
    , SelectionReportSummarized -> Coin
adaBalanceOfExtraCoinSink :: Coin
    , SelectionReportSummarized -> Coin
adaBalanceOfRequestedOutputs :: Coin
    , SelectionReportSummarized -> Coin
adaBalanceOfGeneratedChangeOutputs :: Coin
    , SelectionReportSummarized -> Int
numberOfSelectedInputs :: Int
    , SelectionReportSummarized -> Int
numberOfSelectedCollateralInputs :: Int
    , SelectionReportSummarized -> Int
numberOfRequestedOutputs :: Int
    , SelectionReportSummarized -> Int
numberOfGeneratedChangeOutputs :: Int
    , SelectionReportSummarized -> Int
numberOfUniqueNonAdaAssetsInSelectedInputs :: Int
    , SelectionReportSummarized -> Int
numberOfUniqueNonAdaAssetsInRequestedOutputs :: Int
    , SelectionReportSummarized -> Int
numberOfUniqueNonAdaAssetsInGeneratedChangeOutputs :: Int
    }
    deriving (SelectionReportSummarized -> SelectionReportSummarized -> Bool
(SelectionReportSummarized -> SelectionReportSummarized -> Bool)
-> (SelectionReportSummarized -> SelectionReportSummarized -> Bool)
-> Eq SelectionReportSummarized
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionReportSummarized -> SelectionReportSummarized -> Bool
$c/= :: SelectionReportSummarized -> SelectionReportSummarized -> Bool
== :: SelectionReportSummarized -> SelectionReportSummarized -> Bool
$c== :: SelectionReportSummarized -> SelectionReportSummarized -> Bool
Eq, (forall x.
 SelectionReportSummarized -> Rep SelectionReportSummarized x)
-> (forall x.
    Rep SelectionReportSummarized x -> SelectionReportSummarized)
-> Generic SelectionReportSummarized
forall x.
Rep SelectionReportSummarized x -> SelectionReportSummarized
forall x.
SelectionReportSummarized -> Rep SelectionReportSummarized x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelectionReportSummarized x -> SelectionReportSummarized
$cfrom :: forall x.
SelectionReportSummarized -> Rep SelectionReportSummarized x
Generic, Int -> SelectionReportSummarized -> ShowS
[SelectionReportSummarized] -> ShowS
SelectionReportSummarized -> String
(Int -> SelectionReportSummarized -> ShowS)
-> (SelectionReportSummarized -> String)
-> ([SelectionReportSummarized] -> ShowS)
-> Show SelectionReportSummarized
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionReportSummarized] -> ShowS
$cshowList :: [SelectionReportSummarized] -> ShowS
show :: SelectionReportSummarized -> String
$cshow :: SelectionReportSummarized -> String
showsPrec :: Int -> SelectionReportSummarized -> ShowS
$cshowsPrec :: Int -> SelectionReportSummarized -> ShowS
Show)

-- | Includes detailed information about a selection.
--
data SelectionReportDetailed = SelectionReportDetailed
    { SelectionReportDetailed -> [(TxIn, TxOut)]
selectedInputs :: [(TxIn, TxOut)]
    , SelectionReportDetailed -> [(TxIn, TxOut)]
selectedCollateral :: [(TxIn, TxOut)]
    , SelectionReportDetailed -> [TxOut]
requestedOutputs :: [TxOut]
    , SelectionReportDetailed -> [Flat TokenBundle]
generatedChangeOutputs :: [TokenBundle.Flat TokenBundle]
    }
    deriving (SelectionReportDetailed -> SelectionReportDetailed -> Bool
(SelectionReportDetailed -> SelectionReportDetailed -> Bool)
-> (SelectionReportDetailed -> SelectionReportDetailed -> Bool)
-> Eq SelectionReportDetailed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionReportDetailed -> SelectionReportDetailed -> Bool
$c/= :: SelectionReportDetailed -> SelectionReportDetailed -> Bool
== :: SelectionReportDetailed -> SelectionReportDetailed -> Bool
$c== :: SelectionReportDetailed -> SelectionReportDetailed -> Bool
Eq, (forall x.
 SelectionReportDetailed -> Rep SelectionReportDetailed x)
-> (forall x.
    Rep SelectionReportDetailed x -> SelectionReportDetailed)
-> Generic SelectionReportDetailed
forall x. Rep SelectionReportDetailed x -> SelectionReportDetailed
forall x. SelectionReportDetailed -> Rep SelectionReportDetailed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectionReportDetailed x -> SelectionReportDetailed
$cfrom :: forall x. SelectionReportDetailed -> Rep SelectionReportDetailed x
Generic, Int -> SelectionReportDetailed -> ShowS
[SelectionReportDetailed] -> ShowS
SelectionReportDetailed -> String
(Int -> SelectionReportDetailed -> ShowS)
-> (SelectionReportDetailed -> String)
-> ([SelectionReportDetailed] -> ShowS)
-> Show SelectionReportDetailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionReportDetailed] -> ShowS
$cshowList :: [SelectionReportDetailed] -> ShowS
show :: SelectionReportDetailed -> String
$cshow :: SelectionReportDetailed -> String
showsPrec :: Int -> SelectionReportDetailed -> ShowS
$cshowsPrec :: Int -> SelectionReportDetailed -> ShowS
Show)

instance Buildable SelectionReport where
    build :: SelectionReport -> Builder
build = SelectionReport -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF
instance Buildable SelectionReportSummarized where
    build :: SelectionReportSummarized -> Builder
build = SelectionReportSummarized -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF
instance Buildable SelectionReportDetailed where
    build :: SelectionReportDetailed -> Builder
build = SelectionReportDetailed -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF

makeSelectionReport :: Selection -> SelectionReport
makeSelectionReport :: Selection -> SelectionReport
makeSelectionReport Selection
s = SelectionReport :: SelectionReportSummarized
-> SelectionReportDetailed -> SelectionReport
SelectionReport
    { $sel:summary:SelectionReport :: SelectionReportSummarized
summary = Selection -> SelectionReportSummarized
makeSelectionReportSummarized Selection
s
    , $sel:detail:SelectionReport :: SelectionReportDetailed
detail = Selection -> SelectionReportDetailed
makeSelectionReportDetailed Selection
s
    }

makeSelectionReportSummarized :: Selection -> SelectionReportSummarized
makeSelectionReportSummarized :: Selection -> SelectionReportSummarized
makeSelectionReportSummarized Selection
s = SelectionReportSummarized :: Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> SelectionReportSummarized
SelectionReportSummarized {Int
Coin
numberOfUniqueNonAdaAssetsInGeneratedChangeOutputs :: Int
numberOfUniqueNonAdaAssetsInRequestedOutputs :: Int
numberOfUniqueNonAdaAssetsInSelectedInputs :: Int
numberOfGeneratedChangeOutputs :: Int
numberOfRequestedOutputs :: Int
numberOfSelectedCollateralInputs :: Int
numberOfSelectedInputs :: Int
adaBalanceOfRequestedOutputs :: Coin
adaBalanceOfGeneratedChangeOutputs :: Coin
adaBalanceOfExtraCoinSink :: Coin
adaBalanceOfExtraCoinSource :: Coin
adaBalanceOfSelectedInputs :: Coin
computedFee :: Coin
$sel:numberOfUniqueNonAdaAssetsInGeneratedChangeOutputs:SelectionReportSummarized :: Int
$sel:numberOfUniqueNonAdaAssetsInRequestedOutputs:SelectionReportSummarized :: Int
$sel:numberOfUniqueNonAdaAssetsInSelectedInputs:SelectionReportSummarized :: Int
$sel:numberOfGeneratedChangeOutputs:SelectionReportSummarized :: Int
$sel:numberOfRequestedOutputs:SelectionReportSummarized :: Int
$sel:numberOfSelectedCollateralInputs:SelectionReportSummarized :: Int
$sel:numberOfSelectedInputs:SelectionReportSummarized :: Int
$sel:adaBalanceOfGeneratedChangeOutputs:SelectionReportSummarized :: Coin
$sel:adaBalanceOfRequestedOutputs:SelectionReportSummarized :: Coin
$sel:adaBalanceOfExtraCoinSink:SelectionReportSummarized :: Coin
$sel:adaBalanceOfExtraCoinSource:SelectionReportSummarized :: Coin
$sel:adaBalanceOfSelectedInputs:SelectionReportSummarized :: Coin
$sel:computedFee:SelectionReportSummarized :: Coin
..}
  where
    computedFee :: Coin
computedFee
        = (TokenBundle -> Coin) -> Selection -> Coin
forall change. (change -> Coin) -> SelectionOf change -> Coin
selectionDelta TokenBundle -> Coin
TokenBundle.getCoin Selection
s
    adaBalanceOfSelectedInputs :: Coin
adaBalanceOfSelectedInputs
        = ((TxIn, TxOut) -> Coin) -> NonEmpty (TxIn, TxOut) -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (((Coin -> Const Coin Coin) -> TxOut -> Const Coin TxOut)
-> TxOut -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (IsLabel
  "tokens"
  ((TokenBundle -> Const Coin TokenBundle)
   -> TxOut -> Const Coin TxOut)
(TokenBundle -> Const Coin TokenBundle)
-> TxOut -> Const Coin TxOut
#tokens ((TokenBundle -> Const Coin TokenBundle)
 -> TxOut -> Const Coin TxOut)
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> (Coin -> Const Coin Coin)
-> TxOut
-> Const Coin TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin) (TxOut -> Coin)
-> ((TxIn, TxOut) -> TxOut) -> (TxIn, TxOut) -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) (NonEmpty (TxIn, TxOut) -> Coin) -> NonEmpty (TxIn, TxOut) -> Coin
forall a b. (a -> b) -> a -> b
$ ((NonEmpty (TxIn, TxOut)
  -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
 -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
-> Selection -> NonEmpty (TxIn, TxOut)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection
#inputs Selection
s
    adaBalanceOfExtraCoinSource :: Coin
adaBalanceOfExtraCoinSource
        = ((Coin -> Const Coin Coin) -> Selection -> Const Coin Selection)
-> Selection -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSource"
  ((Coin -> Const Coin Coin) -> Selection -> Const Coin Selection)
(Coin -> Const Coin Coin) -> Selection -> Const Coin Selection
#extraCoinSource Selection
s
    adaBalanceOfExtraCoinSink :: Coin
adaBalanceOfExtraCoinSink
        = ((Coin -> Const Coin Coin) -> Selection -> Const Coin Selection)
-> Selection -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSink"
  ((Coin -> Const Coin Coin) -> Selection -> Const Coin Selection)
(Coin -> Const Coin Coin) -> Selection -> Const Coin Selection
#extraCoinSink Selection
s
    adaBalanceOfGeneratedChangeOutputs :: Coin
adaBalanceOfGeneratedChangeOutputs
        = (TokenBundle -> Coin) -> [TokenBundle] -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (((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) -> [TokenBundle] -> Coin
forall a b. (a -> b) -> a -> b
$ (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
 -> Selection -> Const [TokenBundle] Selection)
-> Selection -> [TokenBundle]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "change"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> Selection -> Const [TokenBundle] Selection)
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> Selection -> Const [TokenBundle] Selection
#change Selection
s
    adaBalanceOfRequestedOutputs :: Coin
adaBalanceOfRequestedOutputs
        = (TxOut -> Coin) -> [TxOut] -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (((Coin -> Const Coin Coin) -> TxOut -> Const Coin TxOut)
-> TxOut -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (IsLabel
  "tokens"
  ((TokenBundle -> Const Coin TokenBundle)
   -> TxOut -> Const Coin TxOut)
(TokenBundle -> Const Coin TokenBundle)
-> TxOut -> Const Coin TxOut
#tokens ((TokenBundle -> Const Coin TokenBundle)
 -> TxOut -> Const Coin TxOut)
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> (Coin -> Const Coin Coin)
-> TxOut
-> Const Coin TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin)) ([TxOut] -> Coin) -> [TxOut] -> Coin
forall a b. (a -> b) -> a -> b
$ (([TxOut] -> Const [TxOut] [TxOut])
 -> Selection -> Const [TxOut] Selection)
-> Selection -> [TxOut]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut])
   -> Selection -> Const [TxOut] Selection)
([TxOut] -> Const [TxOut] [TxOut])
-> Selection -> Const [TxOut] Selection
#outputs Selection
s
    numberOfSelectedInputs :: Int
numberOfSelectedInputs
        = NonEmpty (TxIn, TxOut) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (NonEmpty (TxIn, TxOut) -> Int) -> NonEmpty (TxIn, TxOut) -> Int
forall a b. (a -> b) -> a -> b
$ ((NonEmpty (TxIn, TxOut)
  -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
 -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
-> Selection -> NonEmpty (TxIn, TxOut)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection
#inputs Selection
s
    numberOfSelectedCollateralInputs :: Int
numberOfSelectedCollateralInputs
        = [(TxIn, TxOut)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(TxIn, TxOut)] -> Int) -> [(TxIn, TxOut)] -> Int
forall a b. (a -> b) -> a -> b
$ (([(TxIn, TxOut)] -> Const [(TxIn, TxOut)] [(TxIn, TxOut)])
 -> Selection -> Const [(TxIn, TxOut)] Selection)
-> Selection -> [(TxIn, TxOut)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "collateral"
  (([(TxIn, TxOut)] -> Const [(TxIn, TxOut)] [(TxIn, TxOut)])
   -> Selection -> Const [(TxIn, TxOut)] Selection)
([(TxIn, TxOut)] -> Const [(TxIn, TxOut)] [(TxIn, TxOut)])
-> Selection -> Const [(TxIn, TxOut)] Selection
#collateral Selection
s
    numberOfRequestedOutputs :: Int
numberOfRequestedOutputs
        = [TxOut] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxOut] -> Int) -> [TxOut] -> Int
forall a b. (a -> b) -> a -> b
$ (([TxOut] -> Const [TxOut] [TxOut])
 -> Selection -> Const [TxOut] Selection)
-> Selection -> [TxOut]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut])
   -> Selection -> Const [TxOut] Selection)
([TxOut] -> Const [TxOut] [TxOut])
-> Selection -> Const [TxOut] Selection
#outputs Selection
s
    numberOfGeneratedChangeOutputs :: Int
numberOfGeneratedChangeOutputs
        = [TokenBundle] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TokenBundle] -> Int) -> [TokenBundle] -> Int
forall a b. (a -> b) -> a -> b
$ (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
 -> Selection -> Const [TokenBundle] Selection)
-> Selection -> [TokenBundle]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "change"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> Selection -> Const [TokenBundle] Selection)
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> Selection -> Const [TokenBundle] Selection
#change Selection
s
    numberOfUniqueNonAdaAssetsInSelectedInputs :: Int
numberOfUniqueNonAdaAssetsInSelectedInputs
        = Set AssetId -> Int
forall a. Set a -> Int
Set.size
        (Set AssetId -> Int) -> Set AssetId -> Int
forall a b. (a -> b) -> a -> b
$ ((TxIn, TxOut) -> Set AssetId)
-> NonEmpty (TxIn, TxOut) -> Set AssetId
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TokenBundle -> Set AssetId
TokenBundle.getAssets (TokenBundle -> Set AssetId)
-> ((TxIn, TxOut) -> TokenBundle) -> (TxIn, TxOut) -> Set AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenBundle -> Const TokenBundle TokenBundle)
 -> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens (TxOut -> TokenBundle)
-> ((TxIn, TxOut) -> TxOut) -> (TxIn, TxOut) -> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut) -> TxOut
forall a b. (a, b) -> b
snd)
        (NonEmpty (TxIn, TxOut) -> Set AssetId)
-> NonEmpty (TxIn, TxOut) -> Set AssetId
forall a b. (a -> b) -> a -> b
$ ((NonEmpty (TxIn, TxOut)
  -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
 -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
-> Selection -> NonEmpty (TxIn, TxOut)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection
#inputs Selection
s
    numberOfUniqueNonAdaAssetsInRequestedOutputs :: Int
numberOfUniqueNonAdaAssetsInRequestedOutputs
        = Set AssetId -> Int
forall a. Set a -> Int
Set.size
        (Set AssetId -> Int) -> Set AssetId -> Int
forall a b. (a -> b) -> a -> b
$ (TxOut -> Set AssetId) -> [TxOut] -> Set AssetId
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TokenBundle -> Set AssetId
TokenBundle.getAssets (TokenBundle -> Set AssetId)
-> (TxOut -> TokenBundle) -> TxOut -> Set AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenBundle -> Const TokenBundle TokenBundle)
 -> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens)
        ([TxOut] -> Set AssetId) -> [TxOut] -> Set AssetId
forall a b. (a -> b) -> a -> b
$ (([TxOut] -> Const [TxOut] [TxOut])
 -> Selection -> Const [TxOut] Selection)
-> Selection -> [TxOut]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut])
   -> Selection -> Const [TxOut] Selection)
([TxOut] -> Const [TxOut] [TxOut])
-> Selection -> Const [TxOut] Selection
#outputs Selection
s
    numberOfUniqueNonAdaAssetsInGeneratedChangeOutputs :: Int
numberOfUniqueNonAdaAssetsInGeneratedChangeOutputs
        = Set AssetId -> Int
forall a. Set a -> Int
Set.size
        (Set AssetId -> Int) -> Set AssetId -> Int
forall a b. (a -> b) -> a -> b
$ (TokenBundle -> Set AssetId) -> [TokenBundle] -> Set AssetId
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap TokenBundle -> Set AssetId
TokenBundle.getAssets
        ([TokenBundle] -> Set AssetId) -> [TokenBundle] -> Set AssetId
forall a b. (a -> b) -> a -> b
$ (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
 -> Selection -> Const [TokenBundle] Selection)
-> Selection -> [TokenBundle]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "change"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> Selection -> Const [TokenBundle] Selection)
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> Selection -> Const [TokenBundle] Selection
#change Selection
s

makeSelectionReportDetailed :: Selection -> SelectionReportDetailed
makeSelectionReportDetailed :: Selection -> SelectionReportDetailed
makeSelectionReportDetailed Selection
s = SelectionReportDetailed :: [(TxIn, TxOut)]
-> [(TxIn, TxOut)]
-> [TxOut]
-> [Flat TokenBundle]
-> SelectionReportDetailed
SelectionReportDetailed
    { $sel:selectedInputs:SelectionReportDetailed :: [(TxIn, TxOut)]
selectedInputs
        = NonEmpty (TxIn, TxOut) -> [(TxIn, TxOut)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty (TxIn, TxOut) -> [(TxIn, TxOut)])
-> NonEmpty (TxIn, TxOut) -> [(TxIn, TxOut)]
forall a b. (a -> b) -> a -> b
$ ((NonEmpty (TxIn, TxOut)
  -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
 -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
-> Selection -> NonEmpty (TxIn, TxOut)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection
#inputs Selection
s
    , $sel:selectedCollateral:SelectionReportDetailed :: [(TxIn, TxOut)]
selectedCollateral
        = [(TxIn, TxOut)] -> [(TxIn, TxOut)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ([(TxIn, TxOut)] -> [(TxIn, TxOut)])
-> [(TxIn, TxOut)] -> [(TxIn, TxOut)]
forall a b. (a -> b) -> a -> b
$ (([(TxIn, TxOut)] -> Const [(TxIn, TxOut)] [(TxIn, TxOut)])
 -> Selection -> Const [(TxIn, TxOut)] Selection)
-> Selection -> [(TxIn, TxOut)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "collateral"
  (([(TxIn, TxOut)] -> Const [(TxIn, TxOut)] [(TxIn, TxOut)])
   -> Selection -> Const [(TxIn, TxOut)] Selection)
([(TxIn, TxOut)] -> Const [(TxIn, TxOut)] [(TxIn, TxOut)])
-> Selection -> Const [(TxIn, TxOut)] Selection
#collateral Selection
s
    , $sel:requestedOutputs:SelectionReportDetailed :: [TxOut]
requestedOutputs
        = (([TxOut] -> Const [TxOut] [TxOut])
 -> Selection -> Const [TxOut] Selection)
-> Selection -> [TxOut]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut])
   -> Selection -> Const [TxOut] Selection)
([TxOut] -> Const [TxOut] [TxOut])
-> Selection -> Const [TxOut] Selection
#outputs Selection
s
    , $sel:generatedChangeOutputs:SelectionReportDetailed :: [Flat TokenBundle]
generatedChangeOutputs
        = TokenBundle -> Flat TokenBundle
forall a. a -> Flat a
TokenBundle.Flat (TokenBundle -> Flat TokenBundle)
-> [TokenBundle] -> [Flat TokenBundle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
 -> Selection -> Const [TokenBundle] Selection)
-> Selection -> [TokenBundle]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "change"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> Selection -> Const [TokenBundle] Selection)
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> Selection -> Const [TokenBundle] Selection
#change Selection
s
    }

-- A convenience instance for 'Buildable' contexts that include a nested
-- 'SelectionOf TokenBundle' value.
instance Buildable (SelectionOf TokenBundle) where
    build :: Selection -> Builder
build = SelectionReport -> Builder
forall p. Buildable p => p -> Builder
build (SelectionReport -> Builder)
-> (Selection -> SelectionReport) -> Selection -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> SelectionReport
makeSelectionReport

-- A convenience instance for 'Buildable' contexts that include a nested
-- 'SelectionOf TxOut' value.
instance Buildable (SelectionOf TxOut) where
    build :: SelectionOf TxOut -> Builder
build = SelectionReport -> Builder
forall p. Buildable p => p -> Builder
build
        (SelectionReport -> Builder)
-> (SelectionOf TxOut -> SelectionReport)
-> SelectionOf TxOut
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> SelectionReport
makeSelectionReport
        (Selection -> SelectionReport)
-> (SelectionOf TxOut -> Selection)
-> SelectionOf TxOut
-> SelectionReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([TxOut] -> Identity [TokenBundle])
 -> SelectionOf TxOut -> Identity Selection)
-> ([TxOut] -> [TokenBundle]) -> SelectionOf TxOut -> Selection
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "change"
  (([TxOut] -> Identity [TokenBundle])
   -> SelectionOf TxOut -> Identity Selection)
([TxOut] -> Identity [TokenBundle])
-> SelectionOf TxOut -> Identity Selection
#change ((TxOut -> TokenBundle) -> [TxOut] -> [TokenBundle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxOut -> TokenBundle) -> [TxOut] -> [TokenBundle])
-> (TxOut -> TokenBundle) -> [TxOut] -> [TokenBundle]
forall a b. (a -> b) -> a -> b
$ ((TokenBundle -> Const TokenBundle TokenBundle)
 -> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens)