-- | This module exposes functions to automatically fill parts of a
-- 'Cooked.Skeleton.TxSkel' based on the current state of the blockchain.
module Cooked.MockChain.AutoFilling where

import Cardano.Api qualified as Cardano
import Cardano.Ledger.Shelley.Core qualified as Shelley
import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
import Control.Monad
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Output
import Cooked.MockChain.UtxoSearch
import Cooked.Skeleton
import Data.List (find)
import Data.Map qualified as Map
import Data.Maybe
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api

-- * Auto filling withdrawal amounts

-- | Goes through all the withdrawals of the input skeleton and attempts to fill
-- out the withdrawn amount based on the associated user rewards. Does not
-- tamper with an existing specified amount in such withdrawals. Logs an event
-- when an amount has been successfully auto-filled.
autoFillWithdrawalAmounts :: (MonadBlockChainWithoutValidation m) => TxSkel -> m TxSkel
autoFillWithdrawalAmounts :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
TxSkel -> m TxSkel
autoFillWithdrawalAmounts TxSkel
txSkel = do
  let withdrawals :: [Withdrawal]
withdrawals = Optic' A_Lens NoIx TxSkel [Withdrawal] -> TxSkel -> [Withdrawal]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' TxSkel TxSkelWithdrawals
txSkelWithdrawalsL Lens' TxSkel TxSkelWithdrawals
-> Optic
     An_Iso
     NoIx
     TxSkelWithdrawals
     TxSkelWithdrawals
     [Withdrawal]
     [Withdrawal]
-> Optic' A_Lens NoIx TxSkel [Withdrawal]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso
  NoIx
  TxSkelWithdrawals
  TxSkelWithdrawals
  [Withdrawal]
  [Withdrawal]
txSkelWithdrawalsListI) TxSkel
txSkel
  [Withdrawal]
newWithdrawals <- [Withdrawal] -> (Withdrawal -> m Withdrawal) -> m [Withdrawal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Withdrawal]
withdrawals ((Withdrawal -> m Withdrawal) -> m [Withdrawal])
-> (Withdrawal -> m Withdrawal) -> m [Withdrawal]
forall a b. (a -> b) -> a -> b
$ \Withdrawal
withdrawal -> do
    Maybe Lovelace
currentReward <- User 'IsEither 'Redemption -> m (Maybe Lovelace)
forall c. ToCredential c => c -> m (Maybe Lovelace)
forall (m :: * -> *) c.
(MonadBlockChainWithoutValidation m, ToCredential c) =>
c -> m (Maybe Lovelace)
getCurrentReward (User 'IsEither 'Redemption -> m (Maybe Lovelace))
-> User 'IsEither 'Redemption -> m (Maybe Lovelace)
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx Withdrawal (User 'IsEither 'Redemption)
-> Withdrawal -> User 'IsEither 'Redemption
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Withdrawal (User 'IsEither 'Redemption)
withdrawalUserL Withdrawal
withdrawal
    let (Bool
changed, Withdrawal
newWithdrawal) = case Maybe Lovelace
currentReward of
          Maybe Lovelace
Nothing -> (Bool
False, Withdrawal
withdrawal)
          Just Lovelace
reward -> (Optic' An_AffineTraversal NoIx Withdrawal Lovelace
-> Withdrawal -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
isn't Optic' An_AffineTraversal NoIx Withdrawal Lovelace
withdrawalAmountAT Withdrawal
withdrawal, Lovelace -> Withdrawal -> Withdrawal
fillAmount Lovelace
reward Withdrawal
withdrawal)
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> m ()) -> MockChainLogEntry -> m ()
forall a b. (a -> b) -> a -> b
$
        Credential -> Lovelace -> MockChainLogEntry
