-- | This module handles auto-balancing of transaction skeleton. This includes
-- computation of fees and collaterals because their computation cannot be
-- separated from the balancing.
module Cooked.MockChain.Balancing
  ( balanceTxSkel,
    getMinAndMaxFee,
    estimateTxSkelFee,
  )
where

import Cardano.Api.Ledger qualified as Cardano
import Cardano.Api.Shelley qualified as Cardano
import Cardano.Ledger.Conway.Core qualified as Conway
import Cardano.Ledger.Conway.PParams qualified as Conway
import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
import Cardano.Node.Emulator.Internal.Node.Validation qualified as Emulator
import Control.Monad
import Control.Monad.Except
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Body
import Cooked.MockChain.MinAda
import Cooked.MockChain.UtxoSearch
import Cooked.Output
import Cooked.Skeleton
import Cooked.Wallet
import Data.Bifunctor
import Data.Function
import Data.List (find, partition, sortBy)
import Data.Map qualified as Map
import Data.Maybe
import Data.Ratio qualified as Rat
import Data.Set (Set)
import Data.Set qualified as Set
import Ledger.Tx.CardanoAPI qualified as Ledger
import Lens.Micro.Extras qualified as MicroLens
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Value qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Prelude qualified as PlutusTx

-- | This is the main entry point of our balancing mechanism. This function
-- takes a skeleton and returns a (possibly) balanced skeleton alongside the
-- associated fee, collateral inputs and return collateral wallet, which might
-- be empty when no script is involved in the transaction. The options from the
-- skeleton control whether it should be balanced, and how to compute its
-- associated elements.
balanceTxSkel :: (MonadBlockChainBalancing m) => TxSkel -> m (TxSkel, Integer, Maybe (Set Api.TxOutRef, Wallet))
balanceTxSkel :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
balanceTxSkel skelUnbal :: TxSkel
skelUnbal@TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Set TxOutRef
Set TxLabel
TxSkelWithdrawals
Map TxOutRef TxSkelRedeemer
TxSkelMints
SlotRange
TxOpts
txSkelLabel :: Set TxLabel
txSkelOpts :: TxOpts
txSkelMints :: TxSkelMints
txSkelSigners :: [Wallet]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: TxSkelWithdrawals
txSkelLabel :: TxSkel -> Set TxLabel
txSkelOpts :: TxSkel -> TxOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSigners :: TxSkel -> [Wallet]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelWithdrawals :: TxSkel -> TxSkelWithdrawals
..} = do
  -- We retrieve the possible balancing wallet. Any extra payment will be
  -- redirected to them, and utxos will be taken from their wallet if associated
  -- with the BalancingUtxosFromBalancingWallet policy
  Maybe Wallet
balancingWallet <- case TxOpts -> BalancingPolicy
txOptBalancingPolicy TxOpts
txSkelOpts of
    BalancingPolicy
BalanceWithFirstSigner -> case [Wallet]
txSkelSigners of
      [] -> String -> m (Maybe Wallet)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't select a balancing wallet from the list of signers because it is empty."
      Wallet
bw : [Wallet]
_ -> Maybe Wallet -> m (Maybe Wallet)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Wallet -> m (Maybe Wallet))
-> Maybe Wallet -> m (Maybe Wallet)
forall a b. (a -> b) -> a -> b
$ Wallet -> Maybe Wallet
forall a. a -> Maybe a
Just Wallet
bw
    BalanceWith Wallet
bWallet -> Maybe Wallet -> m (Maybe Wallet)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Wallet -> m (Maybe Wallet))
-> Maybe Wallet -> m (Maybe Wallet)
forall a b. (a -> b) -> a -> b
$ Wallet -> Maybe Wallet
forall a. a -> Maybe a
Just Wallet
bWallet
    BalancingPolicy
DoNotBalance -> Maybe Wallet -> m (Maybe Wallet)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Wallet
forall a. Maybe a
Nothing

  -- The protocol parameters indirectly dictate a minimal and maximal value for a
  -- single transaction fee, which we retrieve.
  (Integer
minFee, Integer
maxFee) <- m (Integer, Integer)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
m (Integer, Integer)
getMinAndMaxFee

  -- We collect collateral inputs candidates. They might be directly provided in
  -- the skeleton, or should be retrieved from a given wallet. They are
  -- associated with a return collateral wallet, which we retrieve as well. All
  -- of this is wrapped in a `Maybe` type to represent the case when the
  -- transaction does not involve script and should not have any kind of
  -- collaterals attached to it.
  Maybe (Set TxOutRef, Wallet)
mCollaterals <- do
    -- We retrieve the various kinds of scripts
    Map ValidatorHash (Versioned Validator)
spendingScripts <- TxSkel -> m (Map ValidatorHash (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map ValidatorHash (Versioned Validator))
txSkelInputValidators TxSkel
skelUnbal
    -- The transaction will only require collaterals when involving scripts
    let noScriptInvolved :: Bool
noScriptInvolved =
          TxSkelMints -> Bool
forall k a. Map k a -> Bool
Map.null TxSkelMints
txSkelMints
            Bool -> Bool -> Bool
&& [(Versioned Script, TxSkelRedeemer)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer))
-> [TxSkelProposal] -> [(Versioned Script, TxSkelRedeemer)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalWitness [TxSkelProposal]
txSkelProposals)
            Bool -> Bool -> Bool
&& Map ValidatorHash (Versioned Validator) -> Bool
forall k a. Map k a -> Bool
Map.null Map ValidatorHash (Versioned Validator)
spendingScripts
            Bool -> Bool -> Bool
&& [Versioned Script] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TxSkel -> [Versioned Script]
txSkelWithdrawalsScripts TxSkel
skelUnbal)
    case (Bool
noScriptInvolved, TxOpts -> CollateralUtxos
txOptCollateralUtxos TxOpts
txSkelOpts) of
      (Bool
True, CollateralUtxosFromSet Set TxOutRef
utxos Wallet
_) -> MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (Either Wallet (Set TxOutRef) -> MockChainLogEntry
MCLogUnusedCollaterals (Either Wallet (Set TxOutRef) -> MockChainLogEntry)
-> Either Wallet (Set TxOutRef) -> MockChainLogEntry
forall a b. (a -> b) -> a -> b
$ Set TxOutRef -> Either Wallet (Set TxOutRef)
forall a b. b -> Either a b
Right Set TxOutRef
utxos) m ()
-> m (Maybe (Set TxOutRef, Wallet))
-> m (Maybe (Set TxOutRef, Wallet))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Set TxOutRef, Wallet)
forall a. Maybe a
Nothing
      (Bool
True, CollateralUtxosFromWallet Wallet
cWallet) -> MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (Either Wallet (Set TxOutRef) -> MockChainLogEntry
MCLogUnusedCollaterals (Either Wallet (Set TxOutRef) -> MockChainLogEntry)
-> Either Wallet (Set TxOutRef) -> MockChainLogEntry
forall a b. (a -> b) -> a -> b
$ Wallet -> Either Wallet (Set TxOutRef)
forall a b. a -> Either a b
Left Wallet
cWallet) m ()
-> m (Maybe (Set TxOutRef, Wallet))
-> m (Maybe (Set TxOutRef, Wallet))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Set TxOutRef, Wallet)
forall a. Maybe a
Nothing
      (Bool
True, CollateralUtxos
CollateralUtxosFromBalancingWallet) -> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Set TxOutRef, Wallet)
forall a. Maybe a
Nothing
      (Bool
False, CollateralUtxosFromSet Set TxOutRef
utxos Wallet
rWallet) -> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet)))
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall a b. (a -> b) -> a -> b
$ (Set TxOutRef, Wallet) -> Maybe (Set TxOutRef, Wallet)
forall a. a -> Maybe a
Just (Set TxOutRef
utxos, Wallet
rWallet)
      (Bool
False, CollateralUtxosFromWallet Wallet
cWallet) -> (Set TxOutRef, Wallet) -> Maybe (Set TxOutRef, Wallet)
forall a. a -> Maybe a
Just ((Set TxOutRef, Wallet) -> Maybe (Set TxOutRef, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
    -> (Set TxOutRef, Wallet))
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Maybe (Set TxOutRef, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Wallet
cWallet) (Set TxOutRef -> (Set TxOutRef, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
    -> Set TxOutRef)
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> (Set TxOutRef, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOutRef] -> Set TxOutRef
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Set TxOutRef)
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
    -> [TxOutRef])
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Set TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxOutRef, ConcreteOutput Credential () Value ScriptHash)
 -> TxOutRef)
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
map (TxOutRef, ConcreteOutput Credential () Value ScriptHash)
-> TxOutRef
forall a b. (a, b) -> a
fst ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
 -> Maybe (Set TxOutRef, Wallet))
