{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- This module provides INTERNAL functions and types for coin selection.
--
-- It is recommended to import from 'Cardano.Wallet.CoinSelection' instead.
--
module Cardano.Wallet.CoinSelection.Internal
    (
    -- * Performing selections
      performSelection
    , Selection (..)
    , SelectionConstraints (..)
    , SelectionError (..)
    , SelectionParams (..)
    , SelectionSkeleton (..)

    -- * Output preparation
    , prepareOutputsWith
    , SelectionOutputError (..)
    , SelectionOutputCoinInsufficientError (..)
    , SelectionOutputSizeExceedsLimitError (..)
    , SelectionOutputTokenQuantityExceedsLimitError (..)

    -- * Verification of post conditions
    , VerificationResult (..)

    -- * Verification of selections and selection errors
    , verifySelection
    , verifySelectionError

    -- * Selection deltas
    , SelectionDelta (..)
    , selectionDeltaAllAssets
    , selectionDeltaCoin
    , selectionHasValidSurplus
    , selectionMinimumCost
    , selectionSurplusCoin

    -- * Selection collateral
    , SelectionCollateralError (..)
    , SelectionCollateralRequirement (..)
    , selectionCollateral
    , selectionCollateralRequired
    , selectionHasSufficientCollateral
    , selectionMinimumCollateral

    -- * Internal types and functions
    , ComputeMinimumCollateralParams (..)
    , computeMinimumCollateral
    , toBalanceConstraintsParams

    ) where

import Prelude

import Algebra.PartialOrd
    ( PartialOrd (..) )
import Cardano.Wallet.CoinSelection.Internal.Balance
    ( SelectionBalanceError (..)
    , SelectionDelta (..)
    , SelectionLimit
    , SelectionSkeleton
    , SelectionStrategy (..)
    )
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, TokenMap )
import Cardano.Wallet.Primitive.Types.TokenQuantity
    ( TokenQuantity )
import Cardano.Wallet.Primitive.Types.Tx
    ( TokenBundleSizeAssessment (..), txOutMaxTokenQuantity )
import Cardano.Wallet.Primitive.Types.UTxOSelection
    ( UTxOSelection )
import Control.Monad
    ( (<=<) )
import Control.Monad.Random.Class
    ( MonadRandom (..) )
import Control.Monad.Random.Extra
    ( NonRandom (..) )
import Control.Monad.Trans.Except
    ( ExceptT (..), runExceptT, withExceptT )
import Data.Function
    ( (&) )
import Data.Functor
    ( (<&>) )
import Data.Generics.Internal.VL.Lens
    ( over, set, view, (^.) )
import Data.Generics.Labels
    ()
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( mapMaybe )
import Data.Ratio
    ( (%) )
import Data.Semigroup
    ( All (..), mtimesDefault )
import GHC.Generics
    ( Generic )
import GHC.Stack
    ( HasCallStack )
import Numeric.Natural
    ( Natural )

import qualified Cardano.Wallet.CoinSelection.Internal.Balance as Balance
import qualified Cardano.Wallet.CoinSelection.Internal.Collateral as Collateral
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
import qualified Data.Foldable as F
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map

--------------------------------------------------------------------------------
-- Types
--------------------------------------------------------------------------------

-- | 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 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 -> 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 ctx -> Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity
        :: Address ctx -> TokenMap -> Coin
        -- ^ Computes the minimum ada quantity required for a given output.
    , SelectionConstraints ctx -> Address ctx -> TokenBundle -> Bool
isBelowMinimumAdaQuantity
        :: Address ctx -> TokenBundle -> Bool
      -- ^ Returns 'True' if the given 'TokenBundle' has a 'Coin' value that is
      -- below the minimum required.
    , 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 -> Int
maximumCollateralInputCount
        :: Int
        -- ^ Specifies an inclusive upper bound on the number of unique inputs
        -- that can be selected as collateral.
    , SelectionConstraints ctx -> Natural
minimumCollateralPercentage
        :: Natural
        -- ^ Specifies the minimum required amount of collateral as a
        -- percentage of the total transaction fee.
    , 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
maximumLengthChangeAddress
        :: Address ctx
    , 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

-- | Specifies all parameters that are specific to a given selection.
--
data SelectionParams ctx = SelectionParams
    { SelectionParams ctx -> TokenMap
assetsToBurn
        :: !TokenMap
        -- ^ Specifies a set of assets to burn.
    , SelectionParams ctx -> TokenMap
assetsToMint
        :: !TokenMap
        -- ^ Specifies a set of assets to mint.
    , SelectionParams ctx -> Coin
extraCoinIn
        :: !Coin
       -- ^ Specifies extra 'Coin' in.
    , SelectionParams ctx -> Coin
extraCoinOut
        :: !Coin
        -- ^ Specifies extra 'Coin' out.
    , SelectionParams ctx -> [(Address ctx, TokenBundle)]
outputsToCover
        :: ![(Address ctx, TokenBundle)]
        -- ^ Specifies a set of outputs that must be paid for.
    , SelectionParams ctx -> Coin
rewardWithdrawal
        :: !Coin
        -- ^ Specifies the value of a withdrawal from a reward account.
    , SelectionParams ctx -> Natural
certificateDepositsTaken
        :: !Natural
        -- ^ Number of deposits for stake key registrations.
    , SelectionParams ctx -> Natural
certificateDepositsReturned
        :: !Natural
        -- ^ Number of deposits from stake key de-registrations.
    , SelectionParams ctx -> SelectionCollateralRequirement
collateralRequirement
        :: !SelectionCollateralRequirement
        -- ^ Specifies the collateral requirement for this selection.
    , SelectionParams ctx -> Map (UTxO ctx) Coin
utxoAvailableForCollateral
        :: !(Map (UTxO ctx) Coin)
        -- ^ 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 ctx -> UTxOSelection (UTxO ctx)
utxoAvailableForInputs
        :: !(UTxOSelection (UTxO ctx))
        -- ^ 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 ctx -> SelectionStrategy
selectionStrategy
        :: SelectionStrategy
        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
    }
    deriving (forall x. SelectionParams ctx -> Rep (SelectionParams ctx) x)
-> (forall x. Rep (SelectionParams ctx) x -> SelectionParams ctx)
-> Generic (SelectionParams ctx)
forall x. Rep (SelectionParams ctx) x -> SelectionParams ctx
forall x. SelectionParams ctx -> Rep (SelectionParams ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x. Rep (SelectionParams ctx) x -> SelectionParams ctx
forall ctx x. SelectionParams ctx -> Rep (SelectionParams ctx) x
$cto :: forall ctx x. Rep (SelectionParams ctx) x -> SelectionParams ctx
$cfrom :: forall ctx x. SelectionParams ctx -> Rep (SelectionParams ctx) x
Generic

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

-- | Indicates that an error occurred while performing a coin selection.
--
data SelectionError ctx
    = SelectionBalanceErrorOf
      (SelectionBalanceError ctx)
    | SelectionCollateralErrorOf
      (SelectionCollateralError ctx)
    | SelectionOutputErrorOf
      (SelectionOutputError ctx)

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

-- | Represents an unsuccessful attempt to select collateral.
--
data SelectionCollateralError ctx = SelectionCollateralError
    { SelectionCollateralError ctx -> Map (UTxO ctx) Coin
largestCombinationAvailable :: Map (UTxO ctx) Coin
        -- ^ The largest combination of coins available.
    , SelectionCollateralError ctx -> Coin
minimumSelectionAmount :: Coin
        -- ^ A lower bound on the sum of coins to be selected as collateral.
    }
    deriving (forall x.
 SelectionCollateralError ctx
 -> Rep (SelectionCollateralError ctx) x)
-> (forall x.
    Rep (SelectionCollateralError ctx) x
    -> SelectionCollateralError ctx)
-> Generic (SelectionCollateralError ctx)
forall x.
Rep (SelectionCollateralError ctx) x
-> SelectionCollateralError ctx
forall x.
SelectionCollateralError ctx
-> Rep (SelectionCollateralError ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionCollateralError ctx) x
-> SelectionCollateralError ctx
forall ctx x.
SelectionCollateralError ctx
-> Rep (SelectionCollateralError ctx) x
$cto :: forall ctx x.
Rep (SelectionCollateralError ctx) x
-> SelectionCollateralError ctx
$cfrom :: forall ctx x.
SelectionCollateralError ctx
-> Rep (SelectionCollateralError ctx) x
Generic

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

-- | Represents a balanced selection.
--
data Selection ctx = Selection
    { Selection ctx -> NonEmpty (UTxO ctx, TokenBundle)
inputs
        :: !(NonEmpty (UTxO ctx, TokenBundle))
        -- ^ Selected inputs.
    , Selection ctx -> [(UTxO ctx, Coin)]
collateral
        :: ![(UTxO ctx, Coin)]
        -- ^ Selected collateral inputs.
    , Selection ctx -> [(Address ctx, TokenBundle)]
outputs
        :: ![(Address ctx, TokenBundle)]
        -- ^ User-specified outputs
    , Selection ctx -> [TokenBundle]
change
        :: ![TokenBundle]
        -- ^ Generated change outputs.
    , Selection ctx -> TokenMap
assetsToMint
        :: !TokenMap
        -- ^ Assets to mint.
    , Selection ctx -> TokenMap
assetsToBurn
        :: !TokenMap
        -- ^ Assets to burn.
    , Selection ctx -> Coin
extraCoinSource
        :: !Coin
        -- ^ An extra source of ada.
    , Selection ctx -> Coin
extraCoinSink
        :: !Coin
        -- ^ An extra sink for ada.
    }
    deriving (forall x. Selection ctx -> Rep (Selection ctx) x)
-> (forall x. Rep (Selection ctx) x -> Selection ctx)
-> Generic (Selection ctx)
forall x. Rep (Selection ctx) x -> Selection ctx
forall x. Selection ctx -> Rep (Selection ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x. Rep (Selection ctx) x -> Selection ctx
forall ctx x. Selection ctx -> Rep (Selection ctx) x
$cto :: forall ctx x. Rep (Selection ctx) x -> Selection ctx
$cfrom :: forall ctx x. Selection ctx -> Rep (Selection ctx) x
Generic

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

-- | Provides a context for functions related to 'performSelection'.

type PerformSelection m ctx a =
    SelectionConstraints ctx ->
    SelectionParams ctx ->
    ExceptT (SelectionError ctx) m a

--------------------------------------------------------------------------------
-- 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.
--
-- This function guarantees that given a set of 'SelectionConstraints' @cs@
-- and 'SelectionParams' @ps@:
--
--  - if creation of a selection succeeds, a value @s@ of type 'Selection'
--    will be returned for which the following property holds:
--
--      >>> verifySelection cs ps s == VerificationSuccess
--
--  - if creation of a selection fails, a value @e@ of type 'SelectionError'
--    will be returned for which the following property holds:
--
--      >>> verifySelectionError cs ps e == VerificationSuccess
--
performSelection
    :: (HasCallStack, MonadRandom m, SelectionContext ctx)
    => PerformSelection m ctx (Selection ctx)
performSelection :: PerformSelection m ctx (Selection ctx)
performSelection SelectionConstraints ctx
cs = PerformSelection m ctx (Selection ctx)
forall (m :: * -> *) ctx.
(HasCallStack, MonadRandom m, SelectionContext ctx) =>
PerformSelection m ctx (Selection ctx)
performSelectionInner SelectionConstraints ctx
cs (SelectionParams ctx
 -> ExceptT (SelectionError ctx) m (Selection ctx))
-> (SelectionParams ctx
    -> ExceptT (SelectionError ctx) m (SelectionParams ctx))
-> SelectionParams ctx
-> ExceptT (SelectionError ctx) m (Selection ctx)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PerformSelection m ctx (SelectionParams ctx)
forall (m :: * -> *) ctx.
Applicative m =>
PerformSelection m ctx (SelectionParams ctx)
prepareOutputs SelectionConstraints ctx
cs

performSelectionInner
    :: (HasCallStack, MonadRandom m, SelectionContext ctx)
    => PerformSelection m ctx (Selection ctx)
performSelectionInner :: PerformSelection m ctx (Selection ctx)
performSelectionInner SelectionConstraints ctx
cs SelectionParams ctx
ps = do
    SelectionResult ctx
balanceResult <- PerformSelection m ctx (SelectionResult ctx)
forall (m :: * -> *) ctx.
(HasCallStack, MonadRandom m, SelectionContext ctx) =>
PerformSelection m ctx (SelectionResult ctx)
performSelectionBalance SelectionConstraints ctx
cs SelectionParams ctx
ps
    SelectionResult (UTxO ctx)
collateralResult <- SelectionResult ctx
-> PerformSelection m ctx (SelectionResult (UTxO ctx))
forall (m :: * -> *) ctx.
(Applicative m, SelectionContext ctx) =>
SelectionResult ctx
-> PerformSelection m ctx (SelectionResult (UTxO ctx))
performSelectionCollateral SelectionResult ctx
balanceResult SelectionConstraints ctx
cs SelectionParams ctx
ps
    Selection ctx -> ExceptT (SelectionError ctx) m (Selection ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection ctx -> ExceptT (SelectionError ctx) m (Selection ctx))
-> Selection ctx -> ExceptT (SelectionError ctx) m (Selection ctx)
forall a b. (a -> b) -> a -> b
$ SelectionParams ctx
-> SelectionResult ctx
-> SelectionResult (UTxO ctx)
-> Selection ctx
forall ctx.
SelectionParams ctx
-> SelectionResult ctx
-> SelectionResult (UTxO ctx)
-> Selection ctx
mkSelection SelectionParams ctx
ps SelectionResult ctx
balanceResult SelectionResult (UTxO ctx)
collateralResult

prepareOutputs :: Applicative m => PerformSelection m ctx (SelectionParams ctx)
prepareOutputs :: PerformSelection m ctx (SelectionParams ctx)
prepareOutputs SelectionConstraints ctx
cs SelectionParams ctx
ps =
    (SelectionOutputError ctx -> SelectionError ctx)
-> ExceptT (SelectionOutputError ctx) m (SelectionParams ctx)
-> ExceptT (SelectionError ctx) m (SelectionParams ctx)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT SelectionOutputError ctx -> SelectionError ctx
forall ctx. SelectionOutputError ctx -> SelectionError ctx
SelectionOutputErrorOf (ExceptT (SelectionOutputError ctx) m (SelectionParams ctx)
 -> ExceptT (SelectionError ctx) m (SelectionParams ctx))
-> ExceptT (SelectionOutputError ctx) m (SelectionParams ctx)
-> ExceptT (SelectionError ctx) m (SelectionParams ctx)
forall a b. (a -> b) -> a -> b
$ m (Either (SelectionOutputError ctx) (SelectionParams ctx))
-> ExceptT (SelectionOutputError ctx) m (SelectionParams ctx)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either (SelectionOutputError ctx) (SelectionParams ctx))
 -> ExceptT (SelectionOutputError ctx) m (SelectionParams ctx))
-> m (Either (SelectionOutputError ctx) (SelectionParams ctx))
-> ExceptT (SelectionOutputError ctx) m (SelectionParams ctx)
forall a b. (a -> b) -> a -> b
$ Either (SelectionOutputError ctx) (SelectionParams ctx)
-> m (Either (SelectionOutputError ctx) (SelectionParams ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (SelectionOutputError ctx) (SelectionParams ctx)
 -> m (Either (SelectionOutputError ctx) (SelectionParams ctx)))
-> Either (SelectionOutputError ctx) (SelectionParams ctx)
-> m (Either (SelectionOutputError ctx) (SelectionParams ctx))
forall a b. (a -> b) -> a -> b
$
    SelectionConstraints ctx
-> [(Address ctx, TokenBundle)]
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall ctx.
SelectionConstraints ctx
-> [(Address ctx, TokenBundle)]
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
prepareOutputsInternal SelectionConstraints ctx
cs ((([(Address ctx, TokenBundle)]
  -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
 -> SelectionParams ctx
 -> Const [(Address ctx, TokenBundle)] (SelectionParams ctx))
-> SelectionParams 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)])
   -> SelectionParams ctx
   -> Const [(Address ctx, TokenBundle)] (SelectionParams ctx))
([(Address ctx, TokenBundle)]
 -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
-> SelectionParams ctx
-> Const [(Address ctx, TokenBundle)] (SelectionParams ctx)
#outputsToCover SelectionParams ctx
ps)
        Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
-> ([(Address ctx, TokenBundle)] -> SelectionParams ctx)
-> Either (SelectionOutputError ctx) (SelectionParams ctx)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[(Address ctx, TokenBundle)]
outputsToCover -> SelectionParams ctx
ps {[(Address ctx, TokenBundle)]
outputsToCover :: [(Address ctx, TokenBundle)]
$sel:outputsToCover:SelectionParams :: [(Address ctx, TokenBundle)]
outputsToCover}

performSelectionBalance
    :: (HasCallStack, MonadRandom m, SelectionContext ctx)
    => PerformSelection m ctx (Balance.SelectionResult ctx)
performSelectionBalance :: PerformSelection m ctx (SelectionResult ctx)
performSelectionBalance SelectionConstraints ctx
cs SelectionParams ctx
ps =
    (SelectionBalanceError ctx -> SelectionError ctx)
-> ExceptT (SelectionBalanceError ctx) m (SelectionResult ctx)
-> ExceptT (SelectionError ctx) m (SelectionResult ctx)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT SelectionBalanceError ctx -> SelectionError ctx
forall ctx. SelectionBalanceError ctx -> SelectionError ctx
SelectionBalanceErrorOf (ExceptT (SelectionBalanceError ctx) m (SelectionResult ctx)
 -> ExceptT (SelectionError ctx) m (SelectionResult ctx))
-> ExceptT (SelectionBalanceError ctx) m (SelectionResult ctx)
-> ExceptT (SelectionError ctx) m (SelectionResult ctx)
forall a b. (a -> b) -> a -> b
$ m (Either (SelectionBalanceError ctx) (SelectionResult ctx))
-> ExceptT (SelectionBalanceError ctx) m (SelectionResult ctx)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either (SelectionBalanceError ctx) (SelectionResult ctx))
 -> ExceptT (SelectionBalanceError ctx) m (SelectionResult ctx))
-> m (Either (SelectionBalanceError ctx) (SelectionResult ctx))
-> ExceptT (SelectionBalanceError ctx) m (SelectionResult ctx)
forall a b. (a -> b) -> a -> b
$
    (SelectionConstraints ctx
 -> SelectionParamsOf [] ctx
 -> m (Either (SelectionBalanceError ctx) (SelectionResult ctx)))
-> (SelectionConstraints ctx, SelectionParamsOf [] ctx)
-> m (Either (SelectionBalanceError ctx) (SelectionResult ctx))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SelectionConstraints ctx
-> SelectionParamsOf [] ctx
-> m (Either (SelectionBalanceError ctx) (SelectionResult ctx))
forall (m :: * -> *) ctx.
(HasCallStack, MonadRandom m, SelectionContext ctx) =>
PerformSelection m [] ctx
Balance.performSelection ((SelectionConstraints ctx, SelectionParamsOf [] ctx)
 -> m (Either (SelectionBalanceError ctx) (SelectionResult ctx)))
-> (SelectionConstraints ctx, SelectionParamsOf [] ctx)
-> m (Either (SelectionBalanceError ctx) (SelectionResult ctx))
forall a b. (a -> b) -> a -> b
$ (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParamsOf [] ctx)
forall ctx.
(SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
toBalanceConstraintsParams (SelectionConstraints ctx
cs, SelectionParams ctx
ps)

performSelectionCollateral
    :: (Applicative m, SelectionContext ctx)
    => Balance.SelectionResult ctx
    -> PerformSelection m ctx (Collateral.SelectionResult (UTxO ctx))
performSelectionCollateral :: SelectionResult ctx
-> PerformSelection m ctx (SelectionResult (UTxO ctx))
performSelectionCollateral SelectionResult ctx
balanceResult SelectionConstraints ctx
cs SelectionParams ctx
ps
    | SelectionParams ctx -> Bool
forall ctx. SelectionParams ctx -> Bool
selectionCollateralRequired SelectionParams ctx
ps =
        (SelectionCollateralError (UTxO ctx) -> SelectionError ctx)
-> ExceptT
     (SelectionCollateralError (UTxO ctx))
     m
     (SelectionResult (UTxO ctx))
-> ExceptT (SelectionError ctx) m (SelectionResult (UTxO ctx))
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT SelectionCollateralError (UTxO ctx) -> SelectionError ctx
forall ctx.
SelectionCollateralError (UTxO ctx) -> SelectionError ctx
mkCollateralError (ExceptT
   (SelectionCollateralError (UTxO ctx))
   m
   (SelectionResult (UTxO ctx))
 -> ExceptT (SelectionError ctx) m (SelectionResult (UTxO ctx)))
-> ExceptT
     (SelectionCollateralError (UTxO ctx))
     m
     (SelectionResult (UTxO ctx))
-> ExceptT (SelectionError ctx) m (SelectionResult (UTxO ctx))
forall a b. (a -> b) -> a -> b
$ m (Either
     (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx)))
-> ExceptT
     (SelectionCollateralError (UTxO ctx))
     m
     (SelectionResult (UTxO ctx))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either
      (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx)))
 -> ExceptT
      (SelectionCollateralError (UTxO ctx))
      m
      (SelectionResult (UTxO ctx)))
-> m (Either
        (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx)))
-> ExceptT
     (SelectionCollateralError (UTxO ctx))
     m
     (SelectionResult (UTxO ctx))
forall a b. (a -> b) -> a -> b
$ Either
  (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx))
-> m (Either
        (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx))
 -> m (Either
         (SelectionCollateralError (UTxO ctx))
         (SelectionResult (UTxO ctx))))
-> Either
     (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx))
-> m (Either
        (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx)))
forall a b. (a -> b) -> a -> b
$
        (SelectionConstraints
 -> SelectionParams (UTxO ctx)
 -> Either
      (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx)))
-> (SelectionConstraints, SelectionParams (UTxO ctx))
-> Either
     (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SelectionConstraints
-> SelectionParams (UTxO ctx)
-> Either
     (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx))
forall u. Ord u => PerformSelection u
Collateral.performSelection ((SelectionConstraints, SelectionParams (UTxO ctx))
 -> Either
      (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx)))
-> (SelectionConstraints, SelectionParams (UTxO ctx))
-> Either
     (SelectionCollateralError (UTxO ctx)) (SelectionResult (UTxO ctx))
forall a b. (a -> b) -> a -> b
$
        SelectionResult ctx
-> (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints, SelectionParams (UTxO ctx))
forall ctx.
SelectionResult ctx
-> (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints, SelectionParams (UTxO ctx))
toCollateralConstraintsParams SelectionResult ctx
balanceResult (SelectionConstraints ctx
cs, SelectionParams ctx
ps)
    | Bool
otherwise =
        m (Either (SelectionError ctx) (SelectionResult (UTxO ctx)))
-> ExceptT (SelectionError ctx) m (SelectionResult (UTxO ctx))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either (SelectionError ctx) (SelectionResult (UTxO ctx)))
 -> ExceptT (SelectionError ctx) m (SelectionResult (UTxO ctx)))