MCLogAutoFilledWithdrawalAmount
          (Optic' A_Getter NoIx Withdrawal Credential
-> Withdrawal -> Credential
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Lens NoIx Withdrawal (User 'IsEither 'Redemption)
withdrawalUserL Optic' A_Lens NoIx Withdrawal (User 'IsEither 'Redemption)
-> Optic
     A_Getter
     NoIx
     (User 'IsEither 'Redemption)
     (User 'IsEither 'Redemption)
     Credential
     Credential
-> Optic' A_Getter NoIx Withdrawal Credential
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (User 'IsEither 'Redemption -> Credential)
-> Optic
     A_Getter
     NoIx
     (User 'IsEither 'Redemption)
     (User 'IsEither 'Redemption)
     Credential
     Credential
forall s a. (s -> a) -> Getter s a
to User 'IsEither 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential) Withdrawal
newWithdrawal)
          (Maybe Lovelace -> Lovelace
forall a. HasCallStack => Maybe a -> a
fromJust (Optic' An_AffineTraversal NoIx Withdrawal Lovelace
-> Withdrawal -> Maybe Lovelace
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' An_AffineTraversal NoIx Withdrawal Lovelace
withdrawalAmountAT Withdrawal
newWithdrawal))
    Withdrawal -> m Withdrawal
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Withdrawal
newWithdrawal
  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 TxSkelWithdrawals
txSkelWithdrawalsL Lens' TxSkel TxSkelWithdrawals
-> Optic
     An_Iso
     NoIx
     TxSkelWithdrawals
     TxSkelWithdrawals
     [Withdrawal]
     [Withdrawal]
-> Optic' A_Lens NoIx TxSkel [Withdrawal]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso
  NoIx
  TxSkelWithdrawals
  TxSkelWithdrawals
  [Withdrawal]
  [Withdrawal]
txSkelWithdrawalsListI Optic' A_Lens NoIx TxSkel [Withdrawal]
-> [Withdrawal] -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Withdrawal]
newWithdrawals

-- * Auto filling constitution script

-- | Goes through all the proposals of the input skeleton and attempts to fill
-- out the constitution scripts with the current one. Does not tamper with an
-- existing specified script in such withdrawals. Logs an event when the
-- constitution script has been successfully auto-filled.
autoFillConstitution :: (MonadBlockChainWithoutValidation m) => TxSkel -> m TxSkel
autoFillConstitution :: forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
TxSkel -> m TxSkel
autoFillConstitution TxSkel
txSkel = do
  Maybe VScript
currentConstitution <- m (Maybe VScript)
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m (Maybe VScript)
getConstitutionScript
  case Maybe VScript
currentConstitution of
    Maybe VScript
Nothing -> TxSkel -> m TxSkel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkel
txSkel
    Just VScript
constitutionScript -> do
      [TxSkelProposal]
newProposals <- [TxSkelProposal]
-> (TxSkelProposal -> m TxSkelProposal) -> m [TxSkelProposal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> TxSkel -> [TxSkelProposal]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL TxSkel
txSkel) ((TxSkelProposal -> m TxSkelProposal) -> m [TxSkelProposal])
-> (TxSkelProposal -> m TxSkelProposal) -> m [TxSkelProposal]
forall a b. (a -> b) -> a -> b
$ \TxSkelProposal
prop -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Optic'
  An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
-> TxSkelProposal -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
isn't Optic'
  An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
txSkelProposalConstitutionAT TxSkelProposal
prop) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> m ()) -> MockChainLogEntry -> m ()
forall a b. (a -> b) -> a -> b
$
            ScriptHash -> MockChainLogEntry
MCLogAutoFilledConstitution (ScriptHash -> MockChainLogEntry)
-> ScriptHash -> MockChainLogEntry
forall a b. (a -> b) -> a -> b
$
              VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash VScript
constitutionScript
        TxSkelProposal -> m TxSkelProposal
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (VScript -> TxSkelProposal -> TxSkelProposal
forall script.
(ToVScript script, Typeable script) =>
script -> TxSkelProposal -> TxSkelProposal
fillConstitution VScript
constitutionScript TxSkelProposal
prop)
      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
& Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> [TxSkelProposal] -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [TxSkelProposal]
newProposals

-- * Auto filling reference scripts