-> m [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> m (Maybe (Set TxOutRef, Wallet))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
-> m [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> m [(TxOutRef, a)]
runUtxoSearch (Wallet
-> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr
-> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
onlyValueOutputsAtSearch Wallet
cWallet)
      (Bool
False, CollateralUtxos
CollateralUtxosFromBalancingWallet) -> case Maybe Wallet
balancingWallet of
        Maybe Wallet
Nothing -> String -> m (Maybe (Set TxOutRef, Wallet))
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't select collateral utxos from a balancing wallet because it does not exist."
        Just Wallet
bWallet -> (Set TxOutRef, Wallet) -> Maybe (Set TxOutRef, Wallet)
forall a. a -> Maybe a
Just ((Set TxOutRef, Wallet) -> Maybe (Set TxOutRef, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
    -> (Set TxOutRef, Wallet))
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Maybe (Set TxOutRef, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Wallet
bWallet) (Set TxOutRef -> (Set TxOutRef, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
    -> Set TxOutRef)
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> (Set TxOutRef, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOutRef] -> Set TxOutRef
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Set TxOutRef)
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
    -> [TxOutRef])
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Set TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxOutRef, ConcreteOutput Credential () Value ScriptHash)
 -> TxOutRef)
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
map (TxOutRef, ConcreteOutput Credential () Value ScriptHash)
-> TxOutRef
forall a b. (a, b) -> a
fst ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
 -> Maybe (Set TxOutRef, Wallet))
-> m [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> m (Maybe (Set TxOutRef, Wallet))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
-> m [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> m [(TxOutRef, a)]
runUtxoSearch (Wallet
-> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr
-> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
onlyValueOutputsAtSearch Wallet
bWallet)

  -- At this point, the presence (or absence) of balancing wallet dictates
  -- whether the transaction should be automatically balanced or not.
  (TxSkel
txSkelBal, Integer
fee, Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet) <- case Maybe Wallet
balancingWallet of
    Maybe Wallet
Nothing ->
      -- The balancing should not be performed. We still adjust the collaterals
      -- though around a provided fee, or the maximum fee.
      let fee :: Integer
fee = case TxOpts -> FeePolicy
txOptFeePolicy TxOpts
txSkelOpts of
            FeePolicy
AutoFeeComputation -> Integer
maxFee
            ManualFee Integer
fee' -> Integer
fee'
       in (TxSkel
skelUnbal,Integer
fee,) (Maybe (Set TxOutRef, Wallet)
 -> (TxSkel, Integer, Maybe (Set TxOutRef, Wallet)))
-> m (Maybe (Set TxOutRef, Wallet))
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
collateralsFromFees Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
    Just Wallet
bWallet -> do
      -- The balancing should be performed. We collect the candidates balancing
      -- utxos based on the associated policy
      [(TxOutRef, TxOut)]
balancingUtxos <-
        case TxOpts -> BalancingUtxos
txOptBalancingUtxos TxOpts
txSkelOpts of
          BalancingUtxos
BalancingUtxosFromBalancingWallet -> UtxoSearch m TxOut -> m [(TxOutRef, TxOut)]
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> m [(TxOutRef, a)]
runUtxoSearch (UtxoSearch m TxOut -> m [(TxOutRef, TxOut)])
-> UtxoSearch m TxOut -> m [(TxOutRef, TxOut)]
forall a b. (a -> b) -> a -> b
$ Wallet
-> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr
-> UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
onlyValueOutputsAtSearch Wallet
bWallet UtxoSearch m (ConcreteOutput Credential () Value ScriptHash)
-> (ConcreteOutput Credential () Value ScriptHash -> TxOut)
-> UtxoSearch m TxOut
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> b) -> UtxoSearch m b
`filterWithAlways` ConcreteOutput Credential () Value ScriptHash -> TxOut
forall o. IsTxInfoOutput o => o -> TxOut
outputTxOut
          BalancingUtxosFromSet Set TxOutRef
utxos ->
            -- We resolve the given set of utxos
            UtxoSearch m TxOut -> m [(TxOutRef, TxOut)]
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> m [(TxOutRef, a)]
runUtxoSearch ([TxOutRef] -> UtxoSearch m TxOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> UtxoSearch m TxOut
txOutByRefSearch (Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
utxos))
              -- We filter out those belonging to scripts, while throwing a
              -- warning if any was actually discarded.
              m [(TxOutRef, TxOut)]
-> ([(TxOutRef, TxOut)] -> m [(TxOutRef, TxOut)])
-> m [(TxOutRef, TxOut)]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((TxOutRef, TxOut) -> Bool)
-> String -> [(TxOutRef, TxOut)] -> m [(TxOutRef, TxOut)]
forall {m :: * -> *} {a}.
MonadBlockChainBalancing m =>
(a -> Bool) -> String -> [a] -> m [a]
filterAndWarn (Maybe (ConcreteOutput PubKeyHash OutputDatum Value ScriptHash)
-> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ConcreteOutput PubKeyHash OutputDatum Value ScriptHash)
 -> Bool)
-> ((TxOutRef, TxOut)
    -> Maybe (ConcreteOutput PubKeyHash OutputDatum Value ScriptHash))
-> (TxOutRef, TxOut)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut
-> Maybe (ConcreteOutput PubKeyHash OutputDatum Value ScriptHash)
TxOut
-> Maybe
     (ConcreteOutput
        PubKeyHash
        (DatumType TxOut)
        (ValueType TxOut)
        (ReferenceScriptType TxOut))
forall out.
IsTxInfoOutput out =>
out
-> Maybe
     (ConcreteOutput
        PubKeyHash
        (DatumType out)
        (ValueType out)
        (ReferenceScriptType out))
isPKOutput (TxOut
 -> Maybe (ConcreteOutput PubKeyHash OutputDatum Value ScriptHash))
-> ((TxOutRef, TxOut) -> TxOut)
-> (TxOutRef, TxOut)
-> Maybe (ConcreteOutput PubKeyHash OutputDatum Value ScriptHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) String
"They belong to scripts."
          -- We filter the candidate utxos by removing those already present in the
          -- skeleton, throwing a warning if any was actually discarded
          m [(TxOutRef, TxOut)]
