{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE TupleSections      #-}
{-# LANGUAGE TypeFamilies       #-}
-- | Calculating transaction fees in the emulator.
module Cardano.Node.Emulator.Fee(
  estimateCardanoBuildTxFee,
  makeAutoBalancedTransaction,
  makeAutoBalancedTransactionWithUtxoProvider,
  utxoProviderFromWalletOutputs,
  BalancingError(..),
  -- * Internals
  selectCoin
) where

import Cardano.Api qualified as C
import Cardano.Api.Shelley qualified as C
import Cardano.Api.Shelley qualified as C.Api
import Cardano.Ledger.BaseTypes (Globals (systemStart))
import Cardano.Ledger.Core qualified as C.Ledger (Tx)
import Cardano.Ledger.Shelley.API qualified as C.Ledger hiding (Tx)
import Cardano.Node.Emulator.Params (EmulatorEra, PParams, Params (emulatorPParams), emulatorEraHistory,
                                     emulatorGlobals, pProtocolParams)
import Cardano.Node.Emulator.Validation (CardanoLedgerError, UTxO (..), makeTransactionBody)
import Control.Arrow ((&&&))
import Control.Lens (over, (&))
import Data.Aeson (FromJSON, ToJSON)
import Data.Bifunctor (bimap, first)
import Data.Foldable (fold, foldl', toList)
import Data.List (sortOn, (\\))
import Data.Map qualified as Map
import Data.Maybe (isNothing, listToMaybe)
import Data.Ord (Down (Down))
import GHC.Generics (Generic)
import Ledger.Address (CardanoAddress)
import Ledger.Index (UtxoIndex (UtxoIndex), ValidationError (..), ValidationPhase (Phase1), adjustCardanoTxOut,
                     minAdaTxOutEstimated)
import Ledger.Tx (ToCardanoError (TxBodyError), TxOut, TxOutRef)
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (CardanoBuildTx (..), fromPlutusIndex, getCardanoBuildTx, toCardanoFee,
                             toCardanoReturnCollateral, toCardanoTotalCollateral)
import Ledger.Tx.CardanoAPI qualified as CardanoAPI
import Ledger.Value.CardanoAPI (isZero, lovelaceToValue, split, valueGeq)

estimateCardanoBuildTxFee
  :: Params
  -> UTxO EmulatorEra
  -> CardanoBuildTx
  -> Either CardanoLedgerError C.Lovelace
estimateCardanoBuildTxFee :: Params
-> UTxO EmulatorEra
-> CardanoBuildTx
-> Either CardanoLedgerError Lovelace
estimateCardanoBuildTxFee Params
params UTxO EmulatorEra
utxo CardanoBuildTx
txBodyContent = do
  let nkeys :: Word
nkeys = TxBodyContent BuildTx BabbageEra -> Word
forall era. TxBodyContent BuildTx era -> Word
C.Api.estimateTransactionKeyWitnessCount (CardanoBuildTx -> TxBodyContent BuildTx BabbageEra
getCardanoBuildTx CardanoBuildTx
txBodyContent)
  TxBody BabbageEra
txBody <- Params
-> UTxO EmulatorEra
-> CardanoBuildTx
-> Either CardanoLedgerError (TxBody BabbageEra)
makeTransactionBody Params
params UTxO EmulatorEra
utxo CardanoBuildTx
txBodyContent
  Lovelace -> Either CardanoLedgerError Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lovelace -> Either CardanoLedgerError Lovelace)
-> Lovelace -> Either CardanoLedgerError Lovelace
forall a b. (a -> b) -> a -> b
$ PParams -> TxBody BabbageEra -> Word -> Lovelace
evaluateTransactionFee (Params -> PParams
emulatorPParams Params
params) TxBody BabbageEra
txBody Word
nkeys

-- | Creates a balanced transaction by calculating the execution units, the fees and the change,
-- which is assigned to the given address. Only balances Ada.
makeAutoBalancedTransaction
  :: Params
  -> UTxO EmulatorEra -- ^ Just the transaction inputs, not the entire 'UTxO'.
  -> CardanoBuildTx
  -> CardanoAddress -- ^ Change address
  -> Either CardanoLedgerError (C.Api.Tx C.Api.BabbageEra)
makeAutoBalancedTransaction :: Params
-> UTxO EmulatorEra
-> CardanoBuildTx
-> CardanoAddress
-> Either CardanoLedgerError (Tx BabbageEra)
makeAutoBalancedTransaction Params
params UTxO EmulatorEra
utxo (CardanoBuildTx TxBodyContent BuildTx BabbageEra
txBodyContent) CardanoAddress
cChangeAddr = (ToCardanoError -> CardanoLedgerError)
-> Either ToCardanoError (Tx BabbageEra)
-> Either CardanoLedgerError (Tx BabbageEra)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToCardanoError -> CardanoLedgerError
forall a b. b -> Either a b
Right (Either ToCardanoError (Tx BabbageEra)
 -> Either CardanoLedgerError (Tx BabbageEra))
-> Either ToCardanoError (Tx BabbageEra)
-> Either CardanoLedgerError (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ do
  -- Compute the change.
  C.Api.BalancedTxBody TxBody BabbageEra
_ TxOut CtxTx BabbageEra
change Lovelace
_ <- (TxBodyErrorAutoBalance -> ToCardanoError)
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
-> Either ToCardanoError (BalancedTxBody BabbageEra)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ToCardanoError
TxBodyError (String -> ToCardanoError)
-> (TxBodyErrorAutoBalance -> String)
-> TxBodyErrorAutoBalance
-> ToCardanoError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyErrorAutoBalance -> String
forall e. Error e => e -> String
C.Api.displayError) (Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
 -> Either ToCardanoError (BalancedTxBody BabbageEra))
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
-> Either ToCardanoError (BalancedTxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$ [TxOut CtxTx BabbageEra]
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
balance []
  let
    -- Recompute execution units with full set of UTxOs, including change.
    trial :: Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
trial = [TxOut CtxTx BabbageEra]
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
balance [TxOut CtxTx BabbageEra
change]
    -- Correct for a negative balance in cases where execution units, and hence fees, have increased.
    change' :: TxOut CtxTx BabbageEra
change' =
      case (TxOut CtxTx BabbageEra
change, Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
trial) of
        (C.Api.TxOut CardanoAddress
addr (C.Api.TxOutValue MultiAssetSupportedInEra BabbageEra
vtype Value
value) TxOutDatum CtxTx BabbageEra
datum ReferenceScript BabbageEra
_referenceScript, Left (C.Api.TxBodyErrorAdaBalanceNegative Lovelace
delta)) ->
          CardanoAddress
-> TxOutValue BabbageEra
-> TxOutDatum CtxTx BabbageEra
-> ReferenceScript BabbageEra
-> TxOut CtxTx BabbageEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
C.Api.TxOut CardanoAddress
addr (MultiAssetSupportedInEra BabbageEra
-> Value -> TxOutValue BabbageEra
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
C.Api.TxOutValue MultiAssetSupportedInEra BabbageEra
vtype (Value -> TxOutValue BabbageEra) -> Value -> TxOutValue BabbageEra
forall a b. (a -> b) -> a -> b
$ Value
value Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Value
lovelaceToValue Lovelace
delta) TxOutDatum CtxTx BabbageEra
datum ReferenceScript BabbageEra
_referenceScript
        (TxOut CtxTx BabbageEra,
 Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra))
_ -> TxOut CtxTx BabbageEra
change
  -- Construct the body with correct execution units and fees.
  C.Api.BalancedTxBody TxBody BabbageEra
txBody TxOut CtxTx BabbageEra
_ Lovelace
_ <- (TxBodyErrorAutoBalance -> ToCardanoError)
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
-> Either ToCardanoError (BalancedTxBody BabbageEra)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ToCardanoError
TxBodyError (String -> ToCardanoError)
-> (TxBodyErrorAutoBalance -> String)
-> TxBodyErrorAutoBalance
-> ToCardanoError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyErrorAutoBalance -> String
forall e. Error e => e -> String
C.Api.displayError) (Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
 -> Either ToCardanoError (BalancedTxBody BabbageEra))
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
-> Either ToCardanoError (BalancedTxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$ [TxOut CtxTx BabbageEra]
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
balance [TxOut CtxTx BabbageEra
change']
  Tx BabbageEra -> Either ToCardanoError (Tx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx BabbageEra -> Either ToCardanoError (Tx BabbageEra))
-> Tx BabbageEra -> Either ToCardanoError (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ [KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
C.Api.makeSignedTransaction [] TxBody BabbageEra
txBody
  where
    eh :: EraHistory CardanoMode
eh = Params -> EraHistory CardanoMode
emulatorEraHistory Params
params
    ss :: SystemStart
ss = Globals -> SystemStart
systemStart (Globals -> SystemStart) -> Globals -> SystemStart
forall a b. (a -> b) -> a -> b
$ Params -> Globals
emulatorGlobals Params
params
    utxo' :: UTxO BabbageEra
utxo' = UTxO EmulatorEra -> UTxO BabbageEra
fromLedgerUTxO UTxO EmulatorEra
utxo
    balance :: [TxOut CtxTx BabbageEra]
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
balance [TxOut CtxTx BabbageEra]
extraOuts = EraInMode BabbageEra CardanoMode
-> SystemStart
-> EraHistory CardanoMode
-> ProtocolParameters
-> Set PoolId
-> UTxO BabbageEra
-> TxBodyContent BuildTx BabbageEra
-> CardanoAddress
-> Maybe Word
-> Either TxBodyErrorAutoBalance (BalancedTxBody BabbageEra)
forall era mode.
IsShelleyBasedEra era =>
EraInMode era mode
-> SystemStart
-> EraHistory mode
-> ProtocolParameters
-> Set PoolId
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either TxBodyErrorAutoBalance (BalancedTxBody era)
C.Api.makeTransactionBodyAutoBalance
      EraInMode BabbageEra CardanoMode
C.Api.BabbageEraInCardanoMode
      SystemStart
ss
      EraHistory CardanoMode
eh
      (Params -> ProtocolParameters
pProtocolParams Params
params)
      Set PoolId
forall a. Monoid a => a
mempty
      UTxO BabbageEra
utxo'
      TxBodyContent BuildTx BabbageEra
txBodyContent { txOuts :: [TxOut CtxTx BabbageEra]
C.Api.txOuts = TxBodyContent BuildTx BabbageEra -> [TxOut CtxTx BabbageEra]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
C.Api.txOuts TxBodyContent BuildTx BabbageEra
txBodyContent [TxOut CtxTx BabbageEra]
-> [TxOut CtxTx BabbageEra] -> [TxOut CtxTx BabbageEra]
forall a. [a] -> [a] -> [a]
++ [TxOut CtxTx BabbageEra]
extraOuts }
      CardanoAddress
cChangeAddr
      Maybe Word
forall a. Maybe a
Nothing

-- | A utxo provider returns outputs that cover at least the given value,
-- and return the change, i.e. how much the outputs overshoot the given value.
type UtxoProvider m = C.Value -> m ([(TxOutRef, TxOut)], C.Value)

-- | Creates a balanced transaction by calculating the execution units, the fees and then the balance.
-- If the balance is negative the utxo provider is asked to pick extra inputs to make the balance is positive,
-- which is then assigned to the change address.
-- The collateral is similarly balanced.
-- Unlike `makeAutoBalancedTransaction` this function also balances non-Ada.
makeAutoBalancedTransactionWithUtxoProvider
    :: Monad m
    => Params
    -> UtxoIndex -- ^ Just the transaction inputs, not the entire 'UTxO'.
    -> CardanoAddress -- ^ Change address
    -> UtxoProvider m
    -> (forall a. CardanoLedgerError -> m a) -- ^ How to handle errors
    -> CardanoBuildTx
    -> m (C.Tx C.BabbageEra)
makeAutoBalancedTransactionWithUtxoProvider :: Params
-> UtxoIndex
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> CardanoBuildTx
-> m (Tx BabbageEra)
makeAutoBalancedTransactionWithUtxoProvider Params
params (UtxoIndex Map TxOutRef TxOut
txUtxo) CardanoAddress
cChangeAddr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter (CardanoBuildTx TxBodyContent BuildTx BabbageEra
unbalancedBodyContent) = do

    let initialFeeEstimate :: Lovelace
initialFeeEstimate = Integer -> Lovelace
C.Lovelace Integer
300_000

        calcFee :: Int -> Lovelace -> m Lovelace
calcFee Int
n Lovelace
fee = do

            (TxBodyContent BuildTx BabbageEra
txBodyContent, [(TxOutRef, TxOut)]
extraUtxos) <- Params
-> Map TxOutRef TxOut
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> Lovelace
-> TxBodyContent BuildTx BabbageEra
-> m (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
forall (m :: * -> *).
Monad m =>
Params
-> Map TxOutRef TxOut
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> Lovelace
-> TxBodyContent BuildTx BabbageEra
-> m (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
handleBalanceTx Params
params Map TxOutRef TxOut
txUtxo CardanoAddress
cChangeAddr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter Lovelace
fee TxBodyContent BuildTx BabbageEra
unbalancedBodyContent

            Lovelace
newFee <- (CardanoLedgerError -> m Lovelace)
-> (Lovelace -> m Lovelace)
-> Either CardanoLedgerError Lovelace
-> m Lovelace
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CardanoLedgerError -> m Lovelace
forall a. CardanoLedgerError -> m a
errorReporter Lovelace -> m Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CardanoLedgerError Lovelace -> m Lovelace)
-> Either CardanoLedgerError Lovelace -> m Lovelace
forall a b. (a -> b) -> a -> b
$ do
                UTxO EmulatorEra
cUtxo <- UtxoIndex -> Either CardanoLedgerError (UTxO EmulatorEra)
fromPlutusIndex (UtxoIndex -> Either CardanoLedgerError (UTxO EmulatorEra))
-> UtxoIndex -> Either CardanoLedgerError (UTxO EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut -> UtxoIndex
UtxoIndex (Map TxOutRef TxOut -> UtxoIndex)
-> Map TxOutRef TxOut -> UtxoIndex
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut
txUtxo Map TxOutRef TxOut -> Map TxOutRef TxOut -> Map TxOutRef TxOut
forall a. Semigroup a => a -> a -> a
<> [(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TxOutRef, TxOut)]
extraUtxos
                Params
-> UTxO EmulatorEra
-> CardanoBuildTx
-> Either CardanoLedgerError Lovelace
estimateCardanoBuildTxFee Params
params UTxO EmulatorEra
cUtxo (TxBodyContent BuildTx BabbageEra -> CardanoBuildTx
CardanoBuildTx TxBodyContent BuildTx BabbageEra
txBodyContent)

            if Lovelace
newFee Lovelace -> Lovelace -> Bool
forall a. Eq a => a -> a -> Bool
/= Lovelace
fee
                then if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int)
                    -- If we don't reach a fixed point, pick the larger fee
                    then Lovelace -> m Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lovelace
newFee Lovelace -> Lovelace -> Lovelace
forall a. Ord a => a -> a -> a
`max` Lovelace
fee)
                    else Int -> Lovelace -> m Lovelace
calcFee (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Lovelace
newFee
                else Lovelace -> m Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lovelace
newFee

    Lovelace
theFee <- Int -> Lovelace -> m Lovelace
calcFee Int
5 Lovelace
initialFeeEstimate

    (TxBodyContent BuildTx BabbageEra
txBodyContent, [(TxOutRef, TxOut)]
extraUtxos) <- Params
-> Map TxOutRef TxOut
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> Lovelace
-> TxBodyContent BuildTx BabbageEra
-> m (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
forall (m :: * -> *).
Monad m =>
Params
-> Map TxOutRef TxOut
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> Lovelace
-> TxBodyContent BuildTx BabbageEra
-> m (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
handleBalanceTx Params
params Map TxOutRef TxOut
txUtxo CardanoAddress
cChangeAddr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter Lovelace
theFee TxBodyContent BuildTx BabbageEra
unbalancedBodyContent

    (CardanoLedgerError -> m (Tx BabbageEra))
-> (Tx BabbageEra -> m (Tx BabbageEra))
-> Either CardanoLedgerError (Tx BabbageEra)
-> m (Tx BabbageEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CardanoLedgerError -> m (Tx BabbageEra)
forall a. CardanoLedgerError -> m a
errorReporter Tx BabbageEra -> m (Tx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CardanoLedgerError (Tx BabbageEra) -> m (Tx BabbageEra))
-> Either CardanoLedgerError (Tx BabbageEra) -> m (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ do
        UTxO EmulatorEra
cUtxo <- UtxoIndex -> Either CardanoLedgerError (UTxO EmulatorEra)
fromPlutusIndex (UtxoIndex -> Either CardanoLedgerError (UTxO EmulatorEra))
-> UtxoIndex -> Either CardanoLedgerError (UTxO EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut -> UtxoIndex
UtxoIndex (Map TxOutRef TxOut -> UtxoIndex)
-> Map TxOutRef TxOut -> UtxoIndex
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut
txUtxo Map TxOutRef TxOut -> Map TxOutRef TxOut -> Map TxOutRef TxOut
forall a. Semigroup a => a -> a -> a
<> [(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TxOutRef, TxOut)]
extraUtxos
        [KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
C.makeSignedTransaction [] (TxBody BabbageEra -> Tx BabbageEra)
-> Either CardanoLedgerError (TxBody BabbageEra)
-> Either CardanoLedgerError (Tx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Params
-> UTxO EmulatorEra
-> CardanoBuildTx
-> Either CardanoLedgerError (TxBody BabbageEra)
makeTransactionBody Params
params UTxO EmulatorEra
cUtxo (TxBodyContent BuildTx BabbageEra -> CardanoBuildTx
CardanoBuildTx TxBodyContent BuildTx BabbageEra
txBodyContent)

-- | Balance an unbalanced transaction by adding missing inputs and outputs
handleBalanceTx
    :: Monad m
    => Params
    -> Map.Map TxOutRef TxOut -- ^ Just the transaction inputs, not the entire 'UTxO'.
    -> C.AddressInEra C.BabbageEra -- ^ Change address
    -> UtxoProvider m -- ^ The utxo provider
    -> (forall a. CardanoLedgerError -> m a) -- ^ How to handle errors
    -> C.Lovelace -- ^ Estimated fee value to use.
    -> C.TxBodyContent C.BuildTx C.BabbageEra
    -> m (C.TxBodyContent C.BuildTx C.BabbageEra, [(TxOutRef, TxOut)])
handleBalanceTx :: Params
-> Map TxOutRef TxOut
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> Lovelace
-> TxBodyContent BuildTx BabbageEra
-> m (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
handleBalanceTx Params
params Map TxOutRef TxOut
txUtxo CardanoAddress
cChangeAddr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter Lovelace
fees TxBodyContent BuildTx BabbageEra
utx = do

    let theFee :: TxFee BabbageEra
theFee = Lovelace -> TxFee BabbageEra
toCardanoFee Lovelace
fees

    let filteredUnbalancedTxTx :: TxBodyContent BuildTx BabbageEra
filteredUnbalancedTxTx = TxBodyContent BuildTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
forall ctx.
TxBodyContent ctx BabbageEra -> TxBodyContent ctx BabbageEra
removeEmptyOutputsBuildTx TxBodyContent BuildTx BabbageEra
utx { txFee :: TxFee BabbageEra
C.txFee = TxFee BabbageEra
theFee }
        txInputs :: [TxIn]
txInputs = TxBodyContent BuildTx BabbageEra -> [TxIn]
forall ctx era. TxBodyContent ctx era -> [TxIn]
Tx.getTxBodyContentInputs TxBodyContent BuildTx BabbageEra
filteredUnbalancedTxTx

        lookupValue :: TxIn -> m Value
lookupValue TxIn
txIn = let txOutRef :: TxOutRef
txOutRef = TxIn -> TxOutRef
Tx.txInRef TxIn
txIn in
          m Value -> (TxOut -> m Value) -> Maybe TxOut -> m Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (CardanoLedgerError -> m Value
forall a. CardanoLedgerError -> m a
errorReporter ((ValidationPhase, ValidationError) -> CardanoLedgerError
forall a b. a -> Either a b
Left (ValidationPhase
Phase1, TxOutRef -> ValidationError
TxOutRefNotFound TxOutRef
txOutRef)))
            (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value) -> (TxOut -> Value) -> TxOut -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Value
Tx.txOutValue)
            (TxOutRef -> Map TxOutRef TxOut -> Maybe TxOut
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
txOutRef Map TxOutRef TxOut
txUtxo)

    [Value]
inputValues <- (TxIn -> m Value) -> [TxIn] -> m [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TxIn -> m Value
lookupValue [TxIn]
txInputs

    let left :: Value
left = TxBodyContent BuildTx BabbageEra -> Value
forall ctx era. TxBodyContent ctx era -> Value
Tx.getTxBodyContentMint TxBodyContent BuildTx BabbageEra
filteredUnbalancedTxTx Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Value] -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Value]
inputValues
        right :: Value
right = Lovelace -> Value
lovelaceToValue Lovelace
fees Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> (TxOut CtxTx BabbageEra -> Value)
-> [TxOut CtxTx BabbageEra] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxOut -> Value
Tx.txOutValue (TxOut -> Value)
-> (TxOut CtxTx BabbageEra -> TxOut)
-> TxOut CtxTx BabbageEra
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx BabbageEra -> TxOut
Tx.TxOut) (TxBodyContent BuildTx BabbageEra -> [TxOut CtxTx BabbageEra]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
C.txOuts TxBodyContent BuildTx BabbageEra
filteredUnbalancedTxTx)
        balance :: Value
balance = Value
left Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
C.negateValue Value
right

    ((Value
neg, [(TxOutRef, TxOut)]
newInputs), (Value
pos, Maybe TxOut
mNewTxOut)) <- Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
forall (m :: * -> *).
Monad m =>
Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
calculateTxChanges Params
params CardanoAddress
cChangeAddr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter ((Value, Value)
 -> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut)))
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
forall a b. (a -> b) -> a -> b
$ Value -> (Value, Value)
split Value
balance

    [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
newTxIns <- ((TxOutRef, TxOut)
 -> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> [(TxOutRef, TxOut)]
-> m [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ToCardanoError
 -> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> (TxIn
    -> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> Either ToCardanoError TxIn
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CardanoLedgerError
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall a. CardanoLedgerError -> m a
errorReporter (CardanoLedgerError
 -> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> (ToCardanoError -> CardanoLedgerError)
-> ToCardanoError
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> CardanoLedgerError
forall a b. b -> Either a b
Right) ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
 -> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> (TxIn
    -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> TxIn
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith (Witness WitCtxTxIn BabbageEra
 -> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
-> Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn BabbageEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
C.KeyWitness KeyWitnessInCtx WitCtxTxIn
C.KeyWitnessForSpending)) (Either ToCardanoError TxIn
 -> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)))
-> ((TxOutRef, TxOut) -> Either ToCardanoError TxIn)
-> (TxOutRef, TxOut)
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> Either ToCardanoError TxIn
CardanoAPI.toCardanoTxIn (TxOutRef -> Either ToCardanoError TxIn)
-> ((TxOutRef, TxOut) -> TxOutRef)
-> (TxOutRef, TxOut)
-> Either ToCardanoError TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst) [(TxOutRef, TxOut)]
newInputs

    let txWithOutputsAdded :: TxBodyContent BuildTx BabbageEra
txWithOutputsAdded = if Value -> Bool
isZero Value
pos
        then TxBodyContent BuildTx BabbageEra
filteredUnbalancedTxTx
        else TxBodyContent BuildTx BabbageEra
filteredUnbalancedTxTx TxBodyContent BuildTx BabbageEra
-> (TxBodyContent BuildTx BabbageEra
    -> TxBodyContent BuildTx BabbageEra)
-> TxBodyContent BuildTx BabbageEra
forall a b. a -> (a -> b) -> b
& ASetter
  (TxBodyContent BuildTx BabbageEra)
  (TxBodyContent BuildTx BabbageEra)
  [TxOut]
  [TxOut]
-> ([TxOut] -> [TxOut])
-> TxBodyContent BuildTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (TxBodyContent BuildTx BabbageEra)
  (TxBodyContent BuildTx BabbageEra)
  [TxOut]
  [TxOut]
forall ctx. Lens' (TxBodyContent ctx BabbageEra) [TxOut]
Tx.txBodyContentOuts ([TxOut] -> [TxOut] -> [TxOut]
forall a. [a] -> [a] -> [a]
++ Maybe TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe TxOut
mNewTxOut)

    let txWithinputsAdded :: TxBodyContent BuildTx BabbageEra
txWithinputsAdded = if Value -> Bool
isZero Value
neg
        then TxBodyContent BuildTx BabbageEra
txWithOutputsAdded
        else TxBodyContent BuildTx BabbageEra
txWithOutputsAdded TxBodyContent BuildTx BabbageEra
-> (TxBodyContent BuildTx BabbageEra
    -> TxBodyContent BuildTx BabbageEra)
-> TxBodyContent BuildTx BabbageEra
forall a b. a -> (a -> b) -> b
& ASetter
  (TxBodyContent BuildTx BabbageEra)
  (TxBodyContent BuildTx BabbageEra)
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> TxBodyContent BuildTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (TxBodyContent BuildTx BabbageEra)
  (TxBodyContent BuildTx BabbageEra)
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
Lens'
  (TxBodyContent BuildTx BabbageEra)
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
Tx.txBodyContentIns ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
forall a. [a] -> [a] -> [a]
++ [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
newTxIns)

    [Value]
collateral <- (TxIn -> m Value) -> [TxIn] -> m [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TxIn -> m Value
lookupValue (TxBodyContent BuildTx BabbageEra -> [TxIn]
forall ctx era. TxBodyContent ctx era -> [TxIn]
Tx.getTxBodyContentCollateralInputs TxBodyContent BuildTx BabbageEra
txWithinputsAdded)
    let returnCollateral :: Maybe TxOut
returnCollateral = TxBodyContent BuildTx BabbageEra -> Maybe TxOut
forall ctx. TxBodyContent ctx BabbageEra -> Maybe TxOut
Tx.getTxBodyContentReturnCollateral TxBodyContent BuildTx BabbageEra
txWithinputsAdded

    if Value -> Bool
isZero ([Value] -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Value]
collateral)
        Bool -> Bool -> Bool
&& [(ScriptWitnessIndex, AnyScriptWitness BabbageEra)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TxBodyContent BuildTx BabbageEra
-> [(ScriptWitnessIndex, AnyScriptWitness BabbageEra)]
forall era.
TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
C.collectTxBodyScriptWitnesses TxBodyContent BuildTx BabbageEra
txWithinputsAdded) -- every script has a redeemer, no redeemers -> no scripts
        Bool -> Bool -> Bool
&& Maybe TxOut -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe TxOut
returnCollateral then
        -- Don't add collateral if there are no plutus scripts that can fail
        -- and there are no collateral inputs or outputs already
        (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
-> m (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyContent BuildTx BabbageEra
txWithinputsAdded, [(TxOutRef, TxOut)]
newInputs)
    else do
        let collAddr :: CardanoAddress
collAddr = CardanoAddress
-> (TxOut -> CardanoAddress) -> Maybe TxOut -> CardanoAddress
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CardanoAddress
cChangeAddr (\(Tx.TxOut (C.TxOut CardanoAddress
aie TxOutValue BabbageEra
_tov TxOutDatum CtxTx BabbageEra
_tod ReferenceScript BabbageEra
_rs)) -> CardanoAddress
aie) Maybe TxOut
returnCollateral
            collateralPercent :: Lovelace
collateralPercent = Lovelace -> (Natural -> Lovelace) -> Maybe Natural -> Lovelace
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Lovelace
100 Natural -> Lovelace
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProtocolParameters -> Maybe Natural
C.protocolParamCollateralPercent (Params -> ProtocolParameters
pProtocolParams Params
params))
            collFees :: Lovelace
collFees = (Lovelace
fees Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
* Lovelace
collateralPercent Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
+ Lovelace
99 {- make sure to round up -}) Lovelace -> Lovelace -> Lovelace
forall a. Integral a => a -> a -> a
`div` Lovelace
100
            collBalance :: Value
collBalance = [Value] -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Value]
collateral Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Value
lovelaceToValue (-Lovelace
collFees)

        ((Value
negColl, [(TxOutRef, TxOut)]
newColInputs), (Value
_, Maybe TxOut
mNewTxOutColl)) <- Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
forall (m :: * -> *).
Monad m =>
Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
calculateTxChanges Params
params CardanoAddress
collAddr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter ((Value, Value)
 -> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut)))
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
forall a b. (a -> b) -> a -> b
$ Value -> (Value, Value)
split Value
collBalance

        case ProtocolParameters -> Maybe Natural
C.Api.protocolParamMaxCollateralInputs (ProtocolParameters -> Maybe Natural)
-> ProtocolParameters -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Params -> ProtocolParameters
pProtocolParams Params
params of
            Just Natural
maxInputs
                | [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
collateral Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(TxOutRef, TxOut)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TxOutRef, TxOut)]
newColInputs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
maxInputs
                -> CardanoLedgerError -> m ()
forall a. CardanoLedgerError -> m a
errorReporter ((ValidationPhase, ValidationError) -> CardanoLedgerError
forall a b. a -> Either a b
Left (ValidationPhase
Phase1, ValidationError
MaxCollateralInputsExceeded))
            Maybe Natural
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        [TxIn]
newTxInsColl <- ((TxOutRef, TxOut) -> m TxIn) -> [(TxOutRef, TxOut)] -> m [TxIn]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ToCardanoError -> m TxIn)
-> (TxIn -> m TxIn) -> Either ToCardanoError TxIn -> m TxIn
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CardanoLedgerError -> m TxIn
forall a. CardanoLedgerError -> m a
errorReporter (CardanoLedgerError -> m TxIn)
-> (ToCardanoError -> CardanoLedgerError)
-> ToCardanoError
-> m TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> CardanoLedgerError
forall a b. b -> Either a b
Right) TxIn -> m TxIn
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError TxIn -> m TxIn)
-> ((TxOutRef, TxOut) -> Either ToCardanoError TxIn)
-> (TxOutRef, TxOut)
-> m TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> Either ToCardanoError TxIn
CardanoAPI.toCardanoTxIn (TxOutRef -> Either ToCardanoError TxIn)
-> ((TxOutRef, TxOut) -> TxOutRef)
-> (TxOutRef, TxOut)
-> Either ToCardanoError TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst) [(TxOutRef, TxOut)]
newColInputs

        let txWithCollateralInputs :: TxBodyContent BuildTx BabbageEra
txWithCollateralInputs = if Value -> Bool
isZero Value
negColl
            then TxBodyContent BuildTx BabbageEra
txWithinputsAdded
            else TxBodyContent BuildTx BabbageEra
txWithinputsAdded TxBodyContent BuildTx BabbageEra
-> (TxBodyContent BuildTx BabbageEra
    -> TxBodyContent BuildTx BabbageEra)
-> TxBodyContent BuildTx BabbageEra
forall a b. a -> (a -> b) -> b
& ASetter
  (TxBodyContent BuildTx BabbageEra)
  (TxBodyContent BuildTx BabbageEra)
  [TxIn]
  [TxIn]
-> ([TxIn] -> [TxIn])
-> TxBodyContent BuildTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (TxBodyContent BuildTx BabbageEra)
  (TxBodyContent BuildTx BabbageEra)
  [TxIn]
  [TxIn]
Lens' (TxBodyContent BuildTx BabbageEra) [TxIn]
Tx.txBodyContentCollateralIns ([TxIn] -> [TxIn] -> [TxIn]
forall a. [a] -> [a] -> [a]
++ [TxIn]
newTxInsColl)

        let totalCollateral :: TxTotalCollateral BabbageEra
totalCollateral = Maybe Lovelace -> TxTotalCollateral BabbageEra
toCardanoTotalCollateral (Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just Lovelace
collFees)

        (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
-> m (TxBodyContent BuildTx BabbageEra, [(TxOutRef, TxOut)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyContent BuildTx BabbageEra
txWithCollateralInputs {
            txTotalCollateral :: TxTotalCollateral BabbageEra
C.txTotalCollateral = TxTotalCollateral BabbageEra
totalCollateral,
            txReturnCollateral :: TxReturnCollateral CtxTx BabbageEra
C.txReturnCollateral = Maybe TxOut -> TxReturnCollateral CtxTx BabbageEra
toCardanoReturnCollateral Maybe TxOut
mNewTxOutColl
        }, [(TxOutRef, TxOut)]
newInputs [(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)] -> [(TxOutRef, TxOut)]
forall a. Semigroup a => a -> a -> a
<> [(TxOutRef, TxOut)]
newColInputs)

removeEmptyOutputsBuildTx :: C.TxBodyContent ctx C.BabbageEra -> C.TxBodyContent ctx C.BabbageEra
removeEmptyOutputsBuildTx :: TxBodyContent ctx BabbageEra -> TxBodyContent ctx BabbageEra
removeEmptyOutputsBuildTx bodyContent :: TxBodyContent ctx BabbageEra
bodyContent@C.TxBodyContent { [TxOut CtxTx BabbageEra]
txOuts :: [TxOut CtxTx BabbageEra]
txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
C.txOuts } = TxBodyContent ctx BabbageEra
bodyContent { txOuts :: [TxOut CtxTx BabbageEra]
C.txOuts = [TxOut CtxTx BabbageEra]
txOuts' }
    where
        txOuts' :: [TxOut CtxTx BabbageEra]
txOuts' = (TxOut CtxTx BabbageEra -> Bool)
-> [TxOut CtxTx BabbageEra] -> [TxOut CtxTx BabbageEra]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (TxOut CtxTx BabbageEra -> Bool)
-> TxOut CtxTx BabbageEra
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Bool
isEmpty' (TxOut -> Bool)
-> (TxOut CtxTx BabbageEra -> TxOut)
-> TxOut CtxTx BabbageEra
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx BabbageEra -> TxOut
Tx.TxOut) [TxOut CtxTx BabbageEra]
txOuts
        isEmpty' :: TxOut -> Bool
isEmpty' TxOut
txOut =
            Value -> Bool
isZero (TxOut -> Value
Tx.txOutValue TxOut
txOut) Bool -> Bool -> Bool
&& Maybe DatumHash -> Bool
forall a. Maybe a -> Bool
isNothing (TxOut -> Maybe DatumHash
Tx.txOutDatumHash TxOut
txOut)

calculateTxChanges
    :: Monad m
    => Params
    -> C.AddressInEra C.BabbageEra -- ^ The address for the change output
    -> UtxoProvider m -- ^ The utxo provider
    -> (forall a. CardanoLedgerError -> m a) -- ^ How to handle errors
    -> (C.Value, C.Value) -- ^ The unbalanced tx's negative and positive balance.
    -> m ((C.Value, [(TxOutRef, TxOut)]), (C.Value, Maybe TxOut))
calculateTxChanges :: Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
calculateTxChanges Params
params CardanoAddress
addr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter (Value
neg, Value
pos) = do

    -- Calculate the change output with minimal ada
    (Value
newNeg, Value
newPos, Maybe TxOut
mExtraTxOut) <- (ToCardanoError -> m (Value, Value, Maybe TxOut))
-> ((Value, Value, Maybe TxOut) -> m (Value, Value, Maybe TxOut))
-> Either ToCardanoError (Value, Value, Maybe TxOut)
-> m (Value, Value, Maybe TxOut)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CardanoLedgerError -> m (Value, Value, Maybe TxOut)
forall a. CardanoLedgerError -> m a
errorReporter (CardanoLedgerError -> m (Value, Value, Maybe TxOut))
-> (ToCardanoError -> CardanoLedgerError)
-> ToCardanoError
-> m (Value, Value, Maybe TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> CardanoLedgerError
forall a b. b -> Either a b
Right) (Value, Value, Maybe TxOut) -> m (Value, Value, Maybe TxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError (Value, Value, Maybe TxOut)
 -> m (Value, Value, Maybe TxOut))
-> Either ToCardanoError (Value, Value, Maybe TxOut)
-> m (Value, Value, Maybe TxOut)
forall a b. (a -> b) -> a -> b
$ if Value -> Bool
isZero Value
pos
        then (Value, Value, Maybe TxOut)
-> Either ToCardanoError (Value, Value, Maybe TxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
neg, Value
pos, Maybe TxOut
forall a. Maybe a
Nothing)
        else do
            let txOut :: TxOut CtxTx BabbageEra
txOut = CardanoAddress
-> TxOutValue BabbageEra
-> TxOutDatum CtxTx BabbageEra
-> ReferenceScript BabbageEra
-> TxOut CtxTx BabbageEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
C.TxOut CardanoAddress
addr (Value -> TxOutValue BabbageEra
CardanoAPI.toCardanoTxOutValue Value
pos) TxOutDatum CtxTx BabbageEra
forall ctx era. TxOutDatum ctx era
C.TxOutDatumNone ReferenceScript BabbageEra
forall era. ReferenceScript era
C.Api.ReferenceScriptNone
            ([Lovelace]
missing, TxOut
extraTxOut) <- PParams -> TxOut -> Either ToCardanoError ([Lovelace], TxOut)
adjustCardanoTxOut (Params -> PParams
emulatorPParams Params
params) (TxOut CtxTx BabbageEra -> TxOut
Tx.TxOut TxOut CtxTx BabbageEra
txOut)
            let missingValue :: Value
missingValue = Lovelace -> Value
lovelaceToValue ([Lovelace] -> Lovelace
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Lovelace]
missing)
            -- Add the missing ada to both sides to keep the balance.
            (Value, Value, Maybe TxOut)
-> Either ToCardanoError (Value, Value, Maybe TxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
neg Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
missingValue, Value
pos Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
missingValue, TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just TxOut
extraTxOut)

    -- Calculate the extra inputs needed
    ([(TxOutRef, TxOut)]
spend, Value
change) <- if Value -> Bool
isZero Value
newNeg
        then ([(TxOutRef, TxOut)], Value) -> m ([(TxOutRef, TxOut)], Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Value
forall a. Monoid a => a
mempty)
        else UtxoProvider m
utxoProvider Value
newNeg

    if Value -> Bool
isZero Value
change
        then do
            -- No change, so the new inputs and outputs have balanced the transaction
            ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value
newNeg, [(TxOutRef, TxOut)]
spend), (Value
newPos, Maybe TxOut
mExtraTxOut))
        else if Maybe TxOut -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe TxOut
mExtraTxOut
            -- We have change so we need an extra output, if we didn't have that yet,
            -- first make one with an estimated minimal amount of ada
            -- which then will calculate a more exact set of inputs
            then Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
forall (m :: * -> *).
Monad m =>
Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
calculateTxChanges Params
params CardanoAddress
addr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter (Value
neg Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Ada -> Value
CardanoAPI.adaToCardanoValue Ada
minAdaTxOutEstimated, Ada -> Value
CardanoAPI.adaToCardanoValue Ada
minAdaTxOutEstimated)
            -- Else recalculate with the change added to both sides
            -- Ideally this creates the same inputs and outputs and then the change will be zero
            -- But possibly the minimal Ada increases and then we also want to compute a new set of inputs
            else Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
forall (m :: * -> *).
Monad m =>
Params
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> (Value, Value)
-> m ((Value, [(TxOutRef, TxOut)]), (Value, Maybe TxOut))
calculateTxChanges Params
params CardanoAddress
addr UtxoProvider m
utxoProvider forall a. CardanoLedgerError -> m a
errorReporter (Value
newNeg Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
change, Value
newPos Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
change)


data BalancingError
    = InsufficientFunds { BalancingError -> Value
total :: C.Value, BalancingError -> Value
expected :: C.Value }
    -- ^ Not enough extra inputs available to balance a transaction.
    | CardanoLedgerError CardanoLedgerError
    deriving stock (Int -> BalancingError -> ShowS
[BalancingError] -> ShowS
BalancingError -> String
(Int -> BalancingError -> ShowS)
-> (BalancingError -> String)
-> ([BalancingError] -> ShowS)
-> Show BalancingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalancingError] -> ShowS
$cshowList :: [BalancingError] -> ShowS
show :: BalancingError -> String
$cshow :: BalancingError -> String
showsPrec :: Int -> BalancingError -> ShowS
$cshowsPrec :: Int -> BalancingError -> ShowS
Show, BalancingError -> BalancingError -> Bool
(BalancingError -> BalancingError -> Bool)
-> (BalancingError -> BalancingError -> Bool) -> Eq BalancingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BalancingError -> BalancingError -> Bool
$c/= :: BalancingError -> BalancingError -> Bool
== :: BalancingError -> BalancingError -> Bool
$c== :: BalancingError -> BalancingError -> Bool
Eq, (forall x. BalancingError -> Rep BalancingError x)
-> (forall x. Rep BalancingError x -> BalancingError)
-> Generic BalancingError
forall x. Rep BalancingError x -> BalancingError
forall x. BalancingError -> Rep BalancingError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BalancingError x -> BalancingError
$cfrom :: forall x. BalancingError -> Rep BalancingError x
Generic)
    deriving anyclass ([BalancingError] -> Encoding
[BalancingError] -> Value
BalancingError -> Encoding
BalancingError -> Value
(BalancingError -> Value)
-> (BalancingError -> Encoding)
-> ([BalancingError] -> Value)
-> ([BalancingError] -> Encoding)
-> ToJSON BalancingError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BalancingError] -> Encoding
$ctoEncodingList :: [BalancingError] -> Encoding
toJSONList :: [BalancingError] -> Value
$ctoJSONList :: [BalancingError] -> Value
toEncoding :: BalancingError -> Encoding
$ctoEncoding :: BalancingError -> Encoding
toJSON :: BalancingError -> Value
$ctoJSON :: BalancingError -> Value
ToJSON, Value -> Parser [BalancingError]
Value -> Parser BalancingError
(Value -> Parser BalancingError)
-> (Value -> Parser [BalancingError]) -> FromJSON BalancingError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BalancingError]
$cparseJSONList :: Value -> Parser [BalancingError]
parseJSON :: Value -> Parser BalancingError
$cparseJSON :: Value -> Parser BalancingError
FromJSON)