-- | Attempts to find in the index a utxo containing a reference script with the
-- given script hash, and attaches it to a redeemer when it does not yet have a
-- reference input and when it is allowed, in which case an event is logged.
updateRedeemedScript :: (MonadBlockChain m) => [Api.TxOutRef] -> User IsScript Redemption -> m (User IsScript Redemption)
updateRedeemedScript :: forall (m :: * -> *).
MonadBlockChain m =>
[TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputs rs :: User 'IsScript 'Redemption
rs@(UserRedeemedScript (script -> VScript
forall script. ToVScript script => script -> VScript
toVScript -> VScript
vScript) txSkelRed :: TxSkelRedeemer
txSkelRed@(TxSkelRedeemer {txSkelRedeemerAutoFill :: TxSkelRedeemer -> Bool
txSkelRedeemerAutoFill = Bool
True})) = do
  [(TxOutRef, TxSkelOut)]
oRefsInInputs <- UtxoSearch m TxSkelOut -> m [(TxOutRef, TxSkelOut)]
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> m [(TxOutRef, a)]
runUtxoSearch (VScript -> UtxoSearch m TxSkelOut
forall (m :: * -> *) s.
(MonadBlockChain m, ToScriptHash s) =>
s -> UtxoSearch m TxSkelOut
referenceScriptOutputsSearch VScript
vScript)
  m (User 'IsScript 'Redemption)
-> (TxOutRef -> m (User 'IsScript 'Redemption))
-> Maybe TxOutRef
-> m (User 'IsScript 'Redemption)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    -- We leave the redeemer unchanged if no reference input was found
    (User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return User 'IsScript 'Redemption
rs)
    -- If a reference input is found, we assign it and log the event
    ( \TxOutRef
oRef -> do
        MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> m ()) -> MockChainLogEntry -> m ()
forall a b. (a -> b) -> a -> b
$ TxSkelRedeemer -> TxOutRef -> ScriptHash -> MockChainLogEntry
MCLogAddedReferenceScript TxSkelRedeemer
txSkelRed TxOutRef
oRef (VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash VScript
vScript)
        User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption))
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall a b. (a -> b) -> a -> b
$ Optic
  An_AffineTraversal
  NoIx
  (User 'IsScript 'Redemption)
  (User 'IsScript 'Redemption)
  TxSkelRedeemer
  TxSkelRedeemer
-> (TxSkelRedeemer -> TxSkelRedeemer)
-> User 'IsScript 'Redemption
-> User 'IsScript 'Redemption
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  An_AffineTraversal
  NoIx
  (User 'IsScript 'Redemption)
  (User 'IsScript 'Redemption)
  TxSkelRedeemer
  TxSkelRedeemer
forall (kind :: UserKind) (mode :: UserMode).
AffineTraversal' (User kind mode) TxSkelRedeemer
userTxSkelRedeemerAT (TxOutRef -> TxSkelRedeemer -> TxSkelRedeemer
fillReferenceInput TxOutRef
oRef) User 'IsScript 'Redemption
rs
    )
    (Maybe TxOutRef -> m (User 'IsScript 'Redemption))
-> Maybe TxOutRef -> m (User 'IsScript 'Redemption)
forall a b. (a -> b) -> a -> b
$ case [(TxOutRef, TxSkelOut)]
oRefsInInputs of
      [] -> Maybe TxOutRef
forall a. Maybe a
Nothing
      -- If possible, we use a reference input appearing in regular inputs
      [(TxOutRef, TxSkelOut)]
l | Just (TxOutRef
oRefM', TxSkelOut
_) <- ((TxOutRef, TxSkelOut) -> Bool)
-> [(TxOutRef, TxSkelOut)] -> Maybe (TxOutRef, TxSkelOut)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TxOutRef
r, TxSkelOut
_) -> TxOutRef
r TxOutRef -> [TxOutRef] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TxOutRef]
inputs) [(TxOutRef, TxSkelOut)]
l -> TxOutRef -> Maybe TxOutRef
forall a. a -> Maybe a
Just TxOutRef
oRefM'
      -- If none exist, we use the first one we find elsewhere
      ((TxOutRef
oRefM', TxSkelOut
_) : [(TxOutRef, TxSkelOut)]
_) -> TxOutRef -> Maybe TxOutRef
forall a. a -> Maybe a
Just TxOutRef
oRefM'
updateRedeemedScript [TxOutRef]
_ User 'IsScript 'Redemption
rs = User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return User 'IsScript 'Redemption
rs

