{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- This module contains functions for incrementally constructing a selection
-- to be included in a migration plan.
--
-- A selection is the basis for a single transaction.
--
-- Use 'create' to create a selection with one or more inputs.
-- Use 'extend' to extend a selection with an additional input.
--
module Cardano.Wallet.Primitive.Migration.Selection
    (
    -- * Types
      Selection (..)
    , SelectionError (..)
    , SelectionFullError (..)
    , RewardWithdrawal (..)

    -- * Creating selections
    , create

    -- * Extending selections
    , extend

    -- * Balancing selections
    , balance

    -- * Adding value to outputs
    , addValueToOutputs

    -- * Minimizing fees
    , minimizeFee
    , minimizeFeeStep

    -- * Computing bulk properties of selections
    , computeCurrentFee
    , computeCurrentSize
    , computeMinimumFee

    -- * Verifying selections for correctness
    , verify
    , SelectionCorrectness (..)

    ) where

import Prelude

import Cardano.Wallet.Primitive.Types.Address.Constants
    ( maxLengthAddress )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
    ( TokenBundle (..) )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( TokenMap )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxConstraints (..)
    , TxSize
    , txOutMaxCoin
    , txOutputCoinCost
    , txOutputHasValidSize
    , txOutputHasValidTokenQuantities
    )
import Control.Monad
    ( (>=>) )
import Data.Bifunctor
    ( first )
import Data.Either.Extra
    ( eitherToMaybe, maybeToEither )
import Data.Generics.Internal.VL.Lens
    ( view )
import Data.Generics.Labels
    ()
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Maybe
    ( catMaybes, listToMaybe )
import GHC.Generics
    ( Generic )

import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as Set

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

-- | A selection is the basis for a single transaction.
--
-- Use 'create' to create a selection with one or more inputs.
-- Use 'extend' to extend a selection with an additional input.
-- Use 'verify' to verify the correctness of a selection.
--
data Selection input = Selection
    { Selection input -> NonEmpty input
inputIds :: !(NonEmpty input)
      -- ^ The selected inputs.
    , Selection input -> TokenBundle
inputBalance :: !TokenBundle
      -- ^ The total balance of value provided by the inputs.
    , Selection input -> NonEmpty TokenBundle
outputs :: !(NonEmpty TokenBundle)
      -- ^ The outputs, adjusted to pay for the fee.
    , Selection input -> Coin
fee :: !Coin
      -- ^ The actual fee payable for this selection.
    , Selection input -> Coin
feeExcess :: !Coin
      -- ^ The excess over the minimum permissible fee for this selection.
    , Selection input -> TxSize
size :: !TxSize
      -- ^ The size of this selection.
    , Selection input -> Coin
rewardWithdrawal :: !Coin
      -- ^ The reward withdrawal amount, if any.
    }
    deriving (Selection input -> Selection input -> Bool
(Selection input -> Selection input -> Bool)
-> (Selection input -> Selection input -> Bool)
-> Eq (Selection input)
forall input.
Eq input =>
Selection input -> Selection input -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection input -> Selection input -> Bool
$c/= :: forall input.
Eq input =>
Selection input -> Selection input -> Bool
== :: Selection input -> Selection input -> Bool
$c== :: forall input.
Eq input =>
Selection input -> Selection input -> Bool
Eq, (forall x. Selection input -> Rep (Selection input) x)
-> (forall x. Rep (Selection input) x -> Selection input)
-> Generic (Selection input)
forall x. Rep (Selection input) x -> Selection input
forall x. Selection input -> Rep (Selection input) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall input x. Rep (Selection input) x -> Selection input
forall input x. Selection input -> Rep (Selection input) x
$cto :: forall input x. Rep (Selection input) x -> Selection input
$cfrom :: forall input x. Selection input -> Rep (Selection input) x
Generic, Int -> Selection input -> ShowS
[Selection input] -> ShowS
Selection input -> String
(Int -> Selection input -> ShowS)
-> (Selection input -> String)
-> ([Selection input] -> ShowS)
-> Show (Selection input)
forall input. Show input => Int -> Selection input -> ShowS
forall input. Show input => [Selection input] -> ShowS
forall input. Show input => Selection input -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selection input] -> ShowS
$cshowList :: forall input. Show input => [Selection input] -> ShowS
show :: Selection input -> String
$cshow :: forall input. Show input => Selection input -> String
showsPrec :: Int -> Selection input -> ShowS
$cshowsPrec :: forall input. Show input => Int -> Selection input -> ShowS
Show)

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

--------------------------------------------------------------------------------
-- Selection errors
--------------------------------------------------------------------------------

-- | Indicates a failure to create or extend a selection.
--
data SelectionError
    = SelectionAdaInsufficient
    -- ^ Indicates that the desired selection would not have enough ada to pay
    -- for the minimum permissible fee.
    | SelectionFull
    -- ^ Indicates that the desired selection would exceed the maximum
    -- selection size.
      SelectionFullError
    deriving (SelectionError -> SelectionError -> Bool
(SelectionError -> SelectionError -> Bool)
-> (SelectionError -> SelectionError -> Bool) -> Eq SelectionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionError -> SelectionError -> Bool
$c/= :: SelectionError -> SelectionError -> Bool
== :: SelectionError -> SelectionError -> Bool
$c== :: SelectionError -> SelectionError -> Bool
Eq, Int -> SelectionError -> ShowS
[SelectionError] -> ShowS
SelectionError -> String
(Int -> SelectionError -> ShowS)
-> (SelectionError -> String)
-> ([SelectionError] -> ShowS)
-> Show SelectionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionError] -> ShowS
$cshowList :: [SelectionError] -> ShowS
show :: SelectionError -> String
$cshow :: SelectionError -> String
showsPrec :: Int -> SelectionError -> ShowS
$cshowsPrec :: Int -> SelectionError -> ShowS
Show)

data SelectionFullError = SelectionFullError
    { SelectionFullError -> TxSize
selectionSizeMaximum :: TxSize
    , SelectionFullError -> TxSize
selectionSizeRequired :: TxSize
    }
    deriving (SelectionFullError -> SelectionFullError -> Bool
(SelectionFullError -> SelectionFullError -> Bool)
-> (SelectionFullError -> SelectionFullError -> Bool)
-> Eq SelectionFullError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionFullError -> SelectionFullError -> Bool
$c/= :: SelectionFullError -> SelectionFullError -> Bool
== :: SelectionFullError -> SelectionFullError -> Bool
$c== :: SelectionFullError -> SelectionFullError -> Bool
Eq, Int -> SelectionFullError -> ShowS
[SelectionFullError] -> ShowS
SelectionFullError -> String
(Int -> SelectionFullError -> ShowS)
-> (SelectionFullError -> String)
-> ([SelectionFullError] -> ShowS)
-> Show SelectionFullError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionFullError] -> ShowS
$cshowList :: [SelectionFullError] -> ShowS
show :: SelectionFullError -> String
$cshow :: SelectionFullError -> String
showsPrec :: Int -> SelectionFullError -> ShowS
$cshowsPrec :: Int -> SelectionFullError -> ShowS
Show)

--------------------------------------------------------------------------------
-- Creating selections
--------------------------------------------------------------------------------

-- | Creates a selection with the given inputs.
--
-- Guarantees the following property for a returned selection 's':
--
-- >>> verify s == SelectionCorrect
--
-- Returns 'SelectionAdaInsufficient' if the desired selection would not have
-- enough ada to pay for the fee.
--
-- Returns 'SelectionFull' if the desired selection would exceed the maximum
-- selection size.
--
create
    :: TxConstraints
    -> RewardWithdrawal
    -> NonEmpty (input, TokenBundle)
    -> Either SelectionError (Selection input)
create :: TxConstraints
-> RewardWithdrawal
-> NonEmpty (input, TokenBundle)
-> Either SelectionError (Selection input)
create TxConstraints
constraints RewardWithdrawal
reward NonEmpty (input, TokenBundle)
inputs =
    TxConstraints