-> ([(TxOutRef, TxOut)] -> m [(TxOutRef, TxOut)])
-> m [(TxOutRef, TxOut)]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((TxOutRef, TxOut) -> Bool)
-> String -> [(TxOutRef, TxOut)] -> m [(TxOutRef, TxOut)]
forall {m :: * -> *} {a}.
MonadBlockChainBalancing m =>
(a -> Bool) -> String -> [a] -> m [a]
filterAndWarn ((TxOutRef -> [TxOutRef] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` TxSkel -> [TxOutRef]
txSkelKnownTxOutRefs TxSkel
skelUnbal) (TxOutRef -> Bool)
-> ((TxOutRef, TxOut) -> TxOutRef) -> (TxOutRef, TxOut) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst) String
"They are already used in the skeleton."

      case TxOpts -> FeePolicy
txOptFeePolicy TxOpts
txSkelOpts of
        -- If fees are left for us to compute, we run a dichotomic search. This
        -- is full auto mode, the most powerful but time-consuming.
        FeePolicy
AutoFeeComputation ->
          Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
computeFeeAndBalance Wallet
bWallet Integer
minFee Integer
maxFee [(TxOutRef, TxOut)]
balancingUtxos Maybe (Set TxOutRef, Wallet)
mCollaterals TxSkel
skelUnbal
        -- If fee are provided manually, we adjust the collaterals and the
        -- skeleton around them directly.
        ManualFee Integer
fee -> do
          Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet <- Integer
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
collateralsFromFees Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
          TxSkel
attemptedSkel <- Wallet -> [(TxOutRef, TxOut)] -> TxSkel -> Integer -> m TxSkel
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet -> [(TxOutRef, TxOut)] -> TxSkel -> Integer -> m TxSkel
computeBalancedTxSkel Wallet
bWallet [(TxOutRef, TxOut)]
balancingUtxos TxSkel
skelUnbal Integer
fee
          (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkel
attemptedSkel, Integer
fee, Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet)

  (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkel
txSkelBal, Integer
fee, Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet)
  where
    filterAndWarn :: (a -> Bool) -> String -> [a] -> m [a]
filterAndWarn a -> Bool
f String
s [a]
l
      | ([a]
ok, Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> ([a] -> Int) -> [a] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Integer
koLength) <- (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
f [a]
l =
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer
koLength Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> m ()) -> MockChainLogEntry -> m ()
forall a b. (a -> b) -> a -> b
$ Integer -> String -> MockChainLogEntry
MCLogDiscardedUtxos Integer
koLength String
s) m () -> m [a] -> m [a]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
ok

-- | This computes the minimum and maximum possible fee a transaction can cost
-- based on the current protocol parameters
getMinAndMaxFee :: (MonadBlockChainBalancing m) => m (Integer, Integer)
getMinAndMaxFee :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
m (Integer, Integer)
getMinAndMaxFee = do
  -- We retrieve the necessary parameters to compute the maximum possible fee
  -- for a transaction. There are quite a few of them.
  PParams
params <- Params -> PParams
Emulator.pEmulatorPParams (Params -> PParams) -> m Params -> m PParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  let maxTxSize :: Integer
maxTxSize = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ Getting Word32 PParams Word32 -> PParams -> Word32
forall a s. Getting a s a -> s -> a
MicroLens.view Getting Word32 PParams Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' PParams Word32
Conway.ppMaxTxSizeL PParams
params
      Emulator.Coin Integer
txFeePerByte = Getting Coin PParams Coin -> PParams -> Coin
forall a s. Getting a s a -> s -> a
MicroLens.view Getting Coin PParams Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' PParams Coin
Conway.ppMinFeeAL PParams
params
      Emulator.Coin Integer
txFeeFixed = Getting Coin PParams Coin -> PParams -> Coin
forall a s. Getting a s a -> s -> a
MicroLens.view Getting Coin PParams Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' PParams Coin
Conway.ppMinFeeBL PParams
params
      Cardano.Prices (NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Cardano.unboundRational -> Rational
priceESteps) (NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Cardano.unboundRational -> Rational
priceEMem) = Getting Prices PParams Prices -> PParams -> Prices
forall a s. Getting a s a -> s -> a
MicroLens.view Getting Prices PParams Prices
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' PParams Prices
Conway.ppPricesL PParams
params
      Cardano.ExUnits (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
eSteps) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
eMem) = Getting ExUnits PParams ExUnits -> PParams -> ExUnits
forall a s. Getting a s a -> s -> a
MicroLens.view Getting ExUnits PParams ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' PParams ExUnits
Conway.ppMaxTxExUnitsL PParams
params
      (NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Cardano.unboundRational -> Rational
refScriptFeePerByte) = Getting NonNegativeInterval PParams NonNegativeInterval
-> PParams -> NonNegativeInterval
forall a s. Getting a s a -> s -> a
MicroLens.view Getting NonNegativeInterval PParams NonNegativeInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' PParams NonNegativeInterval
Conway.ppMinFeeRefScriptCostPerByteL PParams
params
  -- We compute the components of the maximum possible fee, starting with the
  -- maximum fee associated with the transaction size
  let txSizeMaxFees :: Integer
txSizeMaxFees = Integer
maxTxSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
txFeePerByte
  -- maximum fee associated with the number of execution steps for scripts
  let eStepsMaxFees :: Integer
eStepsMaxFees = (Integer
eSteps Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Rational -> Integer
forall a. Ratio a -> a
Rat.numerator Rational
priceESteps) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Rational -> Integer
forall a. Ratio a -> a
Rat.denominator Rational
priceESteps
  -- maximum fee associated with the number of execution memory for scripts
  let eMemMaxFees :: Integer
eMemMaxFees = (Integer
eMem Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Rational -> Integer
forall a. Ratio a -> a
Rat.numerator Rational
priceEMem) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Rational -> Integer
forall a. Ratio a -> a
Rat.denominator Rational
priceEMem
  -- maximum fee associated with the size of all reference scripts
  let refScriptsMaxFees :: Integer
refScriptsMaxFees = (Integer
maxTxSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Rational -> Integer
forall a. Ratio a -> a
Rat.numerator Rational
refScriptFeePerByte) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Rational -> Integer
forall a. Ratio a -> a
Rat.denominator Rational
refScriptFeePerByte
  (Integer, Integer) -> m (Integer, Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( -- Minimal fee is just the fixed portion of the fee
      Integer
txFeeFixed,
      -- Maximal fee is the fixed portion plus all the other maximum fees
      Integer
txFeeFixed Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
txSizeMaxFees Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
eStepsMaxFees Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
eMemMaxFees Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
refScriptsMaxFees
    )

-- | Computes optimal fee for a given skeleton and balances it around those fees.
-- This uses a dichotomic search for an optimal "balanceable around" fee.
computeFeeAndBalance :: (MonadBlockChainBalancing m) => Wallet -> Integer -> Integer -> [(Api.TxOutRef, Api.TxOut)] -> Maybe (Set Api.TxOutRef, Wallet) -> TxSkel -> m (TxSkel, Integer, Maybe (Set Api.TxOutRef, Wallet))
computeFeeAndBalance :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
computeFeeAndBalance Wallet
_ Integer
minFee Integer
maxFee [(TxOutRef, TxOut)]
_ Maybe (Set TxOutRef, Wallet)
_ TxSkel
_
  | Integer
minFee Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxFee =
      MockChainError -> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError
 -> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet)))
-> MockChainError
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall a b. (a -> b) -> a -> b
$ String -> MockChainError
FailWith String
"Unreachable case, please report a bug at https://github.com/tweag/cooked-validators/issues"
computeFeeAndBalance Wallet
balancingWallet Integer
minFee Integer
maxFee [(TxOutRef, TxOut)]
balancingUtxos Maybe (Set TxOutRef, Wallet)
mCollaterals TxSkel
skel
  | Integer
minFee Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
maxFee = do
      -- The fee interval is reduced to a single element, we balance around it
      (Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet, TxSkel
attemptedSkel) <- Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (Maybe (Set TxOutRef, Wallet), TxSkel)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (Maybe (Set TxOutRef, Wallet), TxSkel)
attemptBalancingAndCollaterals Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos Integer
minFee Maybe (Set TxOutRef, Wallet)
mCollaterals TxSkel
skel
      (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkel
attemptedSkel, Integer
minFee, Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet)
computeFeeAndBalance Wallet
balancingWallet Integer
minFee Integer
maxFee [(TxOutRef, TxOut)]
balancingUtxos Maybe (Set TxOutRef, Wallet)
mCollaterals TxSkel
skel
  | Integer
fee <- (Integer
minFee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
maxFee) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2 = do
      -- The fee interval is larger than a single element. We attempt to balance
      -- around its central point, which can fail due to missing value in
      -- balancing utxos or collateral utxos.
      Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
attemptedBalancing <- m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
-> (MockChainError
    -> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)))
-> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
forall a. m a -> (MockChainError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
        ((Maybe (Set TxOutRef, Wallet), TxSkel)
-> Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
forall a. a -> Maybe a
Just ((Maybe (Set TxOutRef, Wallet), TxSkel)
 -> Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
-> m (Maybe (Set TxOutRef, Wallet), TxSkel)
-> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (Maybe (Set TxOutRef, Wallet), TxSkel)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (Maybe (Set TxOutRef, Wallet), TxSkel)
attemptBalancingAndCollaterals Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals TxSkel
skel)
        ((MockChainError
  -> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)))
 -> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)))
-> (MockChainError
    -> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)))
-> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
forall a b. (a -> b) -> a -> b
$ \case
          -- If it fails, and the remaining fee interval is not reduced to the
          -- current fee attempt, we return `Nothing` which signifies that we
          -- need to keep searching. Otherwise, the whole balancing process
          -- fails and we spread the error.
          MCEUnbalanceable {} | Integer
fee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
minFee Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 -> Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
-> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
forall a. Maybe a
Nothing
          MCENoSuitableCollateral {} | Integer
fee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
minFee Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 -> Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
-> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
forall a. Maybe a
Nothing
          MockChainError
err -> MockChainError -> m (Maybe (Maybe (Set TxOutRef, Wallet), TxSkel))
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MockChainError
err

      (Integer
newMinFee, Integer
newMaxFee) <- case Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
attemptedBalancing of
        -- The skeleton was not balanceable, we try strictly smaller fee
        Maybe (Maybe (Set TxOutRef, Wallet), TxSkel)
Nothing -> (Integer, Integer) -> m (Integer, Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
minFee, Integer
fee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
        -- The skeleton was balanceable, we compute and analyse the resulting
        -- fee to seach upwards or downwards for an optimal solution
        Just (Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet, TxSkel
attemptedSkel) -> do
          Integer
newFee <- TxSkel -> Integer -> Maybe (Set TxOutRef, Wallet) -> m Integer
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> Integer -> Maybe (Set TxOutRef, Wallet) -> m Integer
estimateTxSkelFee TxSkel
attemptedSkel Integer
fee Maybe (Set TxOutRef, Wallet)
adjustedColsAndWallet
          (Integer, Integer) -> m (Integer, Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer) -> m (Integer, Integer))
-> (Integer, Integer) -> m (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ case Integer
fee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
newFee of
            -- Current fee is insufficient, we look on the right (strictly)
            Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 -> (Integer
fee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer
maxFee)
            -- Current fee is sufficient, but the set of balancing utxos cannot
            -- necessarily account for less fee, since it was (magically)
            -- exactly enough to compensate for the missing value. Reducing the
            -- fee would ruin this perfect balancing and force an output to be
            -- created at the balancing wallet address, thus we cannot assume
            -- the actual estimated fee can be accounted for with the current
            -- set of balancing utxos and we cannot speed up search.
            Integer
_ | TxSkel -> Value
txSkelValueInOutputs TxSkel
attemptedSkel Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkel -> Value
txSkelValueInOutputs TxSkel
skel -> (Integer
minFee, Integer
fee)
            -- Current fee is sufficient, and the set of utxo could account for
            -- less fee by feeding into whatever output already goes back to the
            -- balancing wallet. We can speed up search, because the current
            -- attempted skeleton could necessarily account for the estimated
            -- fee of the input skeleton.
            Integer
_ -> (Integer
minFee, Integer
newFee)

      Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Set TxOutRef, Wallet))
computeFeeAndBalance Wallet
balancingWallet Integer
newMinFee Integer
newMaxFee [(TxOutRef, TxOut)]
balancingUtxos Maybe (Set TxOutRef, Wallet)
mCollaterals TxSkel
skel

-- | Helper function to group the two real steps of the balancing: balance a
-- skeleton around a given fee, and compute the associated collateral inputs
attemptBalancingAndCollaterals :: (MonadBlockChainBalancing m) => Wallet -> [(Api.TxOutRef, Api.TxOut)] -> Integer -> Maybe (Set Api.TxOutRef, Wallet) -> TxSkel -> m (Maybe (Set Api.TxOutRef, Wallet), TxSkel)
attemptBalancingAndCollaterals :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> TxSkel
-> m (Maybe (Set TxOutRef, Wallet), TxSkel)
attemptBalancingAndCollaterals Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals TxSkel
skel = do
  Maybe (Set TxOutRef, Wallet)
adjustedCollateralIns <- Integer
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
collateralsFromFees Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
  TxSkel
attemptedSkel <- Wallet -> [(TxOutRef, TxOut)] -> TxSkel -> Integer -> m TxSkel
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet -> [(TxOutRef, TxOut)] -> TxSkel -> Integer -> m TxSkel
computeBalancedTxSkel Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos TxSkel
skel Integer
fee
  (Maybe (Set TxOutRef, Wallet), TxSkel)
-> m (Maybe (Set TxOutRef, Wallet), TxSkel)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Set TxOutRef, Wallet)
adjustedCollateralIns, TxSkel
attemptedSkel)

-- | This selects a subset of suitable collateral inputs from a given set while
-- accounting for the ratio to respect between fees and total collaterals, the
-- min ada requirements in the associated return collateral and the maximum
-- number of collateral inputs authorized by protocol parameters.
collateralInsFromFees :: (MonadBlockChainBalancing m) => Integer -> Set Api.TxOutRef -> Wallet -> m (Set Api.TxOutRef)
collateralInsFromFees :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer -> Set TxOutRef -> Wallet -> m (Set TxOutRef)
collateralInsFromFees Integer
fee Set TxOutRef
collateralIns Wallet
returnCollateralWallet = do
  -- We retrieve the protocal parameters
  PParams
params <- Params -> PParams
Emulator.pEmulatorPParams (Params -> PParams) -> m Params -> m PParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  -- We retrieve the max number of collateral inputs, with a default of 10. In
  -- practice this will be around 3.
  let nbMax :: Integer
nbMax = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ Getting Natural PParams Natural -> PParams -> Natural
forall a s. Getting a s a -> s -> a
MicroLens.view Getting Natural PParams Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' PParams Natural
Conway.ppMaxCollateralInputsL PParams
params
  -- We retrieve the percentage to respect between fees and total collaterals
  let percentage :: Integer
percentage = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ Getting Natural PParams Natural -> PParams -> Natural
forall a s. Getting a s a -> s -> a
MicroLens.view Getting Natural PParams Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' PParams Natural
Conway.ppCollateralPercentageL PParams
params
  -- We compute the total collateral to be associated to the transaction as a
  -- value. This will be the target value to be reached by collateral inputs. We
  -- add one because of ledger requirement which seem to round up this value.
  let totalCollateral :: Value
totalCollateral = Integer -> Value
Script.lovelace (Integer -> Value) -> (Integer -> Integer) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
100) (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
percentage) (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer
fee
  -- Collateral tx outputs sorted by decreasing ada amount
  [(TxOutRef, TxOut)]
collateralTxOuts <- UtxoSearch m TxOut -> m [(TxOutRef, TxOut)]
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> m [(TxOutRef, a)]
runUtxoSearch ([TxOutRef] -> UtxoSearch m TxOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> UtxoSearch m TxOut
txOutByRefSearch ([TxOutRef] -> UtxoSearch m TxOut)
-> [TxOutRef] -> UtxoSearch m TxOut
forall a b. (a -> b) -> a -> b
$ Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
collateralIns)
  -- Candidate subsets of utxos to be used as collaterals
  let candidatesRaw :: [([(TxOutRef, TxOut)], Value)]
candidatesRaw = [(TxOutRef, TxOut)]
-> Value -> Integer -> [([(TxOutRef, TxOut)], Value)]
reachValue [(TxOutRef, TxOut)]
collateralTxOuts Value
totalCollateral Integer
nbMax
  -- Preparing a possible collateral error
  let noSuitableCollateralError :: MockChainError
noSuitableCollateralError = Integer -> Integer -> Value -> MockChainError
MCENoSuitableCollateral Integer
fee Integer
percentage Value
totalCollateral
  -- Retrieving and returning the best candidate as a utxo set
  [TxOutRef] -> Set TxOutRef
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Set TxOutRef)
-> (([TxOutRef], Value) -> [TxOutRef])
-> ([TxOutRef], Value)
-> Set TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOutRef], Value) -> [TxOutRef]
forall a b. (a, b) -> a
fst (([TxOutRef], Value) -> Set TxOutRef)
-> m ([TxOutRef], Value) -> m (Set TxOutRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([(TxOutRef, TxOut)], Value)]
-> Wallet -> MockChainError -> m ([TxOutRef], Value)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[([(TxOutRef, TxOut)], Value)]
-> Wallet -> MockChainError -> m ([TxOutRef], Value)
getOptimalCandidate [([(TxOutRef, TxOut)], Value)]
candidatesRaw Wallet
returnCollateralWallet MockChainError
noSuitableCollateralError

-- | This adjusts collateral inputs when necessary
collateralsFromFees :: (MonadBlockChainBalancing m) => Integer -> Maybe (Set Api.TxOutRef, Wallet) -> m (Maybe (Set Api.TxOutRef, Wallet))
collateralsFromFees :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
collateralsFromFees Integer
_ Maybe (Set TxOutRef, Wallet)
Nothing = Maybe (Set TxOutRef, Wallet) -> m (Maybe (Set TxOutRef, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Set TxOutRef, Wallet)
forall a. Maybe a
Nothing
collateralsFromFees Integer
fee (Just (Set TxOutRef
collateralIns, Wallet
returnCollateralWallet)) =
  (Set TxOutRef, Wallet) -> Maybe (Set TxOutRef, Wallet)
forall a. a -> Maybe a
Just ((Set TxOutRef, Wallet) -> Maybe (Set TxOutRef, Wallet))
-> (Set TxOutRef -> (Set TxOutRef, Wallet))
-> Set TxOutRef
-> Maybe (Set TxOutRef, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Wallet
returnCollateralWallet) (Set TxOutRef -> Maybe (Set TxOutRef, Wallet))
-> m (Set TxOutRef) -> m (Maybe (Set TxOutRef, Wallet))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Set TxOutRef -> Wallet -> m (Set TxOutRef)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer -> Set TxOutRef -> Wallet -> m (Set TxOutRef)
collateralInsFromFees Integer
fee Set TxOutRef
collateralIns Wallet
returnCollateralWallet

-- | The main computing function for optimal balancing and collaterals. It
-- computes the subsets of a set of UTxOs that sum up to a certain target. It
-- stops when the target is reached, not adding superfluous UTxOs. Despite
-- optimizations, this function is theoretically in 2^n where n is the number of
-- candidate UTxOs. Use with caution.
reachValue :: [(Api.TxOutRef, Api.TxOut)] -> Api.Value -> Integer -> [([(Api.TxOutRef, Api.TxOut)], Api.Value)]
-- Target is smaller than the empty value (which means in only contains negative
-- entries), we stop looking as adding more elements would be superfluous.
reachValue :: [(TxOutRef, TxOut)]
-> Value -> Integer -> [([(TxOutRef, TxOut)], Value)]
reachValue [(TxOutRef, TxOut)]
_ Value
target Integer
_ | Value
target Value -> Value -> Bool
`Api.leq` Value
forall a. Monoid a => a
mempty = [([], Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate Value
target)]
-- The target is not reached, but the max number of elements is reached, we
-- would need more elements but are not allowed to look for them.
reachValue [(TxOutRef, TxOut)]
_ Value
_ Integer
maxEls | Integer
maxEls Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = []
-- The target is not reached, and cannot possibly be reached, as the remaining
-- candidates do not sum up to the target.
reachValue [(TxOutRef, TxOut)]
l Value
target Integer
_ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Value
target Value -> Value -> Bool
`Api.leq` [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat (TxOut -> Value
Api.txOutValue (TxOut -> Value)
-> ((TxOutRef, TxOut) -> TxOut) -> (TxOutRef, TxOut) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOut
forall a b. (a, b) -> b
snd ((TxOutRef, TxOut) -> Value) -> [(TxOutRef, TxOut)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOutRef, TxOut)]
l) = []
-- There is no more elements to go through and the target has not been
-- reached. Encompassed by the previous case, but needed by GHC.
reachValue [] Value
_ Integer
_ = []
-- Main recursive case, where we either pick or drop the head. We only pick the
-- head if it contributes to reaching the target, i.e. if its intersection with
-- the positive part of the target is not empty.
reachValue (h :: (TxOutRef, TxOut)
h@(TxOutRef
_, TxOut -> Value
Api.txOutValue -> Value
hVal) : [(TxOutRef, TxOut)]
t) Value
target Integer
maxEls =
  [([(TxOutRef, TxOut)], Value)]
-> [([(TxOutRef, TxOut)], Value)] -> [([(TxOutRef, TxOut)], Value)]
forall a. [a] -> [a] -> [a]
(++) ([(TxOutRef, TxOut)]
-> Value -> Integer -> [([(TxOutRef, TxOut)], Value)]
reachValue [(TxOutRef, TxOut)]
t Value
target Integer
maxEls) ([([(TxOutRef, TxOut)], Value)] -> [([(TxOutRef, TxOut)], Value)])
-> [([(TxOutRef, TxOut)], Value)] -> [([(TxOutRef, TxOut)], Value)]
forall a b. (a -> b) -> a -> b
$
    if (Value, Value) -> Value
forall a b. (a, b) -> b
snd (Value -> (Value, Value)
Api.split Value
target) Value -> Value -> Value
forall a. MeetSemiLattice a => a -> a -> a
PlutusTx./\ Value
hVal Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
forall a. Monoid a => a
mempty
      then []
      else ([(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)])
-> ([(TxOutRef, TxOut)], Value) -> ([(TxOutRef, TxOut)], Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TxOutRef, TxOut)
h (TxOutRef, TxOut) -> [(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)]
forall a. a -> [a] -> [a]
:) (([(TxOutRef, TxOut)], Value) -> ([(TxOutRef, TxOut)], Value))
-> [([(TxOutRef, TxOut)], Value)] -> [([(TxOutRef, TxOut)], Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOutRef, TxOut)]
-> Value -> Integer -> [([(TxOutRef, TxOut)], Value)]
reachValue [(TxOutRef, TxOut)]
t (Value
target Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate Value
hVal) (Integer
maxEls Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

-- | A helper function to grab an optimal candidate in terms of having a minimal
-- enough amount of ada to sustain itself meant to be used after calling
-- `reachValue`. This throws an error when there are no suitable candidates.
getOptimalCandidate :: (MonadBlockChainBalancing m) => [([(Api.TxOutRef, Api.TxOut)], Api.Value)] -> Wallet -> MockChainError -> m ([Api.TxOutRef], Api.Value)
getOptimalCandidate :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
[([(TxOutRef, TxOut)], Value)]
-> Wallet -> MockChainError -> m ([TxOutRef], Value)
getOptimalCandidate [([(TxOutRef, TxOut)], Value)]
candidates Wallet
paymentTarget MockChainError
mceError = do
  -- We decorate the candidates with their current ada and min ada requirements
  [([(TxOutRef, TxOut)], Value, Lovelace, Integer)]
candidatesDecorated <- [([(TxOutRef, TxOut)], Value)]
-> (([(TxOutRef, TxOut)], Value)
    -> m ([(TxOutRef, TxOut)], Value, Lovelace, Integer))
-> m [([(TxOutRef, TxOut)], Value, Lovelace, Integer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([(TxOutRef, TxOut)], Value)]
candidates ((([(TxOutRef, TxOut)], Value)
  -> m ([(TxOutRef, TxOut)], Value, Lovelace, Integer))
 -> m [([(TxOutRef, TxOut)], Value, Lovelace, Integer)])
-> (([(TxOutRef, TxOut)], Value)
    -> m ([(TxOutRef, TxOut)], Value, Lovelace, Integer))
-> m [([(TxOutRef, TxOut)], Value, Lovelace, Integer)]
forall a b. (a -> b) -> a -> b
$ \([(TxOutRef, TxOut)]
output, Value
val) ->
    ([(TxOutRef, TxOut)]
output,Value
val,Value -> Lovelace
Api.lovelaceValueOf Value
val,) (Integer -> ([(TxOutRef, TxOut)], Value, Lovelace, Integer))
-> m Integer -> m ([(TxOutRef, TxOut)], Value, Lovelace, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkelOut -> m Integer
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m Integer
getTxSkelOutMinAda (Wallet
paymentTarget Wallet -> Payable '["Value"] -> TxSkelOut
forall owner (els :: [Symbol]).
(Show owner, Typeable owner, IsTxSkelOutAllowedOwner owner,
 ToCredential owner) =>
owner -> Payable els -> TxSkelOut
`receives` Value -> Payable '["Value"]
forall a1. ToValue a1 => a1 -> Payable '["Value"]
Value Value
val)
  -- We filter the candidates that have enough ada to sustain themselves
  let candidatesFiltered :: [(Integer, ([TxOutRef], Value))]
candidatesFiltered = [(Integer
minLv, ((TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst ((TxOutRef, TxOut) -> TxOutRef)
-> [(TxOutRef, TxOut)] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOutRef, TxOut)]
l, Value
val)) | ([(TxOutRef, TxOut)]
l, Value
val, Api.Lovelace Integer
lv, Integer
minLv) <- [([(TxOutRef, TxOut)], Value, Lovelace, Integer)]
candidatesDecorated, Integer
minLv Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lv]
  case ((Integer, ([TxOutRef], Value))
 -> (Integer, ([TxOutRef], Value)) -> Ordering)
-> [(Integer, ([TxOutRef], Value))]
-> [(Integer, ([TxOutRef], Value))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Integer -> Ordering)
-> ((Integer, ([TxOutRef], Value)) -> Integer)
-> (Integer, ([TxOutRef], Value))
-> (Integer, ([TxOutRef], Value))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Integer, ([TxOutRef], Value)) -> Integer
forall a b. (a, b) -> a
fst) [(Integer, ([TxOutRef], Value))]
candidatesFiltered of
    -- If the list of candidates is empty, we throw an error
    [] -> MockChainError -> m ([TxOutRef], Value)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MockChainError
mceError
    (Integer
_, ([TxOutRef], Value)
ret) : [(Integer, ([TxOutRef], Value))]
_ -> ([TxOutRef], Value) -> m ([TxOutRef], Value)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxOutRef], Value)
ret

-- | This function is essentially a copy of
-- https://github.com/input-output-hk/plutus-apps/blob/d4255f05477fd8477ee9673e850ebb9ebb8c9657/plutus-ledger/src/Ledger/Fee.hs#L19
estimateTxSkelFee :: (MonadBlockChainBalancing m) => TxSkel -> Integer -> Maybe (Set Api.TxOutRef, Wallet) -> m Integer
estimateTxSkelFee :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> Integer -> Maybe (Set TxOutRef, Wallet) -> m Integer
estimateTxSkelFee TxSkel
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals = do
  -- We retrieve the necessary data to generate the transaction body
  Params
params <- m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  let collateralIns :: [TxOutRef]
collateralIns = case Maybe (Set TxOutRef, Wallet)
mCollaterals of
        Maybe (Set TxOutRef, Wallet)
Nothing -> []
        Just (Set TxOutRef
s, Wallet
_) -> Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
s
  -- We generate the transaction body content, handling errors in the meantime
  TxBodyContent BuildTx ConwayEra
txBodyContent <- TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxBodyContent BuildTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxBodyContent BuildTx ConwayEra)
txSkelToTxBodyContent TxSkel
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
  -- We create the actual body and send if for validation
  TxBody ConwayEra
txBody <- TxBodyContent BuildTx ConwayEra -> TxSkel -> m (TxBody ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxBodyContent BuildTx ConwayEra -> TxSkel -> m (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent TxSkel
skel
  -- We retrieve the estimate number of required witness in the transaction
  let nkeys :: Word
nkeys = TxBodyContent BuildTx ConwayEra -> Word
forall era. TxBodyContent BuildTx era -> Word
Cardano.estimateTransactionKeyWitnessCount TxBodyContent BuildTx ConwayEra
txBodyContent
  -- We need to reconstruct an index to pass to the fee estimate function
  -- We begin by retrieving the relevant utxos used in the skeleton
  ([TxOutRef]
knownTxORefs, [TxOut]
knownTxOuts) <- [(TxOutRef, TxOut)] -> ([TxOutRef], [TxOut])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TxOutRef, TxOut)] -> ([TxOutRef], [TxOut]))
-> (Map TxOutRef TxOut -> [(TxOutRef, TxOut)])
-> Map TxOutRef TxOut
-> ([TxOutRef], [TxOut])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxOut -> ([TxOutRef], [TxOut]))
-> m (Map TxOutRef TxOut) -> m ([TxOutRef], [TxOut])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef] -> m (Map TxOutRef TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> m (Map TxOutRef TxOut)
lookupUtxos (TxSkel -> [TxOutRef]
txSkelKnownTxOutRefs TxSkel
skel [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. Semigroup a => a -> a -> a
<> [TxOutRef]
collateralIns)
  -- We then compute their Cardano counterparts
  let indexOrError :: Either ToCardanoError (UTxO ConwayEra)
indexOrError = do
        [TxIn]
txInL <- [TxOutRef]
-> (TxOutRef -> Either ToCardanoError TxIn)
-> Either ToCardanoError [TxIn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxOutRef]
knownTxORefs TxOutRef -> Either ToCardanoError TxIn
Ledger.toCardanoTxIn
        [TxOut CtxTx ConwayEra]
txOutL <- [TxOut]
-> (TxOut -> Either ToCardanoError (TxOut CtxTx ConwayEra))
-> Either ToCardanoError [TxOut CtxTx ConwayEra]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxOut]
knownTxOuts ((TxOut -> Either ToCardanoError (TxOut CtxTx ConwayEra))
 -> Either ToCardanoError [TxOut CtxTx ConwayEra])
-> (TxOut -> Either ToCardanoError (TxOut CtxTx ConwayEra))
-> Either ToCardanoError [TxOut CtxTx ConwayEra]
forall a b. (a -> b) -> a -> b
$ NetworkId -> TxOut -> Either ToCardanoError (TxOut CtxTx ConwayEra)
Ledger.toCardanoTxOut (NetworkId
 -> TxOut -> Either ToCardanoError (TxOut CtxTx ConwayEra))
-> NetworkId
-> TxOut
-> Either ToCardanoError (TxOut CtxTx ConwayEra)
forall a b. (a -> b) -> a -> b
$ Params -> NetworkId
Emulator.pNetworkId Params
params
        UTxO ConwayEra -> Either ToCardanoError (UTxO ConwayEra)
forall a. a -> Either ToCardanoError a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO ConwayEra -> Either ToCardanoError (UTxO ConwayEra))
-> UTxO ConwayEra -> Either ToCardanoError (UTxO ConwayEra)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO ConwayEra) -> UTxO ConwayEra
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
Cardano.UTxO (Map TxIn (TxOut CtxUTxO ConwayEra) -> UTxO ConwayEra)
-> Map TxIn (TxOut CtxUTxO ConwayEra) -> UTxO ConwayEra
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut CtxUTxO ConwayEra)]
-> Map TxIn (TxOut CtxUTxO ConwayEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut CtxUTxO ConwayEra)]
 -> Map TxIn (TxOut CtxUTxO ConwayEra))
-> [(TxIn, TxOut CtxUTxO ConwayEra)]
-> Map TxIn (TxOut CtxUTxO ConwayEra)
forall a b. (a -> b) -> a -> b
$ [TxIn]
-> [TxOut CtxUTxO ConwayEra] -> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
txInL ([TxOut CtxUTxO ConwayEra] -> [(TxIn, TxOut CtxUTxO ConwayEra)])
-> [TxOut CtxUTxO ConwayEra] -> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall a b. (a -> b) -> a -> b
$ TxOut CtxTx ConwayEra -> TxOut CtxUTxO ConwayEra
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
Cardano.toCtxUTxOTxOut (TxOut CtxTx ConwayEra -> TxOut CtxUTxO ConwayEra)
-> [TxOut CtxTx ConwayEra] -> [TxOut CtxUTxO ConwayEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut CtxTx ConwayEra]
txOutL
  -- We retrieve the index when it was successfully created
  UTxO ConwayEra
index <- case Either ToCardanoError (UTxO ConwayEra)
indexOrError of
    Left ToCardanoError
err -> MockChainError -> m (UTxO ConwayEra)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m (UTxO ConwayEra))
-> MockChainError -> m (UTxO ConwayEra)
forall a b. (a -> b) -> a -> b
$ GenerateTxError -> MockChainError
MCEGenerationError (GenerateTxError -> MockChainError)
-> GenerateTxError -> MockChainError
forall a b. (a -> b) -> a -> b
$ String -> ToCardanoError -> GenerateTxError
ToCardanoError String
"estimateTxSkelFee: toCardanoError" ToCardanoError
err
    Right UTxO ConwayEra
index' -> UTxO ConwayEra -> m (UTxO ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UTxO ConwayEra
index'
  -- We finally can the fee estimate function
  Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> (Coin -> Integer) -> Coin -> m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
Emulator.unCoin (Coin -> m Integer) -> Coin -> m Integer
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra
-> PParams (ShelleyLedgerEra ConwayEra)
-> UTxO ConwayEra
-> TxBody ConwayEra
-> Word
-> Coin
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era)
-> UTxO era
-> TxBody era
-> Word
-> Coin
Cardano.calculateMinTxFee ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway (Params -> PParams
Emulator.pEmulatorPParams Params
params) UTxO ConwayEra
index TxBody ConwayEra
txBody Word
nkeys

-- | This creates a balanced skeleton from a given skeleton and fee. In other
-- words, this ensures that the following equation holds: input value + minted
-- value + withdrawn value = output value + burned value + fee + deposits
computeBalancedTxSkel :: (MonadBlockChainBalancing m) => Wallet -> [(Api.TxOutRef, Api.TxOut)] -> TxSkel -> Integer -> m TxSkel
computeBalancedTxSkel :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet -> [(TxOutRef, TxOut)] -> TxSkel -> Integer -> m TxSkel
computeBalancedTxSkel Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos txSkel :: TxSkel
txSkel@TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Set TxOutRef
Set TxLabel
TxSkelWithdrawals
Map TxOutRef TxSkelRedeemer
TxSkelMints
SlotRange
TxOpts
txSkelLabel :: TxSkel -> Set TxLabel
txSkelOpts :: TxSkel -> TxOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSigners :: TxSkel -> [Wallet]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelWithdrawals :: TxSkel -> TxSkelWithdrawals
txSkelLabel :: Set TxLabel
txSkelOpts :: TxOpts
txSkelMints :: TxSkelMints
txSkelSigners :: [Wallet]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: TxSkelWithdrawals
..} (Integer -> Value
Script.lovelace -> Value
feeValue) = do
  -- We compute the necessary values from the skeleton that are part of the
  -- equation, except for the `feeValue` which we already have.
  let (Value
burnedValue, Value
mintedValue) = Value -> (Value, Value)
Api.split (Value -> (Value, Value)) -> Value -> (Value, Value)
forall a b. (a -> b) -> a -> b
$ TxSkelMints -> Value
txSkelMintsValue TxSkelMints
txSkelMints
      outValue :: Value
outValue = TxSkel -> Value
txSkelValueInOutputs TxSkel
txSkel
      withdrawnValue :: Value
withdrawnValue = TxSkel -> Value
txSkelWithdrawnValue TxSkel
txSkel
  Value
inValue <- TxSkel -> m Value
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m Value
txSkelInputValue TxSkel
txSkel
  Value
depositedValue <- Lovelace -> Value
forall a. ToValue a => a -> Value
Script.toValue (Lovelace -> Value) -> m Lovelace -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkel -> m Lovelace
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m Lovelace
txSkelProposalsDeposit TxSkel
txSkel
  -- We compute the values missing in the left and right side of the equation
  let (Value
missingRight, Value
missingLeft) = Value -> (Value, Value)
Api.split (Value -> (Value, Value)) -> Value -> (Value, Value)
forall a b. (a -> b) -> a -> b
$ Value
outValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
burnedValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
feeValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
depositedValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate (Value
inValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
mintedValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
withdrawnValue)
  -- We compute the minimal ada requirement of the missing payment
  Integer
rightMinAda <- TxSkelOut -> m Integer
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m Integer
getTxSkelOutMinAda (TxSkelOut -> m Integer) -> TxSkelOut -> m Integer
forall a b. (a -> b) -> a -> b
$ Wallet
balancingWallet Wallet -> Payable '["Value"] -> TxSkelOut
forall owner (els :: [Symbol]).
(Show owner, Typeable owner, IsTxSkelOutAllowedOwner owner,
 ToCredential owner) =>
owner -> Payable els -> TxSkelOut
`receives` Value -> Payable '["Value"]
forall a1. ToValue a1 => a1 -> Payable '["Value"]
Value Value
missingRight
  -- We compute the current ada of the missing payment. If the missing payment
  -- is not empty and the minimal ada is not present, some value is missing.
  let Api.Lovelace Integer
rightAda = Value
missingRight Value -> Optic' A_Lens NoIx Value Lovelace -> Lovelace
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Value Lovelace
Script.adaL
      missingAda :: Integer
missingAda = Integer
rightMinAda Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
rightAda
      missingAdaValue :: Value
missingAdaValue = if Value
missingRight Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& Integer
missingAda Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer -> Value
Script.lovelace Integer
missingAda else Value
forall a. Monoid a => a
mempty
  -- The actual missing value on the left might needs to account for any missing
  -- min ada on the missing payment of the transaction skeleton. This also has
  -- to be repercuted on the missing value on the right.
  let missingLeft' :: Value
missingLeft' = Value
missingLeft Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
missingAdaValue
      missingRight' :: Value
missingRight' = Value
missingRight Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
missingAdaValue
  -- This gives us what we need to run our `reachValue` algorithm and append to
  -- the resulting values whatever payment was missing in the initial skeleton
  let candidatesRaw :: [([(TxOutRef, TxOut)], Value)]
candidatesRaw = (Value -> Value)
-> ([(TxOutRef, TxOut)], Value) -> ([(TxOutRef, TxOut)], Value)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
missingRight') (([(TxOutRef, TxOut)], Value) -> ([(TxOutRef, TxOut)], Value))
-> [([(TxOutRef, TxOut)], Value)] -> [([(TxOutRef, TxOut)], Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOutRef, TxOut)]
-> Value -> Integer -> [([(TxOutRef, TxOut)], Value)]
reachValue [(TxOutRef, TxOut)]
balancingUtxos Value
missingLeft' (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [(TxOutRef, TxOut)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TxOutRef, TxOut)]
balancingUtxos)
  -- We prepare a possible balancing error with the difference between the
  -- requested amount and the maximum amount provided by the balancing wallet
  let totalValue :: Value
totalValue = [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ TxOut -> Value
Api.txOutValue (TxOut -> Value)
-> ((TxOutRef, TxOut) -> TxOut) -> (TxOutRef, TxOut) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOut
forall a b. (a, b) -> b
snd ((TxOutRef, TxOut) -> Value) -> [(TxOutRef, TxOut)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOutRef, TxOut)]
balancingUtxos
      difference :: Value
difference = (Value, Value) -> Value
forall a b. (a, b) -> b
snd ((Value, Value) -> Value) -> (Value, Value) -> Value
forall a b. (a -> b) -> a -> b
$ Value -> (Value, Value)
Api.split (Value -> (Value, Value)) -> Value -> (Value, Value)
forall a b. (a -> b) -> a -> b
$ Value
missingLeft' Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate Value
totalValue
      balancingError :: MockChainError
balancingError = Wallet -> Value -> TxSkel -> MockChainError
MCEUnbalanceable Wallet
balancingWallet Value
difference TxSkel
txSkel
  -- Which one of our candidates should be picked depends on three factors
  -- - Whether there exists a perfect candidate set with empty surplus value
  -- - The `BalancingOutputPolicy` in the skeleton options
  -- - The presence of an existing output at the balancing wallet address
  ([TxOutRef]
additionalInsTxOutRefs, [TxSkelOut]
newTxSkelOuts) <- case (([(TxOutRef, TxOut)], Value) -> Bool)
-> [([(TxOutRef, TxOut)], Value)]
-> Maybe ([(TxOutRef, TxOut)], Value)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
forall a. Monoid a => a
mempty) (Value -> Bool)
-> (([(TxOutRef, TxOut)], Value) -> Value)
-> ([(TxOutRef, TxOut)], Value)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TxOutRef, TxOut)], Value) -> Value
forall a b. (a, b) -> b
snd) [([(TxOutRef, TxOut)], Value)]
candidatesRaw of
    -- There exists a perfect candidate, this is the rarest and easiest
    -- scenario, as the outputs will not change due to balancing. This means
    -- that there was no missing value on the right and the balancing utxos
    -- exactly account for what was missing on the left.
    Just ([(TxOutRef, TxOut)]
txOutRefs, Value
_) -> ([TxOutRef], [TxSkelOut]) -> m ([TxOutRef], [TxSkelOut])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst ((TxOutRef, TxOut) -> TxOutRef)
-> [(TxOutRef, TxOut)] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOutRef, TxOut)]
txOutRefs, [TxSkelOut]
txSkelOuts)
    -- There in an existing output at the owner's address and the balancing
    -- policy allows us to adjust it with additional value.
    Maybe ([(TxOutRef, TxOut)], Value)
Nothing
      | ([TxSkelOut]
before, TxSkelOut
txSkelOut : [TxSkelOut]
after) <- (TxSkelOut -> Bool) -> [TxSkelOut] -> ([TxSkelOut], [TxSkelOut])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(Pays o
o) -> OwnerType o -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential (o
o o -> Optic' A_Lens NoIx o (OwnerType o) -> OwnerType o
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx o (OwnerType o)
forall o. IsAbstractOutput o => Lens' o (OwnerType o)
outputOwnerL) Credential -> Credential -> Bool
forall a. Eq a => a -> a -> Bool
== Wallet -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential Wallet
balancingWallet) [TxSkelOut]
txSkelOuts,
        BalanceOutputPolicy
AdjustExistingOutput <- TxOpts -> BalanceOutputPolicy
txOptBalanceOutputPolicy TxOpts
txSkelOpts -> do
          -- We get the optimal candidate based on an updated value. We update
          -- the `txSkelOuts` by replacing the value content of the selected
          -- output. We keep intact the orders of those outputs.
          let candidatesRaw' :: [([(TxOutRef, TxOut)], Value)]
candidatesRaw' = (Value -> Value)
-> ([(TxOutRef, TxOut)], Value) -> ([(TxOutRef, TxOut)], Value)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> TxSkelOut
txSkelOut TxSkelOut -> Optic' A_Lens NoIx TxSkelOut Value -> Value
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. (Lens' TxSkelOut TxSkelOutValue
txSkelOutValueL Lens' TxSkelOut TxSkelOutValue
-> Optic A_Lens NoIx TxSkelOutValue TxSkelOutValue Value Value
-> Optic' A_Lens NoIx TxSkelOut Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxSkelOutValue TxSkelOutValue Value Value
txSkelOutValueContentL)) (([(TxOutRef, TxOut)], Value) -> ([(TxOutRef, TxOut)], Value))
-> [([(TxOutRef, TxOut)], Value)] -> [([(TxOutRef, TxOut)], Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([(TxOutRef, TxOut)], Value)]
candidatesRaw
          ([TxOutRef]
txOutRefs, Value
val) <- [([(TxOutRef, TxOut)], Value)]
-> Wallet -> MockChainError -> m ([TxOutRef], Value)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[([(TxOutRef, TxOut)], Value)]
-> Wallet -> MockChainError -> m ([TxOutRef], Value)
getOptimalCandidate [([(TxOutRef, TxOut)], Value)]
candidatesRaw' Wallet
balancingWallet MockChainError
balancingError
          ([TxOutRef], [TxSkelOut]) -> m ([TxOutRef], [TxSkelOut])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxOutRef]
txOutRefs, [TxSkelOut]
before [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ (TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& (Lens' TxSkelOut TxSkelOutValue
txSkelOutValueL Lens' TxSkelOut TxSkelOutValue
-> Optic A_Lens NoIx TxSkelOutValue TxSkelOutValue Value Value
-> Optic' A_Lens NoIx TxSkelOut Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxSkelOutValue TxSkelOutValue Value Value
txSkelOutValueContentL) Optic' A_Lens NoIx TxSkelOut Value
-> Value -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Value
val) TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
: [TxSkelOut]
after)
    -- There is no output at the balancing wallet address, or the balancing
    -- policy forces us to create a new output, both yielding the same result.
    Maybe ([(TxOutRef, TxOut)], Value)
_ -> do
      -- We get the optimal candidate, and update the `txSkelOuts` by appending
      -- a new output at the end of the list, to keep the order intact.
      ([TxOutRef]
txOutRefs, Value
val) <- [([(TxOutRef, TxOut)], Value)]
-> Wallet -> MockChainError -> m ([TxOutRef], Value)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[([(TxOutRef, TxOut)], Value)]
-> Wallet -> MockChainError -> m ([TxOutRef], Value)
getOptimalCandidate [([(TxOutRef, TxOut)], Value)]
candidatesRaw Wallet
balancingWallet MockChainError
balancingError
      ([TxOutRef], [TxSkelOut]) -> m ([TxOutRef], [TxSkelOut])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxOutRef]
txOutRefs, [TxSkelOut]
txSkelOuts [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ [Wallet
balancingWallet Wallet -> Payable '["Value"] -> TxSkelOut
forall owner (els :: [Symbol]).
(Show owner, Typeable owner, IsTxSkelOutAllowedOwner owner,
 ToCredential owner) =>
owner -> Payable els -> TxSkelOut
`receives` Value -> Payable '["Value"]
forall a1. ToValue a1 => a1 -> Payable '["Value"]
Value Value
val])
  let newTxSkelIns :: Map TxOutRef TxSkelRedeemer
newTxSkelIns = Map TxOutRef TxSkelRedeemer
txSkelIns Map TxOutRef TxSkelRedeemer
-> Map TxOutRef TxSkelRedeemer -> Map TxOutRef TxSkelRedeemer
forall a. Semigroup a => a -> a -> a
<> [(TxOutRef, TxSkelRedeemer)] -> Map TxOutRef TxSkelRedeemer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((,TxSkelRedeemer
emptyTxSkelRedeemer) (TxOutRef -> (TxOutRef, TxSkelRedeemer))
-> [TxOutRef] -> [(TxOutRef, TxSkelRedeemer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
additionalInsTxOutRefs)
  TxSkel -> m TxSkel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkel -> m TxSkel) -> TxSkel -> m TxSkel
forall a b. (a -> b) -> a -> b
$ (TxSkel
txSkel TxSkel -> (TxSkel -> TxSkel) -> TxSkel
forall a b. a -> (a -> b) -> b
& Lens' TxSkel [TxSkelOut]
txSkelOutsL Lens' TxSkel [TxSkelOut] -> [TxSkelOut] -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [TxSkelOut]
newTxSkelOuts) TxSkel -> (TxSkel -> TxSkel) -> TxSkel
forall a b. a -> (a -> b) -> b
& Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
-> Map TxOutRef TxSkelRedeemer -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Map TxOutRef TxSkelRedeemer
newTxSkelIns