-- | Goes through the various parts of the skeleton where a redeemer can appear,
-- and attempts to attach a reference input to each of them, whenever it is
-- allowed and one has not already been set. Logs an event whenever such an
-- addition occurs.
autoFillReferenceScripts :: forall m. (MonadBlockChain m) => TxSkel -> m TxSkel
autoFillReferenceScripts :: forall (m :: * -> *). MonadBlockChain m => TxSkel -> m TxSkel
autoFillReferenceScripts TxSkel
txSkel = do
  let inputs :: [TxOutRef]
inputs = Optic' A_Getter NoIx TxSkel [TxOutRef] -> TxSkel -> [TxOutRef]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
-> Optic
     A_Getter
     NoIx
     (Map TxOutRef TxSkelRedeemer)
     (Map TxOutRef TxSkelRedeemer)
     [TxOutRef]
     [TxOutRef]
-> Optic' A_Getter NoIx TxSkel [TxOutRef]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map TxOutRef TxSkelRedeemer -> [TxOutRef])
-> Optic
     A_Getter
     NoIx
     (Map TxOutRef TxSkelRedeemer)
     (Map TxOutRef TxSkelRedeemer)
     [TxOutRef]
     [TxOutRef]
forall s a. (s -> a) -> Getter s a
to Map TxOutRef TxSkelRedeemer -> [TxOutRef]
forall k a. Map k a -> [k]
Map.keys) TxSkel
txSkel
  [Mint]