-> Selection input -> Either SelectionError (Selection input)
forall input.
TxConstraints
-> Selection input -> Either SelectionError (Selection input)
balance TxConstraints
constraints (Selection input -> Either SelectionError (Selection input))
-> Selection input -> Either SelectionError (Selection input)
forall a b. (a -> b) -> a -> b
$ Selection :: forall input.
NonEmpty input
-> TokenBundle
-> NonEmpty TokenBundle
-> Coin
-> Coin
-> TxSize
-> Coin
-> Selection input
Selection
        { $sel:inputBalance:Selection :: TokenBundle
inputBalance = ((input, TokenBundle) -> TokenBundle)
-> NonEmpty (input, TokenBundle) -> TokenBundle
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (input, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd NonEmpty (input, TokenBundle)
inputs
        , $sel:inputIds:Selection :: NonEmpty input
inputIds = (input, TokenBundle) -> input
forall a b. (a, b) -> a
fst ((input, TokenBundle) -> input)
-> NonEmpty (input, TokenBundle) -> NonEmpty input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (input, TokenBundle)
inputs
        , $sel:outputs:Selection :: NonEmpty TokenBundle
outputs = TxConstraints -> TokenMap -> TokenBundle
assignMinimumAdaQuantity TxConstraints
constraints (TokenMap -> TokenBundle)
-> NonEmpty TokenMap -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (NonEmpty TokenMap -> TokenMap -> NonEmpty TokenMap)
-> NonEmpty TokenMap -> [TokenMap] -> NonEmpty TokenMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'
                (TxConstraints -> [TokenMap] -> TokenMap -> NonEmpty TokenMap
addValueToOutputs TxConstraints
constraints ([TokenMap] -> TokenMap -> NonEmpty TokenMap)
-> (NonEmpty TokenMap -> [TokenMap])
-> NonEmpty TokenMap
-> TokenMap
-> NonEmpty TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TokenMap -> [TokenMap]
forall a. NonEmpty a -> [a]
NE.toList)
                (TxConstraints -> [TokenMap] -> TokenMap -> NonEmpty TokenMap
addValueToOutputs TxConstraints
constraints [] (NonEmpty TokenMap -> TokenMap
forall a. NonEmpty a -> a
NE.head NonEmpty TokenMap
inputMaps))
                (NonEmpty TokenMap -> [TokenMap]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty TokenMap
inputMaps)
        , $sel:fee:Selection :: Coin
fee = Natural -> Coin
Coin Natural
0
        , $sel:feeExcess:Selection :: Coin
feeExcess = Natural -> Coin
Coin Natural
0
        , $sel:size:Selection :: TxSize
size = TxSize
forall a. Monoid a => a
mempty
        , $sel:rewardWithdrawal:Selection :: Coin
rewardWithdrawal = RewardWithdrawal -> Coin
unRewardWithdrawal RewardWithdrawal
reward
        }
  where
    inputMaps :: NonEmpty TokenMap
inputMaps = ((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens (TokenBundle -> TokenMap)
-> ((input, TokenBundle) -> TokenBundle)
-> (input, TokenBundle)
-> TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (input, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd ((input, TokenBundle) -> TokenMap)
-> NonEmpty (input, TokenBundle) -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (input, TokenBundle)
inputs

--------------------------------------------------------------------------------
-- Extending selections
--------------------------------------------------------------------------------

-- | Extends a selection with an additional input.
--
-- Guarantees the following property for a returned selection 's':
--
-- >>> verify s == SelectionCorrect
--
-- Returns 'SelectionAdaInsufficient' if the desired selection would not have
-- enough ada to pay for the fee.
--
-- Returns 'SelectionFull' if the desired selection would exceed the maximum
-- selection size.
--
extend
    :: TxConstraints
    -> Selection input
    -> (input, TokenBundle)
    -> Either SelectionError (Selection input)
extend :: TxConstraints
-> Selection input
-> (input, TokenBundle)
-> Either SelectionError (Selection input)
extend TxConstraints
constraints Selection input
selection (input
inputId, TokenBundle
inputBundle) =
    TxConstraints
-> Selection input -> Either SelectionError (Selection input)
forall input.
TxConstraints
-> Selection input -> Either SelectionError (Selection input)
balance TxConstraints
constraints (Selection input -> Either SelectionError (Selection input))
-> Selection input -> Either SelectionError (Selection input)
forall a b. (a -> b) -> a -> b
$ Selection :: forall input.
NonEmpty input
-> TokenBundle
-> NonEmpty TokenBundle
-> Coin
-> Coin
-> TxSize
-> Coin
-> Selection input
Selection
        { $sel:inputBalance:Selection :: TokenBundle
inputBalance = TokenBundle
inputBundle TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> Selection input -> TokenBundle
forall input. Selection input -> TokenBundle
inputBalance Selection input
selection
        , $sel:inputIds:Selection :: NonEmpty input
inputIds = input
inputId input -> NonEmpty input -> NonEmpty input
forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons` Selection input -> NonEmpty input
forall input. Selection input -> NonEmpty input
inputIds Selection input
selection
        , $sel:outputs:Selection :: NonEmpty TokenBundle
outputs = TxConstraints -> TokenMap -> TokenBundle
assignMinimumAdaQuantity TxConstraints
constraints (TokenMap -> TokenBundle)
-> NonEmpty TokenMap -> NonEmpty TokenBundle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            TxConstraints -> [TokenMap] -> TokenMap -> NonEmpty TokenMap
addValueToOutputs TxConstraints
constraints
                (((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens (TokenBundle -> TokenMap) -> [TokenBundle] -> [TokenMap]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TokenBundle -> [TokenBundle]
forall a. NonEmpty a -> [a]
NE.toList (Selection input -> NonEmpty TokenBundle
forall input. Selection input -> NonEmpty TokenBundle
outputs Selection input
selection))
                (((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
inputBundle)
        , $sel:fee:Selection :: Coin
fee = Natural -> Coin
Coin Natural
0
        , $sel:feeExcess:Selection :: Coin
feeExcess = Natural -> Coin
Coin Natural
0
        , $sel:size:Selection :: TxSize
size = TxSize
forall a. Monoid a => a
mempty
        , $sel:rewardWithdrawal:Selection :: Coin
rewardWithdrawal = Selection input -> Coin
forall input. Selection input -> Coin
rewardWithdrawal Selection input
selection
        }

--------------------------------------------------------------------------------
-- Balancing selections
--------------------------------------------------------------------------------

-- | Balances the fee for a given selection.
--
-- The ada quantities of the outputs are maximized in order to minimize the fee
-- excess.
--
-- Pre-condition: outputs have minimal ada quantities.
--
-- Guarantees the following property for a returned selection 's':
--
-- >>> verify s == SelectionCorrect
--
balance
    :: TxConstraints
    -> Selection input
    -> Either SelectionError (Selection input)
balance :: TxConstraints
-> Selection input -> Either SelectionError (Selection input)
balance TxConstraints
constraints Selection input
unbalancedSelection = do
    let minimizedOutputs :: NonEmpty TokenBundle
minimizedOutputs = Selection input -> NonEmpty TokenBundle
forall input. Selection input -> NonEmpty TokenBundle
outputs Selection input
unbalancedSelection
    Coin
unbalancedFee <- (NegativeCoin -> SelectionError)
-> Either NegativeCoin Coin -> Either SelectionError Coin
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (SelectionError -> NegativeCoin -> SelectionError
forall a b. a -> b -> a
const SelectionError
SelectionAdaInsufficient) (Either NegativeCoin Coin -> Either SelectionError Coin)
-> Either NegativeCoin Coin -> Either SelectionError Coin
forall a b. (a -> b) -> a -> b
$
        Selection input -> Either NegativeCoin Coin
forall input. Selection input -> Either NegativeCoin Coin
computeCurrentFee Selection input
unbalancedSelection
    let minimumFeeForUnbalancedSelection :: Coin
minimumFeeForUnbalancedSelection =
            TxConstraints -> Selection input -> Coin
forall input. TxConstraints -> Selection input -> Coin
computeMinimumFee TxConstraints
constraints Selection input
unbalancedSelection
    Coin
unbalancedFeeExcess <- SelectionError -> Maybe Coin -> Either SelectionError Coin
forall a b. a -> Maybe b -> Either a b
maybeToEither SelectionError
SelectionAdaInsufficient (Maybe Coin -> Either SelectionError Coin)
-> Maybe Coin -> Either SelectionError Coin
forall a b. (a -> b) -> a -> b
$
        Coin -> Coin -> Maybe Coin
Coin.subtract Coin
unbalancedFee Coin
minimumFeeForUnbalancedSelection
    let (Coin
minimizedFeeExcess, NonEmpty TokenBundle
maximizedOutputs) = TxConstraints
-> (Coin, NonEmpty TokenBundle) -> (Coin, NonEmpty TokenBundle)
minimizeFee TxConstraints
constraints
            (Coin
unbalancedFeeExcess, NonEmpty TokenBundle
minimizedOutputs)
    let costIncrease :: Coin
costIncrease = Coin -> Coin -> Coin
Coin.distance
            (NonEmpty TokenBundle -> Coin
totalCoinCost NonEmpty TokenBundle
minimizedOutputs)
            (NonEmpty TokenBundle -> Coin
totalCoinCost NonEmpty TokenBundle
maximizedOutputs)
    let balancedSelection :: Selection input
balancedSelection = Selection input
unbalancedSelection
            { $sel:fee:Selection :: Coin
fee = [Coin] -> Coin
forall a. Monoid a => [a] -> a
mconcat
                [ Item [Coin]
Coin
minimumFeeForUnbalancedSelection
                , Item [Coin]
Coin
minimizedFeeExcess
                , Item [Coin]
Coin
costIncrease
                ]
            , $sel:feeExcess:Selection :: Coin
feeExcess = Coin
minimizedFeeExcess
            , $sel:outputs:Selection :: NonEmpty TokenBundle
outputs = NonEmpty TokenBundle
maximizedOutputs
            }
    TxSize
size <- TxConstraints -> TxSize -> Either SelectionError TxSize
guardSize TxConstraints
constraints (TxSize -> Either SelectionError TxSize)
-> TxSize -> Either SelectionError TxSize
forall a b. (a -> b) -> a -> b
$
        TxConstraints -> Selection input -> TxSize
forall input. TxConstraints -> Selection input -> TxSize
computeCurrentSize TxConstraints
constraints Selection input
balancedSelection
    Selection input -> Either SelectionError (Selection input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Selection input
balancedSelection {TxSize
size :: TxSize
$sel:size:Selection :: TxSize
size}
  where
    totalCoinCost :: NonEmpty TokenBundle -> Coin
    totalCoinCost :: NonEmpty TokenBundle -> Coin
totalCoinCost = (TokenBundle -> Coin) -> NonEmpty TokenBundle -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TxConstraints -> Coin -> Coin
txOutputCoinCost TxConstraints
constraints (Coin -> Coin) -> (TokenBundle -> Coin) -> TokenBundle -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin)

assignMinimumAdaQuantity :: TxConstraints -> TokenMap -> TokenBundle
assignMinimumAdaQuantity :: TxConstraints -> TokenMap -> TokenBundle
assignMinimumAdaQuantity TxConstraints
constraints TokenMap
m =
    Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c TokenMap
m
  where
    -- Using @maxLengthAddressFor $ Proxy @k@ via @constraints@ would not help
    -- here, as outputs created by the migration algorithm are assigned with
    -- user-defined addresses.
    --
    -- Something we /could/ do would be to pass in the actual user-defined
    -- addresses here, since they are available in the 'createMigrationPlan'
    -- server handler.
    --
    c :: Coin
c = TxConstraints -> Address -> TokenMap -> Coin
txOutputMinimumAdaQuantity TxConstraints
constraints Address
maxLengthAddress TokenMap
m

--------------------------------------------------------------------------------
-- Adding value to outputs
--------------------------------------------------------------------------------

-- | Adds value (obtained from an input) to an existing set of output maps.
--
-- This function attempts to merge the given value into one of the existing
-- output maps. If merging is successful, then the returned output map list
-- will be identical in length and content to the original output map list,
-- except for the merged output.
--
-- If the given value cannot be merged into one of the existing output maps
-- (because it would cause an output to exceed the output size limit), then
-- this function appends the given output map to the given output map list,
-- effectively creating a new output.
--
-- Pre-condition: all output maps in the given list must be within the output
-- size limit.
--
-- Assuming the above pre-condition is met, this function guarantees that all
-- output maps in the returned list will also be within the output size limit.
--
addValueToOutputs
    :: TxConstraints
    -> [TokenMap]
    -- ^ Outputs
    -> TokenMap
    -- ^ Output value to add
    -> NonEmpty TokenMap
    -- ^ Outputs with the additional value added
addValueToOutputs :: TxConstraints -> [TokenMap] -> TokenMap -> NonEmpty TokenMap
addValueToOutputs TxConstraints
constraints [TokenMap]
outputsOriginal TokenMap
outputUnchecked =
    -- We need to be a bit careful with the output value to be added, as it may
    -- itself be oversized. We split it up if any of the output size limits are
    -- exceeded:
    [TokenMap] -> NonEmpty TokenMap
forall a. [a] -> NonEmpty a
NE.fromList
        ([TokenMap] -> NonEmpty TokenMap)
-> [TokenMap] -> NonEmpty TokenMap
forall a b. (a -> b) -> a -> b
$ ([TokenMap] -> TokenMap -> [TokenMap])
-> [TokenMap] -> NonEmpty TokenMap -> [TokenMap]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((TokenMap -> [TokenMap] -> [TokenMap])
-> [TokenMap] -> TokenMap -> [TokenMap]
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenMap -> [TokenMap] -> [TokenMap]
add) [TokenMap]
outputsOriginal
        (NonEmpty TokenMap -> [TokenMap])
-> NonEmpty TokenMap -> [TokenMap]
forall a b. (a -> b) -> a -> b
$ TxConstraints -> TokenMap -> NonEmpty TokenMap
splitOutputIfLimitsExceeded TxConstraints
constraints TokenMap
outputUnchecked
  where
    -- Add an output value (whose size has been checked) to the existing
    -- outputs, merging it into one of the existing outputs if possible.
    add :: TokenMap -> [TokenMap] -> [TokenMap]
    add :: TokenMap -> [TokenMap] -> [TokenMap]
add TokenMap
output [TokenMap]
outputs = [TokenMap] -> [TokenMap] -> [TokenMap]
run [] [TokenMap]
outputsSorted
      where
        -- Attempt to merge the specified output value into one of the existing
        -- outputs, by trying each existing output in turn, and terminating as
        -- soon as a successful candidate for merging is found.
        run :: [TokenMap] -> [TokenMap] -> [TokenMap]
        run :: [TokenMap] -> [TokenMap] -> [TokenMap]
run [TokenMap]
considered (TokenMap
candidate : [TokenMap]
unconsidered) =
            case TokenMap -> TokenMap -> Maybe TokenMap
safeMerge TokenMap
output TokenMap
candidate of
                Just TokenMap
merged -> TokenMap
merged TokenMap -> [TokenMap] -> [TokenMap]
forall a. a -> [a] -> [a]
: ([TokenMap]
considered [TokenMap] -> [TokenMap] -> [TokenMap]
forall a. Semigroup a => a -> a -> a
<> [TokenMap]
unconsidered)
                Maybe TokenMap
Nothing -> [TokenMap] -> [TokenMap] -> [TokenMap]
run (TokenMap
candidate TokenMap -> [TokenMap] -> [TokenMap]
forall a. a -> [a] -> [a]
: [TokenMap]
considered) [TokenMap]
unconsidered
        run [TokenMap]
considered [] =
            -- Merging with an existing output is not possible, so just make
            -- a new output.
            TokenMap
output TokenMap -> [TokenMap] -> [TokenMap]
forall a. a -> [a] -> [a]
: [TokenMap]
considered

        -- To minimize both the number of merge attempts and the size increase
        -- of the merged output compared to the original, we sort the existing
        -- outputs into ascending order according to the number of assets that
        -- would need to be added to each output.
        --
        -- In the absolute ideal case, where an existing output's assets are a
        -- superset of the output value to be added, merging with that output
        -- will not increase its asset count.
        --
        -- As a tie-breaker, we give priority to outputs with smaller numbers
        -- of assets. Merging with a smaller output is more likely to succeed,
        -- because merging with a larger output is more likely to fall foul of
        -- the output size limit.
        outputsSorted :: [TokenMap]
        outputsSorted :: [TokenMap]
outputsSorted = (TokenMap -> (Int, Int)) -> [TokenMap] -> [TokenMap]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn TokenMap -> (Int, Int)
sortOrder [TokenMap]
outputs
          where
            sortOrder :: TokenMap -> (Int, Int)
sortOrder TokenMap
targetOutput =
                (Int
targetOutputAssetCountIncrease, Int
targetOutputAssetCount)
              where
                targetOutputAssetCount :: Int
targetOutputAssetCount
                    = Set AssetId -> Int
forall a. Set a -> Int
Set.size Set AssetId
targetOutputAssets
                targetOutputAssetCountIncrease :: Int
targetOutputAssetCountIncrease
                    = Set AssetId -> Int
forall a. Set a -> Int
Set.size
                    (Set AssetId -> Int) -> Set AssetId -> Int
forall a b. (a -> b) -> a -> b
$ Set AssetId -> Set AssetId -> Set AssetId
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set AssetId
sourceOutputAssets Set AssetId
targetOutputAssets
                sourceOutputAssets :: Set AssetId
sourceOutputAssets = TokenMap -> Set AssetId
TokenMap.getAssets TokenMap
output
                targetOutputAssets :: Set AssetId
targetOutputAssets = TokenMap -> Set AssetId
TokenMap.getAssets TokenMap
targetOutput

    safeMerge :: TokenMap -> TokenMap -> Maybe TokenMap
    safeMerge :: TokenMap -> TokenMap -> Maybe TokenMap
safeMerge TokenMap
a TokenMap
b
        | Bool
isSafe = TokenMap -> Maybe TokenMap
forall a. a -> Maybe a
Just TokenMap
value
        | Bool
otherwise = Maybe TokenMap
forall a. Maybe a
Nothing
      where
        isSafe :: Bool
isSafe = Bool -> Bool -> Bool
(&&)
            (TxConstraints -> TokenMap -> Bool
txOutputHasValidSizeIfAdaMaximized TxConstraints
constraints TokenMap
value)
            (TxConstraints -> TokenMap -> Bool
txOutputHasValidTokenQuantities TxConstraints
constraints TokenMap
value)
        value :: TokenMap
value = TokenMap
a TokenMap -> TokenMap -> TokenMap
forall a. Semigroup a => a -> a -> a
<> TokenMap
b

--------------------------------------------------------------------------------
-- Splitting output values
--------------------------------------------------------------------------------

-- | Splits up an output map into smaller maps if it exceeds any of the limits.
--
splitOutputIfLimitsExceeded
    :: TxConstraints
    -> TokenMap
    -> NonEmpty TokenMap
splitOutputIfLimitsExceeded :: TxConstraints -> TokenMap -> NonEmpty TokenMap
splitOutputIfLimitsExceeded TxConstraints
constraints =
    TxConstraints -> TokenMap -> NonEmpty TokenMap
splitOutputIfTokenQuantityExceedsLimit TxConstraints
constraints (TokenMap -> NonEmpty TokenMap)
-> (TokenMap -> NonEmpty TokenMap) -> TokenMap -> NonEmpty TokenMap
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
    TxConstraints -> TokenMap -> NonEmpty TokenMap
splitOutputIfSizeExceedsLimit TxConstraints
constraints

-- | Splits up an output map if it exceeds the serialized size limit.
--
splitOutputIfSizeExceedsLimit
    :: TxConstraints
    -> TokenMap
    -> NonEmpty TokenMap
splitOutputIfSizeExceedsLimit :: TxConstraints -> TokenMap -> NonEmpty TokenMap
splitOutputIfSizeExceedsLimit TxConstraints
constraints TokenMap
value
    | TxConstraints -> TokenMap -> Bool
txOutputHasValidSizeIfAdaMaximized TxConstraints
constraints TokenMap
value =
        TokenMap -> NonEmpty TokenMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure TokenMap
value
    | Bool
otherwise =
        TokenMap -> NonEmpty TokenMap
split TokenMap
value NonEmpty TokenMap
-> (TokenMap -> NonEmpty TokenMap) -> NonEmpty TokenMap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxConstraints -> TokenMap -> NonEmpty TokenMap
splitOutputIfSizeExceedsLimit TxConstraints
constraints
    | Bool
otherwise =
        TokenMap -> NonEmpty TokenMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure TokenMap
value
  where
    split :: TokenMap -> NonEmpty TokenMap
split = (TokenMap -> NonEmpty () -> NonEmpty TokenMap)
-> NonEmpty () -> TokenMap -> NonEmpty TokenMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenMap -> NonEmpty () -> NonEmpty TokenMap
forall a. TokenMap -> NonEmpty a -> NonEmpty TokenMap
TokenMap.equipartitionAssets (() () -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:| [()])

-- | Splits up an output map if any individual token quantity exceeds the limit.
--
splitOutputIfTokenQuantityExceedsLimit
    :: TxConstraints
    -> TokenMap
    -> NonEmpty TokenMap
splitOutputIfTokenQuantityExceedsLimit :: TxConstraints -> TokenMap -> NonEmpty TokenMap
splitOutputIfTokenQuantityExceedsLimit
    = (TokenMap -> TokenQuantity -> NonEmpty TokenMap)
-> TokenQuantity -> TokenMap -> NonEmpty TokenMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip TokenMap -> TokenQuantity -> NonEmpty TokenMap
TokenMap.equipartitionQuantitiesWithUpperBound
    (TokenQuantity -> TokenMap -> NonEmpty TokenMap)
-> (TxConstraints -> TokenQuantity)
-> TxConstraints
-> TokenMap
-> NonEmpty TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxConstraints -> TokenQuantity
txOutputMaximumTokenQuantity

-- | Checks that an output has a valid size even if it is assigned the maximum
--   possible ada quantity.
--
-- Using this function to check all outputs provided to 'balance' will ensure
-- that it has complete freedom to adjust the ada quantities of those outputs,
-- without exceeding the output size limit.
--
txOutputHasValidSizeIfAdaMaximized :: TxConstraints -> TokenMap -> Bool
txOutputHasValidSizeIfAdaMaximized :: TxConstraints -> TokenMap -> Bool
txOutputHasValidSizeIfAdaMaximized TxConstraints
constraints TokenMap
output =
    TxConstraints -> TokenBundle -> Bool
txOutputHasValidSize TxConstraints
constraints (Coin -> TokenMap -> TokenBundle
TokenBundle Coin
txOutMaxCoin TokenMap
output)

--------------------------------------------------------------------------------
-- Minimizing fees
--------------------------------------------------------------------------------

-- | Minimizes the given fee excess by adding ada to the given output bundles.
--
-- This function:
--
--  - guarantees to leave all non-ada quantities unchanged.
--
--  - guarantees to not change the length of the list.
--
--  - guarantees that each resulting output bundle will have an ada quantity
--    that is greater than or equal to its original ada quantity.
--
--  - guarantees that the resulting fee excess will be less than or equal to
--    the original fee excess.
--
--  - does not check that the given ada quantities are above the minimum
--    required for each output, and therefore only guarantees that the
--    resulting ada quantities will be above the minimum required if the
--    caller makes this guarantee for the original output bundles.
--
-- This function aims to adjust as few output bundles as possible, and in the
-- ideal case, will increase the ada quantity of just one output bundle.
--
-- Increasing the ada quantity of an output may increase the overall cost of
-- that output, as increasing an ada quantity may increase the length of the
-- binary representation used to encode that quantity.
--
-- By maximizing the ada increase of a single output, and minimizing the ada
-- increases of the remaining outputs, we can minimize the cost increase of
-- the overall selection, and therefore maximize the chance of being able to
-- pay for the selection.
--
-- This is a consequence of the following mathematical relationship:
--
-- Consider a non-negative integer constant 'a' defined in terms of a summation
-- of a fixed number 'n' of non-negative integer variables:
--
--    >>> a = a1 + a2 + a3 + ... + an
--
-- Now consider the total space 's' required to encode all of the variables:
--
--    >>> s = length a1 + length a2 + length a3 + ... + length an
--
-- For any given number base, we can get close to the minimal value of 's' by
-- making the following assignments:
--
--    >>> a1 := a
--    >>> a2 := 0
--    >>> a3 := 0
--    >>> ...
--    >>> an := 0
--
-- Consider the following example, working in base 10:
--
--    >>> a = 999
--    >>> n = 9
--
-- If we were to use a flat distribution, where the constant is partitioned
-- into 'n' equal quantities (modulo rounding), our space cost 's' would be:
--
--    >>> s = length  a1 + length  a2 + length  a3 + ... + length  a9
--    >>> s = length 111 + length 111 + length 111 + ... + length 111
--    >>> s =          3 +          3 +          3 + ... +          3
--    >>> s =          3 × 9
--    >>> s = 27
--
-- But by maximizing 'a1' and minimizing the remaining variables, we can obtain
-- the following smaller space cost:
--
--    >>> s = length  a1 + length  a2 + length  a3 + ... + length  a9
--    >>> s = length 999 + length   0 + length   0 + ... + length   0
--    >>> s =          3 +          1 +          1 + ... +          1
--    >>> s =          3 +          8
--    >>> s = 11
--
minimizeFee
    :: TxConstraints
    -> (Coin, NonEmpty TokenBundle)
    -- ^ Fee excess and output bundles.
    -> (Coin, NonEmpty TokenBundle)
    -- ^ Fee excess and output bundles after optimization.
minimizeFee :: TxConstraints
-> (Coin, NonEmpty TokenBundle) -> (Coin, NonEmpty TokenBundle)
minimizeFee TxConstraints
constraints (Coin
currentFeeExcess, NonEmpty TokenBundle
outputs) =
    [TokenBundle] -> NonEmpty TokenBundle
forall a. [a] -> NonEmpty a
NE.fromList ([TokenBundle] -> NonEmpty TokenBundle)
-> (Coin, [TokenBundle]) -> (Coin, NonEmpty TokenBundle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coin -> [TokenBundle] -> [TokenBundle] -> (Coin, [TokenBundle])
run Coin
currentFeeExcess (NonEmpty TokenBundle -> [TokenBundle]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TokenBundle
outputs) []
  where
    run :: Coin -> [TokenBundle] -> [TokenBundle] -> (Coin, [TokenBundle])
    run :: Coin -> [TokenBundle] -> [TokenBundle] -> (Coin, [TokenBundle])
run (Coin Natural
0) [TokenBundle]
remaining [TokenBundle]
processed =
        (Natural -> Coin
Coin Natural
0, [TokenBundle]
processed [TokenBundle] -> [TokenBundle] -> [TokenBundle]
forall a. Semigroup a => a -> a -> a
<> [TokenBundle]
remaining)
    run Coin
feeExcessRemaining [] [TokenBundle]
processed =
        (Coin
feeExcessRemaining, [TokenBundle]
processed)
    run Coin
feeExcessRemaining (TokenBundle
output : [TokenBundle]
remaining) [TokenBundle]
processed =
        Coin -> [TokenBundle] -> [TokenBundle] -> (Coin, [TokenBundle])
run Coin
feeExcessRemaining' [TokenBundle]
remaining (TokenBundle
output' TokenBundle -> [TokenBundle] -> [TokenBundle]
forall a. a -> [a] -> [a]
: [TokenBundle]
processed)
      where
        (Coin
feeExcessRemaining', TokenBundle
output') =
            TxConstraints -> (Coin, TokenBundle) -> (Coin, TokenBundle)
minimizeFeeStep TxConstraints
constraints (Coin
feeExcessRemaining, TokenBundle
output)

-- | Minimizes the given fee excess by adding ada to the given output.
--
-- This function:
--
--  - guarantees to leave all non-ada quantities unchanged.
--
--  - increases the ada quantity of the given output until it is no longer
--    economically worthwhile to increase it further (i.e., if the cost of
--    a further increase would be greater than the increase itself).
--
--  - guarantees that the resulting output bundle will have an ada quantity
--    that is greater than or equal to its original ada quantity.
--
--  - guarantees that the resulting fee excess will be less than or equal to
--    the original fee excess.
--
-- Returns the minimized fee excess and the modified output.
--
minimizeFeeStep
    :: TxConstraints
    -> (Coin, TokenBundle)
    -- ^ Fee excess and output bundle.
    -> (Coin, TokenBundle)
    -- ^ Fee excess and output bundle after optimization.
minimizeFeeStep :: TxConstraints -> (Coin, TokenBundle) -> (Coin, TokenBundle)
minimizeFeeStep TxConstraints
constraints =
    ((Coin, TokenBundle) -> (Coin, TokenBundle))
-> (Coin, TokenBundle) -> (Coin, TokenBundle)
forall a. Eq a => (a -> a) -> a -> a
findFixedPoint (Coin, TokenBundle) -> (Coin, TokenBundle)
reduceFee
  where
    reduceFee :: (Coin, TokenBundle) -> (Coin, TokenBundle)
    reduceFee :: (Coin, TokenBundle) -> (Coin, TokenBundle)
reduceFee (Coin
feeExcess, TokenBundle
outputBundle)
        | Coin
outputCoinFinal Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
> Coin
outputCoin Bool -> Bool -> Bool
&&
          Coin
outputCoinFinalCostIncrease Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
outputCoinFinalIncrease =
            (Coin
feeExcessFinal, TokenBundle
outputBundleFinal)
        | Bool
otherwise =
            (Coin
feeExcess, TokenBundle
outputBundle)
      where
        outputCoin :: Coin
outputCoin = ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin TokenBundle
outputBundle
        outputCoinMaxCostIncrease :: Coin
outputCoinMaxCostIncrease = Coin -> Coin -> Coin
Coin.distance
            (TxConstraints -> Coin -> Coin
txOutputCoinCost TxConstraints
constraints Coin
outputCoin)
            (TxConstraints -> Coin -> Coin
txOutputCoinCost TxConstraints
constraints (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$ Coin
outputCoin Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
feeExcess)
        outputCoinFinal :: Coin
outputCoinFinal = Natural -> Coin
Coin
            (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Coin -> Natural
unCoin Coin
outputCoin
            Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Coin -> Natural
unCoin Coin
feeExcess
            Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Coin -> Natural
unCoin Coin
outputCoinMaxCostIncrease
        outputCoinFinalCostIncrease :: Coin
outputCoinFinalCostIncrease = Coin -> Coin -> Coin
Coin.distance
            (TxConstraints -> Coin -> Coin
txOutputCoinCost TxConstraints
constraints Coin
outputCoin)
            (TxConstraints -> Coin -> Coin
txOutputCoinCost TxConstraints
constraints Coin
outputCoinFinal)
        outputCoinFinalIncrease :: Coin
outputCoinFinalIncrease = Coin -> Coin -> Coin
Coin.distance Coin
outputCoin Coin
outputCoinFinal
        outputBundleFinal :: TokenBundle
outputBundleFinal = TokenBundle -> Coin -> TokenBundle
TokenBundle.setCoin TokenBundle
outputBundle Coin
outputCoinFinal
        feeExcessFinal :: Coin
feeExcessFinal = Natural -> Coin
Coin
            (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Coin -> Natural
unCoin Coin
feeExcess
            Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Coin -> Natural
unCoin Coin
outputCoinFinalIncrease
            Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Coin -> Natural
unCoin Coin
outputCoinFinalCostIncrease

--------------------------------------------------------------------------------
-- Computing bulk properties of selections
--------------------------------------------------------------------------------

-- | Calculates the current fee for a selection.
--
computeCurrentFee :: Selection input -> Either NegativeCoin Coin
computeCurrentFee :: Selection input -> Either NegativeCoin Coin
computeCurrentFee Selection {TokenBundle
inputBalance :: TokenBundle
$sel:inputBalance:Selection :: forall input. Selection input -> TokenBundle
inputBalance, NonEmpty TokenBundle
outputs :: NonEmpty TokenBundle
$sel:outputs:Selection :: forall input. Selection input -> NonEmpty TokenBundle
outputs, Coin
rewardWithdrawal :: Coin
$sel:rewardWithdrawal:Selection :: forall input. Selection input -> Coin
rewardWithdrawal}
    | Coin
adaBalanceIn Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
adaBalanceOut =
        Coin -> Either NegativeCoin Coin
forall a b. b -> Either a b
Right Coin
adaDifference
    | Bool
otherwise =
        NegativeCoin -> Either NegativeCoin Coin
forall a b. a -> Either a b
Left (Coin -> NegativeCoin
NegativeCoin Coin
adaDifference)
  where
    adaBalanceIn :: Coin
adaBalanceIn =
        Coin
rewardWithdrawal Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin TokenBundle
inputBalance
    adaBalanceOut :: Coin
adaBalanceOut =
        (TokenBundle -> Coin) -> NonEmpty TokenBundle -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TokenBundle -> Coin
TokenBundle.getCoin) NonEmpty TokenBundle
outputs
    adaDifference :: Coin
adaDifference =
        Coin -> Coin -> Coin
Coin.distance Coin
adaBalanceIn Coin
adaBalanceOut

-- | Calculates the current size of a selection.
--
computeCurrentSize
    :: TxConstraints
    -> Selection input
    -> TxSize
computeCurrentSize :: TxConstraints -> Selection input -> TxSize
computeCurrentSize TxConstraints
constraints Selection input
selection = [TxSize] -> TxSize
forall a. Monoid a => [a] -> a
mconcat
    [ TxConstraints -> TxSize
txBaseSize TxConstraints
constraints
    , (input -> TxSize) -> NonEmpty input -> TxSize
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TxSize -> input -> TxSize
forall a b. a -> b -> a
const (TxSize -> input -> TxSize) -> TxSize -> input -> TxSize
forall a b. (a -> b) -> a -> b
$ TxConstraints -> TxSize
txInputSize TxConstraints
constraints) (Selection input -> NonEmpty input
forall input. Selection input -> NonEmpty input
inputIds Selection input
selection)
    , (TokenBundle -> TxSize) -> NonEmpty TokenBundle -> TxSize
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TxConstraints -> TokenBundle -> TxSize
txOutputSize TxConstraints
constraints) (Selection input -> NonEmpty TokenBundle
forall input. Selection input -> NonEmpty TokenBundle
outputs Selection input
selection)
    , TxConstraints -> Coin -> TxSize
txRewardWithdrawalSize TxConstraints
constraints (Selection input -> Coin
forall input. Selection input -> Coin
rewardWithdrawal Selection input
selection)
    ]

-- | Calculates the minimum permissible fee for a selection.
--
computeMinimumFee :: TxConstraints -> Selection input -> Coin
computeMinimumFee :: TxConstraints -> Selection input -> Coin
computeMinimumFee TxConstraints
constraints Selection input
selection = [Coin] -> Coin
forall a. Monoid a => [a] -> a
mconcat
    [ TxConstraints -> Coin
txBaseCost TxConstraints
constraints
    , (input -> Coin) -> NonEmpty input -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (Coin -> input -> Coin
forall a b. a -> b -> a
const (Coin -> input -> Coin) -> Coin -> input -> Coin
forall a b. (a -> b) -> a -> b
$ TxConstraints -> Coin
txInputCost TxConstraints
constraints) (Selection input -> NonEmpty input
forall input. Selection input -> NonEmpty input
inputIds Selection input
selection)
    , (TokenBundle -> Coin) -> NonEmpty TokenBundle -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TxConstraints -> TokenBundle -> Coin
txOutputCost TxConstraints
constraints) (Selection input -> NonEmpty TokenBundle
forall input. Selection input -> NonEmpty TokenBundle
outputs Selection input
selection)
    , TxConstraints -> Coin -> Coin
txRewardWithdrawalCost TxConstraints
constraints (Selection input -> Coin
forall input. Selection input -> Coin
rewardWithdrawal Selection input
selection)
    ]

--------------------------------------------------------------------------------
-- Verifying selections for correctness
--------------------------------------------------------------------------------

-- | Indicates whether or not a selection is correct.
--
data SelectionCorrectness
    = SelectionCorrect
    | SelectionIncorrect SelectionCorrectnessError
    deriving (SelectionCorrectness -> SelectionCorrectness -> Bool
(SelectionCorrectness -> SelectionCorrectness -> Bool)
-> (SelectionCorrectness -> SelectionCorrectness -> Bool)
-> Eq SelectionCorrectness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionCorrectness -> SelectionCorrectness -> Bool
$c/= :: SelectionCorrectness -> SelectionCorrectness -> Bool
== :: SelectionCorrectness -> SelectionCorrectness -> Bool
$c== :: SelectionCorrectness -> SelectionCorrectness -> Bool
Eq, Int -> SelectionCorrectness -> ShowS
[SelectionCorrectness] -> ShowS
SelectionCorrectness -> String
(Int -> SelectionCorrectness -> ShowS)
-> (SelectionCorrectness -> String)
-> ([SelectionCorrectness] -> ShowS)
-> Show SelectionCorrectness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionCorrectness] -> ShowS
$cshowList :: [SelectionCorrectness] -> ShowS
show :: SelectionCorrectness -> String
$cshow :: SelectionCorrectness -> String
showsPrec :: Int -> SelectionCorrectness -> ShowS
$cshowsPrec :: Int -> SelectionCorrectness -> ShowS
Show)

-- | Indicates that a selection is incorrect.
--
data SelectionCorrectnessError
    = SelectionAssetBalanceIncorrect
      SelectionAssetBalanceIncorrectError
    | SelectionFeeIncorrect
      SelectionFeeIncorrectError
    | SelectionFeeExcessIncorrect
      SelectionFeeExcessIncorrectError
    | SelectionFeeInsufficient
      SelectionFeeInsufficientError
    | SelectionOutputBelowMinimumAdaQuantity
      SelectionOutputBelowMinimumAdaQuantityError
    | SelectionOutputSizeExceedsLimit
      SelectionOutputSizeExceedsLimitError
    | SelectionSizeExceedsLimit
      SelectionSizeExceedsLimitError
    | SelectionSizeIncorrect
      SelectionSizeIncorrectError
    deriving (SelectionCorrectnessError -> SelectionCorrectnessError -> Bool
(SelectionCorrectnessError -> SelectionCorrectnessError -> Bool)
-> (SelectionCorrectnessError -> SelectionCorrectnessError -> Bool)
-> Eq SelectionCorrectnessError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionCorrectnessError -> SelectionCorrectnessError -> Bool
$c/= :: SelectionCorrectnessError -> SelectionCorrectnessError -> Bool
== :: SelectionCorrectnessError -> SelectionCorrectnessError -> Bool
$c== :: SelectionCorrectnessError -> SelectionCorrectnessError -> Bool
Eq, Int -> SelectionCorrectnessError -> ShowS
[SelectionCorrectnessError] -> ShowS
SelectionCorrectnessError -> String
(Int -> SelectionCorrectnessError -> ShowS)
-> (SelectionCorrectnessError -> String)
-> ([SelectionCorrectnessError] -> ShowS)
-> Show SelectionCorrectnessError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionCorrectnessError] -> ShowS
$cshowList :: [SelectionCorrectnessError] -> ShowS
show :: SelectionCorrectnessError -> String
$cshow :: SelectionCorrectnessError -> String
showsPrec :: Int -> SelectionCorrectnessError -> ShowS
$cshowsPrec :: Int -> SelectionCorrectnessError -> ShowS
Show)

-- | 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 value is incorrect in some way.
--
verify
    :: TxConstraints
    -> Selection input
    -> SelectionCorrectness
verify :: TxConstraints -> Selection input -> SelectionCorrectness
verify TxConstraints
constraints Selection input
selection =
    (SelectionCorrectnessError -> SelectionCorrectness)
-> (() -> SelectionCorrectness)
-> Either SelectionCorrectnessError ()
-> SelectionCorrectness
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SelectionCorrectnessError -> SelectionCorrectness
SelectionIncorrect (SelectionCorrectness -> () -> SelectionCorrectness
forall a b. a -> b -> a
const SelectionCorrectness
SelectionCorrect) Either SelectionCorrectnessError ()
verifyAll
  where
    verifyAll :: Either SelectionCorrectnessError ()
    verifyAll :: Either SelectionCorrectnessError ()
verifyAll = do
        Selection input -> Maybe SelectionAssetBalanceIncorrectError
forall input.
Selection input -> Maybe SelectionAssetBalanceIncorrectError
checkAssetBalance Selection input
selection
            Maybe SelectionAssetBalanceIncorrectError
-> (SelectionAssetBalanceIncorrectError
    -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionAssetBalanceIncorrectError -> SelectionCorrectnessError
SelectionAssetBalanceIncorrect
        Selection input -> Maybe SelectionFeeIncorrectError
forall input. Selection input -> Maybe SelectionFeeIncorrectError
checkFee Selection input
selection
            Maybe SelectionFeeIncorrectError
-> (SelectionFeeIncorrectError -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionFeeIncorrectError -> SelectionCorrectnessError
SelectionFeeIncorrect
        TxConstraints
-> Selection input -> Maybe SelectionFeeInsufficientError
forall input.
TxConstraints
-> Selection input -> Maybe SelectionFeeInsufficientError
checkFeeSufficient TxConstraints
constraints Selection input
selection
            Maybe SelectionFeeInsufficientError
-> (SelectionFeeInsufficientError -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionFeeInsufficientError -> SelectionCorrectnessError
SelectionFeeInsufficient
        TxConstraints
-> Selection input -> Maybe SelectionFeeExcessIncorrectError
forall input.
TxConstraints
-> Selection input -> Maybe SelectionFeeExcessIncorrectError
checkFeeExcess TxConstraints
constraints Selection input
selection
            Maybe SelectionFeeExcessIncorrectError
-> (SelectionFeeExcessIncorrectError -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionFeeExcessIncorrectError -> SelectionCorrectnessError
SelectionFeeExcessIncorrect
        TxConstraints
-> Selection input
-> Maybe SelectionOutputBelowMinimumAdaQuantityError
forall input.
TxConstraints
-> Selection input
-> Maybe SelectionOutputBelowMinimumAdaQuantityError
checkOutputMinimumAdaQuantities TxConstraints
constraints Selection input
selection
            Maybe SelectionOutputBelowMinimumAdaQuantityError
-> (SelectionOutputBelowMinimumAdaQuantityError
    -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionOutputBelowMinimumAdaQuantityError
-> SelectionCorrectnessError
SelectionOutputBelowMinimumAdaQuantity
        TxConstraints
-> Selection input -> Maybe SelectionOutputSizeExceedsLimitError
forall input.
TxConstraints
-> Selection input -> Maybe SelectionOutputSizeExceedsLimitError
checkOutputSizes TxConstraints
constraints Selection input
selection
            Maybe SelectionOutputSizeExceedsLimitError
-> (SelectionOutputSizeExceedsLimitError
    -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionOutputSizeExceedsLimitError -> SelectionCorrectnessError
SelectionOutputSizeExceedsLimit
        TxConstraints
-> Selection input -> Maybe SelectionSizeExceedsLimitError
forall input.
TxConstraints
-> Selection input -> Maybe SelectionSizeExceedsLimitError
checkSizeWithinLimit TxConstraints
constraints Selection input
selection
            Maybe SelectionSizeExceedsLimitError
-> (SelectionSizeExceedsLimitError -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionSizeExceedsLimitError -> SelectionCorrectnessError
SelectionSizeExceedsLimit
        TxConstraints
-> Selection input -> Maybe SelectionSizeIncorrectError
forall input.
TxConstraints
-> Selection input -> Maybe SelectionSizeIncorrectError
checkSizeCorrectness TxConstraints
constraints Selection input
selection
            Maybe SelectionSizeIncorrectError
-> (SelectionSizeIncorrectError -> SelectionCorrectnessError)
-> Either SelectionCorrectnessError ()
forall e1 e2. Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` SelectionSizeIncorrectError -> SelectionCorrectnessError
SelectionSizeIncorrect

    failWith :: Maybe e1 -> (e1 -> e2) -> Either e2 ()
    Maybe e1
onError failWith :: Maybe e1 -> (e1 -> e2) -> Either e2 ()
`failWith` e1 -> e2
thisError = Either e2 () -> (e1 -> Either e2 ()) -> Maybe e1 -> Either e2 ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either e2 ()
forall a b. b -> Either a b
Right ()) (e2 -> Either e2 ()
forall a b. a -> Either a b
Left (e2 -> Either e2 ()) -> (e1 -> e2) -> e1 -> Either e2 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
thisError) Maybe e1
onError

--------------------------------------------------------------------------------
-- Selection correctness: asset balance correctness
--------------------------------------------------------------------------------

data SelectionAssetBalanceIncorrectError = SelectionAssetBalanceIncorrectError
    { SelectionAssetBalanceIncorrectError -> TokenMap
assetBalanceInputs
        :: TokenMap
    , SelectionAssetBalanceIncorrectError -> TokenMap
assetBalanceOutputs
        :: TokenMap
    }
    deriving (SelectionAssetBalanceIncorrectError
-> SelectionAssetBalanceIncorrectError -> Bool
(SelectionAssetBalanceIncorrectError
 -> SelectionAssetBalanceIncorrectError -> Bool)
-> (SelectionAssetBalanceIncorrectError
    -> SelectionAssetBalanceIncorrectError -> Bool)
-> Eq SelectionAssetBalanceIncorrectError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionAssetBalanceIncorrectError
-> SelectionAssetBalanceIncorrectError -> Bool
$c/= :: SelectionAssetBalanceIncorrectError
-> SelectionAssetBalanceIncorrectError -> Bool
== :: SelectionAssetBalanceIncorrectError
-> SelectionAssetBalanceIncorrectError -> Bool
$c== :: SelectionAssetBalanceIncorrectError
-> SelectionAssetBalanceIncorrectError -> Bool
Eq, Int -> SelectionAssetBalanceIncorrectError -> ShowS
[SelectionAssetBalanceIncorrectError] -> ShowS
SelectionAssetBalanceIncorrectError -> String
(Int -> SelectionAssetBalanceIncorrectError -> ShowS)
-> (SelectionAssetBalanceIncorrectError -> String)
-> ([SelectionAssetBalanceIncorrectError] -> ShowS)
-> Show SelectionAssetBalanceIncorrectError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionAssetBalanceIncorrectError] -> ShowS
$cshowList :: [SelectionAssetBalanceIncorrectError] -> ShowS
show :: SelectionAssetBalanceIncorrectError -> String
$cshow :: SelectionAssetBalanceIncorrectError -> String
showsPrec :: Int -> SelectionAssetBalanceIncorrectError -> ShowS
$cshowsPrec :: Int -> SelectionAssetBalanceIncorrectError -> ShowS
Show)

checkAssetBalance
    :: Selection input
    -> Maybe SelectionAssetBalanceIncorrectError
checkAssetBalance :: Selection input -> Maybe SelectionAssetBalanceIncorrectError
checkAssetBalance Selection {TokenBundle
inputBalance :: TokenBundle
$sel:inputBalance:Selection :: forall input. Selection input -> TokenBundle
inputBalance, NonEmpty TokenBundle
outputs :: NonEmpty TokenBundle
$sel:outputs:Selection :: forall input. Selection input -> NonEmpty TokenBundle
outputs}
    | TokenMap
assetBalanceInputs TokenMap -> TokenMap -> Bool
forall a. Eq a => a -> a -> Bool
== TokenMap
assetBalanceOutputs =
        Maybe SelectionAssetBalanceIncorrectError
forall a. Maybe a
Nothing
    | Bool
otherwise =
        SelectionAssetBalanceIncorrectError
-> Maybe SelectionAssetBalanceIncorrectError
forall a. a -> Maybe a
Just SelectionAssetBalanceIncorrectError :: TokenMap -> TokenMap -> SelectionAssetBalanceIncorrectError
SelectionAssetBalanceIncorrectError
            { TokenMap
assetBalanceInputs :: TokenMap
$sel:assetBalanceInputs:SelectionAssetBalanceIncorrectError :: TokenMap
assetBalanceInputs
            , TokenMap
assetBalanceOutputs :: TokenMap
$sel:assetBalanceOutputs:SelectionAssetBalanceIncorrectError :: TokenMap
assetBalanceOutputs
            }
  where
    assetBalanceInputs :: TokenMap
assetBalanceInputs = ((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
inputBalance
    assetBalanceOutputs :: TokenMap
assetBalanceOutputs = (TokenBundle -> TokenMap) -> NonEmpty TokenBundle -> TokenMap
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TokenBundle -> TokenMap
tokens) NonEmpty TokenBundle
outputs

--------------------------------------------------------------------------------
-- Selection correctness: fee correctness
--------------------------------------------------------------------------------

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

checkFee :: Selection input -> Maybe SelectionFeeIncorrectError
checkFee :: Selection input -> Maybe SelectionFeeIncorrectError
checkFee Selection input
selection =
    case Selection input -> Either NegativeCoin Coin
forall input. Selection input -> Either NegativeCoin Coin
computeCurrentFee Selection input
selection of
      Left NegativeCoin
negativeFee ->
          SelectionFeeIncorrectError -> Maybe SelectionFeeIncorrectError
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionFeeIncorrectError :: Either NegativeCoin Coin -> Coin -> SelectionFeeIncorrectError
SelectionFeeIncorrectError
              { $sel:selectionFeeComputed:SelectionFeeIncorrectError :: Either NegativeCoin Coin
selectionFeeComputed = NegativeCoin -> Either NegativeCoin Coin
forall a b. a -> Either a b
Left NegativeCoin
negativeFee
              , $sel:selectionFeeStored:SelectionFeeIncorrectError :: Coin
selectionFeeStored = Selection input -> Coin
forall input. Selection input -> Coin
fee Selection input
selection
              }
      Right Coin
positiveFee | Coin
positiveFee Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Selection input -> Coin
forall input. Selection input -> Coin
fee Selection input
selection ->
          SelectionFeeIncorrectError -> Maybe SelectionFeeIncorrectError
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionFeeIncorrectError :: Either NegativeCoin Coin -> Coin -> SelectionFeeIncorrectError
SelectionFeeIncorrectError
              { $sel:selectionFeeComputed:SelectionFeeIncorrectError :: Either NegativeCoin Coin
selectionFeeComputed = Coin -> Either NegativeCoin Coin
forall a b. b -> Either a b
Right Coin
positiveFee
              , $sel:selectionFeeStored:SelectionFeeIncorrectError :: Coin
selectionFeeStored = Selection input -> Coin
forall input. Selection input -> Coin
fee Selection input
selection
              }
      Right Coin
_ ->
          Maybe SelectionFeeIncorrectError
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- Selection correctness: fee excess correctness
--------------------------------------------------------------------------------

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

checkFeeExcess
    :: TxConstraints
    -> Selection input
    -> Maybe SelectionFeeExcessIncorrectError
checkFeeExcess :: TxConstraints
-> Selection input -> Maybe SelectionFeeExcessIncorrectError
checkFeeExcess TxConstraints
constraints Selection input
selection =
    Coin -> Maybe SelectionFeeExcessIncorrectError
checkInner (Coin -> Maybe SelectionFeeExcessIncorrectError)
-> Maybe Coin -> Maybe SelectionFeeExcessIncorrectError
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either NegativeCoin Coin -> Maybe Coin
forall a b. Either a b -> Maybe b
eitherToMaybe (Selection input -> Either NegativeCoin Coin
forall input. Selection input -> Either NegativeCoin Coin
computeCurrentFee Selection input
selection)
  where
    checkInner :: Coin -> Maybe SelectionFeeExcessIncorrectError
    checkInner :: Coin -> Maybe SelectionFeeExcessIncorrectError
checkInner Coin
currentSelectionFee
        | Coin
selectionFeeExcessExpected Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
selectionFeeExcessActual =
            Maybe SelectionFeeExcessIncorrectError
forall a. Maybe a
Nothing
        | Bool
otherwise =
            SelectionFeeExcessIncorrectError
-> Maybe SelectionFeeExcessIncorrectError
forall a. a -> Maybe a
Just SelectionFeeExcessIncorrectError :: Coin -> Coin -> SelectionFeeExcessIncorrectError
SelectionFeeExcessIncorrectError
                { Coin
selectionFeeExcessActual :: Coin
$sel:selectionFeeExcessActual:SelectionFeeExcessIncorrectError :: Coin
selectionFeeExcessActual
                , Coin
selectionFeeExcessExpected :: Coin
$sel:selectionFeeExcessExpected:SelectionFeeExcessIncorrectError :: Coin
selectionFeeExcessExpected
                }
      where
        selectionFeeExcessActual :: Coin
selectionFeeExcessActual = Selection input -> Coin
forall input. Selection input -> Coin
feeExcess Selection input
selection
        selectionFeeExcessExpected :: Coin
selectionFeeExcessExpected = Coin -> Coin -> Coin
Coin.distance
            (Coin
currentSelectionFee)
            (TxConstraints -> Selection input -> Coin
forall input. TxConstraints -> Selection input -> Coin
computeMinimumFee TxConstraints
constraints Selection input
selection)

--------------------------------------------------------------------------------
-- Selection correctness: fee sufficiency
--------------------------------------------------------------------------------

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

checkFeeSufficient
    :: TxConstraints
    -> Selection input
    -> Maybe SelectionFeeInsufficientError
checkFeeSufficient :: TxConstraints
-> Selection input -> Maybe SelectionFeeInsufficientError
checkFeeSufficient TxConstraints
constraints Selection input
selection =
    case Selection input -> Either NegativeCoin Coin
forall input. Selection input -> Either NegativeCoin Coin
computeCurrentFee Selection input
selection of
        Left NegativeCoin
nf ->
            SelectionFeeInsufficientError
-> Maybe SelectionFeeInsufficientError
forall a. a -> Maybe a
Just SelectionFeeInsufficientError :: Either NegativeCoin Coin -> Coin -> SelectionFeeInsufficientError
SelectionFeeInsufficientError
                { $sel:selectionFeeActual:SelectionFeeInsufficientError :: Either NegativeCoin Coin
selectionFeeActual = NegativeCoin -> Either NegativeCoin Coin
forall a b. a -> Either a b
Left NegativeCoin
nf
                , Coin
selectionFeeMinimum :: Coin
$sel:selectionFeeMinimum:SelectionFeeInsufficientError :: Coin
selectionFeeMinimum
                }
        Right Coin
pf | Coin
pf Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
selectionFeeMinimum ->
            SelectionFeeInsufficientError
-> Maybe SelectionFeeInsufficientError
forall a. a -> Maybe a
Just SelectionFeeInsufficientError :: Either NegativeCoin Coin -> Coin -> SelectionFeeInsufficientError
SelectionFeeInsufficientError
                { $sel:selectionFeeActual:SelectionFeeInsufficientError :: Either NegativeCoin Coin
selectionFeeActual = Coin -> Either NegativeCoin Coin
forall a b. b -> Either a b
Right Coin
pf
                , Coin
selectionFeeMinimum :: Coin
$sel:selectionFeeMinimum:SelectionFeeInsufficientError :: Coin
selectionFeeMinimum
                }
        Right Coin
_ ->
            Maybe SelectionFeeInsufficientError
forall a. Maybe a
Nothing
  where
    selectionFeeMinimum :: Coin
selectionFeeMinimum = TxConstraints -> Selection input -> Coin
forall input. TxConstraints -> Selection input -> Coin
computeMinimumFee TxConstraints
constraints Selection input
selection

--------------------------------------------------------------------------------
-- Selection correctness: minimum ada quantities
--------------------------------------------------------------------------------

data SelectionOutputBelowMinimumAdaQuantityError =
    SelectionOutputBelowMinimumAdaQuantityError
        { SelectionOutputBelowMinimumAdaQuantityError -> TokenBundle
outputBundle :: TokenBundle
          -- ^ The output that is below the expected minimum ada quantity.
        , SelectionOutputBelowMinimumAdaQuantityError -> Coin
expectedMinimumAdaQuantity :: Coin
          -- ^ The expected minimum ada quantity.
        }
    deriving (SelectionOutputBelowMinimumAdaQuantityError
-> SelectionOutputBelowMinimumAdaQuantityError -> Bool
(SelectionOutputBelowMinimumAdaQuantityError
 -> SelectionOutputBelowMinimumAdaQuantityError -> Bool)
-> (SelectionOutputBelowMinimumAdaQuantityError
    -> SelectionOutputBelowMinimumAdaQuantityError -> Bool)
-> Eq SelectionOutputBelowMinimumAdaQuantityError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionOutputBelowMinimumAdaQuantityError
-> SelectionOutputBelowMinimumAdaQuantityError -> Bool
$c/= :: SelectionOutputBelowMinimumAdaQuantityError
-> SelectionOutputBelowMinimumAdaQuantityError -> Bool
== :: SelectionOutputBelowMinimumAdaQuantityError
-> SelectionOutputBelowMinimumAdaQuantityError -> Bool
$c== :: SelectionOutputBelowMinimumAdaQuantityError
-> SelectionOutputBelowMinimumAdaQuantityError -> Bool
Eq, Int -> SelectionOutputBelowMinimumAdaQuantityError -> ShowS
[SelectionOutputBelowMinimumAdaQuantityError] -> ShowS
SelectionOutputBelowMinimumAdaQuantityError -> String
(Int -> SelectionOutputBelowMinimumAdaQuantityError -> ShowS)
-> (SelectionOutputBelowMinimumAdaQuantityError -> String)
-> ([SelectionOutputBelowMinimumAdaQuantityError] -> ShowS)
-> Show SelectionOutputBelowMinimumAdaQuantityError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionOutputBelowMinimumAdaQuantityError] -> ShowS
$cshowList :: [SelectionOutputBelowMinimumAdaQuantityError] -> ShowS
show :: SelectionOutputBelowMinimumAdaQuantityError -> String
$cshow :: SelectionOutputBelowMinimumAdaQuantityError -> String
showsPrec :: Int -> SelectionOutputBelowMinimumAdaQuantityError -> ShowS
$cshowsPrec :: Int -> SelectionOutputBelowMinimumAdaQuantityError -> ShowS
Show)

checkOutputMinimumAdaQuantities
    :: TxConstraints
    -> Selection input
    -> Maybe SelectionOutputBelowMinimumAdaQuantityError
checkOutputMinimumAdaQuantities :: TxConstraints
-> Selection input
-> Maybe SelectionOutputBelowMinimumAdaQuantityError
checkOutputMinimumAdaQuantities TxConstraints
constraints Selection input
selection =
     NonEmpty (Maybe SelectionOutputBelowMinimumAdaQuantityError)
-> Maybe SelectionOutputBelowMinimumAdaQuantityError
forall a. NonEmpty (Maybe a) -> Maybe a
maybesToMaybe (NonEmpty (Maybe SelectionOutputBelowMinimumAdaQuantityError)
 -> Maybe SelectionOutputBelowMinimumAdaQuantityError)
-> NonEmpty (Maybe SelectionOutputBelowMinimumAdaQuantityError)
-> Maybe SelectionOutputBelowMinimumAdaQuantityError
forall a b. (a -> b) -> a -> b
$ TokenBundle -> Maybe SelectionOutputBelowMinimumAdaQuantityError
checkOutput (TokenBundle -> Maybe SelectionOutputBelowMinimumAdaQuantityError)
-> NonEmpty TokenBundle
-> NonEmpty (Maybe SelectionOutputBelowMinimumAdaQuantityError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selection input -> NonEmpty TokenBundle
forall input. Selection input -> NonEmpty TokenBundle
outputs Selection input
selection
  where
    checkOutput
        :: TokenBundle
        -> Maybe SelectionOutputBelowMinimumAdaQuantityError
    checkOutput :: TokenBundle -> Maybe SelectionOutputBelowMinimumAdaQuantityError
checkOutput TokenBundle
outputBundle
        | TokenBundle -> Coin
TokenBundle.getCoin TokenBundle
outputBundle Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
expectedMinimumAdaQuantity =
            Maybe SelectionOutputBelowMinimumAdaQuantityError
forall a. Maybe a
Nothing
        | Bool
otherwise =
            SelectionOutputBelowMinimumAdaQuantityError
-> Maybe SelectionOutputBelowMinimumAdaQuantityError
forall a. a -> Maybe a
Just SelectionOutputBelowMinimumAdaQuantityError :: TokenBundle -> Coin -> SelectionOutputBelowMinimumAdaQuantityError
SelectionOutputBelowMinimumAdaQuantityError
                { TokenBundle
outputBundle :: TokenBundle
$sel:outputBundle:SelectionOutputBelowMinimumAdaQuantityError :: TokenBundle
outputBundle
                , Coin
expectedMinimumAdaQuantity :: Coin
$sel:expectedMinimumAdaQuantity:SelectionOutputBelowMinimumAdaQuantityError :: Coin
expectedMinimumAdaQuantity
                }
      where
        expectedMinimumAdaQuantity :: Coin
expectedMinimumAdaQuantity = TxConstraints -> Address -> TokenMap -> Coin
txOutputMinimumAdaQuantity TxConstraints
constraints
            Address
maxLengthAddress
            (((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
outputBundle)

--------------------------------------------------------------------------------
-- Selection correctness: output sizes
--------------------------------------------------------------------------------

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

checkOutputSizes
    :: TxConstraints
    -> Selection input
    -> Maybe SelectionOutputSizeExceedsLimitError
checkOutputSizes :: TxConstraints
-> Selection input -> Maybe SelectionOutputSizeExceedsLimitError
checkOutputSizes TxConstraints
constraints Selection input
selection =
     NonEmpty (Maybe SelectionOutputSizeExceedsLimitError)
-> Maybe SelectionOutputSizeExceedsLimitError
forall a. NonEmpty (Maybe a) -> Maybe a
maybesToMaybe (NonEmpty (Maybe SelectionOutputSizeExceedsLimitError)
 -> Maybe SelectionOutputSizeExceedsLimitError)
-> NonEmpty (Maybe SelectionOutputSizeExceedsLimitError)
-> Maybe SelectionOutputSizeExceedsLimitError
forall a b. (a -> b) -> a -> b
$ TokenBundle -> Maybe SelectionOutputSizeExceedsLimitError
checkOutput (TokenBundle -> Maybe SelectionOutputSizeExceedsLimitError)
-> NonEmpty TokenBundle
-> NonEmpty (Maybe SelectionOutputSizeExceedsLimitError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selection input -> NonEmpty TokenBundle
forall input. Selection input -> NonEmpty TokenBundle
outputs Selection input
selection
  where
    checkOutput
        :: TokenBundle
        -> Maybe SelectionOutputSizeExceedsLimitError
    checkOutput :: TokenBundle -> Maybe SelectionOutputSizeExceedsLimitError
checkOutput TokenBundle
selectionOutput
        | TxConstraints -> TokenBundle -> Bool
txOutputHasValidSize TxConstraints
constraints TokenBundle
selectionOutput =
            Maybe SelectionOutputSizeExceedsLimitError
forall a. Maybe a
Nothing
        | Bool
otherwise =
            SelectionOutputSizeExceedsLimitError
-> Maybe SelectionOutputSizeExceedsLimitError
forall a. a -> Maybe a
Just SelectionOutputSizeExceedsLimitError :: TokenBundle -> SelectionOutputSizeExceedsLimitError
SelectionOutputSizeExceedsLimitError
                { TokenBundle
selectionOutput :: TokenBundle
$sel:selectionOutput:SelectionOutputSizeExceedsLimitError :: TokenBundle
selectionOutput }

--------------------------------------------------------------------------------
-- Selection correctness: selection size (in comparison to the stored value)
--------------------------------------------------------------------------------

data SelectionSizeIncorrectError = SelectionSizeIncorrectError
    { SelectionSizeIncorrectError -> TxSize
selectionSizeComputed :: TxSize
    , SelectionSizeIncorrectError -> TxSize
selectionSizeStored :: TxSize
    }
    deriving (SelectionSizeIncorrectError -> SelectionSizeIncorrectError -> Bool
(SelectionSizeIncorrectError
 -> SelectionSizeIncorrectError -> Bool)
-> (SelectionSizeIncorrectError
    -> SelectionSizeIncorrectError -> Bool)
-> Eq SelectionSizeIncorrectError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionSizeIncorrectError -> SelectionSizeIncorrectError -> Bool
$c/= :: SelectionSizeIncorrectError -> SelectionSizeIncorrectError -> Bool
== :: SelectionSizeIncorrectError -> SelectionSizeIncorrectError -> Bool
$c== :: SelectionSizeIncorrectError -> SelectionSizeIncorrectError -> Bool
Eq, Int -> SelectionSizeIncorrectError -> ShowS
[SelectionSizeIncorrectError] -> ShowS
SelectionSizeIncorrectError -> String
(Int -> SelectionSizeIncorrectError -> ShowS)
-> (SelectionSizeIncorrectError -> String)
-> ([SelectionSizeIncorrectError] -> ShowS)
-> Show SelectionSizeIncorrectError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionSizeIncorrectError] -> ShowS
$cshowList :: [SelectionSizeIncorrectError] -> ShowS
show :: SelectionSizeIncorrectError -> String
$cshow :: SelectionSizeIncorrectError -> String
showsPrec :: Int -> SelectionSizeIncorrectError -> ShowS
$cshowsPrec :: Int -> SelectionSizeIncorrectError -> ShowS
Show)

checkSizeCorrectness
    :: TxConstraints
    -> Selection input
    -> Maybe SelectionSizeIncorrectError
checkSizeCorrectness :: TxConstraints
-> Selection input -> Maybe SelectionSizeIncorrectError
checkSizeCorrectness TxConstraints
constraints Selection input
selection
    | TxSize
selectionSizeComputed TxSize -> TxSize -> Bool
forall a. Eq a => a -> a -> Bool
== TxSize
selectionSizeStored =
        Maybe SelectionSizeIncorrectError
forall a. Maybe a
Nothing
    | Bool
otherwise = SelectionSizeIncorrectError -> Maybe SelectionSizeIncorrectError
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionSizeIncorrectError :: TxSize -> TxSize -> SelectionSizeIncorrectError
SelectionSizeIncorrectError
        { TxSize
selectionSizeComputed :: TxSize
$sel:selectionSizeComputed:SelectionSizeIncorrectError :: TxSize
selectionSizeComputed
        , TxSize
selectionSizeStored :: TxSize
$sel:selectionSizeStored:SelectionSizeIncorrectError :: TxSize
selectionSizeStored
        }
  where
    selectionSizeComputed :: TxSize
selectionSizeComputed = TxConstraints -> Selection input -> TxSize
forall input. TxConstraints -> Selection input -> TxSize
computeCurrentSize TxConstraints
constraints Selection input
selection
    selectionSizeStored :: TxSize
selectionSizeStored = Selection input -> TxSize
forall input. Selection input -> TxSize
size Selection input
selection

--------------------------------------------------------------------------------
-- Selection correctness: selection size (in comparison to the limit)
--------------------------------------------------------------------------------

data SelectionSizeExceedsLimitError = SelectionSizeExceedsLimitError
    { SelectionSizeExceedsLimitError -> TxSize
selectionSizeComputed :: TxSize
    , SelectionSizeExceedsLimitError -> TxSize
selectionSizeMaximum :: TxSize
    }
    deriving (SelectionSizeExceedsLimitError
-> SelectionSizeExceedsLimitError -> Bool
(SelectionSizeExceedsLimitError
 -> SelectionSizeExceedsLimitError -> Bool)
-> (SelectionSizeExceedsLimitError
    -> SelectionSizeExceedsLimitError -> Bool)
-> Eq SelectionSizeExceedsLimitError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionSizeExceedsLimitError
-> SelectionSizeExceedsLimitError -> Bool
$c/= :: SelectionSizeExceedsLimitError
-> SelectionSizeExceedsLimitError -> Bool
== :: SelectionSizeExceedsLimitError
-> SelectionSizeExceedsLimitError -> Bool
$c== :: SelectionSizeExceedsLimitError
-> SelectionSizeExceedsLimitError -> Bool
Eq, Int -> SelectionSizeExceedsLimitError -> ShowS
[SelectionSizeExceedsLimitError] -> ShowS
SelectionSizeExceedsLimitError -> String
(Int -> SelectionSizeExceedsLimitError -> ShowS)
-> (SelectionSizeExceedsLimitError -> String)
-> ([SelectionSizeExceedsLimitError] -> ShowS)
-> Show SelectionSizeExceedsLimitError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionSizeExceedsLimitError] -> ShowS
$cshowList :: [SelectionSizeExceedsLimitError] -> ShowS
show :: SelectionSizeExceedsLimitError -> String
$cshow :: SelectionSizeExceedsLimitError -> String
showsPrec :: Int -> SelectionSizeExceedsLimitError -> ShowS
$cshowsPrec :: Int -> SelectionSizeExceedsLimitError -> ShowS
Show)

checkSizeWithinLimit
    :: TxConstraints
    -> Selection input
    -> Maybe SelectionSizeExceedsLimitError
checkSizeWithinLimit :: TxConstraints
-> Selection input -> Maybe SelectionSizeExceedsLimitError
checkSizeWithinLimit TxConstraints
constraints Selection input
selection
    | TxSize
selectionSizeComputed TxSize -> TxSize -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSize
selectionSizeMaximum =
        Maybe SelectionSizeExceedsLimitError
forall a. Maybe a
Nothing
    | Bool
otherwise = SelectionSizeExceedsLimitError
-> Maybe SelectionSizeExceedsLimitError
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionSizeExceedsLimitError :: TxSize -> TxSize -> SelectionSizeExceedsLimitError
SelectionSizeExceedsLimitError
        { TxSize
selectionSizeComputed :: TxSize
$sel:selectionSizeComputed:SelectionSizeExceedsLimitError :: TxSize
selectionSizeComputed
        , TxSize
selectionSizeMaximum :: TxSize
$sel:selectionSizeMaximum:SelectionSizeExceedsLimitError :: TxSize
selectionSizeMaximum
        }
  where
    selectionSizeComputed :: TxSize
selectionSizeComputed = TxConstraints -> Selection input -> TxSize
forall input. TxConstraints -> Selection input -> TxSize
computeCurrentSize TxConstraints
constraints Selection input
selection
    selectionSizeMaximum :: TxSize
selectionSizeMaximum = TxConstraints -> TxSize
txMaximumSize TxConstraints
constraints

--------------------------------------------------------------------------------
-- Miscellaneous types and functions
--------------------------------------------------------------------------------

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

findFixedPoint :: Eq a => (a -> a) -> a -> a
findFixedPoint :: (a -> a) -> a -> a
findFixedPoint a -> a
f = a -> a
findInner
  where
    findInner :: a -> a
findInner a
a = let fa :: a
fa = a -> a
f a
a in if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
fa then a
a else a -> a
findInner a
fa

guardSize
    :: TxConstraints
    -> TxSize
    -> Either SelectionError TxSize
guardSize :: TxConstraints -> TxSize -> Either SelectionError TxSize
guardSize TxConstraints
constraints TxSize
selectionSizeRequired
    | TxSize
selectionSizeRequired TxSize -> TxSize -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSize
selectionSizeMaximum =
        TxSize -> Either SelectionError TxSize
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxSize
selectionSizeRequired
    | Bool
otherwise =
        SelectionError -> Either SelectionError TxSize
forall a b. a -> Either a b
Left (SelectionError -> Either SelectionError TxSize)
-> SelectionError -> Either SelectionError TxSize
forall a b. (a -> b) -> a -> b
$ SelectionFullError -> SelectionError
SelectionFull SelectionFullError :: TxSize -> TxSize -> SelectionFullError
SelectionFullError
            { TxSize
selectionSizeMaximum :: TxSize
$sel:selectionSizeMaximum:SelectionFullError :: TxSize
selectionSizeMaximum
            , TxSize
selectionSizeRequired :: TxSize
$sel:selectionSizeRequired:SelectionFullError :: TxSize
selectionSizeRequired
            }
  where
    selectionSizeMaximum :: TxSize
selectionSizeMaximum = TxConstraints -> TxSize
txMaximumSize TxConstraints
constraints

maybesToMaybe :: NonEmpty (Maybe a) -> Maybe a
maybesToMaybe :: NonEmpty (Maybe a) -> Maybe a
maybesToMaybe = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a)
-> (NonEmpty (Maybe a) -> [a]) -> NonEmpty (Maybe a) -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a])
-> (NonEmpty (Maybe a) -> [Maybe a]) -> NonEmpty (Maybe a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Maybe a) -> [Maybe a]
forall a. NonEmpty a -> [a]
NE.toList