-- Build a utxo provider from a set of unspent transaction outputs.
utxoProviderFromWalletOutputs
    :: Map.Map TxOutRef TxOut
    -- ^ The unspent transaction outputs.
    -- Make sure that this doesn't contain any inputs from the transaction being balanced.
    -> UtxoProvider (Either BalancingError)
utxoProviderFromWalletOutputs :: Map TxOutRef TxOut -> UtxoProvider (Either BalancingError)
utxoProviderFromWalletOutputs Map TxOutRef TxOut
walletUtxos Value
value =
    let outRefsWithValue :: [((TxOutRef, TxOut), Value)]
outRefsWithValue = (\(TxOutRef, TxOut)
p -> ((TxOutRef, TxOut)
p, TxOut -> Value
Tx.txOutValue ((TxOutRef, TxOut) -> TxOut
forall a b. (a, b) -> b
snd (TxOutRef, TxOut)
p))) ((TxOutRef, TxOut) -> ((TxOutRef, TxOut), Value))
-> [(TxOutRef, TxOut)] -> [((TxOutRef, TxOut), Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxOutRef TxOut
walletUtxos
    in [((TxOutRef, TxOut), Value)]
-> UtxoProvider (Either BalancingError)
forall a.
Eq a =>
[(a, Value)] -> Value -> Either BalancingError ([a], Value)
selectCoin [((TxOutRef, TxOut), Value)]
outRefsWithValue Value
value

-- | Given a set of @a@s with coin values, and a target value, select a number
-- of @a@ such that their total value is greater than or equal to the target.
selectCoin ::
    Eq a
    => [(a, C.Value)] -- ^ Possible inputs to choose from
    -> C.Value -- ^ The target value
    -> Either BalancingError ([a], C.Value) -- ^ The chosen inputs and the change
selectCoin :: [(a, Value)] -> Value -> Either BalancingError ([a], Value)
selectCoin [(a, Value)]
fnds Value
vl =
    let
        total :: Value
total = ((a, Value) -> Value) -> [(a, Value)] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a, Value) -> Value
forall a b. (a, b) -> b
snd [(a, Value)]
fnds
        err :: Either BalancingError ([a], Value)
err   = BalancingError -> Either BalancingError ([a], Value)
forall a b. a -> Either a b
Left (BalancingError -> Either BalancingError ([a], Value))
-> BalancingError -> Either BalancingError ([a], Value)
forall a b. (a -> b) -> a -> b
$ Value -> Value -> BalancingError
InsufficientFunds Value
total Value
vl
    -- Values are in a partial order: what we want to check is that the
    -- total available funds are bigger than (or equal to) the required value.
    in  if Bool -> Bool
not (Value
total Value -> Value -> Bool
`valueGeq` Value
vl)
        then Either BalancingError ([a], Value)
err
        else
            -- Select inputs per asset class, sorting so we do Ada last.
            -- We want to do the non-Ada asset classes first, because utxo's often contain
            -- extra Ada because of fees or minAda constraints. So when we are done with the
            -- non-Ada asset classes we probably already have picked some Ada too.
            let ([(a, Value)]
usedFinal, Value
remainderFinal) = (([(a, Value)], Value)
 -> (AssetId, Quantity) -> ([(a, Value)], Value))
-> ([(a, Value)], Value)
-> [(AssetId, Quantity)]
-> ([(a, Value)], Value)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([(a, Value)], Value)
-> (AssetId, Quantity) -> ([(a, Value)], Value)
step ([], Value
vl) (((AssetId, Quantity) -> Down (AssetId, Quantity))
-> [(AssetId, Quantity)] -> [(AssetId, Quantity)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (AssetId, Quantity) -> Down (AssetId, Quantity)
forall a. a -> Down a
Down ([(AssetId, Quantity)] -> [(AssetId, Quantity)])
-> [(AssetId, Quantity)] -> [(AssetId, Quantity)]
forall a b. (a -> b) -> a -> b
$ Value -> [(AssetId, Quantity)]
C.valueToList Value
vl)
                step :: ([(a, Value)], Value)
-> (AssetId, Quantity) -> ([(a, Value)], Value)
step ([(a, Value)]
used, Value
remainder) (AssetId
assetId, Quantity
_) =
                    let ([(a, Value)]
used', Value
remainder') = AssetId -> [(a, Value)] -> Value -> ([(a, Value)], Value)
forall a. AssetId -> [(a, Value)] -> Value -> ([(a, Value)], Value)
selectCoinSingle AssetId
assetId ([(a, Value)]
fnds [(a, Value)] -> [(a, Value)] -> [(a, Value)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(a, Value)]
used) Value
remainder
                    in ([(a, Value)]
used [(a, Value)] -> [(a, Value)] -> [(a, Value)]
forall a. Semigroup a => a -> a -> a
<> [(a, Value)]
used', Value
remainder')
            in ([a], Value) -> Either BalancingError ([a], Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((a, Value) -> a) -> [(a, Value)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Value) -> a
forall a b. (a, b) -> a
fst [(a, Value)]
usedFinal, Value -> Value
C.negateValue Value
remainderFinal)

selectCoinSingle
    :: C.AssetId
    -> [(a, C.Value)] -- ^ Possible inputs to choose from
    -> C.Value -- ^ The target value
    -> ([(a, C.Value)], C.Value) -- ^ The chosen inputs and the remainder
selectCoinSingle :: AssetId -> [(a, Value)] -> Value -> ([(a, Value)], Value)
selectCoinSingle AssetId
assetId [(a, Value)]
fnds' Value
vl =
    let
        pick :: Value -> Quantity
pick Value
v = Value -> AssetId -> Quantity
C.selectAsset Value
v AssetId
assetId
        -- We only want the values that contain the given asset class,
        -- and want the single currency values first,
        -- so that we're picking inputs that contain *only* the given asset class when possible.
        -- That being equal we want the input with the largest amount of the given asset class,
        -- to reduce the amount of inputs required. (Particularly useful to prevent hitting MaxCollateralInputs)
        fnds :: [(a, Value)]
fnds = ((a, Value) -> (Int, Down Quantity))
-> [(a, Value)] -> [(a, Value)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ([(AssetId, Quantity)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(AssetId, Quantity)] -> Int)
-> ((a, Value) -> [(AssetId, Quantity)]) -> (a, Value) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(AssetId, Quantity)]
C.valueToList (Value -> [(AssetId, Quantity)])
-> ((a, Value) -> Value) -> (a, Value) -> [(AssetId, Quantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Value) -> Value
forall a b. (a, b) -> b
snd ((a, Value) -> Int)
-> ((a, Value) -> Down Quantity)
-> (a, Value)
-> (Int, Down Quantity)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Quantity -> Down Quantity
forall a. a -> Down a
Down (Quantity -> Down Quantity)
-> ((a, Value) -> Quantity) -> (a, Value) -> Down Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Quantity
pick (Value -> Quantity)
-> ((a, Value) -> Value) -> (a, Value) -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Value) -> Value
forall a b. (a, b) -> b
snd) ([(a, Value)] -> [(a, Value)]) -> [(a, Value)] -> [(a, Value)]
forall a b. (a -> b) -> a -> b
$ ((a, Value) -> Bool) -> [(a, Value)] -> [(a, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
_, Value
v) -> Value -> Quantity
pick Value
v Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
0) [(a, Value)]
fnds'
        -- Given the funds of a wallet, we take just enough from
        -- the target value such that the asset class value of the remainder is <= 0.
        fundsWithRemainder :: [((a, Value), Value)]
fundsWithRemainder = [(a, Value)] -> [Value] -> [((a, Value), Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(a, Value)]
fnds (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
drop Int
1 ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ (Value -> Value -> Value) -> Value -> [Value] -> [Value]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Value
l Value
r -> Value
l Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
C.negateValue Value
r) Value
vl ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ ((a, Value) -> Value) -> [(a, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Value) -> Value
forall a b. (a, b) -> b
snd [(a, Value)]
fnds)
        fundsToSpend :: [((a, Value), Value)]
fundsToSpend       = (((a, Value), Value) -> Bool)
-> [((a, Value), Value)] -> [((a, Value), Value)]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil (\((a, Value)
_, Value
v) -> Value -> Quantity
pick Value
v Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
<= Quantity
0) [((a, Value), Value)]
fundsWithRemainder
        remainder :: Value
remainder          = Value
-> (((a, Value), Value) -> Value)
-> Maybe ((a, Value), Value)
-> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
vl ((a, Value), Value) -> Value
forall a b. (a, b) -> b
snd (Maybe ((a, Value), Value) -> Value)
-> Maybe ((a, Value), Value) -> Value
forall a b. (a -> b) -> a -> b
$ [((a, Value), Value)] -> Maybe ((a, Value), Value)
forall a. [a] -> Maybe a
listToMaybe ([((a, Value), Value)] -> Maybe ((a, Value), Value))
-> [((a, Value), Value)] -> Maybe ((a, Value), Value)
forall a b. (a -> b) -> a -> b
$ [((a, Value), Value)] -> [((a, Value), Value)]
forall a. [a] -> [a]
reverse [((a, Value), Value)]
fundsToSpend
    in (((a, Value), Value) -> (a, Value)
forall a b. (a, b) -> a
fst (((a, Value), Value) -> (a, Value))
-> [((a, Value), Value)] -> [(a, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((a, Value), Value)]
fundsToSpend, Value
remainder)

-- | Take elements from a list until the predicate is satisfied.
-- 'takeUntil' @p@ includes the first element for wich @p@ is true
-- (unlike @takeWhile (not . p)@).
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
_ []       = []
takeUntil a -> Bool
p (a
x:[a]
xs)
    | a -> Bool
p a
x            = [a
x]
    | Bool
otherwise      = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
p [a]
xs


fromLedgerUTxO :: UTxO EmulatorEra
               -> C.Api.UTxO C.Api.BabbageEra
fromLedgerUTxO :: UTxO EmulatorEra -> UTxO BabbageEra
fromLedgerUTxO (UTxO Map (TxIn (Crypto EmulatorEra)) (TxOut EmulatorEra)
utxo) =
    Map TxIn (TxOut CtxUTxO BabbageEra) -> UTxO BabbageEra
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
C.Api.UTxO
  (Map TxIn (TxOut CtxUTxO BabbageEra) -> UTxO BabbageEra)
-> (Map (TxIn StandardCrypto) (TxOut EmulatorEra)
    -> Map TxIn (TxOut CtxUTxO BabbageEra))
-> Map (TxIn StandardCrypto) (TxOut EmulatorEra)
-> UTxO BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut CtxUTxO BabbageEra)]
-> Map TxIn (TxOut CtxUTxO BabbageEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  ([(TxIn, TxOut CtxUTxO BabbageEra)]
 -> Map TxIn (TxOut CtxUTxO BabbageEra))
-> (Map (TxIn StandardCrypto) (TxOut EmulatorEra)
    -> [(TxIn, TxOut CtxUTxO BabbageEra)])
-> Map (TxIn StandardCrypto) (TxOut EmulatorEra)
-> Map TxIn (TxOut CtxUTxO BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn StandardCrypto, TxOut EmulatorEra)
 -> (TxIn, TxOut CtxUTxO BabbageEra))
-> [(TxIn StandardCrypto, TxOut EmulatorEra)]
-> [(TxIn, TxOut CtxUTxO BabbageEra)]
forall a b. (a -> b) -> [a] -> [b]
map ((TxIn StandardCrypto -> TxIn)
-> (TxOut EmulatorEra -> TxOut CtxUTxO BabbageEra)
-> (TxIn StandardCrypto, TxOut EmulatorEra)
-> (TxIn, TxOut CtxUTxO BabbageEra)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TxIn StandardCrypto -> TxIn
C.Api.fromShelleyTxIn (ShelleyBasedEra BabbageEra
-> TxOut EmulatorEra -> TxOut CtxUTxO BabbageEra
forall era ledgerera ctx.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut ledgerera -> TxOut ctx era
C.Api.fromShelleyTxOut ShelleyBasedEra BabbageEra
C.Api.ShelleyBasedEraBabbage))
  ([(TxIn StandardCrypto, TxOut EmulatorEra)]
 -> [(TxIn, TxOut CtxUTxO BabbageEra)])
-> (Map (TxIn StandardCrypto) (TxOut EmulatorEra)
    -> [(TxIn StandardCrypto, TxOut EmulatorEra)])
-> Map (TxIn StandardCrypto) (TxOut EmulatorEra)
-> [(TxIn, TxOut CtxUTxO BabbageEra)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (TxIn StandardCrypto) (TxOut EmulatorEra)
-> [(TxIn StandardCrypto, TxOut EmulatorEra)]
forall k a. Map k a -> [(k, a)]
Map.toList
  (Map (TxIn StandardCrypto) (TxOut EmulatorEra) -> UTxO BabbageEra)
-> Map (TxIn StandardCrypto) (TxOut EmulatorEra) -> UTxO BabbageEra
forall a b. (a -> b) -> a -> b
$ Map (TxIn StandardCrypto) (TxOut EmulatorEra)
Map (TxIn (Crypto EmulatorEra)) (TxOut EmulatorEra)
utxo

-- Adapted from cardano-api Cardano.API.Fee to avoid PParams conversion
evaluateTransactionFee :: PParams -> C.Api.TxBody C.Api.BabbageEra -> Word -> C.Api.Lovelace
evaluateTransactionFee :: PParams -> TxBody BabbageEra -> Word -> Lovelace
evaluateTransactionFee PParams
pparams TxBody BabbageEra
txbody Word
keywitcount = case [KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
C.Api.makeSignedTransaction [] TxBody BabbageEra
txbody of
      C.Api.ShelleyTx ShelleyBasedEra BabbageEra
_  Tx (ShelleyLedgerEra BabbageEra)
tx -> Tx (ShelleyLedgerEra BabbageEra) -> Lovelace
evalShelleyBasedEra Tx (ShelleyLedgerEra BabbageEra)
tx
  where
    evalShelleyBasedEra :: C.Ledger.Tx (C.Api.ShelleyLedgerEra C.Api.BabbageEra) -> C.Api.Lovelace
    evalShelleyBasedEra :: Tx (ShelleyLedgerEra BabbageEra) -> Lovelace
evalShelleyBasedEra Tx (ShelleyLedgerEra BabbageEra)
tx = Coin -> Lovelace
C.Api.fromShelleyLovelace (Coin -> Lovelace) -> Coin -> Lovelace
forall a b. (a -> b) -> a -> b
$ PParams EmulatorEra -> Tx EmulatorEra -> Word -> Coin
forall era. CLI era => PParams era -> Tx era -> Word -> Coin
C.Ledger.evaluateTransactionFee PParams
PParams EmulatorEra
pparams Tx (ShelleyLedgerEra BabbageEra)
Tx EmulatorEra
tx Word
keywitcount