module Cooked.MockChain.Balancing
( balanceTxSkel,
getMinAndMaxFee,
estimateTxSkelFee,
)
where
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Api.Shelley qualified as Cardano
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.Conversion
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx
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
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 Optics.Core
import Plutus.Script.Utils.Ada 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
type Fee = Integer
type Collaterals = Set Api.TxOutRef
type BalancingOutputs = [(Api.TxOutRef, Api.TxOut)]
balanceTxSkel :: (MonadBlockChainBalancing m) => TxSkel -> m (TxSkel, Fee, Maybe (Collaterals, Wallet))
balanceTxSkel :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
balanceTxSkel skelUnbal :: TxSkel
skelUnbal@TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Collaterals
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 :: Collaterals
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 -> Collaterals
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelWithdrawals :: TxSkel -> TxSkelWithdrawals
..} = do
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
(Integer
minFee, Integer
maxFee) <- m (Integer, Integer)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
m (Integer, Integer)
getMinAndMaxFee
Maybe (Collaterals, Wallet)
mCollaterals <- do
Map ValidatorHash (Versioned Validator)
spendingScripts <- TxSkel -> m (Map ValidatorHash (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map ValidatorHash (Versioned Validator))
txSkelInputValidators TxSkel
skelUnbal
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 Collaterals
utxos Wallet
_) -> MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (Either Wallet Collaterals -> MockChainLogEntry
MCLogUnusedCollaterals (Either Wallet Collaterals -> MockChainLogEntry)
-> Either Wallet Collaterals -> MockChainLogEntry
forall a b. (a -> b) -> a -> b
$ Collaterals -> Either Wallet Collaterals
forall a b. b -> Either a b
Right Collaterals
utxos) m ()
-> m (Maybe (Collaterals, Wallet))
-> m (Maybe (Collaterals, Wallet))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Collaterals, Wallet)
forall a. Maybe a
Nothing
(Bool
True, CollateralUtxosFromWallet Wallet
cWallet) -> MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (Either Wallet Collaterals -> MockChainLogEntry
MCLogUnusedCollaterals (Either Wallet Collaterals -> MockChainLogEntry)
-> Either Wallet Collaterals -> MockChainLogEntry
forall a b. (a -> b) -> a -> b
$ Wallet -> Either Wallet Collaterals
forall a b. a -> Either a b
Left Wallet
cWallet) m ()
-> m (Maybe (Collaterals, Wallet))
-> m (Maybe (Collaterals, Wallet))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Collaterals, Wallet)
forall a. Maybe a
Nothing
(Bool
True, CollateralUtxos
CollateralUtxosFromBalancingWallet) -> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Collaterals, Wallet)
forall a. Maybe a
Nothing
(Bool
False, CollateralUtxosFromSet Collaterals
utxos Wallet
rWallet) -> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet)))
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall a b. (a -> b) -> a -> b
$ (Collaterals, Wallet) -> Maybe (Collaterals, Wallet)
forall a. a -> Maybe a
Just (Collaterals
utxos, Wallet
rWallet)
(Bool
False, CollateralUtxosFromWallet Wallet
cWallet) -> (Collaterals, Wallet) -> Maybe (Collaterals, Wallet)
forall a. a -> Maybe a
Just ((Collaterals, Wallet) -> Maybe (Collaterals, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> (Collaterals, Wallet))
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Maybe (Collaterals, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Wallet
cWallet) (Collaterals -> (Collaterals, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Collaterals)
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> (Collaterals, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOutRef] -> Collaterals
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Collaterals)
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> [TxOutRef])
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Collaterals
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 (Collaterals, Wallet))
-> m [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> m (Maybe (Collaterals, 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 (Collaterals, 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 -> (Collaterals, Wallet) -> Maybe (Collaterals, Wallet)
forall a. a -> Maybe a
Just ((Collaterals, Wallet) -> Maybe (Collaterals, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> (Collaterals, Wallet))
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Maybe (Collaterals, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Wallet
bWallet) (Collaterals -> (Collaterals, Wallet))
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Collaterals)
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> (Collaterals, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOutRef] -> Collaterals
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Collaterals)
-> ([(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> [TxOutRef])
-> [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> Collaterals
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 (Collaterals, Wallet))
-> m [(TxOutRef, ConcreteOutput Credential () Value ScriptHash)]
-> m (Maybe (Collaterals, 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)
(TxSkel
txSkelBal, Integer
fee, Maybe (Collaterals, Wallet)
adjustedColsAndWallet) <- case Maybe Wallet
balancingWallet of
Maybe Wallet
Nothing ->
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 (Collaterals, Wallet)
-> (TxSkel, Integer, Maybe (Collaterals, Wallet)))
-> m (Maybe (Collaterals, Wallet))
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
collateralsFromFees Integer
fee Maybe (Collaterals, Wallet)
mCollaterals
Just Wallet
bWallet -> do
[(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 Collaterals
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 (Collaterals -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Collaterals
utxos))
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."
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
FeePolicy
AutoFeeComputation ->
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
computeFeeAndBalance Wallet
bWallet Integer
minFee Integer
maxFee [(TxOutRef, TxOut)]
balancingUtxos Maybe (Collaterals, Wallet)
mCollaterals TxSkel
skelUnbal
ManualFee Integer
fee -> do
Maybe (Collaterals, Wallet)
adjustedColsAndWallet <- Integer
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
collateralsFromFees Integer
fee Maybe (Collaterals, 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 (Collaterals, Wallet))
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkel
attemptedSkel, Integer
fee, Maybe (Collaterals, Wallet)
adjustedColsAndWallet)
(TxSkel, Integer, Maybe (Collaterals, Wallet))
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkel
txSkelBal, Integer
fee, Maybe (Collaterals, 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
getMinAndMaxFee :: (MonadBlockChainBalancing m) => m (Fee, Fee)
getMinAndMaxFee :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
m (Integer, Integer)
getMinAndMaxFee = do
let defMaxTxExecutionUnits :: ExecutionUnits
defMaxTxExecutionUnits =
Cardano.ExecutionUnits {executionSteps :: Natural
executionSteps = Natural
10_000_000_000, executionMemory :: Natural
executionMemory = Natural
14_000_000}
defExecutionUnitPrices :: ExecutionUnitPrices
defExecutionUnitPrices =
Cardano.ExecutionUnitPrices {priceExecutionSteps :: Rational
priceExecutionSteps = Integer
721 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
Rat.% Integer
10_000_000, priceExecutionMemory :: Rational
priceExecutionMemory = Integer
577 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
Rat.% Integer
10_000}
ProtocolParameters
params <- Params -> ProtocolParameters
Emulator.pProtocolParams (Params -> ProtocolParameters) -> m Params -> m ProtocolParameters
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 = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Natural
Cardano.protocolParamMaxTxSize ProtocolParameters
params
Emulator.Coin Integer
txFeePerByte = ProtocolParameters -> Coin
Cardano.protocolParamTxFeePerByte ProtocolParameters
params
Emulator.Coin Integer
txFeeFixed = ProtocolParameters -> Coin
Cardano.protocolParamTxFeeFixed ProtocolParameters
params
Cardano.ExecutionUnitPrices Rational
priceESteps Rational
priceEMem = ExecutionUnitPrices
-> Maybe ExecutionUnitPrices -> ExecutionUnitPrices
forall a. a -> Maybe a -> a
fromMaybe ExecutionUnitPrices
defExecutionUnitPrices (Maybe ExecutionUnitPrices -> ExecutionUnitPrices)
-> Maybe ExecutionUnitPrices -> ExecutionUnitPrices
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Maybe ExecutionUnitPrices
Cardano.protocolParamPrices ProtocolParameters
params
Cardano.ExecutionUnits (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
eSteps) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
eMem) = ExecutionUnits -> Maybe ExecutionUnits -> ExecutionUnits
forall a. a -> Maybe a -> a
fromMaybe ExecutionUnits
defMaxTxExecutionUnits (Maybe ExecutionUnits -> ExecutionUnits)
-> Maybe ExecutionUnits -> ExecutionUnits
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Maybe ExecutionUnits
Cardano.protocolParamMaxTxExUnits ProtocolParameters
params
let sizeFees :: Integer
sizeFees = Integer
txFeeFixed Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
maxTxSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
txFeePerByte)
eStepsFees :: Integer
eStepsFees = (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
eMemFees :: Integer
eMemFees = (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
(Integer, Integer) -> m (Integer, Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
txFeeFixed, Integer
sizeFees Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
eStepsFees Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
eMemFees)
computeFeeAndBalance :: (MonadBlockChainBalancing m) => Wallet -> Fee -> Fee -> BalancingOutputs -> Maybe (Collaterals, Wallet) -> TxSkel -> m (TxSkel, Fee, Maybe (Collaterals, Wallet))
computeFeeAndBalance :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
computeFeeAndBalance Wallet
_ Integer
minFee Integer
maxFee [(TxOutRef, TxOut)]
_ Maybe (Collaterals, Wallet)
_ TxSkel
_
| Integer
minFee Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxFee =
MockChainError -> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet)))
-> MockChainError
-> m (TxSkel, Integer, Maybe (Collaterals, 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 (Collaterals, Wallet)
mCollaterals TxSkel
skel
| Integer
minFee Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
maxFee = do
(Maybe (Collaterals, Wallet)
adjustedColsAndWallet, TxSkel
attemptedSkel) <- Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (Maybe (Collaterals, Wallet), TxSkel)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (Maybe (Collaterals, Wallet), TxSkel)
attemptBalancingAndCollaterals Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos Integer
minFee Maybe (Collaterals, Wallet)
mCollaterals TxSkel
skel
(TxSkel, Integer, Maybe (Collaterals, Wallet))
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkel
attemptedSkel, Integer
minFee, Maybe (Collaterals, Wallet)
adjustedColsAndWallet)
computeFeeAndBalance Wallet
balancingWallet Integer
minFee Integer
maxFee [(TxOutRef, TxOut)]
balancingUtxos Maybe (Collaterals, 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
Maybe (Maybe (Collaterals, Wallet), TxSkel)
attemptedBalancing <- m (Maybe (Maybe (Collaterals, Wallet), TxSkel))
-> (MockChainError
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel)))
-> m (Maybe (Maybe (Collaterals, 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 (Collaterals, Wallet), TxSkel)
-> Maybe (Maybe (Collaterals, Wallet), TxSkel)
forall a. a -> Maybe a
Just ((Maybe (Collaterals, Wallet), TxSkel)
-> Maybe (Maybe (Collaterals, Wallet), TxSkel))
-> m (Maybe (Collaterals, Wallet), TxSkel)
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (Maybe (Collaterals, Wallet), TxSkel)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (Maybe (Collaterals, Wallet), TxSkel)
attemptBalancingAndCollaterals Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos Integer
fee Maybe (Collaterals, Wallet)
mCollaterals TxSkel
skel)
((MockChainError
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel)))
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel)))
-> (MockChainError
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel)))
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel))
forall a b. (a -> b) -> a -> b
$ \case
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 (Collaterals, Wallet), TxSkel)
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe (Collaterals, 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 (Collaterals, Wallet), TxSkel)
-> m (Maybe (Maybe (Collaterals, Wallet), TxSkel))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe (Collaterals, Wallet), TxSkel)
forall a. Maybe a
Nothing
MockChainError
err -> MockChainError -> m (Maybe (Maybe (Collaterals, 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 (Collaterals, Wallet), TxSkel)
attemptedBalancing of
Maybe (Maybe (Collaterals, 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)
Just (Maybe (Collaterals, Wallet)
adjustedColsAndWallet, TxSkel
attemptedSkel) -> do
Integer
newFee <- TxSkel -> Integer -> Maybe (Collaterals, Wallet) -> m Integer
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> Integer -> Maybe (Collaterals, Wallet) -> m Integer
estimateTxSkelFee TxSkel
attemptedSkel Integer
fee Maybe (Collaterals, 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
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)
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)
Integer
_ -> (Integer
minFee, Integer
newFee)
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> Integer
-> Integer
-> [(TxOutRef, TxOut)]
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (TxSkel, Integer, Maybe (Collaterals, Wallet))
computeFeeAndBalance Wallet
balancingWallet Integer
newMinFee Integer
newMaxFee [(TxOutRef, TxOut)]
balancingUtxos Maybe (Collaterals, Wallet)
mCollaterals TxSkel
skel
attemptBalancingAndCollaterals :: (MonadBlockChainBalancing m) => Wallet -> BalancingOutputs -> Fee -> Maybe (Collaterals, Wallet) -> TxSkel -> m (Maybe (Collaterals, Wallet), TxSkel)
attemptBalancingAndCollaterals :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Wallet
-> [(TxOutRef, TxOut)]
-> Integer
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> m (Maybe (Collaterals, Wallet), TxSkel)
attemptBalancingAndCollaterals Wallet
balancingWallet [(TxOutRef, TxOut)]
balancingUtxos Integer
fee Maybe (Collaterals, Wallet)
mCollaterals TxSkel
skel = do
Maybe (Collaterals, Wallet)
adjustedCollateralIns <- Integer
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
collateralsFromFees Integer
fee Maybe (Collaterals, 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 (Collaterals, Wallet), TxSkel)
-> m (Maybe (Collaterals, Wallet), TxSkel)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Collaterals, Wallet)
adjustedCollateralIns, TxSkel
attemptedSkel)
collateralInsFromFees :: (MonadBlockChainBalancing m) => Fee -> Collaterals -> Wallet -> m Collaterals
collateralInsFromFees :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer -> Collaterals -> Wallet -> m Collaterals
collateralInsFromFees Integer
fee Collaterals
collateralIns Wallet
returnCollateralWallet = do
Integer
nbMax <- Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> (Params -> Natural) -> Params -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
10 (Maybe Natural -> Natural)
-> (Params -> Maybe Natural) -> Params -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Maybe Natural
Cardano.protocolParamMaxCollateralInputs (ProtocolParameters -> Maybe Natural)
-> (Params -> ProtocolParameters) -> Params -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> ProtocolParameters
Emulator.pProtocolParams (Params -> Integer) -> m Params -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
Integer
percentage <- Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> (Params -> Natural) -> Params -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
100 (Maybe Natural -> Natural)
-> (Params -> Maybe Natural) -> Params -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Maybe Natural
Cardano.protocolParamCollateralPercent (ProtocolParameters -> Maybe Natural)
-> (Params -> ProtocolParameters) -> Params -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> ProtocolParameters
Emulator.pProtocolParams (Params -> Integer) -> m Params -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
let totalCollateral :: Value
totalCollateral = Coin -> Value
forall a. ToValue a => a -> Value
toValue (Coin -> Value) -> (Integer -> Coin) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Cardano.Coin (Integer -> Coin) -> (Integer -> Integer) -> Integer -> Coin
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
[(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
$ Collaterals -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Collaterals
collateralIns)
let candidatesRaw :: [([(TxOutRef, TxOut)], Value)]
candidatesRaw = [(TxOutRef, TxOut)]
-> Value -> Integer -> [([(TxOutRef, TxOut)], Value)]
reachValue [(TxOutRef, TxOut)]
collateralTxOuts Value
totalCollateral Integer
nbMax
let noSuitableCollateralError :: MockChainError
noSuitableCollateralError = Integer -> Integer -> Value -> MockChainError
MCENoSuitableCollateral Integer
fee Integer
percentage Value
totalCollateral
[TxOutRef] -> Collaterals
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Collaterals)
-> (([TxOutRef], Value) -> [TxOutRef])
-> ([TxOutRef], Value)
-> Collaterals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOutRef], Value) -> [TxOutRef]
forall a b. (a, b) -> a
fst (([TxOutRef], Value) -> Collaterals)
-> m ([TxOutRef], Value) -> m Collaterals
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
collateralsFromFees :: (MonadBlockChainBalancing m) => Fee -> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
collateralsFromFees :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
collateralsFromFees Integer
_ Maybe (Collaterals, Wallet)
Nothing = Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Collaterals, Wallet)
forall a. Maybe a
Nothing
collateralsFromFees Integer
fee (Just (Collaterals
collateralIns, Wallet
returnCollateralWallet)) =
(Collaterals, Wallet) -> Maybe (Collaterals, Wallet)
forall a. a -> Maybe a
Just ((Collaterals, Wallet) -> Maybe (Collaterals, Wallet))
-> (Collaterals -> (Collaterals, Wallet))
-> Collaterals
-> Maybe (Collaterals, Wallet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Wallet
returnCollateralWallet) (Collaterals -> Maybe (Collaterals, Wallet))
-> m Collaterals -> m (Maybe (Collaterals, Wallet))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Collaterals -> Wallet -> m Collaterals
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer -> Collaterals -> Wallet -> m Collaterals
collateralInsFromFees Integer
fee Collaterals
collateralIns Wallet
returnCollateralWallet
reachValue :: BalancingOutputs -> Api.Value -> Integer -> [(BalancingOutputs, Api.Value)]
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)]
reachValue [(TxOutRef, TxOut)]
_ Value
_ Integer
maxEls | Integer
maxEls Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = []
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) = []
reachValue [] Value
_ Integer
_ = []
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)
getOptimalCandidate :: (MonadBlockChainBalancing m) => [(BalancingOutputs, 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
Params
params <- m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
let candidatesDecorated :: [([(TxOutRef, TxOut)],
(Value, Ada, Either GenerateTxError Integer))]
candidatesDecorated = (Value -> (Value, Ada, Either GenerateTxError Integer))
-> ([(TxOutRef, TxOut)], Value)
-> ([(TxOutRef, TxOut)],
(Value, Ada, Either GenerateTxError Integer))
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
val -> (Value
val, Value -> Ada
Script.fromValue Value
val, Params -> TxSkelOut -> Either GenerateTxError Integer
getTxSkelOutMinAda Params
params (TxSkelOut -> Either GenerateTxError Integer)
-> TxSkelOut -> Either GenerateTxError Integer
forall a b. (a -> b) -> a -> b
$ Wallet -> Value -> TxSkelOut
forall a. ToPubKeyHash a => a -> Value -> TxSkelOut
paysPK Wallet
paymentTarget Value
val)) (([(TxOutRef, TxOut)], Value)
-> ([(TxOutRef, TxOut)],
(Value, Ada, Either GenerateTxError Integer)))
-> [([(TxOutRef, TxOut)], Value)]
-> [([(TxOutRef, TxOut)],
(Value, Ada, Either GenerateTxError Integer))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([(TxOutRef, TxOut)], Value)]
candidates
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, Script.Lovelace Integer
lv, Right Integer
minLv)) <- [([(TxOutRef, TxOut)],
(Value, Ada, Either GenerateTxError 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
[] -> 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
estimateTxSkelFee :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Maybe (Collaterals, Wallet) -> m Fee
estimateTxSkelFee :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> Integer -> Maybe (Collaterals, Wallet) -> m Integer
estimateTxSkelFee TxSkel
skel Integer
fee Maybe (Collaterals, Wallet)
mCollaterals = do
Params
params <- m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
Map DatumHash Datum
managedData <- TxSkel -> m (Map DatumHash Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map DatumHash Datum)
txSkelHashedData TxSkel
skel
let collateralIns :: [TxOutRef]
collateralIns = case Maybe (Collaterals, Wallet)
mCollaterals of
Maybe (Collaterals, Wallet)
Nothing -> []
Just (Collaterals
s, Wallet
_) -> Collaterals -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Collaterals
s
Map TxOutRef TxOut
managedTxOuts <- [TxOutRef] -> m (Map TxOutRef TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> m (Map TxOutRef TxOut)
lookupUtxos ([TxOutRef] -> m (Map TxOutRef TxOut))
-> [TxOutRef] -> m (Map TxOutRef TxOut)
forall a b. (a -> b) -> a -> b
$ TxSkel -> [TxOutRef]
txSkelKnownTxOutRefs TxSkel
skel [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. Semigroup a => a -> a -> a
<> [TxOutRef]
collateralIns
Map ValidatorHash (Versioned Validator)
managedValidators <- TxSkel -> m (Map ValidatorHash (Versioned Validator))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (Map ValidatorHash (Versioned Validator))
txSkelInputValidators TxSkel
skel
TxBodyContent BuildTx ConwayEra
txBodyContent <- case Integer
-> Params
-> Map DatumHash Datum
-> Map TxOutRef TxOut
-> Map ValidatorHash (Versioned Validator)
-> Maybe (Collaterals, Wallet)
-> TxSkel
-> Either GenerateTxError (TxBodyContent BuildTx ConwayEra)
generateBodyContent Integer
fee Params
params Map DatumHash Datum
managedData Map TxOutRef TxOut
managedTxOuts Map ValidatorHash (Versioned Validator)
managedValidators Maybe (Collaterals, Wallet)
mCollaterals TxSkel
skel of
Left GenerateTxError
err -> MockChainError -> m (TxBodyContent BuildTx ConwayEra)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m (TxBodyContent BuildTx ConwayEra))
-> MockChainError -> m (TxBodyContent BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$ GenerateTxError -> MockChainError
MCEGenerationError GenerateTxError
err
Right TxBodyContent BuildTx ConwayEra
txBodyContent -> TxBodyContent BuildTx ConwayEra
-> m (TxBodyContent BuildTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxBodyContent BuildTx ConwayEra
txBodyContent
TxBody ConwayEra
txBody <- case ShelleyBasedEra ConwayEra
-> TxBodyContent BuildTx ConwayEra
-> Either TxBodyError (TxBody ConwayEra)
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
Cardano.createAndValidateTransactionBody ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway TxBodyContent BuildTx ConwayEra
txBodyContent of
Left TxBodyError
err -> MockChainError -> m (TxBody ConwayEra)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m (TxBody ConwayEra))
-> MockChainError -> m (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ GenerateTxError -> MockChainError
MCEGenerationError (GenerateTxError -> MockChainError)
-> GenerateTxError -> MockChainError
forall a b. (a -> b) -> a -> b
$ String -> TxBodyError -> GenerateTxError
TxBodyError String
"Error creating body when estimating fees" TxBodyError
err
Right TxBody ConwayEra
txBody -> TxBody ConwayEra -> m (TxBody ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxBody ConwayEra
txBody
let nkeys :: Word
nkeys = TxBodyContent BuildTx ConwayEra -> Word
forall era. TxBodyContent BuildTx era -> Word
Cardano.estimateTransactionKeyWitnessCount TxBodyContent BuildTx ConwayEra
txBodyContent
([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)
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
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'
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
computeBalancedTxSkel :: (MonadBlockChainBalancing m) => Wallet -> BalancingOutputs -> TxSkel -> Fee -> 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]
Collaterals
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 -> Collaterals
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 :: Collaterals
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: TxSkelWithdrawals
..} (Integer -> Value
Script.lovelace -> Value
feeValue) = do
Params
params <- m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
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
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
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)
Integer
rightMinAda <- case Params -> TxSkelOut -> Either GenerateTxError Integer
getTxSkelOutMinAda Params
params (TxSkelOut -> Either GenerateTxError Integer)
-> TxSkelOut -> Either GenerateTxError Integer
forall a b. (a -> b) -> a -> b
$ Wallet -> Value -> TxSkelOut
forall a. ToPubKeyHash a => a -> Value -> TxSkelOut
paysPK Wallet
balancingWallet Value
missingRight of
Left GenerateTxError
err -> MockChainError -> m Integer
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m Integer) -> MockChainError -> m Integer
forall a b. (a -> b) -> a -> b
$ GenerateTxError -> MockChainError
MCEGenerationError GenerateTxError
err
Right Integer
a -> Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
a
let Script.Lovelace Integer
rightAda = Value
missingRight Value -> Optic' A_Lens NoIx Value Ada -> Ada
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Value Ada
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
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
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)
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
([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
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)
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
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
toCredential Wallet
balancingWallet) [TxSkelOut]
txSkelOuts,
BalanceOutputPolicy
AdjustExistingOutput <- TxOpts -> BalanceOutputPolicy
txOptBalanceOutputPolicy TxOpts
txSkelOpts -> do
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
^. Optic' A_Lens NoIx TxSkelOut Value
txSkelOutValueL) (([(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
& Optic' A_Lens NoIx TxSkelOut Value
txSkelOutValueL 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)
Maybe ([(TxOutRef, TxOut)], Value)
_ -> do
([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 -> Value -> TxSkelOut
forall a. ToPubKeyHash a => a -> Value -> TxSkelOut
paysPK Wallet
balancingWallet 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