-> m (Either (SelectionError ctx) (SelectionResult (UTxO ctx)))
-> ExceptT (SelectionError ctx) m (SelectionResult (UTxO ctx))
forall a b. (a -> b) -> a -> b
$ Either (SelectionError ctx) (SelectionResult (UTxO ctx))
-> m (Either (SelectionError ctx) (SelectionResult (UTxO ctx)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (SelectionError ctx) (SelectionResult (UTxO ctx))
 -> m (Either (SelectionError ctx) (SelectionResult (UTxO ctx))))
-> Either (SelectionError ctx) (SelectionResult (UTxO ctx))
-> m (Either (SelectionError ctx) (SelectionResult (UTxO ctx)))
forall a b. (a -> b) -> a -> b
$ SelectionResult (UTxO ctx)
-> Either (SelectionError ctx) (SelectionResult (UTxO ctx))
forall a b. b -> Either a b
Right SelectionResult (UTxO ctx)
forall u. SelectionResult u
Collateral.selectionResultEmpty
  where
    mkCollateralError
        :: Collateral.SelectionCollateralError (UTxO ctx)
        -> SelectionError ctx
    mkCollateralError :: SelectionCollateralError (UTxO ctx) -> SelectionError ctx
mkCollateralError Collateral.SelectionCollateralError {Map (UTxO ctx) Coin
Coin
$sel:minimumSelectionAmount:SelectionCollateralError :: forall u. SelectionCollateralError u -> Coin
$sel:largestCombinationAvailable:SelectionCollateralError :: forall u. SelectionCollateralError u -> Map u Coin
minimumSelectionAmount :: Coin
largestCombinationAvailable :: Map (UTxO ctx) Coin
..} =
        SelectionCollateralError ctx -> SelectionError ctx
forall ctx. SelectionCollateralError ctx -> SelectionError ctx
SelectionCollateralErrorOf
        SelectionCollateralError :: forall ctx.
Map (UTxO ctx) Coin -> Coin -> SelectionCollateralError ctx
SelectionCollateralError {Map (UTxO ctx) Coin
Coin
minimumSelectionAmount :: Coin
largestCombinationAvailable :: Map (UTxO ctx) Coin
$sel:minimumSelectionAmount:SelectionCollateralError :: Coin
$sel:largestCombinationAvailable:SelectionCollateralError :: Map (UTxO ctx) Coin
..}

-- | Returns a selection's ordinary outputs and change outputs in a single list.
--
-- Since change outputs do not have addresses at the point of generation,
-- this function assigns all change outputs with a dummy change address
-- of the maximum possible length.
--
selectionAllOutputs
    :: SelectionConstraints ctx
    -> Selection ctx
    -> [(Address ctx, TokenBundle)]
selectionAllOutputs :: SelectionConstraints ctx
-> Selection ctx -> [(Address ctx, TokenBundle)]
selectionAllOutputs SelectionConstraints ctx
constraints Selection ctx
selection = [(Address ctx, TokenBundle)]
-> [(Address ctx, TokenBundle)] -> [(Address ctx, TokenBundle)]
forall a. Semigroup a => a -> a -> a
(<>)
    (Selection ctx
selection Selection ctx
-> (([(Address ctx, TokenBundle)]
     -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
    -> Selection ctx
    -> Const [(Address ctx, TokenBundle)] (Selection ctx))
-> [(Address ctx, TokenBundle)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputs"
  (([(Address ctx, TokenBundle)]
    -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
   -> Selection ctx
   -> Const [(Address ctx, TokenBundle)] (Selection ctx))
([(Address ctx, TokenBundle)]
 -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
-> Selection ctx
-> Const [(Address ctx, TokenBundle)] (Selection ctx)
#outputs)
    (Selection ctx
selection Selection ctx
-> (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
    -> Selection ctx -> Const [TokenBundle] (Selection ctx))
-> [TokenBundle]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "change"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> Selection ctx -> Const [TokenBundle] (Selection ctx))
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> Selection ctx -> Const [TokenBundle] (Selection ctx)
#change [TokenBundle]
-> (TokenBundle -> (Address ctx, TokenBundle))
-> [(Address ctx, TokenBundle)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (SelectionConstraints ctx -> Address ctx
forall ctx. SelectionConstraints ctx -> Address ctx
maximumLengthChangeAddress SelectionConstraints ctx
constraints, ))

-- | Creates constraints and parameters for 'Balance.performSelection'.
--
toBalanceConstraintsParams
    :: forall ctx.
       (        SelectionConstraints ctx,         SelectionParams ctx)
    -> (Balance.SelectionConstraints ctx, Balance.SelectionParams ctx)
toBalanceConstraintsParams :: (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
toBalanceConstraintsParams (SelectionConstraints ctx
constraints, SelectionParams ctx
params) =
    (SelectionConstraints ctx
balanceConstraints, SelectionParams ctx
balanceParams)
  where
    balanceConstraints :: SelectionConstraints ctx
balanceConstraints = SelectionConstraints :: forall ctx.
(TokenBundle -> TokenBundleSizeAssessment)
-> (Address ctx -> TokenMap -> Coin)
-> (SelectionSkeleton ctx -> Coin)
-> ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> Address ctx
-> Coin
-> TokenQuantity
-> Address ctx
-> SelectionConstraints ctx
Balance.SelectionConstraints
        { $sel:computeMinimumAdaQuantity:SelectionConstraints :: Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity =
            (((Address ctx -> TokenMap -> Coin)
  -> Const
       (Address ctx -> TokenMap -> Coin)
       (Address ctx -> TokenMap -> Coin))
 -> SelectionConstraints ctx
 -> Const
      (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Address ctx -> TokenMap -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "computeMinimumAdaQuantity"
  (((Address ctx -> TokenMap -> Coin)
    -> Const
         (Address ctx -> TokenMap -> Coin)
         (Address ctx -> TokenMap -> Coin))
   -> SelectionConstraints ctx
   -> Const
        (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
((Address ctx -> TokenMap -> Coin)
 -> Const
      (Address ctx -> TokenMap -> Coin)
      (Address ctx -> TokenMap -> Coin))
-> SelectionConstraints ctx
-> Const
     (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx)
#computeMinimumAdaQuantity SelectionConstraints ctx
constraints
        , $sel:computeMinimumCost:SelectionConstraints :: SelectionSkeleton ctx -> Coin
computeMinimumCost =
            (((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
constraints
                (SelectionSkeleton ctx -> Coin)
-> ((SelectionSkeleton ctx -> Coin)
    -> SelectionSkeleton ctx -> Coin)
-> SelectionSkeleton ctx
-> Coin
forall a b. a -> (a -> b) -> b
& (SelectionSkeleton ctx -> Coin) -> SelectionSkeleton ctx -> Coin
adjustComputeMinimumCost
        , $sel:computeSelectionLimit:SelectionConstraints :: [(Address ctx, TokenBundle)] -> SelectionLimit
computeSelectionLimit =
            ((([(Address ctx, TokenBundle)] -> SelectionLimit)
  -> Const
       ([(Address ctx, TokenBundle)] -> SelectionLimit)
       ([(Address ctx, TokenBundle)] -> SelectionLimit))
 -> SelectionConstraints ctx
 -> Const
      ([(Address ctx, TokenBundle)] -> SelectionLimit)
      (SelectionConstraints ctx))
-> SelectionConstraints ctx
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "computeSelectionLimit"
  ((([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> Const
         ([(Address ctx, TokenBundle)] -> SelectionLimit)
         ([(Address ctx, TokenBundle)] -> SelectionLimit))
   -> SelectionConstraints ctx
   -> Const
        ([(Address ctx, TokenBundle)] -> SelectionLimit)
        (SelectionConstraints ctx))
(([(Address ctx, TokenBundle)] -> SelectionLimit)
 -> Const
      ([(Address ctx, TokenBundle)] -> SelectionLimit)
      ([(Address ctx, TokenBundle)] -> SelectionLimit))
-> SelectionConstraints ctx
-> Const
     ([(Address ctx, TokenBundle)] -> SelectionLimit)
     (SelectionConstraints ctx)
#computeSelectionLimit SelectionConstraints ctx
constraints
                ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> (([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> [(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall a b. a -> (a -> b) -> b
& ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)] -> SelectionLimit
adjustComputeSelectionLimit
        , $sel:assessTokenBundleSize:SelectionConstraints :: TokenBundle -> TokenBundleSizeAssessment
assessTokenBundleSize =
            (((TokenBundle -> TokenBundleSizeAssessment)
  -> Const
       (TokenBundle -> TokenBundleSizeAssessment)
       (TokenBundle -> TokenBundleSizeAssessment))
 -> SelectionConstraints ctx
 -> Const
      (TokenBundle -> TokenBundleSizeAssessment)
      (SelectionConstraints ctx))
-> SelectionConstraints ctx
-> 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))
   -> SelectionConstraints ctx
   -> Const
        (TokenBundle -> TokenBundleSizeAssessment)
        (SelectionConstraints ctx))
((TokenBundle -> TokenBundleSizeAssessment)
 -> Const
      (TokenBundle -> TokenBundleSizeAssessment)
      (TokenBundle -> TokenBundleSizeAssessment))
-> SelectionConstraints ctx
-> Const
     (TokenBundle -> TokenBundleSizeAssessment)
     (SelectionConstraints ctx)
#assessTokenBundleSize SelectionConstraints ctx
constraints
        , $sel:maximumOutputAdaQuantity:SelectionConstraints :: Coin
maximumOutputAdaQuantity =
            ((Coin -> Const Coin Coin)
 -> SelectionConstraints ctx
 -> Const Coin (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "maximumOutputAdaQuantity"
  ((Coin -> Const Coin Coin)
   -> SelectionConstraints ctx
   -> Const Coin (SelectionConstraints ctx))
(Coin -> Const Coin Coin)
-> SelectionConstraints ctx
-> Const Coin (SelectionConstraints ctx)
#maximumOutputAdaQuantity SelectionConstraints ctx
constraints
        , $sel:maximumOutputTokenQuantity:SelectionConstraints :: TokenQuantity
maximumOutputTokenQuantity =
            ((TokenQuantity -> Const TokenQuantity TokenQuantity)
 -> SelectionConstraints ctx
 -> Const TokenQuantity (SelectionConstraints ctx))
-> SelectionConstraints ctx -> TokenQuantity
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "maximumOutputTokenQuantity"
  ((TokenQuantity -> Const TokenQuantity TokenQuantity)
   -> SelectionConstraints ctx
   -> Const TokenQuantity (SelectionConstraints ctx))
(TokenQuantity -> Const TokenQuantity TokenQuantity)
-> SelectionConstraints ctx
-> Const TokenQuantity (SelectionConstraints ctx)
#maximumOutputTokenQuantity SelectionConstraints ctx
constraints
        , $sel:maximumLengthChangeAddress:SelectionConstraints :: Address ctx
maximumLengthChangeAddress =
            ((Address ctx -> Const (Address ctx) (Address ctx))
 -> SelectionConstraints ctx
 -> Const (Address ctx) (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Address ctx
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "maximumLengthChangeAddress"
  ((Address ctx -> Const (Address ctx) (Address ctx))
   -> SelectionConstraints ctx
   -> Const (Address ctx) (SelectionConstraints ctx))
(Address ctx -> Const (Address ctx) (Address ctx))
-> SelectionConstraints ctx
-> Const (Address ctx) (SelectionConstraints ctx)
#maximumLengthChangeAddress SelectionConstraints ctx
constraints
        , $sel:nullAddress:SelectionConstraints :: Address ctx
nullAddress =
            ((Address ctx -> Const (Address ctx) (Address ctx))
 -> SelectionConstraints ctx
 -> Const (Address ctx) (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Address ctx
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "nullAddress"
  ((Address ctx -> Const (Address ctx) (Address ctx))
   -> SelectionConstraints ctx
   -> Const (Address ctx) (SelectionConstraints ctx))
(Address ctx -> Const (Address ctx) (Address ctx))
-> SelectionConstraints ctx
-> Const (Address ctx) (SelectionConstraints ctx)
#nullAddress SelectionConstraints ctx
constraints
        }
      where
        adjustComputeMinimumCost
            :: (SelectionSkeleton ctx -> Coin)
            -> (SelectionSkeleton ctx -> Coin)
        adjustComputeMinimumCost :: (SelectionSkeleton ctx -> Coin) -> SelectionSkeleton ctx -> Coin
adjustComputeMinimumCost =
            SelectionParams ctx
-> ((SelectionSkeleton ctx -> Coin)
    -> SelectionSkeleton ctx -> Coin)
-> (SelectionSkeleton ctx -> Coin)
-> SelectionSkeleton ctx
-> Coin
forall ctx a. SelectionParams ctx -> (a -> a) -> a -> a
whenCollateralRequired SelectionParams ctx
params ((SelectionSkeleton ctx -> Coin)
-> (SelectionSkeleton ctx -> SelectionSkeleton ctx)
-> SelectionSkeleton ctx
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSkeleton ctx -> SelectionSkeleton ctx
adjustSelectionSkeleton)
          where
            -- When collateral is required, we reserve space for collateral
            -- inputs ahead of time by adding the maximum allowed number of
            -- collateral inputs (defined by 'maximumCollateralInputCount')
            -- to the skeleton input count.
            --
            -- This ensures that the collateral inputs are already paid for
            -- when 'Balance.performSelection' is generating change outputs.
            --
            -- In many cases, the maximum allowed number of collateral inputs
            -- will be greater than the number eventually required, which will
            -- lead to a fee that is slightly higher than necessary.
            --
            -- However, since the maximum number of collateral inputs is very
            -- small, and since the marginal cost of a single extra input is
            -- relatively small, this fee increase is likely to be very small.
            --
            adjustSelectionSkeleton
                :: SelectionSkeleton ctx
                -> SelectionSkeleton ctx
            adjustSelectionSkeleton :: SelectionSkeleton ctx -> SelectionSkeleton ctx
adjustSelectionSkeleton = ((Int -> Identity Int)
 -> SelectionSkeleton ctx -> Identity (SelectionSkeleton ctx))
-> (Int -> Int) -> SelectionSkeleton ctx -> SelectionSkeleton ctx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "skeletonInputCount"
  ((Int -> Identity Int)
   -> SelectionSkeleton ctx -> Identity (SelectionSkeleton ctx))
(Int -> Identity Int)
-> SelectionSkeleton ctx -> Identity (SelectionSkeleton ctx)
#skeletonInputCount
                (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int -> Const Int Int)
 -> SelectionConstraints ctx
 -> Const Int (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Int
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "maximumCollateralInputCount"
  ((Int -> Const Int Int)
   -> SelectionConstraints ctx
   -> Const Int (SelectionConstraints ctx))
(Int -> Const Int Int)
-> SelectionConstraints ctx -> Const Int (SelectionConstraints ctx)
#maximumCollateralInputCount SelectionConstraints ctx
constraints)

        adjustComputeSelectionLimit
            :: ([(Address ctx, TokenBundle)] -> SelectionLimit)
            -> ([(Address ctx, TokenBundle)] -> SelectionLimit)
        adjustComputeSelectionLimit :: ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)] -> SelectionLimit
adjustComputeSelectionLimit =
            SelectionParams ctx
-> (([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> [(Address ctx, TokenBundle)] -> SelectionLimit)
-> ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall ctx a. SelectionParams ctx -> (a -> a) -> a -> a
whenCollateralRequired SelectionParams ctx
params ((SelectionLimit -> SelectionLimit)
-> ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectionLimit -> SelectionLimit
adjustSelectionLimit)
          where
            -- When collateral is required, we reserve space for collateral
            -- inputs ahead of time by subtracting the maximum allowed number
            -- of collateral inputs (defined by 'maximumCollateralInputCount')
            -- from the selection limit.
            --
            -- This ensures that when we come to perform collateral selection,
            -- there is still space available.
            --
            adjustSelectionLimit :: SelectionLimit -> SelectionLimit
            adjustSelectionLimit :: SelectionLimit -> SelectionLimit
adjustSelectionLimit = (SelectionLimit -> Int -> SelectionLimit)
-> Int -> SelectionLimit -> SelectionLimit
forall a b c. (a -> b -> c) -> b -> a -> c
flip SelectionLimit -> Int -> SelectionLimit
Balance.reduceSelectionLimitBy
                (((Int -> Const Int Int)
 -> SelectionConstraints ctx
 -> Const Int (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Int
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "maximumCollateralInputCount"
  ((Int -> Const Int Int)
   -> SelectionConstraints ctx
   -> Const Int (SelectionConstraints ctx))
(Int -> Const Int Int)
-> SelectionConstraints ctx -> Const Int (SelectionConstraints ctx)
#maximumCollateralInputCount SelectionConstraints ctx
constraints)

    balanceParams :: SelectionParams ctx
balanceParams = SelectionParams :: forall (f :: * -> *) ctx.
f (Address ctx, TokenBundle)
-> UTxOSelection (UTxO ctx)
-> Coin
-> Coin
-> TokenMap
-> TokenMap
-> SelectionStrategy
-> SelectionParamsOf f ctx
Balance.SelectionParams
        { $sel:assetsToBurn:SelectionParams :: TokenMap
assetsToBurn =
            ((TokenMap -> Const TokenMap TokenMap)
 -> SelectionParams ctx -> Const TokenMap (SelectionParams ctx))
-> SelectionParams ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToBurn"
  ((TokenMap -> Const TokenMap TokenMap)
   -> SelectionParams ctx -> Const TokenMap (SelectionParams ctx))
(TokenMap -> Const TokenMap TokenMap)
-> SelectionParams ctx -> Const TokenMap (SelectionParams ctx)
#assetsToBurn SelectionParams ctx
params
        , $sel:assetsToMint:SelectionParams :: TokenMap
assetsToMint =
            ((TokenMap -> Const TokenMap TokenMap)
 -> SelectionParams ctx -> Const TokenMap (SelectionParams ctx))
-> SelectionParams ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToMint"
  ((TokenMap -> Const TokenMap TokenMap)
   -> SelectionParams ctx -> Const TokenMap (SelectionParams ctx))
(TokenMap -> Const TokenMap TokenMap)
-> SelectionParams ctx -> Const TokenMap (SelectionParams ctx)
#assetsToMint SelectionParams ctx
params
        , $sel:extraCoinSource:SelectionParams :: Coin
extraCoinSource =
            ((Coin -> Const Coin Coin)
 -> SelectionParams ctx -> Const Coin (SelectionParams ctx))
-> SelectionParams ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "rewardWithdrawal"
  ((Coin -> Const Coin Coin)
   -> SelectionParams ctx -> Const Coin (SelectionParams ctx))
(Coin -> Const Coin Coin)
-> SelectionParams ctx -> Const Coin (SelectionParams ctx)
#rewardWithdrawal SelectionParams ctx
params Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> ((Coin -> Const Coin Coin)
 -> SelectionParams ctx -> Const Coin (SelectionParams ctx))
-> SelectionParams ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinIn"
  ((Coin -> Const Coin Coin)
   -> SelectionParams ctx -> Const Coin (SelectionParams ctx))
(Coin -> Const Coin Coin)
-> SelectionParams ctx -> Const Coin (SelectionParams ctx)
#extraCoinIn SelectionParams ctx
params Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<>
            Natural -> Coin -> Coin
forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault
                (((Natural -> Const Natural Natural)
 -> SelectionParams ctx -> Const Natural (SelectionParams ctx))
-> SelectionParams ctx -> Natural
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "certificateDepositsReturned"
  ((Natural -> Const Natural Natural)
   -> SelectionParams ctx -> Const Natural (SelectionParams ctx))
(Natural -> Const Natural Natural)
-> SelectionParams ctx -> Const Natural (SelectionParams ctx)
#certificateDepositsReturned SelectionParams ctx
params)
                (((Coin -> Const Coin Coin)
 -> SelectionConstraints ctx
 -> Const Coin (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "certificateDepositAmount"
  ((Coin -> Const Coin Coin)
   -> SelectionConstraints ctx
   -> Const Coin (SelectionConstraints ctx))
(Coin -> Const Coin Coin)
-> SelectionConstraints ctx
-> Const Coin (SelectionConstraints ctx)
#certificateDepositAmount SelectionConstraints ctx
constraints)
        , $sel:extraCoinSink:SelectionParams :: Coin
extraCoinSink = ((Coin -> Const Coin Coin)
 -> SelectionParams ctx -> Const Coin (SelectionParams ctx))
-> SelectionParams ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinOut"
  ((Coin -> Const Coin Coin)
   -> SelectionParams ctx -> Const Coin (SelectionParams ctx))
(Coin -> Const Coin Coin)
-> SelectionParams ctx -> Const Coin (SelectionParams ctx)
#extraCoinOut SelectionParams ctx
params Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<>
            Natural -> Coin -> Coin
forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault
                (((Natural -> Const Natural Natural)
 -> SelectionParams ctx -> Const Natural (SelectionParams ctx))
-> SelectionParams ctx -> Natural
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "certificateDepositsTaken"
  ((Natural -> Const Natural Natural)
   -> SelectionParams ctx -> Const Natural (SelectionParams ctx))
(Natural -> Const Natural Natural)
-> SelectionParams ctx -> Const Natural (SelectionParams ctx)
#certificateDepositsTaken SelectionParams ctx
params)
                (((Coin -> Const Coin Coin)
 -> SelectionConstraints ctx
 -> Const Coin (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "certificateDepositAmount"
  ((Coin -> Const Coin Coin)
   -> SelectionConstraints ctx
   -> Const Coin (SelectionConstraints ctx))
(Coin -> Const Coin Coin)
-> SelectionConstraints ctx
-> Const Coin (SelectionConstraints ctx)
#certificateDepositAmount SelectionConstraints ctx
constraints)
        , $sel:outputsToCover:SelectionParams :: [(Address ctx, TokenBundle)]
outputsToCover =
            (([(Address ctx, TokenBundle)]
  -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
 -> SelectionParams ctx
 -> Const [(Address ctx, TokenBundle)] (SelectionParams ctx))
-> SelectionParams 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)])
   -> SelectionParams ctx
   -> Const [(Address ctx, TokenBundle)] (SelectionParams ctx))
([(Address ctx, TokenBundle)]
 -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
-> SelectionParams ctx
-> Const [(Address ctx, TokenBundle)] (SelectionParams ctx)
#outputsToCover SelectionParams ctx
params
        , $sel:utxoAvailable:SelectionParams :: UTxOSelection (UTxO ctx)
utxoAvailable =
            ((UTxOSelection (UTxO ctx)
  -> Const (UTxOSelection (UTxO ctx)) (UTxOSelection (UTxO ctx)))
 -> SelectionParams ctx
 -> Const (UTxOSelection (UTxO ctx)) (SelectionParams ctx))
-> SelectionParams ctx -> UTxOSelection (UTxO ctx)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "utxoAvailableForInputs"
  ((UTxOSelection (UTxO ctx)
    -> Const (UTxOSelection (UTxO ctx)) (UTxOSelection (UTxO ctx)))
   -> SelectionParams ctx
   -> Const (UTxOSelection (UTxO ctx)) (SelectionParams ctx))
(UTxOSelection (UTxO ctx)
 -> Const (UTxOSelection (UTxO ctx)) (UTxOSelection (UTxO ctx)))
-> SelectionParams ctx
-> Const (UTxOSelection (UTxO ctx)) (SelectionParams ctx)
#utxoAvailableForInputs SelectionParams ctx
params
        , $sel:selectionStrategy:SelectionParams :: SelectionStrategy
selectionStrategy =
            ((SelectionStrategy -> Const SelectionStrategy SelectionStrategy)
 -> SelectionParams ctx
 -> Const SelectionStrategy (SelectionParams ctx))
-> SelectionParams ctx -> SelectionStrategy
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "selectionStrategy"
  ((SelectionStrategy -> Const SelectionStrategy SelectionStrategy)
   -> SelectionParams ctx
   -> Const SelectionStrategy (SelectionParams ctx))
(SelectionStrategy -> Const SelectionStrategy SelectionStrategy)
-> SelectionParams ctx
-> Const SelectionStrategy (SelectionParams ctx)
#selectionStrategy SelectionParams ctx
params
        }

-- | Creates constraints and parameters for 'Collateral.performSelection'.
--
toCollateralConstraintsParams
    :: Balance.SelectionResult ctx
    ->  ( SelectionConstraints ctx
        , SelectionParams ctx
        )
    ->  ( Collateral.SelectionConstraints
        , Collateral.SelectionParams (UTxO ctx)
        )
toCollateralConstraintsParams :: SelectionResult ctx
-> (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints, SelectionParams (UTxO ctx))
toCollateralConstraintsParams SelectionResult ctx
balanceResult (SelectionConstraints ctx
constraints, SelectionParams ctx
params) =
    (SelectionConstraints
collateralConstraints, SelectionParams (UTxO ctx)
collateralParams)
  where
    collateralConstraints :: SelectionConstraints
collateralConstraints = SelectionConstraints :: Int -> SearchSpaceLimit -> SelectionConstraints
Collateral.SelectionConstraints
        { $sel:maximumSelectionSize:SelectionConstraints :: Int
maximumSelectionSize =
            ((Int -> Const Int Int)
 -> SelectionConstraints ctx
 -> Const Int (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Int
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "maximumCollateralInputCount"
  ((Int -> Const Int Int)
   -> SelectionConstraints ctx
   -> Const Int (SelectionConstraints ctx))
(Int -> Const Int Int)
-> SelectionConstraints ctx -> Const Int (SelectionConstraints ctx)
#maximumCollateralInputCount SelectionConstraints ctx
constraints
        , $sel:searchSpaceLimit:SelectionConstraints :: SearchSpaceLimit
searchSpaceLimit =
            -- We use the default search space limit here, as this value is
            -- used in the test suite for 'Collateral.performSelection'. We
            -- can therefore be reasonably confident that the process of
            -- selecting collateral will not use inordinate amounts of time
            -- and space:
            SearchSpaceLimit
Collateral.searchSpaceLimitDefault
        }
    collateralParams :: SelectionParams (UTxO ctx)
collateralParams = SelectionParams :: forall u. Map u Coin -> Coin -> SelectionParams u
Collateral.SelectionParams
        { $sel:coinsAvailable:SelectionParams :: Map (UTxO ctx) Coin
coinsAvailable =
            ((Map (UTxO ctx) Coin
  -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
 -> SelectionParams ctx
 -> Const (Map (UTxO ctx) Coin) (SelectionParams ctx))
-> SelectionParams ctx -> Map (UTxO ctx) Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "utxoAvailableForCollateral"
  ((Map (UTxO ctx) Coin
    -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
   -> SelectionParams ctx
   -> Const (Map (UTxO ctx) Coin) (SelectionParams ctx))
(Map (UTxO ctx) Coin
 -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
-> SelectionParams ctx
-> Const (Map (UTxO ctx) Coin) (SelectionParams ctx)
#utxoAvailableForCollateral SelectionParams ctx
params
        , $sel:minimumSelectionAmount:SelectionParams :: Coin
minimumSelectionAmount =
            ComputeMinimumCollateralParams -> Coin
computeMinimumCollateral ComputeMinimumCollateralParams :: Natural -> Coin -> ComputeMinimumCollateralParams
ComputeMinimumCollateralParams
                { $sel:minimumCollateralPercentage:ComputeMinimumCollateralParams :: Natural
minimumCollateralPercentage =
                    ((Natural -> Const Natural Natural)
 -> SelectionConstraints ctx
 -> Const Natural (SelectionConstraints ctx))
-> SelectionConstraints ctx -> Natural
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "minimumCollateralPercentage"
  ((Natural -> Const Natural Natural)
   -> SelectionConstraints ctx
   -> Const Natural (SelectionConstraints ctx))
(Natural -> Const Natural Natural)
-> SelectionConstraints ctx
-> Const Natural (SelectionConstraints ctx)
#minimumCollateralPercentage SelectionConstraints ctx
constraints
                , $sel:transactionFee:ComputeMinimumCollateralParams :: Coin
transactionFee =
                    SelectionResult ctx -> Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionResultOf f ctx -> Coin
Balance.selectionSurplusCoin SelectionResult ctx
balanceResult
                }
        }

-- | Creates a 'Selection' from selections of inputs and collateral.
--
mkSelection
    :: SelectionParams ctx
    -> Balance.SelectionResult ctx
    -> Collateral.SelectionResult (UTxO ctx)
    -> Selection ctx
mkSelection :: SelectionParams ctx
-> SelectionResult ctx
-> SelectionResult (UTxO ctx)
-> Selection ctx
mkSelection SelectionParams ctx
_params SelectionResult ctx
balanceResult SelectionResult (UTxO ctx)
collateralResult = Selection :: forall ctx.
NonEmpty (UTxO ctx, TokenBundle)
-> [(UTxO ctx, Coin)]
-> [(Address ctx, TokenBundle)]
-> [TokenBundle]
-> TokenMap
-> TokenMap
-> Coin
-> Coin
-> Selection ctx
Selection
    { $sel:inputs:Selection :: NonEmpty (UTxO ctx, TokenBundle)
inputs = ((NonEmpty (UTxO ctx, TokenBundle)
  -> Const
       (NonEmpty (UTxO ctx, TokenBundle))
       (NonEmpty (UTxO ctx, TokenBundle)))
 -> SelectionResult ctx
 -> Const (NonEmpty (UTxO ctx, TokenBundle)) (SelectionResult ctx))
-> SelectionResult 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)))
   -> SelectionResult ctx
   -> Const (NonEmpty (UTxO ctx, TokenBundle)) (SelectionResult ctx))
(NonEmpty (UTxO ctx, TokenBundle)
 -> Const
      (NonEmpty (UTxO ctx, TokenBundle))
      (NonEmpty (UTxO ctx, TokenBundle)))
-> SelectionResult ctx
-> Const (NonEmpty (UTxO ctx, TokenBundle)) (SelectionResult ctx)
#inputsSelected SelectionResult ctx
balanceResult
    , $sel:collateral:Selection :: [(UTxO ctx, Coin)]
collateral = Map (UTxO ctx) Coin -> [(UTxO ctx, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (UTxO ctx) Coin -> [(UTxO ctx, Coin)])
-> Map (UTxO ctx) Coin -> [(UTxO ctx, Coin)]
forall a b. (a -> b) -> a -> b
$ ((Map (UTxO ctx) Coin
  -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
 -> SelectionResult (UTxO ctx)
 -> Const (Map (UTxO ctx) Coin) (SelectionResult (UTxO ctx)))
-> SelectionResult (UTxO ctx) -> Map (UTxO ctx) Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coinsSelected"
  ((Map (UTxO ctx) Coin
    -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
   -> SelectionResult (UTxO ctx)
   -> Const (Map (UTxO ctx) Coin) (SelectionResult (UTxO ctx)))
(Map (UTxO ctx) Coin
 -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
-> SelectionResult (UTxO ctx)
-> Const (Map (UTxO ctx) Coin) (SelectionResult (UTxO ctx))
#coinsSelected SelectionResult (UTxO ctx)
collateralResult
    , $sel:outputs:Selection :: [(Address ctx, TokenBundle)]
outputs = (([(Address ctx, TokenBundle)]
  -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
 -> SelectionResult ctx
 -> Const [(Address ctx, TokenBundle)] (SelectionResult ctx))
-> SelectionResult ctx -> [(Address ctx, TokenBundle)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputsCovered"
  (([(Address ctx, TokenBundle)]
    -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
   -> SelectionResult ctx
   -> Const [(Address ctx, TokenBundle)] (SelectionResult ctx))
([(Address ctx, TokenBundle)]
 -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
-> SelectionResult ctx
-> Const [(Address ctx, TokenBundle)] (SelectionResult ctx)
#outputsCovered SelectionResult ctx
balanceResult
    , $sel:change:Selection :: [TokenBundle]
change = (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
 -> SelectionResult ctx
 -> Const [TokenBundle] (SelectionResult ctx))
-> SelectionResult ctx -> [TokenBundle]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "changeGenerated"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> SelectionResult ctx
   -> Const [TokenBundle] (SelectionResult ctx))
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> SelectionResult ctx -> Const [TokenBundle] (SelectionResult ctx)
#changeGenerated SelectionResult ctx
balanceResult
    , $sel:assetsToMint:Selection :: TokenMap
assetsToMint = ((TokenMap -> Const TokenMap TokenMap)
 -> SelectionResult ctx -> Const TokenMap (SelectionResult ctx))
-> SelectionResult ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToMint"
  ((TokenMap -> Const TokenMap TokenMap)
   -> SelectionResult ctx -> Const TokenMap (SelectionResult ctx))
(TokenMap -> Const TokenMap TokenMap)
-> SelectionResult ctx -> Const TokenMap (SelectionResult ctx)
#assetsToMint SelectionResult ctx
balanceResult
    , $sel:assetsToBurn:Selection :: TokenMap
assetsToBurn = ((TokenMap -> Const TokenMap TokenMap)
 -> SelectionResult ctx -> Const TokenMap (SelectionResult ctx))
-> SelectionResult ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToBurn"
  ((TokenMap -> Const TokenMap TokenMap)
   -> SelectionResult ctx -> Const TokenMap (SelectionResult ctx))
(TokenMap -> Const TokenMap TokenMap)
-> SelectionResult ctx -> Const TokenMap (SelectionResult ctx)
#assetsToBurn SelectionResult ctx
balanceResult
    , $sel:extraCoinSource:Selection :: Coin
extraCoinSource = ((Coin -> Const Coin Coin)
 -> SelectionResult ctx -> Const Coin (SelectionResult ctx))
-> SelectionResult ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSource"
  ((Coin -> Const Coin Coin)
   -> SelectionResult ctx -> Const Coin (SelectionResult ctx))
(Coin -> Const Coin Coin)
-> SelectionResult ctx -> Const Coin (SelectionResult ctx)
#extraCoinSource SelectionResult ctx
balanceResult
    , $sel:extraCoinSink:Selection :: Coin
extraCoinSink = ((Coin -> Const Coin Coin)
 -> SelectionResult ctx -> Const Coin (SelectionResult ctx))
-> SelectionResult ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSink"
  ((Coin -> Const Coin Coin)
   -> SelectionResult ctx -> Const Coin (SelectionResult ctx))
(Coin -> Const Coin Coin)
-> SelectionResult ctx -> Const Coin (SelectionResult ctx)
#extraCoinSink SelectionResult ctx
balanceResult
    }

-- | Converts a 'Selection' to a balance result.
--
toBalanceResult :: Selection ctx -> Balance.SelectionResult ctx
toBalanceResult :: Selection ctx -> SelectionResult ctx
toBalanceResult Selection ctx
selection = SelectionResult :: forall (f :: * -> *) ctx.
NonEmpty (UTxO ctx, TokenBundle)
-> Coin
-> Coin
-> f (Address ctx, TokenBundle)
-> [TokenBundle]
-> TokenMap
-> TokenMap
-> SelectionResultOf f ctx
Balance.SelectionResult
    { $sel:inputsSelected:SelectionResult :: NonEmpty (UTxO ctx, TokenBundle)
inputsSelected = ((NonEmpty (UTxO ctx, TokenBundle)
  -> Const
       (NonEmpty (UTxO ctx, TokenBundle))
       (NonEmpty (UTxO ctx, TokenBundle)))
 -> Selection ctx
 -> Const (NonEmpty (UTxO ctx, TokenBundle)) (Selection ctx))
-> Selection ctx -> NonEmpty (UTxO ctx, TokenBundle)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputs"
  ((NonEmpty (UTxO ctx, TokenBundle)
    -> Const
         (NonEmpty (UTxO ctx, TokenBundle))
         (NonEmpty (UTxO ctx, TokenBundle)))
   -> Selection ctx
   -> Const (NonEmpty (UTxO ctx, TokenBundle)) (Selection ctx))
(NonEmpty (UTxO ctx, TokenBundle)
 -> Const
      (NonEmpty (UTxO ctx, TokenBundle))
      (NonEmpty (UTxO ctx, TokenBundle)))
-> Selection ctx
-> Const (NonEmpty (UTxO ctx, TokenBundle)) (Selection ctx)
#inputs Selection ctx
selection
    , $sel:outputsCovered:SelectionResult :: [(Address ctx, TokenBundle)]
outputsCovered = (([(Address ctx, TokenBundle)]
  -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
 -> Selection ctx
 -> Const [(Address ctx, TokenBundle)] (Selection ctx))
-> Selection ctx -> [(Address ctx, TokenBundle)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputs"
  (([(Address ctx, TokenBundle)]
    -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
   -> Selection ctx
   -> Const [(Address ctx, TokenBundle)] (Selection ctx))
([(Address ctx, TokenBundle)]
 -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
-> Selection ctx
-> Const [(Address ctx, TokenBundle)] (Selection ctx)
#outputs Selection ctx
selection
    , $sel:changeGenerated:SelectionResult :: [TokenBundle]
changeGenerated = (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
 -> Selection ctx -> Const [TokenBundle] (Selection ctx))
-> Selection ctx -> [TokenBundle]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "change"
  (([TokenBundle] -> Const [TokenBundle] [TokenBundle])
   -> Selection ctx -> Const [TokenBundle] (Selection ctx))
([TokenBundle] -> Const [TokenBundle] [TokenBundle])
-> Selection ctx -> Const [TokenBundle] (Selection ctx)
#change Selection ctx
selection
    , $sel:assetsToMint:SelectionResult :: TokenMap
assetsToMint = ((TokenMap -> Const TokenMap TokenMap)
 -> Selection ctx -> Const TokenMap (Selection ctx))
-> Selection ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToMint"
  ((TokenMap -> Const TokenMap TokenMap)
   -> Selection ctx -> Const TokenMap (Selection ctx))
(TokenMap -> Const TokenMap TokenMap)
-> Selection ctx -> Const TokenMap (Selection ctx)
#assetsToMint Selection ctx
selection
    , $sel:assetsToBurn:SelectionResult :: TokenMap
assetsToBurn = ((TokenMap -> Const TokenMap TokenMap)
 -> Selection ctx -> Const TokenMap (Selection ctx))
-> Selection ctx -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assetsToBurn"
  ((TokenMap -> Const TokenMap TokenMap)
   -> Selection ctx -> Const TokenMap (Selection ctx))
(TokenMap -> Const TokenMap TokenMap)
-> Selection ctx -> Const TokenMap (Selection ctx)
#assetsToBurn Selection ctx
selection
    , $sel:extraCoinSource:SelectionResult :: Coin
extraCoinSource = ((Coin -> Const Coin Coin)
 -> Selection ctx -> Const Coin (Selection ctx))
-> Selection ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSource"
  ((Coin -> Const Coin Coin)
   -> Selection ctx -> Const Coin (Selection ctx))
(Coin -> Const Coin Coin)
-> Selection ctx -> Const Coin (Selection ctx)
#extraCoinSource Selection ctx
selection
    , $sel:extraCoinSink:SelectionResult :: Coin
extraCoinSink = ((Coin -> Const Coin Coin)
 -> Selection ctx -> Const Coin (Selection ctx))
-> Selection ctx -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "extraCoinSink"
  ((Coin -> Const Coin Coin)
   -> Selection ctx -> Const Coin (Selection ctx))
(Coin -> Const Coin Coin)
-> Selection ctx -> Const Coin (Selection ctx)
#extraCoinSink Selection ctx
selection
    }

--------------------------------------------------------------------------------
-- Verification of post conditions
--------------------------------------------------------------------------------

-- | The result of verifying a post condition.
--
data VerificationResult
    = VerificationSuccess
    | VerificationFailure (NonEmpty VerificationFailureReason)
    deriving Int -> VerificationResult -> ShowS
[VerificationResult] -> ShowS
VerificationResult -> String
(Int -> VerificationResult -> ShowS)
-> (VerificationResult -> String)
-> ([VerificationResult] -> ShowS)
-> Show VerificationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerificationResult] -> ShowS
$cshowList :: [VerificationResult] -> ShowS
show :: VerificationResult -> String
$cshow :: VerificationResult -> String
showsPrec :: Int -> VerificationResult -> ShowS
$cshowsPrec :: Int -> VerificationResult -> ShowS
Show

-- | Represents a reason for verification failure.
--
data VerificationFailureReason =
    forall failureReason. Show failureReason =>
    VerificationFailureReason failureReason
deriving instance Show VerificationFailureReason

instance Eq VerificationResult where
    VerificationResult
r1 == :: VerificationResult -> VerificationResult -> Bool
== VerificationResult
r2 = VerificationResult -> String
forall a. Show a => a -> String
show VerificationResult
r1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== VerificationResult -> String
forall a. Show a => a -> String
show VerificationResult
r2

instance Monoid VerificationResult where
    mempty :: VerificationResult
mempty = VerificationResult
VerificationSuccess

instance Semigroup VerificationResult where
    VerificationResult
r1 <> :: VerificationResult -> VerificationResult -> VerificationResult
<> VerificationResult
r2 = [VerificationFailureReason] -> VerificationResult
verificationResultFromFailureReasons ([VerificationFailureReason] -> VerificationResult)
-> [VerificationFailureReason] -> VerificationResult
forall a b. (a -> b) -> a -> b
$ [VerificationFailureReason]
-> [VerificationFailureReason] -> [VerificationFailureReason]
forall a. Semigroup a => a -> a -> a
(<>)
        (VerificationResult -> [VerificationFailureReason]
verificationResultToFailureReasons VerificationResult
r1)
        (VerificationResult -> [VerificationFailureReason]
verificationResultToFailureReasons VerificationResult
r2)

-- | Constructs a singleton verification failure.
--
verificationFailure
    :: forall failureReason. Show failureReason
    => failureReason
    -> VerificationResult
verificationFailure :: failureReason -> VerificationResult
verificationFailure failureReason
a = NonEmpty VerificationFailureReason -> VerificationResult
VerificationFailure (failureReason -> VerificationFailureReason
forall failureReason.
Show failureReason =>
failureReason -> VerificationFailureReason
VerificationFailureReason failureReason
a VerificationFailureReason
-> [VerificationFailureReason]
-> NonEmpty VerificationFailureReason
forall a. a -> [a] -> NonEmpty a
:| [])

-- | Constructs a 'VerificationResult' from a list of failure reasons.
--
verificationResultFromFailureReasons
    :: [VerificationFailureReason] -> VerificationResult
verificationResultFromFailureReasons :: [VerificationFailureReason] -> VerificationResult
verificationResultFromFailureReasons =
    VerificationResult
-> (NonEmpty VerificationFailureReason -> VerificationResult)
-> Maybe (NonEmpty VerificationFailureReason)
-> VerificationResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VerificationResult
VerificationSuccess NonEmpty VerificationFailureReason -> VerificationResult
VerificationFailure (Maybe (NonEmpty VerificationFailureReason) -> VerificationResult)
-> ([VerificationFailureReason]
    -> Maybe (NonEmpty VerificationFailureReason))
-> [VerificationFailureReason]
-> VerificationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VerificationFailureReason]
-> Maybe (NonEmpty VerificationFailureReason)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty

-- | Deconstructs a 'VerificationResult' into a list of failure reasons.
--
verificationResultToFailureReasons
    :: VerificationResult -> [VerificationFailureReason]
verificationResultToFailureReasons :: VerificationResult -> [VerificationFailureReason]
verificationResultToFailureReasons = \case
    VerificationResult
VerificationSuccess -> []
    VerificationFailure NonEmpty VerificationFailureReason
reasons -> NonEmpty VerificationFailureReason -> [VerificationFailureReason]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty VerificationFailureReason
reasons

-- | Verifies the given condition.
--
-- If the given condition is 'True', returns 'VerificationSuccess'.
--
-- Otherwise, returns 'VerificationFailure' with the given reason.
--
verify
    :: forall failureReason. Show failureReason
    => Bool
    -> failureReason
    -> VerificationResult
verify :: Bool -> failureReason -> VerificationResult
verify Bool
condition failureReason
failureReason =
    if Bool
condition
    then VerificationResult
VerificationSuccess
    else failureReason -> VerificationResult
forall failureReason.
Show failureReason =>
failureReason -> VerificationResult
verificationFailure failureReason
failureReason

-- | Verifies all of the given conditions.
--
-- If the given conditions are all 'True', returns 'VerificationSuccess'.
--
-- Otherwise, returns 'VerificationFailure' with the given reason.
--
verifyAll
    :: forall f failureReason. (Foldable f, Show failureReason)
    => f Bool
    -> failureReason
    -> VerificationResult
verifyAll :: f Bool -> failureReason -> VerificationResult
verifyAll f Bool
conditions = Bool -> failureReason -> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify (All -> Bool
getAll (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> All) -> f Bool -> All
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Bool -> All
All f Bool
conditions)

-- | Verifies that the given list is empty.
--
-- If the given list is empty, returns 'VerificationSuccess'.
--
-- Otherwise, returns 'VerificationFailure', with given reason constructor
-- applied to the non-empty list.
--
verifyEmpty
    :: forall failureReason a. Show failureReason
    => [a]
    -> (NonEmpty a -> failureReason)
    -> VerificationResult
verifyEmpty :: [a] -> (NonEmpty a -> failureReason) -> VerificationResult
verifyEmpty [a]
xs NonEmpty a -> failureReason
failureReason =
    VerificationResult
-> (NonEmpty a -> VerificationResult)
-> Maybe (NonEmpty a)
-> VerificationResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (VerificationResult
VerificationSuccess)
        (failureReason -> VerificationResult
forall failureReason.
Show failureReason =>
failureReason -> VerificationResult
verificationFailure (failureReason -> VerificationResult)
-> (NonEmpty a -> failureReason)
-> NonEmpty a
-> VerificationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> failureReason
failureReason)
        ([a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
xs)

--------------------------------------------------------------------------------
-- Selection verification
--------------------------------------------------------------------------------

-- | The type of all 'Selection' verification functions.
--
type VerifySelection ctx =
    SelectionConstraints ctx ->
    SelectionParams ctx ->
    Selection ctx ->
    VerificationResult

-- | Verifies a 'Selection' for correctness.
--
-- This function is provided primarily as a convenience for testing. As such,
-- it's not usually necessary to call this function from ordinary application
-- code, unless you suspect that a 'Selection' is incorrect in some way.
--
verifySelection :: SelectionContext ctx => VerifySelection ctx
verifySelection :: VerifySelection ctx
verifySelection = [VerifySelection ctx] -> VerifySelection ctx
forall a. Monoid a => [a] -> a
mconcat
    [ VerifySelection ctx
forall ctx. VerifySelection ctx
verifySelectionCollateralSufficient
    , VerifySelection ctx
forall ctx. SelectionContext ctx => VerifySelection ctx
verifySelectionCollateralSuitable
    , VerifySelection ctx
forall ctx. VerifySelection ctx
verifySelectionDeltaValid
    , VerifySelection ctx
forall ctx. VerifySelection ctx
verifySelectionInputCountWithinLimit
    , VerifySelection ctx
forall ctx. SelectionContext ctx => VerifySelection ctx
verifySelectionOutputCoinsSufficient
    , VerifySelection ctx
forall ctx. SelectionContext ctx => VerifySelection ctx
verifySelectionOutputSizesWithinLimit
    , VerifySelection ctx
forall ctx. SelectionContext ctx => VerifySelection ctx
verifySelectionOutputTokenQuantitiesWithinLimit
    ]

--------------------------------------------------------------------------------
-- Selection verification: collateral sufficiency
--------------------------------------------------------------------------------

data FailureToVerifySelectionCollateralSufficient =
    FailureToVerifySelectionCollateralSufficient
    { FailureToVerifySelectionCollateralSufficient -> Coin
collateralSelected :: Coin
    , FailureToVerifySelectionCollateralSufficient -> Coin
collateralRequired :: Coin
    }
    deriving (FailureToVerifySelectionCollateralSufficient
-> FailureToVerifySelectionCollateralSufficient -> Bool
(FailureToVerifySelectionCollateralSufficient
 -> FailureToVerifySelectionCollateralSufficient -> Bool)
-> (FailureToVerifySelectionCollateralSufficient
    -> FailureToVerifySelectionCollateralSufficient -> Bool)
-> Eq FailureToVerifySelectionCollateralSufficient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionCollateralSufficient
-> FailureToVerifySelectionCollateralSufficient -> Bool
$c/= :: FailureToVerifySelectionCollateralSufficient
-> FailureToVerifySelectionCollateralSufficient -> Bool
== :: FailureToVerifySelectionCollateralSufficient
-> FailureToVerifySelectionCollateralSufficient -> Bool
$c== :: FailureToVerifySelectionCollateralSufficient
-> FailureToVerifySelectionCollateralSufficient -> Bool
Eq, Int -> FailureToVerifySelectionCollateralSufficient -> ShowS
[FailureToVerifySelectionCollateralSufficient] -> ShowS
FailureToVerifySelectionCollateralSufficient -> String
(Int -> FailureToVerifySelectionCollateralSufficient -> ShowS)
-> (FailureToVerifySelectionCollateralSufficient -> String)
-> ([FailureToVerifySelectionCollateralSufficient] -> ShowS)
-> Show FailureToVerifySelectionCollateralSufficient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionCollateralSufficient] -> ShowS
$cshowList :: [FailureToVerifySelectionCollateralSufficient] -> ShowS
show :: FailureToVerifySelectionCollateralSufficient -> String
$cshow :: FailureToVerifySelectionCollateralSufficient -> String
showsPrec :: Int -> FailureToVerifySelectionCollateralSufficient -> ShowS
$cshowsPrec :: Int -> FailureToVerifySelectionCollateralSufficient -> ShowS
Show)

verifySelectionCollateralSufficient :: VerifySelection ctx
verifySelectionCollateralSufficient :: VerifySelection ctx
verifySelectionCollateralSufficient SelectionConstraints ctx
cs SelectionParams ctx
ps Selection ctx
selection =
    Bool
-> FailureToVerifySelectionCollateralSufficient
-> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        (Coin
collateralSelected Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
collateralRequired)
        (FailureToVerifySelectionCollateralSufficient :: Coin -> Coin -> FailureToVerifySelectionCollateralSufficient
FailureToVerifySelectionCollateralSufficient {Coin
collateralRequired :: Coin
collateralSelected :: Coin
$sel:collateralRequired:FailureToVerifySelectionCollateralSufficient :: Coin
$sel:collateralSelected:FailureToVerifySelectionCollateralSufficient :: Coin
..})
  where
    collateralSelected :: Coin
collateralSelected = Selection ctx -> Coin
forall ctx. Selection ctx -> Coin
selectionCollateral Selection ctx
selection
    collateralRequired :: Coin
collateralRequired = SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
forall ctx.
SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
selectionMinimumCollateral SelectionConstraints ctx
cs SelectionParams ctx
ps Selection ctx
selection

--------------------------------------------------------------------------------
-- Selection verification: collateral suitability
--------------------------------------------------------------------------------

data FailureToVerifySelectionCollateralSuitable u =
    FailureToVerifySelectionCollateralSuitable
    { FailureToVerifySelectionCollateralSuitable u -> [(u, Coin)]
collateralSelected
        :: [(u, Coin)]
    , FailureToVerifySelectionCollateralSuitable u -> [(u, Coin)]
collateralSelectedButUnsuitable
        :: [(u, Coin)]
    }
    deriving (FailureToVerifySelectionCollateralSuitable u
-> FailureToVerifySelectionCollateralSuitable u -> Bool
(FailureToVerifySelectionCollateralSuitable u
 -> FailureToVerifySelectionCollateralSuitable u -> Bool)
-> (FailureToVerifySelectionCollateralSuitable u
    -> FailureToVerifySelectionCollateralSuitable u -> Bool)
-> Eq (FailureToVerifySelectionCollateralSuitable u)
forall u.
Eq u =>
FailureToVerifySelectionCollateralSuitable u
-> FailureToVerifySelectionCollateralSuitable u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionCollateralSuitable u
-> FailureToVerifySelectionCollateralSuitable u -> Bool
$c/= :: forall u.
Eq u =>
FailureToVerifySelectionCollateralSuitable u
-> FailureToVerifySelectionCollateralSuitable u -> Bool
== :: FailureToVerifySelectionCollateralSuitable u
-> FailureToVerifySelectionCollateralSuitable u -> Bool
$c== :: forall u.
Eq u =>
FailureToVerifySelectionCollateralSuitable u
-> FailureToVerifySelectionCollateralSuitable u -> Bool
Eq, Int -> FailureToVerifySelectionCollateralSuitable u -> ShowS
[FailureToVerifySelectionCollateralSuitable u] -> ShowS
FailureToVerifySelectionCollateralSuitable u -> String
(Int -> FailureToVerifySelectionCollateralSuitable u -> ShowS)
-> (FailureToVerifySelectionCollateralSuitable u -> String)
-> ([FailureToVerifySelectionCollateralSuitable u] -> ShowS)
-> Show (FailureToVerifySelectionCollateralSuitable u)
forall u.
Show u =>
Int -> FailureToVerifySelectionCollateralSuitable u -> ShowS
forall u.
Show u =>
[FailureToVerifySelectionCollateralSuitable u] -> ShowS
forall u.
Show u =>
FailureToVerifySelectionCollateralSuitable u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionCollateralSuitable u] -> ShowS
$cshowList :: forall u.
Show u =>
[FailureToVerifySelectionCollateralSuitable u] -> ShowS
show :: FailureToVerifySelectionCollateralSuitable u -> String
$cshow :: forall u.
Show u =>
FailureToVerifySelectionCollateralSuitable u -> String
showsPrec :: Int -> FailureToVerifySelectionCollateralSuitable u -> ShowS
$cshowsPrec :: forall u.
Show u =>
Int -> FailureToVerifySelectionCollateralSuitable u -> ShowS
Show)

verifySelectionCollateralSuitable
    :: forall ctx. SelectionContext ctx => VerifySelection ctx
verifySelectionCollateralSuitable :: VerifySelection ctx
verifySelectionCollateralSuitable SelectionConstraints ctx
_cs SelectionParams ctx
ps Selection ctx
selection =
    Bool
-> FailureToVerifySelectionCollateralSuitable (UTxO ctx)
-> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        ([(UTxO ctx, Coin)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(UTxO ctx, Coin)]
collateralSelectedButUnsuitable)
        (FailureToVerifySelectionCollateralSuitable :: forall u.
[(u, Coin)]
-> [(u, Coin)] -> FailureToVerifySelectionCollateralSuitable u
FailureToVerifySelectionCollateralSuitable {[(UTxO ctx, Coin)]
collateralSelected :: [(UTxO ctx, Coin)]
collateralSelectedButUnsuitable :: [(UTxO ctx, Coin)]
$sel:collateralSelectedButUnsuitable:FailureToVerifySelectionCollateralSuitable :: [(UTxO ctx, Coin)]
$sel:collateralSelected:FailureToVerifySelectionCollateralSuitable :: [(UTxO ctx, Coin)]
..})
  where
    collateralSelected :: [(UTxO ctx, Coin)]
collateralSelected =
        Selection ctx
selection Selection ctx
-> (([(UTxO ctx, Coin)]
     -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
    -> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx))
-> [(UTxO ctx, Coin)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "collateral"
  (([(UTxO ctx, Coin)]
    -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
   -> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx))
([(UTxO ctx, Coin)] -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
-> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx)
#collateral
    collateralSelectedButUnsuitable :: [(UTxO ctx, Coin)]
collateralSelectedButUnsuitable =
        ((UTxO ctx, Coin) -> Bool)
-> [(UTxO ctx, Coin)] -> [(UTxO ctx, Coin)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((UTxO ctx, Coin) -> Bool) -> (UTxO ctx, Coin) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO ctx, Coin) -> Bool
utxoSuitableForCollateral) [(UTxO ctx, Coin)]
collateralSelected

    -- Since the caller of 'performSelection' is responsible for verifying that
    -- all entries within 'utxoAvailableForCollateral' are suitable for use as
    -- collateral, here we merely verify that the selected entry is indeed a
    -- member of this set.
    utxoSuitableForCollateral :: (UTxO ctx, Coin) -> Bool
    utxoSuitableForCollateral :: (UTxO ctx, Coin) -> Bool
utxoSuitableForCollateral (UTxO ctx
i, Coin
c) =
        UTxO ctx -> Coin -> Map (UTxO ctx) Coin
forall k a. k -> a -> Map k a
Map.singleton UTxO ctx
i Coin
c
        Map (UTxO ctx) Coin -> Map (UTxO ctx) Coin -> Bool
forall k a. (Ord k, Eq a) => Map k a -> Map k a -> Bool
`Map.isSubmapOf`
        ((Map (UTxO ctx) Coin
  -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
 -> SelectionParams ctx
 -> Const (Map (UTxO ctx) Coin) (SelectionParams ctx))
-> SelectionParams ctx -> Map (UTxO ctx) Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "utxoAvailableForCollateral"
  ((Map (UTxO ctx) Coin
    -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
   -> SelectionParams ctx
   -> Const (Map (UTxO ctx) Coin) (SelectionParams ctx))
(Map (UTxO ctx) Coin
 -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
-> SelectionParams ctx
-> Const (Map (UTxO ctx) Coin) (SelectionParams ctx)
#utxoAvailableForCollateral SelectionParams ctx
ps

--------------------------------------------------------------------------------
-- Selection verification: delta validity
--------------------------------------------------------------------------------

data FailureToVerifySelectionDeltaValid = FailureToVerifySelectionDeltaValid
    { FailureToVerifySelectionDeltaValid -> SelectionDelta TokenBundle
delta
        :: SelectionDelta TokenBundle
    , FailureToVerifySelectionDeltaValid -> Coin
minimumCost
        :: Coin
    , FailureToVerifySelectionDeltaValid -> Coin
maximumCost
        :: Coin
    }
    deriving (FailureToVerifySelectionDeltaValid
-> FailureToVerifySelectionDeltaValid -> Bool
(FailureToVerifySelectionDeltaValid
 -> FailureToVerifySelectionDeltaValid -> Bool)
-> (FailureToVerifySelectionDeltaValid
    -> FailureToVerifySelectionDeltaValid -> Bool)
-> Eq FailureToVerifySelectionDeltaValid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionDeltaValid
-> FailureToVerifySelectionDeltaValid -> Bool
$c/= :: FailureToVerifySelectionDeltaValid
-> FailureToVerifySelectionDeltaValid -> Bool
== :: FailureToVerifySelectionDeltaValid
-> FailureToVerifySelectionDeltaValid -> Bool
$c== :: FailureToVerifySelectionDeltaValid
-> FailureToVerifySelectionDeltaValid -> Bool
Eq, Int -> FailureToVerifySelectionDeltaValid -> ShowS
[FailureToVerifySelectionDeltaValid] -> ShowS
FailureToVerifySelectionDeltaValid -> String
(Int -> FailureToVerifySelectionDeltaValid -> ShowS)
-> (FailureToVerifySelectionDeltaValid -> String)
-> ([FailureToVerifySelectionDeltaValid] -> ShowS)
-> Show FailureToVerifySelectionDeltaValid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionDeltaValid] -> ShowS
$cshowList :: [FailureToVerifySelectionDeltaValid] -> ShowS
show :: FailureToVerifySelectionDeltaValid -> String
$cshow :: FailureToVerifySelectionDeltaValid -> String
showsPrec :: Int -> FailureToVerifySelectionDeltaValid -> ShowS
$cshowsPrec :: Int -> FailureToVerifySelectionDeltaValid -> ShowS
Show)

verifySelectionDeltaValid :: VerifySelection ctx
verifySelectionDeltaValid :: VerifySelection ctx
verifySelectionDeltaValid SelectionConstraints ctx
cs SelectionParams ctx
ps Selection ctx
selection =
    Bool -> FailureToVerifySelectionDeltaValid -> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        (SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Bool
forall ctx.
SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Bool
selectionHasValidSurplus SelectionConstraints ctx
cs SelectionParams ctx
ps Selection ctx
selection)
        (FailureToVerifySelectionDeltaValid :: SelectionDelta TokenBundle
-> Coin -> Coin -> FailureToVerifySelectionDeltaValid
FailureToVerifySelectionDeltaValid {Coin
SelectionDelta TokenBundle
maximumCost :: Coin
minimumCost :: Coin
delta :: SelectionDelta TokenBundle
$sel:maximumCost:FailureToVerifySelectionDeltaValid :: Coin
$sel:minimumCost:FailureToVerifySelectionDeltaValid :: Coin
$sel:delta:FailureToVerifySelectionDeltaValid :: SelectionDelta TokenBundle
..})
  where
    delta :: SelectionDelta TokenBundle
delta = Selection ctx -> SelectionDelta TokenBundle
forall ctx. Selection ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets Selection ctx
selection
    minimumCost :: Coin
minimumCost = SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
forall ctx.
SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
selectionMinimumCost SelectionConstraints ctx
cs SelectionParams ctx
ps Selection ctx
selection
    maximumCost :: Coin
maximumCost = SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
forall ctx.
SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
selectionMaximumCost SelectionConstraints ctx
cs SelectionParams ctx
ps Selection ctx
selection

--------------------------------------------------------------------------------
-- Selection verification: selection limit
--------------------------------------------------------------------------------

data FailureToVerifySelectionInputCountWithinLimit =
    FailureToVerifySelectionInputCountWithinLimit
    { FailureToVerifySelectionInputCountWithinLimit -> Int
collateralInputCount
        :: Int
    , FailureToVerifySelectionInputCountWithinLimit -> Int
ordinaryInputCount
        :: Int
    , FailureToVerifySelectionInputCountWithinLimit -> Int
totalInputCount
        :: Int
    , FailureToVerifySelectionInputCountWithinLimit -> SelectionLimit
selectionLimit
        :: SelectionLimit
    }
    deriving (FailureToVerifySelectionInputCountWithinLimit
-> FailureToVerifySelectionInputCountWithinLimit -> Bool
(FailureToVerifySelectionInputCountWithinLimit
 -> FailureToVerifySelectionInputCountWithinLimit -> Bool)
-> (FailureToVerifySelectionInputCountWithinLimit
    -> FailureToVerifySelectionInputCountWithinLimit -> Bool)
-> Eq FailureToVerifySelectionInputCountWithinLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionInputCountWithinLimit
-> FailureToVerifySelectionInputCountWithinLimit -> Bool
$c/= :: FailureToVerifySelectionInputCountWithinLimit
-> FailureToVerifySelectionInputCountWithinLimit -> Bool
== :: FailureToVerifySelectionInputCountWithinLimit
-> FailureToVerifySelectionInputCountWithinLimit -> Bool
$c== :: FailureToVerifySelectionInputCountWithinLimit
-> FailureToVerifySelectionInputCountWithinLimit -> Bool
Eq, Int -> FailureToVerifySelectionInputCountWithinLimit -> ShowS
[FailureToVerifySelectionInputCountWithinLimit] -> ShowS
FailureToVerifySelectionInputCountWithinLimit -> String
(Int -> FailureToVerifySelectionInputCountWithinLimit -> ShowS)
-> (FailureToVerifySelectionInputCountWithinLimit -> String)
-> ([FailureToVerifySelectionInputCountWithinLimit] -> ShowS)
-> Show FailureToVerifySelectionInputCountWithinLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionInputCountWithinLimit] -> ShowS
$cshowList :: [FailureToVerifySelectionInputCountWithinLimit] -> ShowS
show :: FailureToVerifySelectionInputCountWithinLimit -> String
$cshow :: FailureToVerifySelectionInputCountWithinLimit -> String
showsPrec :: Int -> FailureToVerifySelectionInputCountWithinLimit -> ShowS
$cshowsPrec :: Int -> FailureToVerifySelectionInputCountWithinLimit -> ShowS
Show)

verifySelectionInputCountWithinLimit :: VerifySelection ctx
verifySelectionInputCountWithinLimit :: VerifySelection ctx
verifySelectionInputCountWithinLimit SelectionConstraints ctx
cs SelectionParams ctx
_ps Selection ctx
selection =
    Bool
-> FailureToVerifySelectionInputCountWithinLimit
-> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        (Int -> SelectionLimit
forall a. a -> SelectionLimitOf a
Balance.MaximumInputLimit Int
totalInputCount SelectionLimit -> SelectionLimit -> Bool
forall a. Ord a => a -> a -> Bool
<= SelectionLimit
selectionLimit)
        (FailureToVerifySelectionInputCountWithinLimit :: Int
-> Int
-> Int
-> SelectionLimit
-> FailureToVerifySelectionInputCountWithinLimit
FailureToVerifySelectionInputCountWithinLimit {Int
SelectionLimit
ordinaryInputCount :: Int
collateralInputCount :: Int
selectionLimit :: SelectionLimit
totalInputCount :: Int
$sel:selectionLimit:FailureToVerifySelectionInputCountWithinLimit :: SelectionLimit
$sel:totalInputCount:FailureToVerifySelectionInputCountWithinLimit :: Int
$sel:ordinaryInputCount:FailureToVerifySelectionInputCountWithinLimit :: Int
$sel:collateralInputCount:FailureToVerifySelectionInputCountWithinLimit :: Int
..})
  where
    collateralInputCount :: Int
collateralInputCount = [(UTxO ctx, Coin)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Selection ctx
selection Selection ctx
-> (([(UTxO ctx, Coin)]
     -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
    -> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx))
-> [(UTxO ctx, Coin)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "collateral"
  (([(UTxO ctx, Coin)]
    -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
   -> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx))
([(UTxO ctx, Coin)] -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
-> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx)
#collateral)
    ordinaryInputCount :: Int
ordinaryInputCount = NonEmpty (UTxO ctx, TokenBundle) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Selection ctx
selection Selection ctx
-> ((NonEmpty (UTxO ctx, TokenBundle)
     -> Const
          (NonEmpty (UTxO ctx, TokenBundle))
          (NonEmpty (UTxO ctx, TokenBundle)))
    -> Selection ctx
    -> Const (NonEmpty (UTxO ctx, TokenBundle)) (Selection ctx))
-> NonEmpty (UTxO ctx, TokenBundle)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  ((NonEmpty (UTxO ctx, TokenBundle)
    -> Const
         (NonEmpty (UTxO ctx, TokenBundle))
         (NonEmpty (UTxO ctx, TokenBundle)))
   -> Selection ctx
   -> Const (NonEmpty (UTxO ctx, TokenBundle)) (Selection ctx))
(NonEmpty (UTxO ctx, TokenBundle)
 -> Const
      (NonEmpty (UTxO ctx, TokenBundle))
      (NonEmpty (UTxO ctx, TokenBundle)))
-> Selection ctx
-> Const (NonEmpty (UTxO ctx, TokenBundle)) (Selection ctx)
#inputs)
    totalInputCount :: Int
totalInputCount = Int
collateralInputCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ordinaryInputCount
    selectionLimit :: SelectionLimit
selectionLimit = (SelectionConstraints ctx
cs SelectionConstraints ctx
-> ((([(Address ctx, TokenBundle)] -> SelectionLimit)
     -> Const
          ([(Address ctx, TokenBundle)] -> SelectionLimit)
          ([(Address ctx, TokenBundle)] -> SelectionLimit))
    -> SelectionConstraints ctx
    -> Const
         ([(Address ctx, TokenBundle)] -> SelectionLimit)
         (SelectionConstraints ctx))
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "computeSelectionLimit"
  ((([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> Const
         ([(Address ctx, TokenBundle)] -> SelectionLimit)
         ([(Address ctx, TokenBundle)] -> SelectionLimit))
   -> SelectionConstraints ctx
   -> Const
        ([(Address ctx, TokenBundle)] -> SelectionLimit)
        (SelectionConstraints ctx))
(([(Address ctx, TokenBundle)] -> SelectionLimit)
 -> Const
      ([(Address ctx, TokenBundle)] -> SelectionLimit)
      ([(Address ctx, TokenBundle)] -> SelectionLimit))
-> SelectionConstraints ctx
-> Const
     ([(Address ctx, TokenBundle)] -> SelectionLimit)
     (SelectionConstraints ctx)
#computeSelectionLimit) (Selection ctx
selection Selection ctx
-> (([(Address ctx, TokenBundle)]
     -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
    -> Selection ctx
    -> Const [(Address ctx, TokenBundle)] (Selection ctx))
-> [(Address ctx, TokenBundle)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputs"
  (([(Address ctx, TokenBundle)]
    -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
   -> Selection ctx
   -> Const [(Address ctx, TokenBundle)] (Selection ctx))
([(Address ctx, TokenBundle)]
 -> Const [(Address ctx, TokenBundle)] [(Address ctx, TokenBundle)])
-> Selection ctx
-> Const [(Address ctx, TokenBundle)] (Selection ctx)
#outputs)

--------------------------------------------------------------------------------
-- Selection verification: minimum ada quantities
--------------------------------------------------------------------------------

newtype FailureToVerifySelectionOutputCoinsSufficient ctx =
    FailureToVerifySelectionOutputCoinsSufficient
    (NonEmpty (SelectionOutputCoinInsufficientError ctx))
    deriving (FailureToVerifySelectionOutputCoinsSufficient ctx
-> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool
(FailureToVerifySelectionOutputCoinsSufficient ctx
 -> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool)
-> (FailureToVerifySelectionOutputCoinsSufficient ctx
    -> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool)
-> Eq (FailureToVerifySelectionOutputCoinsSufficient ctx)
forall ctx.
SelectionContext ctx =>
FailureToVerifySelectionOutputCoinsSufficient ctx
-> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionOutputCoinsSufficient ctx
-> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool
$c/= :: forall ctx.
SelectionContext ctx =>
FailureToVerifySelectionOutputCoinsSufficient ctx
-> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool
== :: FailureToVerifySelectionOutputCoinsSufficient ctx
-> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool
$c== :: forall ctx.
SelectionContext ctx =>
FailureToVerifySelectionOutputCoinsSufficient ctx
-> FailureToVerifySelectionOutputCoinsSufficient ctx -> Bool
Eq, Int -> FailureToVerifySelectionOutputCoinsSufficient ctx -> ShowS
[FailureToVerifySelectionOutputCoinsSufficient ctx] -> ShowS
FailureToVerifySelectionOutputCoinsSufficient ctx -> String
(Int -> FailureToVerifySelectionOutputCoinsSufficient ctx -> ShowS)
-> (FailureToVerifySelectionOutputCoinsSufficient ctx -> String)
-> ([FailureToVerifySelectionOutputCoinsSufficient ctx] -> ShowS)
-> Show (FailureToVerifySelectionOutputCoinsSufficient ctx)
forall ctx.
SelectionContext ctx =>
Int -> FailureToVerifySelectionOutputCoinsSufficient ctx -> ShowS
forall ctx.
SelectionContext ctx =>
[FailureToVerifySelectionOutputCoinsSufficient ctx] -> ShowS
forall ctx.
SelectionContext ctx =>
FailureToVerifySelectionOutputCoinsSufficient ctx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionOutputCoinsSufficient ctx] -> ShowS
$cshowList :: forall ctx.
SelectionContext ctx =>
[FailureToVerifySelectionOutputCoinsSufficient ctx] -> ShowS
show :: FailureToVerifySelectionOutputCoinsSufficient ctx -> String
$cshow :: forall ctx.
SelectionContext ctx =>
FailureToVerifySelectionOutputCoinsSufficient ctx -> String
showsPrec :: Int -> FailureToVerifySelectionOutputCoinsSufficient ctx -> ShowS
$cshowsPrec :: forall ctx.
SelectionContext ctx =>
Int -> FailureToVerifySelectionOutputCoinsSufficient ctx -> ShowS
Show)

data SelectionOutputCoinInsufficientError ctx =
    SelectionOutputCoinInsufficientError
        { SelectionOutputCoinInsufficientError ctx -> Coin
minimumExpectedCoin :: Coin
        , SelectionOutputCoinInsufficientError ctx
-> (Address ctx, TokenBundle)
output :: (Address ctx, TokenBundle)
        }
    deriving (forall x.
 SelectionOutputCoinInsufficientError ctx
 -> Rep (SelectionOutputCoinInsufficientError ctx) x)
-> (forall x.
    Rep (SelectionOutputCoinInsufficientError ctx) x
    -> SelectionOutputCoinInsufficientError ctx)
-> Generic (SelectionOutputCoinInsufficientError ctx)
forall x.
Rep (SelectionOutputCoinInsufficientError ctx) x
-> SelectionOutputCoinInsufficientError ctx
forall x.
SelectionOutputCoinInsufficientError ctx
-> Rep (SelectionOutputCoinInsufficientError ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionOutputCoinInsufficientError ctx) x
-> SelectionOutputCoinInsufficientError ctx
forall ctx x.
SelectionOutputCoinInsufficientError ctx
-> Rep (SelectionOutputCoinInsufficientError ctx) x
$cto :: forall ctx x.
Rep (SelectionOutputCoinInsufficientError ctx) x
-> SelectionOutputCoinInsufficientError ctx
$cfrom :: forall ctx x.
SelectionOutputCoinInsufficientError ctx
-> Rep (SelectionOutputCoinInsufficientError ctx) x
Generic

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

verifySelectionOutputCoinsSufficient
    :: forall ctx. SelectionContext ctx => VerifySelection ctx
verifySelectionOutputCoinsSufficient :: VerifySelection ctx
verifySelectionOutputCoinsSufficient SelectionConstraints ctx
cs SelectionParams ctx
_ps Selection ctx
selection =
    [SelectionOutputCoinInsufficientError ctx]
-> (NonEmpty (SelectionOutputCoinInsufficientError ctx)
    -> FailureToVerifySelectionOutputCoinsSufficient ctx)
-> VerificationResult
forall failureReason a.
Show failureReason =>
[a] -> (NonEmpty a -> failureReason) -> VerificationResult
verifyEmpty [SelectionOutputCoinInsufficientError ctx]
errors NonEmpty (SelectionOutputCoinInsufficientError ctx)
-> FailureToVerifySelectionOutputCoinsSufficient ctx
forall ctx.
NonEmpty (SelectionOutputCoinInsufficientError ctx)
-> FailureToVerifySelectionOutputCoinsSufficient ctx
FailureToVerifySelectionOutputCoinsSufficient
  where
    errors :: [SelectionOutputCoinInsufficientError ctx]
    errors :: [SelectionOutputCoinInsufficientError ctx]
errors = ((Address ctx, TokenBundle)
 -> Maybe (SelectionOutputCoinInsufficientError ctx))
-> [(Address ctx, TokenBundle)]
-> [SelectionOutputCoinInsufficientError ctx]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Address ctx, TokenBundle)
-> Maybe (SelectionOutputCoinInsufficientError ctx)
maybeError (SelectionConstraints ctx
-> Selection ctx -> [(Address ctx, TokenBundle)]
forall ctx.
SelectionConstraints ctx
-> Selection ctx -> [(Address ctx, TokenBundle)]
selectionAllOutputs SelectionConstraints ctx
cs Selection ctx
selection)

    maybeError
        :: (Address ctx, TokenBundle)
        -> Maybe (SelectionOutputCoinInsufficientError ctx)
    maybeError :: (Address ctx, TokenBundle)
-> Maybe (SelectionOutputCoinInsufficientError ctx)
maybeError (Address ctx, TokenBundle)
output
        | (Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
output TokenBundle
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
minimumExpectedCoin =
            SelectionOutputCoinInsufficientError ctx
-> Maybe (SelectionOutputCoinInsufficientError ctx)
forall a. a -> Maybe a
Just SelectionOutputCoinInsufficientError :: forall ctx.
Coin
-> (Address ctx, TokenBundle)
-> SelectionOutputCoinInsufficientError ctx
SelectionOutputCoinInsufficientError
                {Coin
minimumExpectedCoin :: Coin
$sel:minimumExpectedCoin:SelectionOutputCoinInsufficientError :: Coin
minimumExpectedCoin, (Address ctx, TokenBundle)
output :: (Address ctx, TokenBundle)
$sel:output:SelectionOutputCoinInsufficientError :: (Address ctx, TokenBundle)
output}
        | Bool
otherwise =
            Maybe (SelectionOutputCoinInsufficientError ctx)
forall a. Maybe a
Nothing
      where
        minimumExpectedCoin :: Coin
        minimumExpectedCoin :: Coin
minimumExpectedCoin =
            (SelectionConstraints ctx
cs SelectionConstraints ctx
-> (((Address ctx -> TokenMap -> Coin)
     -> Const
          (Address ctx -> TokenMap -> Coin)
          (Address ctx -> TokenMap -> Coin))
    -> SelectionConstraints ctx
    -> Const
         (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
-> Address ctx
-> TokenMap
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "computeMinimumAdaQuantity"
  (((Address ctx -> TokenMap -> Coin)
    -> Const
         (Address ctx -> TokenMap -> Coin)
         (Address ctx -> TokenMap -> Coin))
   -> SelectionConstraints ctx
   -> Const
        (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
((Address ctx -> TokenMap -> Coin)
 -> Const
      (Address ctx -> TokenMap -> Coin)
      (Address ctx -> TokenMap -> Coin))
-> SelectionConstraints ctx
-> Const
     (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx)
#computeMinimumAdaQuantity)
            ((Address ctx, TokenBundle) -> Address ctx
forall a b. (a, b) -> a
fst (Address ctx, TokenBundle)
output)
            ((Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
output TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)

--------------------------------------------------------------------------------
-- Selection verification: output sizes
--------------------------------------------------------------------------------

newtype FailureToVerifySelectionOutputSizesWithinLimit address =
    FailureToVerifySelectionOutputSizesWithinLimit
    (NonEmpty (SelectionOutputSizeExceedsLimitError address))
    deriving (FailureToVerifySelectionOutputSizesWithinLimit address
-> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool
(FailureToVerifySelectionOutputSizesWithinLimit address
 -> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool)
-> (FailureToVerifySelectionOutputSizesWithinLimit address
    -> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool)
-> Eq (FailureToVerifySelectionOutputSizesWithinLimit address)
forall address.
SelectionContext address =>
FailureToVerifySelectionOutputSizesWithinLimit address
-> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionOutputSizesWithinLimit address
-> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool
$c/= :: forall address.
SelectionContext address =>
FailureToVerifySelectionOutputSizesWithinLimit address
-> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool
== :: FailureToVerifySelectionOutputSizesWithinLimit address
-> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool
$c== :: forall address.
SelectionContext address =>
FailureToVerifySelectionOutputSizesWithinLimit address
-> FailureToVerifySelectionOutputSizesWithinLimit address -> Bool
Eq, Int
-> FailureToVerifySelectionOutputSizesWithinLimit address -> ShowS
[FailureToVerifySelectionOutputSizesWithinLimit address] -> ShowS
FailureToVerifySelectionOutputSizesWithinLimit address -> String
(Int
 -> FailureToVerifySelectionOutputSizesWithinLimit address -> ShowS)
-> (FailureToVerifySelectionOutputSizesWithinLimit address
    -> String)
-> ([FailureToVerifySelectionOutputSizesWithinLimit address]
    -> ShowS)
-> Show (FailureToVerifySelectionOutputSizesWithinLimit address)
forall address.
SelectionContext address =>
Int
-> FailureToVerifySelectionOutputSizesWithinLimit address -> ShowS
forall address.
SelectionContext address =>
[FailureToVerifySelectionOutputSizesWithinLimit address] -> ShowS
forall address.
SelectionContext address =>
FailureToVerifySelectionOutputSizesWithinLimit address -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionOutputSizesWithinLimit address] -> ShowS
$cshowList :: forall address.
SelectionContext address =>
[FailureToVerifySelectionOutputSizesWithinLimit address] -> ShowS
show :: FailureToVerifySelectionOutputSizesWithinLimit address -> String
$cshow :: forall address.
SelectionContext address =>
FailureToVerifySelectionOutputSizesWithinLimit address -> String
showsPrec :: Int
-> FailureToVerifySelectionOutputSizesWithinLimit address -> ShowS
$cshowsPrec :: forall address.
SelectionContext address =>
Int
-> FailureToVerifySelectionOutputSizesWithinLimit address -> ShowS
Show)

verifySelectionOutputSizesWithinLimit
    :: forall ctx. (SelectionContext ctx) => VerifySelection ctx
verifySelectionOutputSizesWithinLimit :: VerifySelection ctx
verifySelectionOutputSizesWithinLimit SelectionConstraints ctx
cs SelectionParams ctx
_ps Selection ctx
selection =
    [SelectionOutputSizeExceedsLimitError ctx]
-> (NonEmpty (SelectionOutputSizeExceedsLimitError ctx)
    -> FailureToVerifySelectionOutputSizesWithinLimit ctx)
-> VerificationResult
forall failureReason a.
Show failureReason =>
[a] -> (NonEmpty a -> failureReason) -> VerificationResult
verifyEmpty [SelectionOutputSizeExceedsLimitError ctx]
errors NonEmpty (SelectionOutputSizeExceedsLimitError ctx)
-> FailureToVerifySelectionOutputSizesWithinLimit ctx
forall address.
NonEmpty (SelectionOutputSizeExceedsLimitError address)
-> FailureToVerifySelectionOutputSizesWithinLimit address
FailureToVerifySelectionOutputSizesWithinLimit
  where
    errors :: [SelectionOutputSizeExceedsLimitError ctx]
    errors :: [SelectionOutputSizeExceedsLimitError ctx]
errors = ((Address ctx, TokenBundle)
 -> Maybe (SelectionOutputSizeExceedsLimitError ctx))
-> [(Address ctx, TokenBundle)]
-> [SelectionOutputSizeExceedsLimitError ctx]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputSizeExceedsLimitError ctx)
forall ctx.
SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputSizeExceedsLimitError ctx)
verifyOutputSize SelectionConstraints ctx
cs) (SelectionConstraints ctx
-> Selection ctx -> [(Address ctx, TokenBundle)]
forall ctx.
SelectionConstraints ctx
-> Selection ctx -> [(Address ctx, TokenBundle)]
selectionAllOutputs SelectionConstraints ctx
cs Selection ctx
selection)

--------------------------------------------------------------------------------
-- Selection verification: output token quantities
--------------------------------------------------------------------------------

newtype FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address =
    FailureToVerifySelectionOutputTokenQuantitiesWithinLimit
    (NonEmpty (SelectionOutputTokenQuantityExceedsLimitError address))
    deriving (FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> Bool
(FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
 -> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
 -> Bool)
-> (FailureToVerifySelectionOutputTokenQuantitiesWithinLimit
      address
    -> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
    -> Bool)
-> Eq
     (FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address)
forall address.
SelectionContext address =>
FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> Bool
$c/= :: forall address.
SelectionContext address =>
FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> Bool
== :: FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> Bool
$c== :: forall address.
SelectionContext address =>
FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> Bool
Eq, Int
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> ShowS
[FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address]
-> ShowS
FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> String
(Int
 -> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
 -> ShowS)
-> (FailureToVerifySelectionOutputTokenQuantitiesWithinLimit
      address
    -> String)
-> ([FailureToVerifySelectionOutputTokenQuantitiesWithinLimit
       address]
    -> ShowS)
-> Show
     (FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address)
forall address.
SelectionContext address =>
Int
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> ShowS
forall address.
SelectionContext address =>
[FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address]
-> ShowS
forall address.
SelectionContext address =>
FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address]
-> ShowS
$cshowList :: forall address.
SelectionContext address =>
[FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address]
-> ShowS
show :: FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> String
$cshow :: forall address.
SelectionContext address =>
FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> String
showsPrec :: Int
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> ShowS
$cshowsPrec :: forall address.
SelectionContext address =>
Int
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
-> ShowS
Show)

verifySelectionOutputTokenQuantitiesWithinLimit
    :: forall ctx. SelectionContext ctx => VerifySelection ctx
verifySelectionOutputTokenQuantitiesWithinLimit :: VerifySelection ctx
verifySelectionOutputTokenQuantitiesWithinLimit SelectionConstraints ctx
cs SelectionParams ctx
_ps Selection ctx
selection =
    [SelectionOutputTokenQuantityExceedsLimitError ctx]
-> (NonEmpty (SelectionOutputTokenQuantityExceedsLimitError ctx)
    -> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit ctx)
-> VerificationResult
forall failureReason a.
Show failureReason =>
[a] -> (NonEmpty a -> failureReason) -> VerificationResult
verifyEmpty [SelectionOutputTokenQuantityExceedsLimitError ctx]
errors NonEmpty (SelectionOutputTokenQuantityExceedsLimitError ctx)
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit ctx
forall address.
NonEmpty (SelectionOutputTokenQuantityExceedsLimitError address)
-> FailureToVerifySelectionOutputTokenQuantitiesWithinLimit address
FailureToVerifySelectionOutputTokenQuantitiesWithinLimit
  where
    errors :: [SelectionOutputTokenQuantityExceedsLimitError ctx]
    errors :: [SelectionOutputTokenQuantityExceedsLimitError ctx]
errors = (Address ctx, TokenBundle)
-> [SelectionOutputTokenQuantityExceedsLimitError ctx]
forall ctx.
(Address ctx, TokenBundle)
-> [SelectionOutputTokenQuantityExceedsLimitError ctx]
verifyOutputTokenQuantities ((Address ctx, TokenBundle)
 -> [SelectionOutputTokenQuantityExceedsLimitError ctx])
-> [(Address ctx, TokenBundle)]
-> [SelectionOutputTokenQuantityExceedsLimitError ctx]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SelectionConstraints ctx
-> Selection ctx -> [(Address ctx, TokenBundle)]
forall ctx.
SelectionConstraints ctx
-> Selection ctx -> [(Address ctx, TokenBundle)]
selectionAllOutputs SelectionConstraints ctx
cs Selection ctx
selection

--------------------------------------------------------------------------------
-- Selection error verification
--------------------------------------------------------------------------------

-- | The type of all 'SelectionError' verification functions.
--
type VerifySelectionError e ctx =
    SelectionConstraints ctx -> SelectionParams ctx -> e -> VerificationResult

-- | Verifies a 'SelectionError' for correctness.
--
-- This function is provided primarily as a convenience for testing. As such,
-- it's not usually necessary to call this function from ordinary application
-- code, unless you suspect that a 'SelectionError' is incorrect in some way.
--
verifySelectionError
    :: SelectionContext ctx => VerifySelectionError (SelectionError ctx) ctx
verifySelectionError :: VerifySelectionError (SelectionError ctx) ctx
verifySelectionError SelectionConstraints ctx
cs SelectionParams ctx
ps = \case
    SelectionBalanceErrorOf SelectionBalanceError ctx
e ->
        VerifySelectionError (SelectionBalanceError ctx) ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError (SelectionBalanceError ctx) ctx
verifySelectionBalanceError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionBalanceError ctx
e
    SelectionCollateralErrorOf SelectionCollateralError ctx
e ->
        VerifySelectionError (SelectionCollateralError ctx) ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError (SelectionCollateralError ctx) ctx
verifySelectionCollateralError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionCollateralError ctx
e
    SelectionOutputErrorOf SelectionOutputError ctx
e ->
        VerifySelectionError (SelectionOutputError ctx) ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError (SelectionOutputError ctx) ctx
verifySelectionOutputError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionOutputError ctx
e

--------------------------------------------------------------------------------
-- Selection error verification: balance errors
--------------------------------------------------------------------------------

verifySelectionBalanceError
    :: SelectionContext ctx
    => VerifySelectionError (SelectionBalanceError ctx) ctx
verifySelectionBalanceError :: VerifySelectionError (SelectionBalanceError ctx) ctx
verifySelectionBalanceError SelectionConstraints ctx
cs SelectionParams ctx
ps = \case
    Balance.BalanceInsufficient BalanceInsufficientError
e ->
        VerifySelectionError BalanceInsufficientError ctx
forall ctx. VerifySelectionError BalanceInsufficientError ctx
verifyBalanceInsufficientError SelectionConstraints ctx
cs SelectionParams ctx
ps BalanceInsufficientError
e
    SelectionBalanceError ctx
Balance.EmptyUTxO ->
        VerifySelectionError () ctx
forall ctx. SelectionContext ctx => VerifySelectionError () ctx
verifyEmptyUTxOError SelectionConstraints ctx
cs SelectionParams ctx
ps ()
    Balance.UnableToConstructChange UnableToConstructChangeError
e->
        VerifySelectionError UnableToConstructChangeError ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError UnableToConstructChangeError ctx
verifyUnableToConstructChangeError SelectionConstraints ctx
cs SelectionParams ctx
ps UnableToConstructChangeError
e
    Balance.SelectionLimitReached SelectionLimitReachedError ctx
e ->
        VerifySelectionError (SelectionLimitReachedError ctx) ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError (SelectionLimitReachedError ctx) ctx
verifySelectionLimitReachedError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionLimitReachedError ctx
e

--------------------------------------------------------------------------------
-- Selection error verification: balance insufficient errors
--------------------------------------------------------------------------------

data FailureToVerifyBalanceInsufficientError =
    FailureToVerifyBalanceInsufficientError
    { FailureToVerifyBalanceInsufficientError -> TokenBundle
utxoBalanceAvailable :: TokenBundle
    , FailureToVerifyBalanceInsufficientError -> TokenBundle
utxoBalanceRequired :: TokenBundle
    }
    deriving (FailureToVerifyBalanceInsufficientError
-> FailureToVerifyBalanceInsufficientError -> Bool
(FailureToVerifyBalanceInsufficientError
 -> FailureToVerifyBalanceInsufficientError -> Bool)
-> (FailureToVerifyBalanceInsufficientError
    -> FailureToVerifyBalanceInsufficientError -> Bool)
-> Eq FailureToVerifyBalanceInsufficientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifyBalanceInsufficientError
-> FailureToVerifyBalanceInsufficientError -> Bool
$c/= :: FailureToVerifyBalanceInsufficientError
-> FailureToVerifyBalanceInsufficientError -> Bool
== :: FailureToVerifyBalanceInsufficientError
-> FailureToVerifyBalanceInsufficientError -> Bool
$c== :: FailureToVerifyBalanceInsufficientError
-> FailureToVerifyBalanceInsufficientError -> Bool
Eq, Int -> FailureToVerifyBalanceInsufficientError -> ShowS
[FailureToVerifyBalanceInsufficientError] -> ShowS
FailureToVerifyBalanceInsufficientError -> String
(Int -> FailureToVerifyBalanceInsufficientError -> ShowS)
-> (FailureToVerifyBalanceInsufficientError -> String)
-> ([FailureToVerifyBalanceInsufficientError] -> ShowS)
-> Show FailureToVerifyBalanceInsufficientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifyBalanceInsufficientError] -> ShowS
$cshowList :: [FailureToVerifyBalanceInsufficientError] -> ShowS
show :: FailureToVerifyBalanceInsufficientError -> String
$cshow :: FailureToVerifyBalanceInsufficientError -> String
showsPrec :: Int -> FailureToVerifyBalanceInsufficientError -> ShowS
$cshowsPrec :: Int -> FailureToVerifyBalanceInsufficientError -> ShowS
Show)

verifyBalanceInsufficientError
    :: VerifySelectionError Balance.BalanceInsufficientError ctx
verifyBalanceInsufficientError :: VerifySelectionError BalanceInsufficientError ctx
verifyBalanceInsufficientError SelectionConstraints ctx
cs SelectionParams ctx
ps BalanceInsufficientError
e =
    [Bool]
-> FailureToVerifyBalanceInsufficientError -> VerificationResult
forall (f :: * -> *) failureReason.
(Foldable f, Show failureReason) =>
f Bool -> failureReason -> VerificationResult
verifyAll
        [ Bool -> Bool
not (TokenBundle
utxoBalanceRequired TokenBundle -> TokenBundle -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenBundle
utxoBalanceAvailable)
        , Bool -> Bool
not (SelectionParamsOf [] ctx -> Bool
forall (f :: * -> *) ctx.
Foldable f =>
SelectionParamsOf f ctx -> Bool
Balance.isUTxOBalanceSufficient SelectionParamsOf [] ctx
balanceParams)
        ]
        FailureToVerifyBalanceInsufficientError :: TokenBundle
-> TokenBundle -> FailureToVerifyBalanceInsufficientError
FailureToVerifyBalanceInsufficientError {TokenBundle
utxoBalanceAvailable :: TokenBundle
utxoBalanceRequired :: TokenBundle
$sel:utxoBalanceRequired:FailureToVerifyBalanceInsufficientError :: TokenBundle
$sel:utxoBalanceAvailable:FailureToVerifyBalanceInsufficientError :: TokenBundle
..}
  where
    balanceParams :: SelectionParamsOf [] ctx
balanceParams = (SelectionConstraints ctx, SelectionParamsOf [] ctx)
-> SelectionParamsOf [] ctx
forall a b. (a, b) -> b
snd ((SelectionConstraints ctx, SelectionParamsOf [] ctx)
 -> SelectionParamsOf [] ctx)
-> (SelectionConstraints ctx, SelectionParamsOf [] ctx)
-> SelectionParamsOf [] ctx
forall a b. (a -> b) -> a -> b
$ (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParamsOf [] ctx)
forall ctx.
(SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
toBalanceConstraintsParams (SelectionConstraints ctx
cs, SelectionParams ctx
ps)
    utxoBalanceAvailable :: TokenBundle
utxoBalanceAvailable = BalanceInsufficientError
e BalanceInsufficientError
-> ((TokenBundle -> Const TokenBundle TokenBundle)
    -> BalanceInsufficientError
    -> Const TokenBundle BalanceInsufficientError)
-> TokenBundle
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "utxoBalanceAvailable"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> BalanceInsufficientError
   -> Const TokenBundle BalanceInsufficientError)
(TokenBundle -> Const TokenBundle TokenBundle)
-> BalanceInsufficientError
-> Const TokenBundle BalanceInsufficientError
#utxoBalanceAvailable
    utxoBalanceRequired :: TokenBundle
utxoBalanceRequired = BalanceInsufficientError
e BalanceInsufficientError
-> ((TokenBundle -> Const TokenBundle TokenBundle)
    -> BalanceInsufficientError
    -> Const TokenBundle BalanceInsufficientError)
-> TokenBundle
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "utxoBalanceRequired"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> BalanceInsufficientError
   -> Const TokenBundle BalanceInsufficientError)
(TokenBundle -> Const TokenBundle TokenBundle)
-> BalanceInsufficientError
-> Const TokenBundle BalanceInsufficientError
#utxoBalanceRequired

--------------------------------------------------------------------------------
-- Selection error verification: empty UTxO errors
--------------------------------------------------------------------------------

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

verifyEmptyUTxOError :: SelectionContext ctx => VerifySelectionError () ctx
verifyEmptyUTxOError :: VerifySelectionError () ctx
verifyEmptyUTxOError SelectionConstraints ctx
_cs SelectionParams {UTxOSelection (UTxO ctx)
utxoAvailableForInputs :: UTxOSelection (UTxO ctx)
$sel:utxoAvailableForInputs:SelectionParams :: forall ctx. SelectionParams ctx -> UTxOSelection (UTxO ctx)
utxoAvailableForInputs} ()
_e =
    Bool
-> FailureToVerifyEmptyUTxOError (UTxO ctx) -> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        (UTxOSelection (UTxO ctx)
utxoAvailableForInputs UTxOSelection (UTxO ctx) -> UTxOSelection (UTxO ctx) -> Bool
forall a. Eq a => a -> a -> Bool
== UTxOSelection (UTxO ctx)
forall u. UTxOSelection u
UTxOSelection.empty)
        (FailureToVerifyEmptyUTxOError :: forall u. UTxOSelection u -> FailureToVerifyEmptyUTxOError u
FailureToVerifyEmptyUTxOError {UTxOSelection (UTxO ctx)
utxoAvailableForInputs :: UTxOSelection (UTxO ctx)
$sel:utxoAvailableForInputs:FailureToVerifyEmptyUTxOError :: UTxOSelection (UTxO ctx)
utxoAvailableForInputs})

--------------------------------------------------------------------------------
-- Selection error verification: insufficient minimum ada quantity errors
--------------------------------------------------------------------------------

data FailureToVerifySelectionOutputCoinInsufficientError address =
    FailureToVerifySelectionOutputCoinInsufficientError
    { FailureToVerifySelectionOutputCoinInsufficientError address
-> (address, TokenBundle)
reportedOutput :: (address, TokenBundle)
    , FailureToVerifySelectionOutputCoinInsufficientError address -> Coin
reportedMinCoinValue :: Coin
    , FailureToVerifySelectionOutputCoinInsufficientError address -> Coin
verifiedMinCoinValue :: Coin
    }
    deriving (FailureToVerifySelectionOutputCoinInsufficientError address
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> Bool
(FailureToVerifySelectionOutputCoinInsufficientError address
 -> FailureToVerifySelectionOutputCoinInsufficientError address
 -> Bool)
-> (FailureToVerifySelectionOutputCoinInsufficientError address
    -> FailureToVerifySelectionOutputCoinInsufficientError address
    -> Bool)
-> Eq (FailureToVerifySelectionOutputCoinInsufficientError address)
forall address.
Eq address =>
FailureToVerifySelectionOutputCoinInsufficientError address
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionOutputCoinInsufficientError address
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> Bool
$c/= :: forall address.
Eq address =>
FailureToVerifySelectionOutputCoinInsufficientError address
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> Bool
== :: FailureToVerifySelectionOutputCoinInsufficientError address
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> Bool
$c== :: forall address.
Eq address =>
FailureToVerifySelectionOutputCoinInsufficientError address
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> Bool
Eq, Int
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> ShowS
[FailureToVerifySelectionOutputCoinInsufficientError address]
-> ShowS
FailureToVerifySelectionOutputCoinInsufficientError address
-> String
(Int
 -> FailureToVerifySelectionOutputCoinInsufficientError address
 -> ShowS)
-> (FailureToVerifySelectionOutputCoinInsufficientError address
    -> String)
-> ([FailureToVerifySelectionOutputCoinInsufficientError address]
    -> ShowS)
-> Show
     (FailureToVerifySelectionOutputCoinInsufficientError address)
forall address.
Show address =>
Int
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> ShowS
forall address.
Show address =>
[FailureToVerifySelectionOutputCoinInsufficientError address]
-> ShowS
forall address.
Show address =>
FailureToVerifySelectionOutputCoinInsufficientError address
-> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionOutputCoinInsufficientError address]
-> ShowS
$cshowList :: forall address.
Show address =>
[FailureToVerifySelectionOutputCoinInsufficientError address]
-> ShowS
show :: FailureToVerifySelectionOutputCoinInsufficientError address
-> String
$cshow :: forall address.
Show address =>
FailureToVerifySelectionOutputCoinInsufficientError address
-> String
showsPrec :: Int
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> ShowS
$cshowsPrec :: forall address.
Show address =>
Int
-> FailureToVerifySelectionOutputCoinInsufficientError address
-> ShowS
Show)

verifySelectionOutputCoinInsufficientError
    :: SelectionContext ctx
    => VerifySelectionError (SelectionOutputCoinInsufficientError ctx) ctx
verifySelectionOutputCoinInsufficientError :: VerifySelectionError (SelectionOutputCoinInsufficientError ctx) ctx
verifySelectionOutputCoinInsufficientError SelectionConstraints ctx
cs SelectionParams ctx
_ps SelectionOutputCoinInsufficientError ctx
e =
    [Bool]
-> FailureToVerifySelectionOutputCoinInsufficientError
     (Address ctx)
-> VerificationResult
forall (f :: * -> *) failureReason.
(Foldable f, Show failureReason) =>
f Bool -> failureReason -> VerificationResult
verifyAll
        [ Bool
isBelowMinimum
        , Coin
reportedMinCoinValue Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
verifiedMinCoinValue
        , Coin
reportedMinCoinValue Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
> (Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
reportedOutput TokenBundle
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin
        ]
        FailureToVerifySelectionOutputCoinInsufficientError :: forall address.
(address, TokenBundle)
-> Coin
-> Coin
-> FailureToVerifySelectionOutputCoinInsufficientError address
FailureToVerifySelectionOutputCoinInsufficientError {(Address ctx, TokenBundle)
Coin
reportedOutput :: (Address ctx, TokenBundle)
verifiedMinCoinValue :: Coin
reportedMinCoinValue :: Coin
$sel:verifiedMinCoinValue:FailureToVerifySelectionOutputCoinInsufficientError :: Coin
$sel:reportedMinCoinValue:FailureToVerifySelectionOutputCoinInsufficientError :: Coin
$sel:reportedOutput:FailureToVerifySelectionOutputCoinInsufficientError :: (Address ctx, TokenBundle)
..}
  where
    isBelowMinimum :: Bool
    isBelowMinimum :: Bool
isBelowMinimum = (Address ctx -> TokenBundle -> Bool)
-> (Address ctx, TokenBundle) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SelectionConstraints ctx
cs SelectionConstraints ctx
-> (((Address ctx -> TokenBundle -> Bool)
     -> Const
          (Address ctx -> TokenBundle -> Bool)
          (Address ctx -> TokenBundle -> Bool))
    -> SelectionConstraints ctx
    -> Const
         (Address ctx -> TokenBundle -> Bool) (SelectionConstraints ctx))
-> Address ctx
-> TokenBundle
-> Bool
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "isBelowMinimumAdaQuantity"
  (((Address ctx -> TokenBundle -> Bool)
    -> Const
         (Address ctx -> TokenBundle -> Bool)
         (Address ctx -> TokenBundle -> Bool))
   -> SelectionConstraints ctx
   -> Const
        (Address ctx -> TokenBundle -> Bool) (SelectionConstraints ctx))
((Address ctx -> TokenBundle -> Bool)
 -> Const
      (Address ctx -> TokenBundle -> Bool)
      (Address ctx -> TokenBundle -> Bool))
-> SelectionConstraints ctx
-> Const
     (Address ctx -> TokenBundle -> Bool) (SelectionConstraints ctx)
#isBelowMinimumAdaQuantity) (Address ctx, TokenBundle)
reportedOutput

    reportedOutput :: (Address ctx, TokenBundle)
reportedOutput = SelectionOutputCoinInsufficientError ctx
e SelectionOutputCoinInsufficientError ctx
-> (((Address ctx, TokenBundle)
     -> Const (Address ctx, TokenBundle) (Address ctx, TokenBundle))
    -> SelectionOutputCoinInsufficientError ctx
    -> Const
         (Address ctx, TokenBundle)
         (SelectionOutputCoinInsufficientError ctx))
-> (Address ctx, TokenBundle)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "output"
  (((Address ctx, TokenBundle)
    -> Const (Address ctx, TokenBundle) (Address ctx, TokenBundle))
   -> SelectionOutputCoinInsufficientError ctx
   -> Const
        (Address ctx, TokenBundle)
        (SelectionOutputCoinInsufficientError ctx))
((Address ctx, TokenBundle)
 -> Const (Address ctx, TokenBundle) (Address ctx, TokenBundle))
-> SelectionOutputCoinInsufficientError ctx
-> Const
     (Address ctx, TokenBundle)
     (SelectionOutputCoinInsufficientError ctx)
#output
    reportedMinCoinValue :: Coin
reportedMinCoinValue = SelectionOutputCoinInsufficientError ctx
e SelectionOutputCoinInsufficientError ctx
-> ((Coin -> Const Coin Coin)
    -> SelectionOutputCoinInsufficientError ctx
    -> Const Coin (SelectionOutputCoinInsufficientError ctx))
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "minimumExpectedCoin"
  ((Coin -> Const Coin Coin)
   -> SelectionOutputCoinInsufficientError ctx
   -> Const Coin (SelectionOutputCoinInsufficientError ctx))
(Coin -> Const Coin Coin)
-> SelectionOutputCoinInsufficientError ctx
-> Const Coin (SelectionOutputCoinInsufficientError ctx)
#minimumExpectedCoin
    verifiedMinCoinValue :: Coin
verifiedMinCoinValue =
        (SelectionConstraints ctx
cs SelectionConstraints ctx
-> (((Address ctx -> TokenMap -> Coin)
     -> Const
          (Address ctx -> TokenMap -> Coin)
          (Address ctx -> TokenMap -> Coin))
    -> SelectionConstraints ctx
    -> Const
         (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
-> Address ctx
-> TokenMap
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "computeMinimumAdaQuantity"
  (((Address ctx -> TokenMap -> Coin)
    -> Const
         (Address ctx -> TokenMap -> Coin)
         (Address ctx -> TokenMap -> Coin))
   -> SelectionConstraints ctx
   -> Const
        (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
((Address ctx -> TokenMap -> Coin)
 -> Const
      (Address ctx -> TokenMap -> Coin)
      (Address ctx -> TokenMap -> Coin))
-> SelectionConstraints ctx
-> Const
     (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx)
#computeMinimumAdaQuantity)
        ((Address ctx, TokenBundle) -> Address ctx
forall a b. (a, b) -> a
fst (Address ctx, TokenBundle)
reportedOutput)
        ((Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
reportedOutput TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)

--------------------------------------------------------------------------------
-- Selection error verification: selection limit errors
--------------------------------------------------------------------------------

data FailureToVerifySelectionLimitReachedError u =
    FailureToVerifySelectionLimitReachedError
        { FailureToVerifySelectionLimitReachedError u -> [(u, TokenBundle)]
selectedInputs
            :: [(u, TokenBundle)]
            -- ^ The inputs that were actually selected.
        , FailureToVerifySelectionLimitReachedError u -> Int
selectedInputCount
            :: Int
            -- ^ The number of inputs that were actually selected.
        , FailureToVerifySelectionLimitReachedError u -> SelectionLimit
selectionLimitOriginal
            :: SelectionLimit
            -- ^ The selection limit before accounting for collateral inputs.
        , FailureToVerifySelectionLimitReachedError u -> SelectionLimit
selectionLimitAdjusted
            :: SelectionLimit
            -- ^ The selection limit after accounting for collateral inputs.
        }
    deriving (FailureToVerifySelectionLimitReachedError u
-> FailureToVerifySelectionLimitReachedError u -> Bool
(FailureToVerifySelectionLimitReachedError u
 -> FailureToVerifySelectionLimitReachedError u -> Bool)
-> (FailureToVerifySelectionLimitReachedError u
    -> FailureToVerifySelectionLimitReachedError u -> Bool)
-> Eq (FailureToVerifySelectionLimitReachedError u)
forall u.
Eq u =>
FailureToVerifySelectionLimitReachedError u
-> FailureToVerifySelectionLimitReachedError u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionLimitReachedError u
-> FailureToVerifySelectionLimitReachedError u -> Bool
$c/= :: forall u.
Eq u =>
FailureToVerifySelectionLimitReachedError u
-> FailureToVerifySelectionLimitReachedError u -> Bool
== :: FailureToVerifySelectionLimitReachedError u
-> FailureToVerifySelectionLimitReachedError u -> Bool
$c== :: forall u.
Eq u =>
FailureToVerifySelectionLimitReachedError u
-> FailureToVerifySelectionLimitReachedError u -> Bool
Eq, Int -> FailureToVerifySelectionLimitReachedError u -> ShowS
[FailureToVerifySelectionLimitReachedError u] -> ShowS
FailureToVerifySelectionLimitReachedError u -> String
(Int -> FailureToVerifySelectionLimitReachedError u -> ShowS)
-> (FailureToVerifySelectionLimitReachedError u -> String)
-> ([FailureToVerifySelectionLimitReachedError u] -> ShowS)
-> Show (FailureToVerifySelectionLimitReachedError u)
forall u.
Show u =>
Int -> FailureToVerifySelectionLimitReachedError u -> ShowS
forall u.
Show u =>
[FailureToVerifySelectionLimitReachedError u] -> ShowS
forall u.
Show u =>
FailureToVerifySelectionLimitReachedError u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionLimitReachedError u] -> ShowS
$cshowList :: forall u.
Show u =>
[FailureToVerifySelectionLimitReachedError u] -> ShowS
show :: FailureToVerifySelectionLimitReachedError u -> String
$cshow :: forall u.
Show u =>
FailureToVerifySelectionLimitReachedError u -> String
showsPrec :: Int -> FailureToVerifySelectionLimitReachedError u -> ShowS
$cshowsPrec :: forall u.
Show u =>
Int -> FailureToVerifySelectionLimitReachedError u -> ShowS
Show)

-- | Verifies a 'Balance.SelectionLimitReachedError'.
--
-- This function verifies that the number of the selected inputs is correct
-- given the amount of space we expect to be reserved for collateral inputs.
--
verifySelectionLimitReachedError
    :: forall ctx. SelectionContext ctx
    => VerifySelectionError (Balance.SelectionLimitReachedError ctx) ctx
verifySelectionLimitReachedError :: VerifySelectionError (SelectionLimitReachedError ctx) ctx
verifySelectionLimitReachedError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionLimitReachedError ctx
e =
    Bool
-> FailureToVerifySelectionLimitReachedError (UTxO ctx)
-> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        (Int -> SelectionLimit
forall a. a -> SelectionLimitOf a
Balance.MaximumInputLimit Int
selectedInputCount SelectionLimit -> SelectionLimit -> Bool
forall a. Ord a => a -> a -> Bool
>= SelectionLimit
selectionLimitAdjusted)
        (FailureToVerifySelectionLimitReachedError :: forall u.
[(u, TokenBundle)]
-> Int
-> SelectionLimit
-> SelectionLimit
-> FailureToVerifySelectionLimitReachedError u
FailureToVerifySelectionLimitReachedError {Int
[(UTxO ctx, TokenBundle)]
SelectionLimit
selectionLimitOriginal :: SelectionLimit
selectedInputs :: [(UTxO ctx, TokenBundle)]
selectionLimitAdjusted :: SelectionLimit
selectedInputCount :: Int
$sel:selectionLimitAdjusted:FailureToVerifySelectionLimitReachedError :: SelectionLimit
$sel:selectionLimitOriginal:FailureToVerifySelectionLimitReachedError :: SelectionLimit
$sel:selectedInputCount:FailureToVerifySelectionLimitReachedError :: Int
$sel:selectedInputs:FailureToVerifySelectionLimitReachedError :: [(UTxO ctx, TokenBundle)]
..})
  where
    selectedInputs :: [(UTxO ctx, TokenBundle)]
    selectedInputs :: [(UTxO ctx, TokenBundle)]
selectedInputs = SelectionLimitReachedError ctx
e SelectionLimitReachedError ctx
-> (([(UTxO ctx, TokenBundle)]
     -> Const [(UTxO ctx, TokenBundle)] [(UTxO ctx, TokenBundle)])
    -> SelectionLimitReachedError ctx
    -> Const
         [(UTxO ctx, TokenBundle)] (SelectionLimitReachedError ctx))
-> [(UTxO ctx, TokenBundle)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputsSelected"
  (([(UTxO ctx, TokenBundle)]
    -> Const [(UTxO ctx, TokenBundle)] [(UTxO ctx, TokenBundle)])
   -> SelectionLimitReachedError ctx
   -> Const
        [(UTxO ctx, TokenBundle)] (SelectionLimitReachedError ctx))
([(UTxO ctx, TokenBundle)]
 -> Const [(UTxO ctx, TokenBundle)] [(UTxO ctx, TokenBundle)])
-> SelectionLimitReachedError ctx
-> Const [(UTxO ctx, TokenBundle)] (SelectionLimitReachedError ctx)
#inputsSelected

    selectedInputCount :: Int
    selectedInputCount :: Int
selectedInputCount = [(UTxO ctx, TokenBundle)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length [(UTxO ctx, TokenBundle)]
selectedInputs

    selectionLimitAdjusted :: SelectionLimit
    selectionLimitAdjusted :: SelectionLimit
selectionLimitAdjusted = (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
forall ctx.
(SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
toBalanceConstraintsParams (SelectionConstraints ctx
cs, SelectionParams ctx
ps)
        (SelectionConstraints ctx, SelectionParams ctx)
-> ((SelectionConstraints ctx, SelectionParams ctx)
    -> SelectionConstraints ctx)
-> SelectionConstraints ctx
forall a b. a -> (a -> b) -> b
& (SelectionConstraints ctx, SelectionParams ctx)
-> SelectionConstraints ctx
forall a b. (a, b) -> a
fst
        SelectionConstraints ctx
-> (SelectionConstraints ctx
    -> [(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall a b. a -> (a -> b) -> b
& ((([(Address ctx, TokenBundle)] -> SelectionLimit)
  -> Const
       ([(Address ctx, TokenBundle)] -> SelectionLimit)
       ([(Address ctx, TokenBundle)] -> SelectionLimit))
 -> SelectionConstraints ctx
 -> Const
      ([(Address ctx, TokenBundle)] -> SelectionLimit)
      (SelectionConstraints ctx))
-> SelectionConstraints ctx
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "computeSelectionLimit"
  ((([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> Const
         ([(Address ctx, TokenBundle)] -> SelectionLimit)
         ([(Address ctx, TokenBundle)] -> SelectionLimit))
   -> SelectionConstraints ctx
   -> Const
        ([(Address ctx, TokenBundle)] -> SelectionLimit)
        (SelectionConstraints ctx))
(([(Address ctx, TokenBundle)] -> SelectionLimit)
 -> Const
      ([(Address ctx, TokenBundle)] -> SelectionLimit)
      ([(Address ctx, TokenBundle)] -> SelectionLimit))
-> SelectionConstraints ctx
-> Const
     ([(Address ctx, TokenBundle)] -> SelectionLimit)
     (SelectionConstraints ctx)
#computeSelectionLimit
        ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> (([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> SelectionLimit)
-> SelectionLimit
forall a b. a -> (a -> b) -> b
& (([(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)
 -> [(Address ctx, TokenBundle)])
-> NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
forall a b. (a -> b) -> a -> b
$ SelectionLimitReachedError ctx
e SelectionLimitReachedError ctx
-> ((NonEmpty (Address ctx, TokenBundle)
     -> Const
          (NonEmpty (Address ctx, TokenBundle))
          (NonEmpty (Address ctx, TokenBundle)))
    -> SelectionLimitReachedError ctx
    -> Const
         (NonEmpty (Address ctx, TokenBundle))
         (SelectionLimitReachedError ctx))
-> NonEmpty (Address ctx, TokenBundle)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputsToCover"
  ((NonEmpty (Address ctx, TokenBundle)
    -> Const
         (NonEmpty (Address ctx, TokenBundle))
         (NonEmpty (Address ctx, TokenBundle)))
   -> SelectionLimitReachedError ctx
   -> Const
        (NonEmpty (Address ctx, TokenBundle))
        (SelectionLimitReachedError ctx))
(NonEmpty (Address ctx, TokenBundle)
 -> Const
      (NonEmpty (Address ctx, TokenBundle))
      (NonEmpty (Address ctx, TokenBundle)))
-> SelectionLimitReachedError ctx
-> Const
     (NonEmpty (Address ctx, TokenBundle))
     (SelectionLimitReachedError ctx)
#outputsToCover)

    selectionLimitOriginal :: SelectionLimit
    selectionLimitOriginal :: SelectionLimit
selectionLimitOriginal = SelectionConstraints ctx
cs
        SelectionConstraints ctx
-> (SelectionConstraints ctx
    -> [(Address ctx, TokenBundle)] -> SelectionLimit)
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall a b. a -> (a -> b) -> b
& ((([(Address ctx, TokenBundle)] -> SelectionLimit)
  -> Const
       ([(Address ctx, TokenBundle)] -> SelectionLimit)
       ([(Address ctx, TokenBundle)] -> SelectionLimit))
 -> SelectionConstraints ctx
 -> Const
      ([(Address ctx, TokenBundle)] -> SelectionLimit)
      (SelectionConstraints ctx))
-> SelectionConstraints ctx
-> [(Address ctx, TokenBundle)]
-> SelectionLimit
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "computeSelectionLimit"
  ((([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> Const
         ([(Address ctx, TokenBundle)] -> SelectionLimit)
         ([(Address ctx, TokenBundle)] -> SelectionLimit))
   -> SelectionConstraints ctx
   -> Const
        ([(Address ctx, TokenBundle)] -> SelectionLimit)
        (SelectionConstraints ctx))
(([(Address ctx, TokenBundle)] -> SelectionLimit)
 -> Const
      ([(Address ctx, TokenBundle)] -> SelectionLimit)
      ([(Address ctx, TokenBundle)] -> SelectionLimit))
-> SelectionConstraints ctx
-> Const
     ([(Address ctx, TokenBundle)] -> SelectionLimit)
     (SelectionConstraints ctx)
#computeSelectionLimit
        ([(Address ctx, TokenBundle)] -> SelectionLimit)
-> (([(Address ctx, TokenBundle)] -> SelectionLimit)
    -> SelectionLimit)
-> SelectionLimit
forall a b. a -> (a -> b) -> b
& (([(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)
 -> [(Address ctx, TokenBundle)])
-> NonEmpty (Address ctx, TokenBundle)
-> [(Address ctx, TokenBundle)]
forall a b. (a -> b) -> a -> b
$ SelectionLimitReachedError ctx
e SelectionLimitReachedError ctx
-> ((NonEmpty (Address ctx, TokenBundle)
     -> Const
          (NonEmpty (Address ctx, TokenBundle))
          (NonEmpty (Address ctx, TokenBundle)))
    -> SelectionLimitReachedError ctx
    -> Const
         (NonEmpty (Address ctx, TokenBundle))
         (SelectionLimitReachedError ctx))
-> NonEmpty (Address ctx, TokenBundle)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputsToCover"
  ((NonEmpty (Address ctx, TokenBundle)
    -> Const
         (NonEmpty (Address ctx, TokenBundle))
         (NonEmpty (Address ctx, TokenBundle)))
   -> SelectionLimitReachedError ctx
   -> Const
        (NonEmpty (Address ctx, TokenBundle))
        (SelectionLimitReachedError ctx))
(NonEmpty (Address ctx, TokenBundle)
 -> Const
      (NonEmpty (Address ctx, TokenBundle))
      (NonEmpty (Address ctx, TokenBundle)))
-> SelectionLimitReachedError ctx
-> Const
     (NonEmpty (Address ctx, TokenBundle))
     (SelectionLimitReachedError ctx)
#outputsToCover)

--------------------------------------------------------------------------------
-- Selection error verification: change construction errors
--------------------------------------------------------------------------------

data FailureToVerifyUnableToConstructChangeError ctx =
    FailureToVerifyUnableToConstructChangeError
        { FailureToVerifyUnableToConstructChangeError ctx
-> UnableToConstructChangeError
errorOriginal
            :: Balance.UnableToConstructChangeError
            -- ^ The original error.
        , FailureToVerifyUnableToConstructChangeError ctx
-> SelectionError ctx
errorWithMinimalConstraints
            :: SelectionError ctx
            -- ^ An error encountered when attempting to re-run the selection
            -- process with minimal constraints.
        }

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

-- | Verifies a 'Balance.UnableToConstructChangeError'.
--
-- This function verifies that it's possible to successfully re-run the
-- selection process with exactly the same parameters /if/ we modify the
-- constraints to be minimal, where we have:
--
--   - a minimum cost function that always returns zero.
--   - a minimum ada quantity function that always returns zero.
--
-- Such an attempt should always succeed, since 'UnableToConstructChangeError'
-- should be returned if (and only if) the available UTxO balance:
--
--  - is sufficient to cover the desired total output balance; but
--
--  - is NOT sufficient to cover:
--
--      a. the minimum cost of the transaction;
--      b. the minimum ada quantities of generated change outputs.
--
-- If the available UTxO balance is not sufficient to cover the desired total
-- output balance, then 'performSelection' should explicitly indicate that the
-- balance is insufficient by returning a 'BalanceInsufficientError' instead.
--
verifyUnableToConstructChangeError
    :: forall ctx. SelectionContext ctx
    => VerifySelectionError Balance.UnableToConstructChangeError ctx
verifyUnableToConstructChangeError :: VerifySelectionError UnableToConstructChangeError ctx
verifyUnableToConstructChangeError SelectionConstraints ctx
cs SelectionParams ctx
ps UnableToConstructChangeError
errorOriginal =
    case Either (SelectionError ctx) (Selection ctx)
resultWithMinimalConstraints of
        Left SelectionError ctx
errorWithMinimalConstraints ->
            FailureToVerifyUnableToConstructChangeError ctx
-> VerificationResult
forall failureReason.
Show failureReason =>
failureReason -> VerificationResult
verificationFailure
            FailureToVerifyUnableToConstructChangeError :: forall ctx.
UnableToConstructChangeError
-> SelectionError ctx
-> FailureToVerifyUnableToConstructChangeError ctx
FailureToVerifyUnableToConstructChangeError {UnableToConstructChangeError
SelectionError ctx
errorWithMinimalConstraints :: SelectionError ctx
errorOriginal :: UnableToConstructChangeError
$sel:errorWithMinimalConstraints:FailureToVerifyUnableToConstructChangeError :: SelectionError ctx
$sel:errorOriginal:FailureToVerifyUnableToConstructChangeError :: UnableToConstructChangeError
..}
        Right Selection ctx
_ ->
            VerificationResult
VerificationSuccess
  where
    -- The result of attempting to re-run the selection process with minimal
    -- constraints, where we have:
    --
    --   - a minimum cost function that always returns zero.
    --   - a minimum ada quantity function that always returns zero.
    --
    resultWithMinimalConstraints :: Either (SelectionError ctx) (Selection ctx)
    resultWithMinimalConstraints :: Either (SelectionError ctx) (Selection ctx)
resultWithMinimalConstraints =
        -- The 'performSelection' function requires a 'MonadRandom' context so
        -- that it can select entries at random from the available UTxO set.
        --
        -- However, for this verification step, we don't actually require UTxO
        -- selection to be random. We only require that the 'performSelection'
        -- function is able to select some sequence of UTxOs that collectively
        -- covers the desired output amount.
        --
        -- To satisfy the requirement to provide a 'MonadRandom' context, we use
        -- the 'NonRandom' type, for which a 'MonadRandom' instance is provided.
        -- This instance, when asked to provide a random value from within a
        -- range of values, will always provide the same value.
        --
        -- This means that each internal step of 'performSelection' will select
        -- a value from the same relative position of the leftover available
        -- UTxO set. However, since selecting a UTxO entry removes it from the
        -- leftover set, every subsequent step will select a different entry,
        -- and thus the selection algorithm will always be able to make forward
        -- progress.
        --
        NonRandom (Either (SelectionError ctx) (Selection ctx))
-> Either (SelectionError ctx) (Selection ctx)
forall a. NonRandom a -> a
runNonRandom (NonRandom (Either (SelectionError ctx) (Selection ctx))
 -> Either (SelectionError ctx) (Selection ctx))
-> NonRandom (Either (SelectionError ctx) (Selection ctx))
-> Either (SelectionError ctx) (Selection ctx)
forall a b. (a -> b) -> a -> b
$ ExceptT (SelectionError ctx) NonRandom (Selection ctx)
-> NonRandom (Either (SelectionError ctx) (Selection ctx))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (SelectionError ctx) NonRandom (Selection ctx)
 -> NonRandom (Either (SelectionError ctx) (Selection ctx)))
-> ExceptT (SelectionError ctx) NonRandom (Selection ctx)
-> NonRandom (Either (SelectionError ctx) (Selection ctx))
forall a b. (a -> b) -> a -> b
$ PerformSelection NonRandom ctx (Selection ctx)
forall (m :: * -> *) ctx.
(HasCallStack, MonadRandom m, SelectionContext ctx) =>
PerformSelection m ctx (Selection ctx)
performSelection SelectionConstraints ctx
cs' SelectionParams ctx
ps
      where
        -- A modified set of constraints that should always allow the
        -- successful creation of a selection:
        cs' :: SelectionConstraints ctx
cs' = SelectionConstraints ctx
cs
            { $sel:computeMinimumAdaQuantity:SelectionConstraints :: Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity = (TokenMap -> Coin) -> Address ctx -> TokenMap -> Coin
forall a b. a -> b -> a
const ((TokenMap -> Coin) -> Address ctx -> TokenMap -> Coin)
-> (TokenMap -> Coin) -> Address ctx -> TokenMap -> Coin
forall a b. (a -> b) -> a -> b
$ Coin -> TokenMap -> Coin
forall a b. a -> b -> a
const (Coin -> TokenMap -> Coin) -> Coin -> TokenMap -> Coin
forall a b. (a -> b) -> a -> b
$ Natural -> Coin
Coin Natural
0
            , $sel:computeMinimumCost:SelectionConstraints :: SelectionSkeleton ctx -> Coin
computeMinimumCost = Coin -> SelectionSkeleton ctx -> Coin
forall a b. a -> b -> a
const (Coin -> SelectionSkeleton ctx -> Coin)
-> Coin -> SelectionSkeleton ctx -> Coin
forall a b. (a -> b) -> a -> b
$ Natural -> Coin
Coin Natural
0
            , $sel:computeSelectionLimit:SelectionConstraints :: [(Address ctx, TokenBundle)] -> SelectionLimit
computeSelectionLimit = SelectionLimit -> [(Address ctx, TokenBundle)] -> SelectionLimit
forall a b. a -> b -> a
const SelectionLimit
forall a. SelectionLimitOf a
Balance.NoLimit
            }

--------------------------------------------------------------------------------
-- Selection error verification: collateral errors
--------------------------------------------------------------------------------

data FailureToVerifySelectionCollateralError u =
    FailureToVerifySelectionCollateralError
        { FailureToVerifySelectionCollateralError u -> Map u Coin
largestCombination
            :: Map u Coin
            -- ^ The largest available UTxO combination reported.
        , FailureToVerifySelectionCollateralError u -> Coin
largestCombinationValue
            :: Coin
            -- ^ The total balance of the largest available UTxO combination.
        , FailureToVerifySelectionCollateralError u -> Int
largestCombinationSize
            :: Int
            -- ^ The size of the largest available UTxO combination.
        , FailureToVerifySelectionCollateralError u -> Map u Coin
largestCombinationUnsuitableSubset
            :: Map u Coin
            -- ^ The subset of UTxOs in the largest available combination that
            -- are not suitable for use as collateral.
            --
            -- UTxOs that are not suitable for collateral should never be made
            -- available to the collateral selection algorithm, and should
            -- therefore never be included in any error reported by the
            -- collateral selection algorithm.
        , FailureToVerifySelectionCollateralError u -> Int
maximumSelectionSize
            :: Int
            -- ^ The maximum number of entries permitted in the largest
            -- combination, determined by the maximum allowable number of
            -- collateral inputs.
        , FailureToVerifySelectionCollateralError u -> Coin
minimumSelectionAmount
            :: Coin
            -- ^ The reported minimum selection amount.
        }
        deriving (FailureToVerifySelectionCollateralError u
-> FailureToVerifySelectionCollateralError u -> Bool
(FailureToVerifySelectionCollateralError u
 -> FailureToVerifySelectionCollateralError u -> Bool)
-> (FailureToVerifySelectionCollateralError u
    -> FailureToVerifySelectionCollateralError u -> Bool)
-> Eq (FailureToVerifySelectionCollateralError u)
forall u.
Eq u =>
FailureToVerifySelectionCollateralError u
-> FailureToVerifySelectionCollateralError u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureToVerifySelectionCollateralError u
-> FailureToVerifySelectionCollateralError u -> Bool
$c/= :: forall u.
Eq u =>
FailureToVerifySelectionCollateralError u
-> FailureToVerifySelectionCollateralError u -> Bool
== :: FailureToVerifySelectionCollateralError u
-> FailureToVerifySelectionCollateralError u -> Bool
$c== :: forall u.
Eq u =>
FailureToVerifySelectionCollateralError u
-> FailureToVerifySelectionCollateralError u -> Bool
Eq, Int -> FailureToVerifySelectionCollateralError u -> ShowS
[FailureToVerifySelectionCollateralError u] -> ShowS
FailureToVerifySelectionCollateralError u -> String
(Int -> FailureToVerifySelectionCollateralError u -> ShowS)
-> (FailureToVerifySelectionCollateralError u -> String)
-> ([FailureToVerifySelectionCollateralError u] -> ShowS)
-> Show (FailureToVerifySelectionCollateralError u)
forall u.
Show u =>
Int -> FailureToVerifySelectionCollateralError u -> ShowS
forall u.
Show u =>
[FailureToVerifySelectionCollateralError u] -> ShowS
forall u.
Show u =>
FailureToVerifySelectionCollateralError u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureToVerifySelectionCollateralError u] -> ShowS
$cshowList :: forall u.
Show u =>
[FailureToVerifySelectionCollateralError u] -> ShowS
show :: FailureToVerifySelectionCollateralError u -> String
$cshow :: forall u.
Show u =>
FailureToVerifySelectionCollateralError u -> String
showsPrec :: Int -> FailureToVerifySelectionCollateralError u -> ShowS
$cshowsPrec :: forall u.
Show u =>
Int -> FailureToVerifySelectionCollateralError u -> ShowS
Show)

verifySelectionCollateralError
    :: forall ctx. SelectionContext ctx
    => VerifySelectionError (SelectionCollateralError ctx) ctx
verifySelectionCollateralError :: VerifySelectionError (SelectionCollateralError ctx) ctx
verifySelectionCollateralError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionCollateralError ctx
e =
    [Bool]
-> FailureToVerifySelectionCollateralError (UTxO ctx)
-> VerificationResult
forall (f :: * -> *) failureReason.
(Foldable f, Show failureReason) =>
f Bool -> failureReason -> VerificationResult
verifyAll
        [ Map (UTxO ctx) Coin -> Bool
forall k a. Map k a -> Bool
Map.null Map (UTxO ctx) Coin
largestCombinationUnsuitableSubset
        , Int
largestCombinationSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maximumSelectionSize
        , Coin
largestCombinationValue Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
minimumSelectionAmount
        ]
        (FailureToVerifySelectionCollateralError :: forall u.
Map u Coin
-> Coin
-> Int
-> Map u Coin
-> Int
-> Coin
-> FailureToVerifySelectionCollateralError u
FailureToVerifySelectionCollateralError {Int
Map (UTxO ctx) Coin
Coin
largestCombination :: Map (UTxO ctx) Coin
minimumSelectionAmount :: Coin
largestCombinationValue :: Coin
maximumSelectionSize :: Int
largestCombinationSize :: Int
largestCombinationUnsuitableSubset :: Map (UTxO ctx) Coin
$sel:minimumSelectionAmount:FailureToVerifySelectionCollateralError :: Coin
$sel:maximumSelectionSize:FailureToVerifySelectionCollateralError :: Int
$sel:largestCombinationUnsuitableSubset:FailureToVerifySelectionCollateralError :: Map (UTxO ctx) Coin
$sel:largestCombinationSize:FailureToVerifySelectionCollateralError :: Int
$sel:largestCombinationValue:FailureToVerifySelectionCollateralError :: Coin
$sel:largestCombination:FailureToVerifySelectionCollateralError :: Map (UTxO ctx) Coin
..})
  where
    largestCombination :: Map (UTxO ctx) Coin
    largestCombination :: Map (UTxO ctx) Coin
largestCombination = SelectionCollateralError ctx
e SelectionCollateralError ctx
-> ((Map (UTxO ctx) Coin
     -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
    -> SelectionCollateralError ctx
    -> Const (Map (UTxO ctx) Coin) (SelectionCollateralError ctx))
-> Map (UTxO ctx) Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "largestCombinationAvailable"
  ((Map (UTxO ctx) Coin
    -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
   -> SelectionCollateralError ctx
   -> Const (Map (UTxO ctx) Coin) (SelectionCollateralError ctx))
(Map (UTxO ctx) Coin
 -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
-> SelectionCollateralError ctx
-> Const (Map (UTxO ctx) Coin) (SelectionCollateralError ctx)
#largestCombinationAvailable
    largestCombinationSize :: Int
    largestCombinationSize :: Int
largestCombinationSize = Map (UTxO ctx) Coin -> Int
forall k a. Map k a -> Int
Map.size Map (UTxO ctx) Coin
largestCombination
    largestCombinationValue :: Coin
    largestCombinationValue :: Coin
largestCombinationValue = Map (UTxO ctx) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold Map (UTxO ctx) Coin
largestCombination

    largestCombinationUnsuitableSubset :: Map (UTxO ctx) Coin
    largestCombinationUnsuitableSubset :: Map (UTxO ctx) Coin
largestCombinationUnsuitableSubset = Map (UTxO ctx) Coin -> Set (UTxO ctx) -> Map (UTxO ctx) Coin
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys
        (Map (UTxO ctx) Coin
largestCombination)
        (Map (UTxO ctx) Coin -> Set (UTxO ctx)
forall k a. Map k a -> Set k
Map.keysSet (Map (UTxO ctx) Coin -> Set (UTxO ctx))
-> Map (UTxO ctx) Coin -> Set (UTxO ctx)
forall a b. (a -> b) -> a -> b
$ SelectionParams ctx
ps SelectionParams ctx
-> ((Map (UTxO ctx) Coin
     -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
    -> SelectionParams ctx
    -> Const (Map (UTxO ctx) Coin) (SelectionParams ctx))
-> Map (UTxO ctx) Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "utxoAvailableForCollateral"
  ((Map (UTxO ctx) Coin
    -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
   -> SelectionParams ctx
   -> Const (Map (UTxO ctx) Coin) (SelectionParams ctx))
(Map (UTxO ctx) Coin
 -> Const (Map (UTxO ctx) Coin) (Map (UTxO ctx) Coin))
-> SelectionParams ctx
-> Const (Map (UTxO ctx) Coin) (SelectionParams ctx)
#utxoAvailableForCollateral)

    maximumSelectionSize :: Int
    maximumSelectionSize :: Int
maximumSelectionSize = SelectionConstraints ctx
cs SelectionConstraints ctx
-> ((Int -> Const Int Int)
    -> SelectionConstraints ctx
    -> Const Int (SelectionConstraints ctx))
-> Int
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "maximumCollateralInputCount"
  ((Int -> Const Int Int)
   -> SelectionConstraints ctx
   -> Const Int (SelectionConstraints ctx))
(Int -> Const Int Int)
-> SelectionConstraints ctx -> Const Int (SelectionConstraints ctx)
#maximumCollateralInputCount
    minimumSelectionAmount :: Coin
    minimumSelectionAmount :: Coin
minimumSelectionAmount = SelectionCollateralError ctx
e SelectionCollateralError ctx
-> ((Coin -> Const Coin Coin)
    -> SelectionCollateralError ctx
    -> Const Coin (SelectionCollateralError ctx))
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "minimumSelectionAmount"
  ((Coin -> Const Coin Coin)
   -> SelectionCollateralError ctx
   -> Const Coin (SelectionCollateralError ctx))
(Coin -> Const Coin Coin)
-> SelectionCollateralError ctx
-> Const Coin (SelectionCollateralError ctx)
#minimumSelectionAmount

--------------------------------------------------------------------------------
-- Selection error verification: output errors
--------------------------------------------------------------------------------

verifySelectionOutputError
    :: SelectionContext ctx
    => VerifySelectionError (SelectionOutputError ctx) ctx
verifySelectionOutputError :: VerifySelectionError (SelectionOutputError ctx) ctx
verifySelectionOutputError SelectionConstraints ctx
cs SelectionParams ctx
ps = \case
    SelectionOutputCoinInsufficient SelectionOutputCoinInsufficientError ctx
e ->
        VerifySelectionError (SelectionOutputCoinInsufficientError ctx) ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError (SelectionOutputCoinInsufficientError ctx) ctx
verifySelectionOutputCoinInsufficientError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionOutputCoinInsufficientError ctx
e
    SelectionOutputSizeExceedsLimit SelectionOutputSizeExceedsLimitError ctx
e ->
        VerifySelectionError (SelectionOutputSizeExceedsLimitError ctx) ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError (SelectionOutputSizeExceedsLimitError ctx) ctx
verifySelectionOutputSizeExceedsLimitError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionOutputSizeExceedsLimitError ctx
e
    SelectionOutputTokenQuantityExceedsLimit SelectionOutputTokenQuantityExceedsLimitError ctx
e ->
        VerifySelectionError
  (SelectionOutputTokenQuantityExceedsLimitError ctx) ctx
forall ctx.
SelectionContext ctx =>
VerifySelectionError
  (SelectionOutputTokenQuantityExceedsLimitError ctx) ctx
verifySelectionOutputTokenQuantityExceedsLimitError SelectionConstraints ctx
cs SelectionParams ctx
ps SelectionOutputTokenQuantityExceedsLimitError ctx
e

--------------------------------------------------------------------------------
-- Selection error verification: output size errors
--------------------------------------------------------------------------------

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

verifySelectionOutputSizeExceedsLimitError
    :: SelectionContext ctx
    => VerifySelectionError (SelectionOutputSizeExceedsLimitError ctx) ctx
verifySelectionOutputSizeExceedsLimitError :: VerifySelectionError (SelectionOutputSizeExceedsLimitError ctx) ctx
verifySelectionOutputSizeExceedsLimitError SelectionConstraints ctx
cs SelectionParams ctx
_ps SelectionOutputSizeExceedsLimitError ctx
e =
    Bool
-> FailureToVerifySelectionOutputSizeExceedsLimitError
     (Address ctx)
-> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        (Bool -> Bool
not Bool
isWithinLimit)
        (FailureToVerifySelectionOutputSizeExceedsLimitError :: forall address.
(address, TokenBundle)
-> FailureToVerifySelectionOutputSizeExceedsLimitError address
FailureToVerifySelectionOutputSizeExceedsLimitError {(Address ctx, TokenBundle)
outputReportedAsExceedingLimit :: (Address ctx, TokenBundle)
$sel:outputReportedAsExceedingLimit:FailureToVerifySelectionOutputSizeExceedsLimitError :: (Address ctx, TokenBundle)
..})
  where
    isWithinLimit :: Bool
isWithinLimit = case (SelectionConstraints ctx
cs SelectionConstraints ctx
-> (((TokenBundle -> TokenBundleSizeAssessment)
     -> Const
          (TokenBundle -> TokenBundleSizeAssessment)
          (TokenBundle -> TokenBundleSizeAssessment))
    -> SelectionConstraints ctx
    -> Const
         (TokenBundle -> TokenBundleSizeAssessment)
         (SelectionConstraints ctx))
-> TokenBundle
-> TokenBundleSizeAssessment
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "assessTokenBundleSize"
  (((TokenBundle -> TokenBundleSizeAssessment)
    -> Const
         (TokenBundle -> TokenBundleSizeAssessment)
         (TokenBundle -> TokenBundleSizeAssessment))
   -> SelectionConstraints ctx
   -> Const
        (TokenBundle -> TokenBundleSizeAssessment)
        (SelectionConstraints ctx))
((TokenBundle -> TokenBundleSizeAssessment)
 -> Const
      (TokenBundle -> TokenBundleSizeAssessment)
      (TokenBundle -> TokenBundleSizeAssessment))
-> SelectionConstraints ctx
-> Const
     (TokenBundle -> TokenBundleSizeAssessment)
     (SelectionConstraints ctx)
#assessTokenBundleSize) TokenBundle
bundle of
        TokenBundleSizeAssessment
TokenBundleSizeWithinLimit -> Bool
True
        TokenBundleSizeAssessment
TokenBundleSizeExceedsLimit -> Bool
False
      where
        bundle :: TokenBundle
bundle = (Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
outputReportedAsExceedingLimit

    outputReportedAsExceedingLimit :: (Address ctx, TokenBundle)
outputReportedAsExceedingLimit = SelectionOutputSizeExceedsLimitError ctx
e SelectionOutputSizeExceedsLimitError ctx
-> (((Address ctx, TokenBundle)
     -> Const (Address ctx, TokenBundle) (Address ctx, TokenBundle))
    -> SelectionOutputSizeExceedsLimitError ctx
    -> Const
         (Address ctx, TokenBundle)
         (SelectionOutputSizeExceedsLimitError ctx))
-> (Address ctx, TokenBundle)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputThatExceedsLimit"
  (((Address ctx, TokenBundle)
    -> Const (Address ctx, TokenBundle) (Address ctx, TokenBundle))
   -> SelectionOutputSizeExceedsLimitError ctx
   -> Const
        (Address ctx, TokenBundle)
        (SelectionOutputSizeExceedsLimitError ctx))
((Address ctx, TokenBundle)
 -> Const (Address ctx, TokenBundle) (Address ctx, TokenBundle))
-> SelectionOutputSizeExceedsLimitError ctx
-> Const
     (Address ctx, TokenBundle)
     (SelectionOutputSizeExceedsLimitError ctx)
#outputThatExceedsLimit

--------------------------------------------------------------------------------
-- Selection error verification: output token quantity errors
--------------------------------------------------------------------------------

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

verifySelectionOutputTokenQuantityExceedsLimitError
    :: SelectionContext ctx
    => VerifySelectionError
        (SelectionOutputTokenQuantityExceedsLimitError ctx) ctx
verifySelectionOutputTokenQuantityExceedsLimitError :: VerifySelectionError
  (SelectionOutputTokenQuantityExceedsLimitError ctx) ctx
verifySelectionOutputTokenQuantityExceedsLimitError SelectionConstraints ctx
_cs SelectionParams ctx
_ps SelectionOutputTokenQuantityExceedsLimitError ctx
e =
    Bool
-> FailureToVerifySelectionOutputTokenQuantityExceedsLimitError ctx
-> VerificationResult
forall failureReason.
Show failureReason =>
Bool -> failureReason -> VerificationResult
verify
        (SelectionOutputTokenQuantityExceedsLimitError ctx
e SelectionOutputTokenQuantityExceedsLimitError ctx
-> ((TokenQuantity -> Const TokenQuantity TokenQuantity)
    -> SelectionOutputTokenQuantityExceedsLimitError ctx
    -> Const
         TokenQuantity (SelectionOutputTokenQuantityExceedsLimitError ctx))
-> TokenQuantity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "quantity"
  ((TokenQuantity -> Const TokenQuantity TokenQuantity)
   -> SelectionOutputTokenQuantityExceedsLimitError ctx
   -> Const
        TokenQuantity (SelectionOutputTokenQuantityExceedsLimitError ctx))
(TokenQuantity -> Const TokenQuantity TokenQuantity)
-> SelectionOutputTokenQuantityExceedsLimitError ctx
-> Const
     TokenQuantity (SelectionOutputTokenQuantityExceedsLimitError ctx)
#quantity TokenQuantity -> TokenQuantity -> Bool
forall a. Ord a => a -> a -> Bool
> SelectionOutputTokenQuantityExceedsLimitError ctx
e SelectionOutputTokenQuantityExceedsLimitError ctx
-> ((TokenQuantity -> Const TokenQuantity TokenQuantity)
    -> SelectionOutputTokenQuantityExceedsLimitError ctx
    -> Const
         TokenQuantity (SelectionOutputTokenQuantityExceedsLimitError ctx))
-> TokenQuantity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "quantityMaxBound"
  ((TokenQuantity -> Const TokenQuantity TokenQuantity)
   -> SelectionOutputTokenQuantityExceedsLimitError ctx
   -> Const
        TokenQuantity (SelectionOutputTokenQuantityExceedsLimitError ctx))
(TokenQuantity -> Const TokenQuantity TokenQuantity)
-> SelectionOutputTokenQuantityExceedsLimitError ctx
-> Const
     TokenQuantity (SelectionOutputTokenQuantityExceedsLimitError ctx)
#quantityMaxBound)
        (SelectionOutputTokenQuantityExceedsLimitError ctx
-> FailureToVerifySelectionOutputTokenQuantityExceedsLimitError ctx
forall ctx.
SelectionOutputTokenQuantityExceedsLimitError ctx
-> FailureToVerifySelectionOutputTokenQuantityExceedsLimitError ctx
FailureToVerifySelectionOutputTokenQuantityExceedsLimitError SelectionOutputTokenQuantityExceedsLimitError ctx
e)

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

-- | Calculates the selection delta for all assets.
--
-- See 'SelectionDelta'.
--
selectionDeltaAllAssets :: Selection ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets :: Selection ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets = SelectionResultOf [] ctx -> SelectionDelta TokenBundle
forall (f :: * -> *) ctx.
Foldable f =>
SelectionResultOf f ctx -> SelectionDelta TokenBundle
Balance.selectionDeltaAllAssets (SelectionResultOf [] ctx -> SelectionDelta TokenBundle)
-> (Selection ctx -> SelectionResultOf [] ctx)
-> Selection ctx
-> SelectionDelta TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection ctx -> SelectionResultOf [] ctx
forall ctx. Selection ctx -> SelectionResult ctx
toBalanceResult

-- | Calculates the ada selection delta.
--
-- See 'SelectionDelta'.
--
selectionDeltaCoin :: Selection ctx -> SelectionDelta Coin
selectionDeltaCoin :: Selection 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)
-> (Selection ctx -> SelectionDelta TokenBundle)
-> Selection ctx
-> SelectionDelta Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection ctx -> SelectionDelta TokenBundle
forall ctx. Selection ctx -> SelectionDelta TokenBundle
selectionDeltaAllAssets

-- | Indicates whether or not a selection has a valid surplus.
--
-- This function returns 'True' if and only if the selection has a delta that
-- is a *surplus*, and that surplus is greater than or equal to the result of
-- 'selectionMinimumCost'.
--
-- See 'SelectionDelta'.
--
selectionHasValidSurplus
    :: SelectionConstraints ctx -> SelectionParams ctx -> Selection ctx -> Bool
selectionHasValidSurplus :: SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Bool
selectionHasValidSurplus SelectionConstraints ctx
constraints SelectionParams ctx
params Selection ctx
selection =
    SelectionConstraints ctx -> SelectionResultOf [] ctx -> Bool
forall (f :: * -> *) ctx.
Foldable f =>
SelectionConstraints ctx -> SelectionResultOf f ctx -> Bool
Balance.selectionHasValidSurplus
        ((SelectionConstraints ctx, SelectionParams ctx)
-> SelectionConstraints ctx
forall a b. (a, b) -> a
fst ((SelectionConstraints ctx, SelectionParams ctx)
 -> SelectionConstraints ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
-> SelectionConstraints ctx
forall a b. (a -> b) -> a -> b
$ (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
forall ctx.
(SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
toBalanceConstraintsParams (SelectionConstraints ctx
constraints, SelectionParams ctx
params))
        (Selection ctx -> SelectionResultOf [] ctx
forall ctx. Selection ctx -> SelectionResult ctx
toBalanceResult Selection ctx
selection)

-- | Computes the minimum required cost of a selection.
--
selectionMinimumCost
    :: SelectionConstraints ctx -> SelectionParams ctx -> Selection ctx -> Coin
selectionMinimumCost :: SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
selectionMinimumCost SelectionConstraints ctx
constraints SelectionParams ctx
params Selection ctx
selection =
    SelectionConstraints ctx -> SelectionResultOf [] ctx -> Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
Balance.selectionMinimumCost
        ((SelectionConstraints ctx, SelectionParams ctx)
-> SelectionConstraints ctx
forall a b. (a, b) -> a
fst ((SelectionConstraints ctx, SelectionParams ctx)
 -> SelectionConstraints ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
-> SelectionConstraints ctx
forall a b. (a -> b) -> a -> b
$ (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
forall ctx.
(SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
toBalanceConstraintsParams (SelectionConstraints ctx
constraints, SelectionParams ctx
params))
        (Selection ctx -> SelectionResultOf [] ctx
forall ctx. Selection ctx -> SelectionResult ctx
toBalanceResult Selection ctx
selection)

-- | Computes the maximum acceptable cost of a selection.
--
selectionMaximumCost
    :: SelectionConstraints ctx -> SelectionParams ctx -> Selection ctx -> Coin
selectionMaximumCost :: SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
selectionMaximumCost SelectionConstraints ctx
constraints SelectionParams ctx
params Selection ctx
selection =
    SelectionConstraints ctx -> SelectionResultOf [] ctx -> Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionConstraints ctx -> SelectionResultOf f ctx -> Coin
Balance.selectionMaximumCost
        ((SelectionConstraints ctx, SelectionParams ctx)
-> SelectionConstraints ctx
forall a b. (a, b) -> a
fst ((SelectionConstraints ctx, SelectionParams ctx)
 -> SelectionConstraints ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
-> SelectionConstraints ctx
forall a b. (a -> b) -> a -> b
$ (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
forall ctx.
(SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints ctx, SelectionParams ctx)
toBalanceConstraintsParams (SelectionConstraints ctx
constraints, SelectionParams ctx
params))
        (Selection ctx -> SelectionResultOf [] ctx
forall ctx. Selection ctx -> SelectionResult ctx
toBalanceResult Selection 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 :: Selection ctx -> Coin
selectionSurplusCoin :: Selection ctx -> Coin
selectionSurplusCoin = SelectionResultOf [] ctx -> Coin
forall (f :: * -> *) ctx.
Foldable f =>
SelectionResultOf f ctx -> Coin
Balance.selectionSurplusCoin (SelectionResultOf [] ctx -> Coin)
-> (Selection ctx -> SelectionResultOf [] ctx)
-> Selection ctx
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection ctx -> SelectionResultOf [] ctx
forall ctx. Selection ctx -> SelectionResult ctx
toBalanceResult

--------------------------------------------------------------------------------
-- Selection collateral
--------------------------------------------------------------------------------

-- | Indicates the collateral requirement for a selection.
--
data SelectionCollateralRequirement
    = SelectionCollateralRequired
    -- ^ Indicates that collateral is required.
    | SelectionCollateralNotRequired
    -- ^ Indicates that collateral is not required.
    deriving (SelectionCollateralRequirement
SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> Bounded SelectionCollateralRequirement
forall a. a -> a -> Bounded a
maxBound :: SelectionCollateralRequirement
$cmaxBound :: SelectionCollateralRequirement
minBound :: SelectionCollateralRequirement
$cminBound :: SelectionCollateralRequirement
Bounded, Int -> SelectionCollateralRequirement
SelectionCollateralRequirement -> Int
SelectionCollateralRequirement -> [SelectionCollateralRequirement]
SelectionCollateralRequirement -> SelectionCollateralRequirement
SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
(SelectionCollateralRequirement -> SelectionCollateralRequirement)
-> (SelectionCollateralRequirement
    -> SelectionCollateralRequirement)
-> (Int -> SelectionCollateralRequirement)
-> (SelectionCollateralRequirement -> Int)
-> (SelectionCollateralRequirement
    -> [SelectionCollateralRequirement])
-> (SelectionCollateralRequirement
    -> SelectionCollateralRequirement
    -> [SelectionCollateralRequirement])
-> (SelectionCollateralRequirement
    -> SelectionCollateralRequirement
    -> [SelectionCollateralRequirement])
-> (SelectionCollateralRequirement
    -> SelectionCollateralRequirement
    -> SelectionCollateralRequirement
    -> [SelectionCollateralRequirement])
-> Enum SelectionCollateralRequirement
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 :: SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
$cenumFromThenTo :: SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
enumFromTo :: SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
$cenumFromTo :: SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
enumFromThen :: SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
$cenumFromThen :: SelectionCollateralRequirement
-> SelectionCollateralRequirement
-> [SelectionCollateralRequirement]
enumFrom :: SelectionCollateralRequirement -> [SelectionCollateralRequirement]
$cenumFrom :: SelectionCollateralRequirement -> [SelectionCollateralRequirement]
fromEnum :: SelectionCollateralRequirement -> Int
$cfromEnum :: SelectionCollateralRequirement -> Int
toEnum :: Int -> SelectionCollateralRequirement
$ctoEnum :: Int -> SelectionCollateralRequirement
pred :: SelectionCollateralRequirement -> SelectionCollateralRequirement
$cpred :: SelectionCollateralRequirement -> SelectionCollateralRequirement
succ :: SelectionCollateralRequirement -> SelectionCollateralRequirement
$csucc :: SelectionCollateralRequirement -> SelectionCollateralRequirement
Enum, SelectionCollateralRequirement
-> SelectionCollateralRequirement -> Bool
(SelectionCollateralRequirement
 -> SelectionCollateralRequirement -> Bool)
-> (SelectionCollateralRequirement
    -> SelectionCollateralRequirement -> Bool)
-> Eq SelectionCollateralRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionCollateralRequirement
-> SelectionCollateralRequirement -> Bool
$c/= :: SelectionCollateralRequirement
-> SelectionCollateralRequirement -> Bool
== :: SelectionCollateralRequirement
-> SelectionCollateralRequirement -> Bool
$c== :: SelectionCollateralRequirement
-> SelectionCollateralRequirement -> Bool
Eq, (forall x.
 SelectionCollateralRequirement
 -> Rep SelectionCollateralRequirement x)
-> (forall x.
    Rep SelectionCollateralRequirement x
    -> SelectionCollateralRequirement)
-> Generic SelectionCollateralRequirement
forall x.
Rep SelectionCollateralRequirement x
-> SelectionCollateralRequirement
forall x.
SelectionCollateralRequirement
-> Rep SelectionCollateralRequirement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelectionCollateralRequirement x
-> SelectionCollateralRequirement
$cfrom :: forall x.
SelectionCollateralRequirement
-> Rep SelectionCollateralRequirement x
Generic, Int -> SelectionCollateralRequirement -> ShowS
[SelectionCollateralRequirement] -> ShowS
SelectionCollateralRequirement -> String
(Int -> SelectionCollateralRequirement -> ShowS)
-> (SelectionCollateralRequirement -> String)
-> ([SelectionCollateralRequirement] -> ShowS)
-> Show SelectionCollateralRequirement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionCollateralRequirement] -> ShowS
$cshowList :: [SelectionCollateralRequirement] -> ShowS
show :: SelectionCollateralRequirement -> String
$cshow :: SelectionCollateralRequirement -> String
showsPrec :: Int -> SelectionCollateralRequirement -> ShowS
$cshowsPrec :: Int -> SelectionCollateralRequirement -> ShowS
Show)

-- | Indicates 'True' if and only if collateral is required.
--
selectionCollateralRequired :: SelectionParams ctx -> Bool
selectionCollateralRequired :: SelectionParams ctx -> Bool
selectionCollateralRequired SelectionParams ctx
params = case ((SelectionCollateralRequirement
  -> Const
       SelectionCollateralRequirement SelectionCollateralRequirement)
 -> SelectionParams ctx
 -> Const SelectionCollateralRequirement (SelectionParams ctx))
-> SelectionParams ctx -> SelectionCollateralRequirement
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "collateralRequirement"
  ((SelectionCollateralRequirement
    -> Const
         SelectionCollateralRequirement SelectionCollateralRequirement)
   -> SelectionParams ctx
   -> Const SelectionCollateralRequirement (SelectionParams ctx))
(SelectionCollateralRequirement
 -> Const
      SelectionCollateralRequirement SelectionCollateralRequirement)
-> SelectionParams ctx
-> Const SelectionCollateralRequirement (SelectionParams ctx)
#collateralRequirement SelectionParams ctx
params of
    SelectionCollateralRequirement
SelectionCollateralRequired    -> Bool
True
    SelectionCollateralRequirement
SelectionCollateralNotRequired -> Bool
False

-- | Applies the given transformation function only when collateral is required.
--
whenCollateralRequired
    :: SelectionParams ctx
    -> (a -> a)
    -> (a -> a)
whenCollateralRequired :: SelectionParams ctx -> (a -> a) -> a -> a
whenCollateralRequired SelectionParams ctx
params a -> a
f
    | SelectionParams ctx -> Bool
forall ctx. SelectionParams ctx -> Bool
selectionCollateralRequired SelectionParams ctx
params = a -> a
f
    | Bool
otherwise = a -> a
forall a. a -> a
id

-- | Computes the total amount of collateral within a selection.
--
selectionCollateral :: Selection ctx -> Coin
selectionCollateral :: Selection ctx -> Coin
selectionCollateral = ((UTxO ctx, Coin) -> Coin) -> [(UTxO ctx, Coin)] -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (UTxO ctx, Coin) -> Coin
forall a b. (a, b) -> b
snd ([(UTxO ctx, Coin)] -> Coin)
-> (Selection ctx -> [(UTxO ctx, Coin)]) -> Selection ctx -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(UTxO ctx, Coin)]
  -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
 -> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx))
-> Selection ctx -> [(UTxO ctx, Coin)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "collateral"
  (([(UTxO ctx, Coin)]
    -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
   -> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx))
([(UTxO ctx, Coin)] -> Const [(UTxO ctx, Coin)] [(UTxO ctx, Coin)])
-> Selection ctx -> Const [(UTxO ctx, Coin)] (Selection ctx)
#collateral

-- | Indicates whether or not a selection has sufficient collateral.
--
selectionHasSufficientCollateral
    :: SelectionConstraints ctx -> SelectionParams ctx -> Selection ctx -> Bool
selectionHasSufficientCollateral :: SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Bool
selectionHasSufficientCollateral SelectionConstraints ctx
constraints SelectionParams ctx
params Selection ctx
selection =
    Coin
actual Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
required
  where
    actual :: Coin
actual = Selection ctx -> Coin
forall ctx. Selection ctx -> Coin
selectionCollateral Selection ctx
selection
    required :: Coin
required = SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
forall ctx.
SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
selectionMinimumCollateral SelectionConstraints ctx
constraints SelectionParams ctx
params Selection ctx
selection

-- | Computes the minimum required amount of collateral for a selection.
--
selectionMinimumCollateral
    :: SelectionConstraints ctx -> SelectionParams ctx -> Selection ctx -> Coin
selectionMinimumCollateral :: SelectionConstraints ctx
-> SelectionParams ctx -> Selection ctx -> Coin
selectionMinimumCollateral SelectionConstraints ctx
constraints SelectionParams ctx
params Selection ctx
selection
    | SelectionParams ctx -> Bool
forall ctx. SelectionParams ctx -> Bool
selectionCollateralRequired SelectionParams ctx
params =
        ((Coin -> Const Coin Coin)
 -> SelectionParams (UTxO ctx)
 -> Const Coin (SelectionParams (UTxO ctx)))
-> SelectionParams (UTxO ctx) -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "minimumSelectionAmount"
  ((Coin -> Const Coin Coin)
   -> SelectionParams (UTxO ctx)
   -> Const Coin (SelectionParams (UTxO ctx)))
(Coin -> Const Coin Coin)
-> SelectionParams (UTxO ctx)
-> Const Coin (SelectionParams (UTxO ctx))
#minimumSelectionAmount (SelectionParams (UTxO ctx) -> Coin)
-> SelectionParams (UTxO ctx) -> Coin
forall a b. (a -> b) -> a -> b
$ (SelectionConstraints, SelectionParams (UTxO ctx))
-> SelectionParams (UTxO ctx)
forall a b. (a, b) -> b
snd ((SelectionConstraints, SelectionParams (UTxO ctx))
 -> SelectionParams (UTxO ctx))
-> (SelectionConstraints, SelectionParams (UTxO ctx))
-> SelectionParams (UTxO ctx)
forall a b. (a -> b) -> a -> b
$
        SelectionResult ctx
-> (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints, SelectionParams (UTxO ctx))
forall ctx.
SelectionResult ctx
-> (SelectionConstraints ctx, SelectionParams ctx)
-> (SelectionConstraints, SelectionParams (UTxO ctx))
toCollateralConstraintsParams
            (Selection ctx -> SelectionResult ctx
forall ctx. Selection ctx -> SelectionResult ctx
toBalanceResult Selection ctx
selection)
            (SelectionConstraints ctx
constraints, SelectionParams ctx
params)
    | Bool
otherwise = Natural -> Coin
Coin Natural
0

-- | Parameters for 'computeMinimumCollateral'.

data ComputeMinimumCollateralParams = ComputeMinimumCollateralParams
    { ComputeMinimumCollateralParams -> Natural
minimumCollateralPercentage :: Natural
    , ComputeMinimumCollateralParams -> Coin
transactionFee :: Coin
    }
    deriving (ComputeMinimumCollateralParams
-> ComputeMinimumCollateralParams -> Bool
(ComputeMinimumCollateralParams
 -> ComputeMinimumCollateralParams -> Bool)
-> (ComputeMinimumCollateralParams
    -> ComputeMinimumCollateralParams -> Bool)
-> Eq ComputeMinimumCollateralParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputeMinimumCollateralParams
-> ComputeMinimumCollateralParams -> Bool
$c/= :: ComputeMinimumCollateralParams
-> ComputeMinimumCollateralParams -> Bool
== :: ComputeMinimumCollateralParams
-> ComputeMinimumCollateralParams -> Bool
$c== :: ComputeMinimumCollateralParams
-> ComputeMinimumCollateralParams -> Bool
Eq, (forall x.
 ComputeMinimumCollateralParams
 -> Rep ComputeMinimumCollateralParams x)
-> (forall x.
    Rep ComputeMinimumCollateralParams x
    -> ComputeMinimumCollateralParams)
-> Generic ComputeMinimumCollateralParams
forall x.
Rep ComputeMinimumCollateralParams x
-> ComputeMinimumCollateralParams
forall x.
ComputeMinimumCollateralParams
-> Rep ComputeMinimumCollateralParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ComputeMinimumCollateralParams x
-> ComputeMinimumCollateralParams
$cfrom :: forall x.
ComputeMinimumCollateralParams
-> Rep ComputeMinimumCollateralParams x
Generic, Int -> ComputeMinimumCollateralParams -> ShowS
[ComputeMinimumCollateralParams] -> ShowS
ComputeMinimumCollateralParams -> String
(Int -> ComputeMinimumCollateralParams -> ShowS)
-> (ComputeMinimumCollateralParams -> String)
-> ([ComputeMinimumCollateralParams] -> ShowS)
-> Show ComputeMinimumCollateralParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputeMinimumCollateralParams] -> ShowS
$cshowList :: [ComputeMinimumCollateralParams] -> ShowS
show :: ComputeMinimumCollateralParams -> String
$cshow :: ComputeMinimumCollateralParams -> String
showsPrec :: Int -> ComputeMinimumCollateralParams -> ShowS
$cshowsPrec :: Int -> ComputeMinimumCollateralParams -> ShowS
Show)

-- | Computes the minimum required amount of collateral given a fee and a
--   minimum collateral percentage.
--
computeMinimumCollateral
    :: ComputeMinimumCollateralParams
    -> Coin
computeMinimumCollateral :: ComputeMinimumCollateralParams -> Coin
computeMinimumCollateral ComputeMinimumCollateralParams
params =
    Natural -> Coin
Coin (Natural -> Coin) -> (Coin -> Natural) -> Coin -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Natural -> Natural
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Natural -> Natural)
-> (Coin -> Ratio Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Ratio Natural
forall a. Integral a => a -> a -> Ratio a
% Natural
100) (Natural -> Ratio Natural)
-> (Coin -> Natural) -> Coin -> Ratio Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$
    Natural -> Coin -> Coin
forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault
        (((Natural -> Const Natural Natural)
 -> ComputeMinimumCollateralParams
 -> Const Natural ComputeMinimumCollateralParams)
-> ComputeMinimumCollateralParams -> Natural
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "minimumCollateralPercentage"
  ((Natural -> Const Natural Natural)
   -> ComputeMinimumCollateralParams
   -> Const Natural ComputeMinimumCollateralParams)
(Natural -> Const Natural Natural)
-> ComputeMinimumCollateralParams
-> Const Natural ComputeMinimumCollateralParams
#minimumCollateralPercentage ComputeMinimumCollateralParams
params)
        (((Coin -> Const Coin Coin)
 -> ComputeMinimumCollateralParams
 -> Const Coin ComputeMinimumCollateralParams)
-> ComputeMinimumCollateralParams -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "transactionFee"
  ((Coin -> Const Coin Coin)
   -> ComputeMinimumCollateralParams
   -> Const Coin ComputeMinimumCollateralParams)
(Coin -> Const Coin Coin)
-> ComputeMinimumCollateralParams
-> Const Coin ComputeMinimumCollateralParams
#transactionFee ComputeMinimumCollateralParams
params)

--------------------------------------------------------------------------------
-- Preparing outputs
--------------------------------------------------------------------------------

-- | Prepares the given user-specified outputs, ensuring that they are valid.
--
prepareOutputsInternal
    :: forall ctx. SelectionConstraints ctx
    -> [(Address ctx, TokenBundle)]
    -> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
prepareOutputsInternal :: SelectionConstraints ctx
-> [(Address ctx, TokenBundle)]
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
prepareOutputsInternal SelectionConstraints ctx
constraints [(Address ctx, TokenBundle)]
outputsUnprepared
    | SelectionOutputSizeExceedsLimitError ctx
e : [SelectionOutputSizeExceedsLimitError ctx]
_ <- [SelectionOutputSizeExceedsLimitError ctx]
excessivelyLargeBundles =
        SelectionOutputError ctx
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall a b. a -> Either a b
Left (SelectionOutputError ctx
 -> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)])
-> SelectionOutputError ctx
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall a b. (a -> b) -> a -> b
$
        -- We encountered one or more excessively large token bundles.
        -- Just report the first such bundle:
        SelectionOutputSizeExceedsLimitError ctx
-> SelectionOutputError ctx
forall ctx.
SelectionOutputSizeExceedsLimitError ctx
-> SelectionOutputError ctx
SelectionOutputSizeExceedsLimit SelectionOutputSizeExceedsLimitError ctx
e
    | SelectionOutputTokenQuantityExceedsLimitError ctx
e : [SelectionOutputTokenQuantityExceedsLimitError ctx]
_ <- [SelectionOutputTokenQuantityExceedsLimitError ctx]
excessiveTokenQuantities =
        SelectionOutputError ctx
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall a b. a -> Either a b
Left (SelectionOutputError ctx
 -> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)])
-> SelectionOutputError ctx
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall a b. (a -> b) -> a -> b
$
        -- We encountered one or more excessive token quantities.
        -- Just report the first such quantity:
        SelectionOutputTokenQuantityExceedsLimitError ctx
-> SelectionOutputError ctx
forall ctx.
SelectionOutputTokenQuantityExceedsLimitError ctx
-> SelectionOutputError ctx
SelectionOutputTokenQuantityExceedsLimit SelectionOutputTokenQuantityExceedsLimitError ctx
e
    | SelectionOutputCoinInsufficientError ctx
e : [SelectionOutputCoinInsufficientError ctx]
_ <- [SelectionOutputCoinInsufficientError ctx]
insufficientCoins =
        SelectionOutputError ctx
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall a b. a -> Either a b
Left (SelectionOutputError ctx
 -> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)])
-> SelectionOutputError ctx
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall a b. (a -> b) -> a -> b
$
        -- We encountered one or more outputs with an ada quantity that is
        -- below the minimum required quantity.
        -- Just report the first such output:
        SelectionOutputCoinInsufficientError ctx
-> SelectionOutputError ctx
forall ctx.
SelectionOutputCoinInsufficientError ctx
-> SelectionOutputError ctx
SelectionOutputCoinInsufficient SelectionOutputCoinInsufficientError ctx
e
    | Bool
otherwise =
        [(Address ctx, TokenBundle)]
-> Either (SelectionOutputError ctx) [(Address ctx, TokenBundle)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Address ctx, TokenBundle)]
outputsToCover
  where
    SelectionConstraints
        { Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity :: Address ctx -> TokenMap -> Coin
$sel:computeMinimumAdaQuantity:SelectionConstraints :: forall ctx.
SelectionConstraints ctx -> Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity
        } = SelectionConstraints ctx
constraints

    -- The complete list of token bundles whose serialized lengths are greater
    -- than the limit of what is allowed in a transaction output:
    excessivelyLargeBundles
        :: [SelectionOutputSizeExceedsLimitError ctx]
    excessivelyLargeBundles :: [SelectionOutputSizeExceedsLimitError ctx]
excessivelyLargeBundles =
        ((Address ctx, TokenBundle)
 -> Maybe (SelectionOutputSizeExceedsLimitError ctx))
-> [(Address ctx, TokenBundle)]
-> [SelectionOutputSizeExceedsLimitError ctx]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputSizeExceedsLimitError ctx)
forall ctx.
SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputSizeExceedsLimitError ctx)
verifyOutputSize SelectionConstraints ctx
constraints) [(Address ctx, TokenBundle)]
outputsToCover

    -- The complete list of token quantities that exceed the maximum quantity
    -- allowed in a transaction output:
    excessiveTokenQuantities
        :: [SelectionOutputTokenQuantityExceedsLimitError ctx]
    excessiveTokenQuantities :: [SelectionOutputTokenQuantityExceedsLimitError ctx]
excessiveTokenQuantities = (Address ctx, TokenBundle)
-> [SelectionOutputTokenQuantityExceedsLimitError ctx]
forall ctx.
(Address ctx, TokenBundle)
-> [SelectionOutputTokenQuantityExceedsLimitError ctx]
verifyOutputTokenQuantities ((Address ctx, TokenBundle)
 -> [SelectionOutputTokenQuantityExceedsLimitError ctx])
-> [(Address ctx, TokenBundle)]
-> [SelectionOutputTokenQuantityExceedsLimitError ctx]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Address ctx, TokenBundle)]
outputsToCover

    -- The complete list of outputs whose ada quantities are below the minimum
    -- required:
    insufficientCoins
        :: [SelectionOutputCoinInsufficientError ctx]
    insufficientCoins :: [SelectionOutputCoinInsufficientError ctx]
insufficientCoins =
        ((Address ctx, TokenBundle)
 -> Maybe (SelectionOutputCoinInsufficientError ctx))
-> [(Address ctx, TokenBundle)]
-> [SelectionOutputCoinInsufficientError ctx]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputCoinInsufficientError ctx)
forall ctx.
SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputCoinInsufficientError ctx)
verifyOutputCoinSufficient SelectionConstraints ctx
constraints) [(Address ctx, TokenBundle)]
outputsToCover

    outputsToCover :: [(Address ctx, TokenBundle)]
outputsToCover =
        (Address ctx -> TokenMap -> Coin)
-> [(Address ctx, TokenBundle)] -> [(Address ctx, TokenBundle)]
forall (f :: * -> *) address.
Functor f =>
(address -> TokenMap -> Coin)
-> f (address, TokenBundle) -> f (address, TokenBundle)
prepareOutputsWith Address ctx -> TokenMap -> Coin
computeMinimumAdaQuantity [(Address ctx, TokenBundle)]
outputsUnprepared

-- | Assigns minimal ada quantities to outputs without ada quantities.
--
-- This function only modifies outputs that have an ada quantity of zero.
-- Outputs that have non-zero ada quantities will not be modified.
--
prepareOutputsWith
    :: forall f address. Functor f
    => (address -> TokenMap -> Coin)
    -> f (address, TokenBundle)
    -> f (address, TokenBundle)
prepareOutputsWith :: (address -> TokenMap -> Coin)
-> f (address, TokenBundle) -> f (address, TokenBundle)
prepareOutputsWith address -> TokenMap -> Coin
minCoinValueFor =
    ((address, TokenBundle) -> (address, TokenBundle))
-> f (address, TokenBundle) -> f (address, TokenBundle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (address, TokenBundle) -> (address, TokenBundle)
augmentBundle
  where
    augmentBundle :: (address, TokenBundle) -> (address, TokenBundle)
    augmentBundle :: (address, TokenBundle) -> (address, TokenBundle)
augmentBundle (address
addr, TokenBundle
bundle) = (address
addr,) (TokenBundle -> (address, TokenBundle))
-> TokenBundle -> (address, TokenBundle)
forall a b. (a -> b) -> a -> b
$
        if TokenBundle -> Coin
TokenBundle.getCoin TokenBundle
bundle Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> Coin
Coin Natural
0
        then TokenBundle
bundle TokenBundle -> (TokenBundle -> TokenBundle) -> TokenBundle
forall a b. a -> (a -> b) -> b
& Lens TokenBundle TokenBundle Coin Coin
-> Coin -> TokenBundle -> TokenBundle
forall s t a b. Lens s t a b -> b -> s -> t
set IsLabel "coin" ((Coin -> f Coin) -> TokenBundle -> f TokenBundle)
Lens TokenBundle TokenBundle Coin Coin
#coin (address -> TokenMap -> Coin
minCoinValueFor address
addr (((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
bundle))
        else TokenBundle
bundle

-- | Indicates a problem when preparing outputs for a coin selection.
--
data SelectionOutputError ctx
    = SelectionOutputCoinInsufficient
        (SelectionOutputCoinInsufficientError ctx)
    | SelectionOutputSizeExceedsLimit
        (SelectionOutputSizeExceedsLimitError ctx)
    | SelectionOutputTokenQuantityExceedsLimit
        (SelectionOutputTokenQuantityExceedsLimitError ctx)
    deriving (forall x.
 SelectionOutputError ctx -> Rep (SelectionOutputError ctx) x)
-> (forall x.
    Rep (SelectionOutputError ctx) x -> SelectionOutputError ctx)
-> Generic (SelectionOutputError ctx)
forall x.
Rep (SelectionOutputError ctx) x -> SelectionOutputError ctx
forall x.
SelectionOutputError ctx -> Rep (SelectionOutputError ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionOutputError ctx) x -> SelectionOutputError ctx
forall ctx x.
SelectionOutputError ctx -> Rep (SelectionOutputError ctx) x
$cto :: forall ctx x.
Rep (SelectionOutputError ctx) x -> SelectionOutputError ctx
$cfrom :: forall ctx x.
SelectionOutputError ctx -> Rep (SelectionOutputError ctx) x
Generic

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

newtype SelectionOutputSizeExceedsLimitError ctx =
    SelectionOutputSizeExceedsLimitError
    { SelectionOutputSizeExceedsLimitError ctx
-> (Address ctx, TokenBundle)
outputThatExceedsLimit :: (Address ctx, TokenBundle)
    }
    deriving (forall x.
 SelectionOutputSizeExceedsLimitError ctx
 -> Rep (SelectionOutputSizeExceedsLimitError ctx) x)
-> (forall x.
    Rep (SelectionOutputSizeExceedsLimitError ctx) x
    -> SelectionOutputSizeExceedsLimitError ctx)
-> Generic (SelectionOutputSizeExceedsLimitError ctx)
forall x.
Rep (SelectionOutputSizeExceedsLimitError ctx) x
-> SelectionOutputSizeExceedsLimitError ctx
forall x.
SelectionOutputSizeExceedsLimitError ctx
-> Rep (SelectionOutputSizeExceedsLimitError ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionOutputSizeExceedsLimitError ctx) x
-> SelectionOutputSizeExceedsLimitError ctx
forall ctx x.
SelectionOutputSizeExceedsLimitError ctx
-> Rep (SelectionOutputSizeExceedsLimitError ctx) x
$cto :: forall ctx x.
Rep (SelectionOutputSizeExceedsLimitError ctx) x
-> SelectionOutputSizeExceedsLimitError ctx
$cfrom :: forall ctx x.
SelectionOutputSizeExceedsLimitError ctx
-> Rep (SelectionOutputSizeExceedsLimitError ctx) x
Generic

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

-- | Verifies the size of an output.
--
-- Returns 'SelectionOutputSizeExceedsLimitError' if and only if the size
-- exceeds the limit defined by the protocol.
--
verifyOutputSize
    :: SelectionConstraints ctx
    -> (Address ctx, TokenBundle)
    -> Maybe (SelectionOutputSizeExceedsLimitError ctx)
verifyOutputSize :: SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputSizeExceedsLimitError ctx)
verifyOutputSize SelectionConstraints ctx
cs (Address ctx, TokenBundle)
out
    | Bool
withinLimit =
        Maybe (SelectionOutputSizeExceedsLimitError ctx)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        SelectionOutputSizeExceedsLimitError ctx
-> Maybe (SelectionOutputSizeExceedsLimitError ctx)
forall a. a -> Maybe a
Just (SelectionOutputSizeExceedsLimitError ctx
 -> Maybe (SelectionOutputSizeExceedsLimitError ctx))
-> SelectionOutputSizeExceedsLimitError ctx
-> Maybe (SelectionOutputSizeExceedsLimitError ctx)
forall a b. (a -> b) -> a -> b
$ (Address ctx, TokenBundle)
-> SelectionOutputSizeExceedsLimitError ctx
forall ctx.
(Address ctx, TokenBundle)
-> SelectionOutputSizeExceedsLimitError ctx
SelectionOutputSizeExceedsLimitError (Address ctx, TokenBundle)
out
  where
    withinLimit :: Bool
    withinLimit :: Bool
withinLimit =
        case (SelectionConstraints ctx
cs SelectionConstraints ctx
-> (((TokenBundle -> TokenBundleSizeAssessment)
     -> Const
          (TokenBundle -> TokenBundleSizeAssessment)
          (TokenBundle -> TokenBundleSizeAssessment))
    -> SelectionConstraints ctx
    -> Const
         (TokenBundle -> TokenBundleSizeAssessment)
         (SelectionConstraints ctx))
-> TokenBundle
-> TokenBundleSizeAssessment
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "assessTokenBundleSize"
  (((TokenBundle -> TokenBundleSizeAssessment)
    -> Const
         (TokenBundle -> TokenBundleSizeAssessment)
         (TokenBundle -> TokenBundleSizeAssessment))
   -> SelectionConstraints ctx
   -> Const
        (TokenBundle -> TokenBundleSizeAssessment)
        (SelectionConstraints ctx))
((TokenBundle -> TokenBundleSizeAssessment)
 -> Const
      (TokenBundle -> TokenBundleSizeAssessment)
      (TokenBundle -> TokenBundleSizeAssessment))
-> SelectionConstraints ctx
-> Const
     (TokenBundle -> TokenBundleSizeAssessment)
     (SelectionConstraints ctx)
#assessTokenBundleSize) ((Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
out) of
            TokenBundleSizeAssessment
TokenBundleSizeWithinLimit -> Bool
True
            TokenBundleSizeAssessment
TokenBundleSizeExceedsLimit -> Bool
False

-- | Indicates that a token quantity exceeds the maximum quantity that can
--   appear in a transaction output's token bundle.
--
data SelectionOutputTokenQuantityExceedsLimitError ctx =
    SelectionOutputTokenQuantityExceedsLimitError
    { SelectionOutputTokenQuantityExceedsLimitError ctx -> Address ctx
address :: !(Address ctx)
      -- ^ The address to which this token quantity was to be sent.
    , SelectionOutputTokenQuantityExceedsLimitError ctx -> AssetId
asset :: !AssetId
      -- ^ The asset identifier to which this token quantity corresponds.
    , SelectionOutputTokenQuantityExceedsLimitError ctx -> TokenQuantity
quantity :: !TokenQuantity
      -- ^ The token quantity that exceeded the bound.
    , SelectionOutputTokenQuantityExceedsLimitError ctx -> TokenQuantity
quantityMaxBound :: !TokenQuantity
      -- ^ The maximum allowable token quantity.
    }
    deriving (forall x.
 SelectionOutputTokenQuantityExceedsLimitError ctx
 -> Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x)
-> (forall x.
    Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x
    -> SelectionOutputTokenQuantityExceedsLimitError ctx)
-> Generic (SelectionOutputTokenQuantityExceedsLimitError ctx)
forall x.
Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x
-> SelectionOutputTokenQuantityExceedsLimitError ctx
forall x.
SelectionOutputTokenQuantityExceedsLimitError ctx
-> Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x.
Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x
-> SelectionOutputTokenQuantityExceedsLimitError ctx
forall ctx x.
SelectionOutputTokenQuantityExceedsLimitError ctx
-> Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x
$cto :: forall ctx x.
Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x
-> SelectionOutputTokenQuantityExceedsLimitError ctx
$cfrom :: forall ctx x.
SelectionOutputTokenQuantityExceedsLimitError ctx
-> Rep (SelectionOutputTokenQuantityExceedsLimitError ctx) x
Generic

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

-- | Verifies the token quantities of an output.
--
-- Returns a list of token quantities that exceed the limit defined by the
-- protocol.
--
verifyOutputTokenQuantities
    :: (Address ctx, TokenBundle)
    -> [SelectionOutputTokenQuantityExceedsLimitError ctx]
verifyOutputTokenQuantities :: (Address ctx, TokenBundle)
-> [SelectionOutputTokenQuantityExceedsLimitError ctx]
verifyOutputTokenQuantities (Address ctx, TokenBundle)
out =
    [ SelectionOutputTokenQuantityExceedsLimitError :: forall ctx.
Address ctx
-> AssetId
-> TokenQuantity
-> TokenQuantity
-> SelectionOutputTokenQuantityExceedsLimitError ctx
SelectionOutputTokenQuantityExceedsLimitError
        {Address ctx
address :: Address ctx
$sel:address:SelectionOutputTokenQuantityExceedsLimitError :: Address ctx
address, AssetId
asset :: AssetId
$sel:asset:SelectionOutputTokenQuantityExceedsLimitError :: AssetId
asset, TokenQuantity
quantity :: TokenQuantity
$sel:quantity:SelectionOutputTokenQuantityExceedsLimitError :: TokenQuantity
quantity, $sel:quantityMaxBound:SelectionOutputTokenQuantityExceedsLimitError :: TokenQuantity
quantityMaxBound = TokenQuantity
txOutMaxTokenQuantity}
    | let address :: Address ctx
address = (Address ctx, TokenBundle) -> Address ctx
forall a b. (a, b) -> a
fst (Address ctx, TokenBundle)
out
    , (AssetId
asset, TokenQuantity
quantity) <- TokenMap -> [(AssetId, TokenQuantity)]
TokenMap.toFlatList (TokenMap -> [(AssetId, TokenQuantity)])
-> TokenMap -> [(AssetId, TokenQuantity)]
forall a b. (a -> b) -> a -> b
$ ((Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
out) TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens
    , TokenQuantity
quantity TokenQuantity -> TokenQuantity -> Bool
forall a. Ord a => a -> a -> Bool
> TokenQuantity
txOutMaxTokenQuantity
    ]

-- | Verifies that an output's ada quantity is sufficient.
--
-- An output's ada quantity must be greater than or equal to the minimum
-- required quantity for that output.
--
verifyOutputCoinSufficient
    :: SelectionConstraints ctx
    -> (Address ctx, TokenBundle)
    -> Maybe (SelectionOutputCoinInsufficientError ctx)
verifyOutputCoinSufficient :: SelectionConstraints ctx
-> (Address ctx, TokenBundle)
-> Maybe (SelectionOutputCoinInsufficientError ctx)
verifyOutputCoinSufficient SelectionConstraints ctx
constraints (Address ctx, TokenBundle)
output
    | Bool
isBelowMinimum =
        SelectionOutputCoinInsufficientError ctx
-> Maybe (SelectionOutputCoinInsufficientError ctx)
forall a. a -> Maybe a
Just SelectionOutputCoinInsufficientError :: forall ctx.
Coin
-> (Address ctx, TokenBundle)
-> SelectionOutputCoinInsufficientError ctx
SelectionOutputCoinInsufficientError {Coin
minimumExpectedCoin :: Coin
$sel:minimumExpectedCoin:SelectionOutputCoinInsufficientError :: Coin
minimumExpectedCoin, (Address ctx, TokenBundle)
output :: (Address ctx, TokenBundle)
$sel:output:SelectionOutputCoinInsufficientError :: (Address ctx, TokenBundle)
output}
    | Bool
otherwise =
        Maybe (SelectionOutputCoinInsufficientError ctx)
forall a. Maybe a
Nothing
  where
    isBelowMinimum :: Bool
    isBelowMinimum :: Bool
isBelowMinimum = (Address ctx -> TokenBundle -> Bool)
-> (Address ctx, TokenBundle) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SelectionConstraints ctx
constraints SelectionConstraints ctx
-> (((Address ctx -> TokenBundle -> Bool)
     -> Const
          (Address ctx -> TokenBundle -> Bool)
          (Address ctx -> TokenBundle -> Bool))
    -> SelectionConstraints ctx
    -> Const
         (Address ctx -> TokenBundle -> Bool) (SelectionConstraints ctx))
-> Address ctx
-> TokenBundle
-> Bool
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "isBelowMinimumAdaQuantity"
  (((Address ctx -> TokenBundle -> Bool)
    -> Const
         (Address ctx -> TokenBundle -> Bool)
         (Address ctx -> TokenBundle -> Bool))
   -> SelectionConstraints ctx
   -> Const
        (Address ctx -> TokenBundle -> Bool) (SelectionConstraints ctx))
((Address ctx -> TokenBundle -> Bool)
 -> Const
      (Address ctx -> TokenBundle -> Bool)
      (Address ctx -> TokenBundle -> Bool))
-> SelectionConstraints ctx
-> Const
     (Address ctx -> TokenBundle -> Bool) (SelectionConstraints ctx)
#isBelowMinimumAdaQuantity) (Address ctx, TokenBundle)
output

    minimumExpectedCoin :: Coin
    minimumExpectedCoin :: Coin
minimumExpectedCoin =
        (SelectionConstraints ctx
constraints SelectionConstraints ctx
-> (((Address ctx -> TokenMap -> Coin)
     -> Const
          (Address ctx -> TokenMap -> Coin)
          (Address ctx -> TokenMap -> Coin))
    -> SelectionConstraints ctx
    -> Const
         (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
-> Address ctx
-> TokenMap
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "computeMinimumAdaQuantity"
  (((Address ctx -> TokenMap -> Coin)
    -> Const
         (Address ctx -> TokenMap -> Coin)
         (Address ctx -> TokenMap -> Coin))
   -> SelectionConstraints ctx
   -> Const
        (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx))
((Address ctx -> TokenMap -> Coin)
 -> Const
      (Address ctx -> TokenMap -> Coin)
      (Address ctx -> TokenMap -> Coin))
-> SelectionConstraints ctx
-> Const
     (Address ctx -> TokenMap -> Coin) (SelectionConstraints ctx)
#computeMinimumAdaQuantity)
        ((Address ctx, TokenBundle) -> Address ctx
forall a b. (a, b) -> a
fst (Address ctx, TokenBundle)
output)
        ((Address ctx, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address ctx, TokenBundle)
output TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)