newMints <- [Mint] -> (Mint -> m Mint) -> m [Mint]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Optic' A_Lens NoIx TxSkel [Mint] -> TxSkel -> [Mint]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' TxSkel TxSkelMints
txSkelMintsL Lens' TxSkel TxSkelMints
-> Optic An_Iso NoIx TxSkelMints TxSkelMints [Mint] [Mint]
-> Optic' A_Lens NoIx TxSkel [Mint]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx TxSkelMints TxSkelMints [Mint] [Mint]
txSkelMintsListI) TxSkel
txSkel) ((Mint -> m Mint) -> m [Mint]) -> (Mint -> m Mint) -> m [Mint]
forall a b. (a -> b) -> a -> b
$ \(Mint User 'IsScript 'Redemption
rs [(TokenName, Integer)]
tks) ->
    (User 'IsScript 'Redemption -> [(TokenName, Integer)] -> Mint
`Mint` [(TokenName, Integer)]
tks) (User 'IsScript 'Redemption -> Mint)
-> m (User 'IsScript 'Redemption) -> m Mint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall (m :: * -> *).
MonadBlockChain m =>
[TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputs User 'IsScript 'Redemption
rs
  [(TxOutRef, TxSkelRedeemer)]
newInputs <- [(TxOutRef, TxSkelRedeemer)]
-> ((TxOutRef, TxSkelRedeemer) -> m (TxOutRef, TxSkelRedeemer))
-> m [(TxOutRef, TxSkelRedeemer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Optic' A_Getter NoIx TxSkel [(TxOutRef, TxSkelRedeemer)]
-> TxSkel -> [(TxOutRef, TxSkelRedeemer)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
-> Optic
     A_Getter
     NoIx
     (Map TxOutRef TxSkelRedeemer)
     (Map TxOutRef TxSkelRedeemer)
     [(TxOutRef, TxSkelRedeemer)]
     [(TxOutRef, TxSkelRedeemer)]
-> Optic' A_Getter NoIx TxSkel [(TxOutRef, TxSkelRedeemer)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)])
-> Optic
     A_Getter
     NoIx
     (Map TxOutRef TxSkelRedeemer)
     (Map TxOutRef TxSkelRedeemer)
     [(TxOutRef, TxSkelRedeemer)]
     [(TxOutRef, TxSkelRedeemer)]
forall s a. (s -> a) -> Getter s a
to Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList) TxSkel
txSkel) (((TxOutRef, TxSkelRedeemer) -> m (TxOutRef, TxSkelRedeemer))
 -> m [(TxOutRef, TxSkelRedeemer)])
-> ((TxOutRef, TxSkelRedeemer) -> m (TxOutRef, TxSkelRedeemer))
-> m [(TxOutRef, TxSkelRedeemer)]
forall a b. (a -> b) -> a -> b
$ \(TxOutRef
oRef, TxSkelRedeemer
red) ->
    (TxOutRef
oRef,) (TxSkelRedeemer -> (TxOutRef, TxSkelRedeemer))
-> m TxSkelRedeemer -> m (TxOutRef, TxSkelRedeemer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      Maybe VScript
validatorM <- Optic' An_AffineTraversal NoIx TxSkelOut VScript
-> TxOutRef -> m (Maybe VScript)
forall (m :: * -> *) af (is :: IxList) c.
(MonadBlockChainBalancing m, Is af An_AffineFold) =>
Optic' af is TxSkelOut c -> TxOutRef -> m (Maybe c)
previewByRef (Lens' TxSkelOut (User 'IsEither 'Allocation)
txSkelOutOwnerL Lens' TxSkelOut (User 'IsEither 'Allocation)
-> Optic
     An_AffineTraversal
     NoIx
     (User 'IsEither 'Allocation)
     (User 'IsEither 'Allocation)
     VScript
     VScript
-> Optic' An_AffineTraversal NoIx TxSkelOut VScript
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_AffineTraversal
  NoIx
  (User 'IsEither 'Allocation)
  (User 'IsEither 'Allocation)
  VScript
  VScript
forall (kind :: UserKind) (mode :: UserMode).
AffineTraversal' (User kind mode) VScript
userVScriptAT) TxOutRef
oRef
      case Maybe VScript
validatorM of
        Maybe VScript
Nothing -> TxSkelRedeemer -> m TxSkelRedeemer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelRedeemer
red
        Just VScript
val -> Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
-> User 'IsScript 'Redemption -> TxSkelRedeemer
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
userTxSkelRedeemerL (User 'IsScript 'Redemption -> TxSkelRedeemer)
-> m (User 'IsScript 'Redemption) -> m TxSkelRedeemer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall (m :: * -> *).
MonadBlockChain m =>
[TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputs (VScript -> TxSkelRedeemer -> User 'IsScript 'Redemption
forall script (a :: UserKind).
(a ∈ '[ 'IsScript, 'IsEither], ToVScript script,
 Typeable script) =>
script -> TxSkelRedeemer -> User a 'Redemption
UserRedeemedScript VScript
val TxSkelRedeemer
red)
  [TxSkelProposal]
newProposals <- [TxSkelProposal]
-> (TxSkelProposal -> m TxSkelProposal) -> m [TxSkelProposal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> TxSkel -> [TxSkelProposal]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL TxSkel
txSkel) ((TxSkelProposal -> m TxSkelProposal) -> m [TxSkelProposal])
-> (TxSkelProposal -> m TxSkelProposal) -> m [TxSkelProposal]
forall a b. (a -> b) -> a -> b
$ \TxSkelProposal
prop ->
    case Optic'
  An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
-> TxSkelProposal -> Maybe (User 'IsScript 'Redemption)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (AffineTraversal'
  TxSkelProposal (Maybe (User 'IsScript 'Redemption))
forall (kind :: UserKind).
Typeable kind =>
AffineTraversal' TxSkelProposal (Maybe (User kind 'Redemption))
txSkelProposalMConstitutionAT AffineTraversal'
  TxSkelProposal (Maybe (User 'IsScript 'Redemption))
-> Optic
     A_Prism
     NoIx
     (Maybe (User 'IsScript 'Redemption))
     (Maybe (User 'IsScript 'Redemption))
     (User 'IsScript 'Redemption)
     (User 'IsScript 'Redemption)
-> Optic'
     An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (User 'IsScript 'Redemption))
  (Maybe (User 'IsScript 'Redemption))
  (User 'IsScript 'Redemption)
  (User 'IsScript 'Redemption)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) TxSkelProposal
prop of
      Maybe (User 'IsScript 'Redemption)
Nothing -> TxSkelProposal -> m TxSkelProposal
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelProposal
prop
      Just User 'IsScript 'Redemption
rs -> (User 'IsScript 'Redemption -> TxSkelProposal -> TxSkelProposal)
-> TxSkelProposal -> User 'IsScript 'Redemption -> TxSkelProposal
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Optic'
  An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
-> User 'IsScript 'Redemption -> TxSkelProposal -> TxSkelProposal
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (AffineTraversal'
  TxSkelProposal (Maybe (User 'IsScript 'Redemption))
forall (kind :: UserKind).
Typeable kind =>
AffineTraversal' TxSkelProposal (Maybe (User kind 'Redemption))
txSkelProposalMConstitutionAT AffineTraversal'
  TxSkelProposal (Maybe (User 'IsScript 'Redemption))
-> Optic
     A_Prism
     NoIx
     (Maybe (User 'IsScript 'Redemption))
     (Maybe (User 'IsScript 'Redemption))
     (User 'IsScript 'Redemption)
     (User 'IsScript 'Redemption)
-> Optic'
     An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (User 'IsScript 'Redemption))
  (Maybe (User 'IsScript 'Redemption))
  (User 'IsScript 'Redemption)
  (User 'IsScript 'Redemption)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)) TxSkelProposal
prop (User 'IsScript 'Redemption -> TxSkelProposal)
-> m (User 'IsScript 'Redemption) -> m TxSkelProposal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall (m :: * -> *).
MonadBlockChain m =>
[TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputs User 'IsScript 'Redemption
rs
  [Withdrawal]
newWithdrawals <- [Withdrawal] -> (Withdrawal -> m Withdrawal) -> m [Withdrawal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Optic' A_Lens NoIx TxSkel [Withdrawal] -> TxSkel -> [Withdrawal]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' TxSkel TxSkelWithdrawals
txSkelWithdrawalsL Lens' TxSkel TxSkelWithdrawals
-> Optic
     An_Iso
     NoIx
     TxSkelWithdrawals
     TxSkelWithdrawals
     [Withdrawal]
     [Withdrawal]
-> Optic' A_Lens NoIx TxSkel [Withdrawal]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso
  NoIx
  TxSkelWithdrawals
  TxSkelWithdrawals
  [Withdrawal]
  [Withdrawal]
txSkelWithdrawalsListI) TxSkel
txSkel) ((Withdrawal -> m Withdrawal) -> m [Withdrawal])
-> (Withdrawal -> m Withdrawal) -> m [Withdrawal]
forall a b. (a -> b) -> a -> b
$
    \withdrawal :: Withdrawal
withdrawal@(Withdrawal User 'IsEither 'Redemption
user Maybe Lovelace
lv) -> case Optic'
  A_Prism
  NoIx
  (User 'IsEither 'Redemption)
  (User 'IsScript 'Redemption)
-> User 'IsEither 'Redemption -> Maybe (User 'IsScript 'Redemption)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic'
  A_Prism
  NoIx
  (User 'IsEither 'Redemption)
  (User 'IsScript 'Redemption)
forall (mode :: UserMode).
Prism' (User 'IsEither mode) (User 'IsScript mode)
userEitherScriptP User 'IsEither 'Redemption
user of
      Maybe (User 'IsScript 'Redemption)
Nothing -> Withdrawal -> m Withdrawal
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Withdrawal
withdrawal
      Just User 'IsScript 'Redemption
urs -> (User 'IsEither 'Redemption -> Maybe Lovelace -> Withdrawal
`Withdrawal` Maybe Lovelace
lv) (User 'IsEither 'Redemption -> Withdrawal)
-> (User 'IsScript 'Redemption -> User 'IsEither 'Redemption)
-> User 'IsScript 'Redemption
-> Withdrawal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic'
  A_Prism
  NoIx
  (User 'IsEither 'Redemption)
  (User 'IsScript 'Redemption)
-> User 'IsScript 'Redemption -> User 'IsEither 'Redemption
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic'
  A_Prism
  NoIx
  (User 'IsEither 'Redemption)
  (User 'IsScript 'Redemption)
forall (mode :: UserMode).
Prism' (User 'IsEither mode) (User 'IsScript mode)
userEitherScriptP (User 'IsScript 'Redemption -> Withdrawal)
-> m (User 'IsScript 'Redemption) -> m Withdrawal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
forall (m :: * -> *).
MonadBlockChain m =>
[TxOutRef]
-> User 'IsScript 'Redemption -> m (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputs User 'IsScript 'Redemption
urs
  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 TxSkelMints
txSkelMintsL
      Lens' TxSkel TxSkelMints
-> Optic An_Iso NoIx TxSkelMints TxSkelMints [Mint] [Mint]
-> Optic' A_Lens NoIx TxSkel [Mint]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx TxSkelMints TxSkelMints [Mint] [Mint]
txSkelMintsListI
      Optic' A_Lens NoIx TxSkel [Mint] -> [Mint] -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Mint]
newMints
      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
.~ [(TxOutRef, TxSkelRedeemer)] -> Map TxOutRef TxSkelRedeemer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TxOutRef, TxSkelRedeemer)]
newInputs
      TxSkel -> (TxSkel -> TxSkel) -> TxSkel
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL
      Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> [TxSkelProposal] -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [TxSkelProposal]
newProposals
      TxSkel -> (TxSkel -> TxSkel) -> TxSkel
forall a b. a -> (a -> b) -> b
& Lens' TxSkel TxSkelWithdrawals
txSkelWithdrawalsL
      Lens' TxSkel TxSkelWithdrawals
-> Optic
     An_Iso
     NoIx
     TxSkelWithdrawals
     TxSkelWithdrawals
     [Withdrawal]
     [Withdrawal]
-> Optic' A_Lens NoIx TxSkel [Withdrawal]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso
  NoIx
  TxSkelWithdrawals
  TxSkelWithdrawals
  [Withdrawal]
  [Withdrawal]
txSkelWithdrawalsListI
      Optic' A_Lens NoIx TxSkel [Withdrawal]
-> [Withdrawal] -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Withdrawal]
newWithdrawals

-- * Auto filling min ada amounts

-- | Compute the required minimal ADA for a given output
getTxSkelOutMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m Integer
getTxSkelOutMinAda :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m Integer
getTxSkelOutMinAda TxSkelOut
txSkelOut = do
  PParams
params <- Params -> PParams
Emulator.pEmulatorPParams (Params -> PParams) -> m Params -> m PParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  Coin -> Integer
Cardano.unCoin
    (Coin -> Integer)
-> (TxOut CtxTx ConwayEra -> Coin)
-> TxOut CtxTx ConwayEra
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams -> TxOut EmulatorEra -> Coin
forall era. EraTxOut era => PParams era -> TxOut era -> Coin
Shelley.getMinCoinTxOut PParams
params
    (BabbageTxOut EmulatorEra -> Coin)
-> (TxOut CtxTx ConwayEra -> BabbageTxOut EmulatorEra)
-> TxOut CtxTx ConwayEra
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra ConwayEra
-> TxOut CtxUTxO ConwayEra -> TxOut EmulatorEra
forall era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut ledgerera
Cardano.toShelleyTxOut ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway
    (TxOut CtxUTxO ConwayEra -> BabbageTxOut EmulatorEra)
-> (TxOut CtxTx ConwayEra -> TxOut CtxUTxO ConwayEra)
-> TxOut CtxTx ConwayEra
-> BabbageTxOut EmulatorEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx ConwayEra -> TxOut CtxUTxO ConwayEra
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
Cardano.toCtxUTxOTxOut
    (TxOut CtxTx ConwayEra -> Integer)
-> m (TxOut CtxTx ConwayEra) -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkelOut -> m (TxOut CtxTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m (TxOut CtxTx ConwayEra)
toCardanoTxOut TxSkelOut
txSkelOut

-- | This transforms an output into another output which contains the minimal
-- required ada. If the previous quantity of ADA was sufficient, it remains
-- unchanged. This can require a few iterations to converge, as the added ADA
-- will increase the size of the UTXO which in turn might need more ADA.
toTxSkelOutWithMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
-- The auto adjustment is disabled so nothing is done here
toTxSkelOutWithMinAda :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m TxSkelOut
toTxSkelOutWithMinAda txSkelOut :: TxSkelOut
txSkelOut@((TxSkelOut -> Optic' A_Lens NoIx TxSkelOut Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TxSkelOut Bool
txSkelOutValueAutoAdjustL) -> Bool
False) = TxSkelOut -> m TxSkelOut
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
txSkelOut
-- The auto adjustment is enabled
toTxSkelOutWithMinAda TxSkelOut
txSkelOut = do
  TxSkelOut
txSkelOut' <- TxSkelOut -> m TxSkelOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m TxSkelOut
go TxSkelOut
txSkelOut
  let originalAda :: Lovelace
originalAda = Optic' A_Lens NoIx TxSkelOut Lovelace -> TxSkelOut -> Lovelace
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' TxSkelOut Value
txSkelOutValueL Lens' TxSkelOut Value
-> Optic A_Lens NoIx Value Value Lovelace Lovelace
-> Optic' A_Lens NoIx TxSkelOut Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Value Value Lovelace Lovelace
valueLovelaceL) TxSkelOut
txSkelOut
      updatedAda :: Lovelace
updatedAda = Optic' A_Lens NoIx TxSkelOut Lovelace -> TxSkelOut -> Lovelace
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' TxSkelOut Value
txSkelOutValueL Lens' TxSkelOut Value
-> Optic A_Lens NoIx Value Value Lovelace Lovelace
-> Optic' A_Lens NoIx TxSkelOut Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Value Value Lovelace Lovelace
valueLovelaceL) TxSkelOut
txSkelOut'
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Lovelace
originalAda Lovelace -> Lovelace -> Bool
forall a. Eq a => a -> a -> Bool
/= Lovelace
updatedAda) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MockChainLogEntry -> m ()
forall (m :: * -> *).
MonadBlockChainBalancing m =>
MockChainLogEntry -> m ()
logEvent (MockChainLogEntry -> m ()) -> MockChainLogEntry -> m ()
forall a b. (a -> b) -> a -> b
$ TxSkelOut -> Lovelace -> MockChainLogEntry
MCLogAdjustedTxSkelOut TxSkelOut
txSkelOut Lovelace
updatedAda
  TxSkelOut -> m TxSkelOut
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
txSkelOut'
  where
    go :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
    go :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m TxSkelOut
go TxSkelOut
skelOut = do
      -- Computing the required minimal amount of ADA in this output
      Integer
requiredAda <- TxSkelOut -> m Integer
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m Integer
getTxSkelOutMinAda TxSkelOut
skelOut
      -- If this amount is sufficient, we return Nothing, otherwise, we adjust the
      -- output and possibly iterate
      if Lovelace -> Integer
Api.getLovelace (TxSkelOut
skelOut TxSkelOut -> Optic' A_Lens NoIx TxSkelOut Lovelace -> Lovelace
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' TxSkelOut Value
txSkelOutValueL Lens' TxSkelOut Value
-> Optic A_Lens NoIx Value Value Lovelace Lovelace
-> Optic' A_Lens NoIx TxSkelOut Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Value Value Lovelace Lovelace
valueLovelaceL) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
requiredAda
        then TxSkelOut -> m TxSkelOut
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
skelOut
        else TxSkelOut -> m TxSkelOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m TxSkelOut
go (TxSkelOut -> m TxSkelOut) -> TxSkelOut -> m TxSkelOut
forall a b. (a -> b) -> a -> b
$ TxSkelOut
skelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut Value
txSkelOutValueL Lens' TxSkelOut Value
-> Optic A_Lens NoIx Value Value Lovelace Lovelace
-> Optic' A_Lens NoIx TxSkelOut Lovelace
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Value Value Lovelace Lovelace
valueLovelaceL Optic' A_Lens NoIx TxSkelOut Lovelace
-> Lovelace -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Integer -> Lovelace
Api.Lovelace Integer
requiredAda

-- | This goes through all the `TxSkelOut`s of the given skeleton and updates
-- their ada value when requested by the user and required by the protocol
-- parameters. Logs an event whenever such a change occurs.
autoFillMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
autoFillMinAda :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m TxSkel
autoFillMinAda TxSkel
skel = (\[TxSkelOut]
x -> TxSkel
skel 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]
x) ([TxSkelOut] -> TxSkel) -> m [TxSkelOut] -> m TxSkel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSkelOut] -> (TxSkelOut -> m TxSkelOut) -> m [TxSkelOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (TxSkel
skel TxSkel -> Lens' TxSkel [TxSkelOut] -> [TxSkelOut]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' TxSkel [TxSkelOut]
txSkelOutsL) TxSkelOut -> m TxSkelOut
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m TxSkelOut
toTxSkelOutWithMinAda