-- | 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.GenerateTx.Output
import Cooked.MockChain.Log
import Cooked.MockChain.Read
import Cooked.MockChain.UtxoSearch
import Cooked.Skeleton
import Cooked.Tweak.Common
import Data.List (find)
import Data.Map qualified as Map
import Data.Maybe
import Ledger.Tx qualified as Ledger
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
import Polysemy
import Polysemy.Error

-- * 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 ::
  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
  Sem effs ()
autoFillWithdrawalAmounts :: forall (effs :: EffectRow).
Members '[MockChainRead, Tweak, MockChainLog] effs =>
Sem effs ()
autoFillWithdrawalAmounts = do
  [Withdrawal]
withdrawals <- Optic' A_Lens NoIx TxSkel [Withdrawal] -> Sem effs [Withdrawal]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak (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)
  [Withdrawal]
newWithdrawals <- [Withdrawal]
-> (Withdrawal -> Sem effs Withdrawal) -> Sem effs [Withdrawal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Withdrawal]
withdrawals ((Withdrawal -> Sem effs Withdrawal) -> Sem effs [Withdrawal])
-> (Withdrawal -> Sem effs Withdrawal) -> Sem effs [Withdrawal]
forall a b. (a -> b) -> a -> b
$ \Withdrawal
withdrawal -> do
    Maybe Lovelace
currentReward <- User 'IsEither 'Redemption -> Sem effs (Maybe Lovelace)
forall (effs :: EffectRow) c.
(Member MockChainRead effs, ToCredential c) =>
c -> Sem effs (Maybe Lovelace)
getCurrentReward (User 'IsEither 'Redemption -> Sem effs (Maybe Lovelace))
-> User 'IsEither 'Redemption -> Sem effs (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 -> Sem effs () -> Sem effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed (Sem effs () -> Sem effs ()) -> Sem effs () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$
      MockChainLogEntry -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem effs ())
-> MockChainLogEntry -> Sem effs ()
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 -> Sem effs Withdrawal
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return Withdrawal
newWithdrawal
  Optic' A_Lens NoIx TxSkel [Withdrawal]
-> [Withdrawal] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak (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) [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 ::
  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
  Sem effs ()
autoFillConstitution :: forall (effs :: EffectRow).
Members '[MockChainRead, Tweak, MockChainLog] effs =>
Sem effs ()
autoFillConstitution = do
  Maybe VScript
currentConstitution <- Sem effs (Maybe VScript)
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs (Maybe VScript)
getConstitutionScript
  case Maybe VScript
currentConstitution of
    Maybe VScript
Nothing -> () -> Sem effs ()
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just VScript
constitutionScript -> do
      [TxSkelProposal]
proposals <- Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> Sem effs [TxSkelProposal]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL
      [TxSkelProposal]
newProposals <- [TxSkelProposal]
-> (TxSkelProposal -> Sem effs TxSkelProposal)
-> Sem effs [TxSkelProposal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxSkelProposal]
proposals ((TxSkelProposal -> Sem effs TxSkelProposal)
 -> Sem effs [TxSkelProposal])
-> (TxSkelProposal -> Sem effs TxSkelProposal)
-> Sem effs [TxSkelProposal]
forall a b. (a -> b) -> a -> b
$ \TxSkelProposal
prop -> do
        Bool -> Sem effs () -> Sem effs ()
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) (Sem effs () -> Sem effs ()) -> Sem effs () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$
          MockChainLogEntry -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem effs ())
-> MockChainLogEntry -> Sem effs ()
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 -> Sem effs TxSkelProposal
forall a. a -> Sem effs 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)
      Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> [TxSkelProposal] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL [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 ::
  (Members '[MockChainLog, MockChainRead] effs) =>
  [Api.TxOutRef] ->
  User IsScript Redemption ->
  Sem effs (User IsScript Redemption)
updateRedeemedScript :: forall (effs :: EffectRow).
Members '[MockChainLog, MockChainRead] effs =>
[TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (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]
oRefsInInputs <- Sem effs (UtxoSearchResult NoIx) -> Sem effs [TxOutRef]
forall (effs :: EffectRow) (elems :: IxList).
Sem effs (UtxoSearchResult elems) -> Sem effs [TxOutRef]
getTxOutRefs (Sem effs (UtxoSearchResult NoIx) -> Sem effs [TxOutRef])
-> Sem effs (UtxoSearchResult NoIx) -> Sem effs [TxOutRef]
forall a b. (a -> b) -> a -> b
$ (Sem effs (UtxoSearchResult NoIx)
 -> Sem effs (UtxoSearchResult NoIx))
-> Sem effs (UtxoSearchResult NoIx)
forall (effs :: EffectRow) (els :: IxList).
Member MockChainRead effs =>
(UtxoSearch effs NoIx -> UtxoSearch effs els)
-> UtxoSearch effs els
allUtxosSearch ((Sem effs (UtxoSearchResult NoIx)
  -> Sem effs (UtxoSearchResult NoIx))
 -> Sem effs (UtxoSearchResult NoIx))
-> (Sem effs (UtxoSearchResult NoIx)
    -> Sem effs (UtxoSearchResult NoIx))
-> Sem effs (UtxoSearchResult NoIx)
forall a b. (a -> b) -> a -> b
$ VScript
-> Sem effs (UtxoSearchResult NoIx)
-> Sem effs (UtxoSearchResult NoIx)
forall s (effs :: EffectRow) (els :: IxList).
ToScriptHash s =>
s -> UtxoSearch effs els -> UtxoSearch effs els
ensureProperReferenceScript VScript
vScript
    Sem effs (User 'IsScript 'Redemption)
-> (TxOutRef -> Sem effs (User 'IsScript 'Redemption))
-> Maybe TxOutRef
-> Sem effs (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 -> Sem effs (User 'IsScript 'Redemption)
forall a. a -> Sem effs 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 -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem effs ())
-> MockChainLogEntry -> Sem effs ()
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 -> Sem effs (User 'IsScript 'Redemption)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (User 'IsScript 'Redemption
 -> Sem effs (User 'IsScript 'Redemption))
-> User 'IsScript 'Redemption
-> Sem effs (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 -> Sem effs (User 'IsScript 'Redemption))
-> Maybe TxOutRef -> Sem effs (User 'IsScript 'Redemption)
forall a b. (a -> b) -> a -> b
$ case [TxOutRef]
oRefsInInputs of
        [] -> Maybe TxOutRef
forall a. Maybe a
Nothing
        -- If possible, we use a reference input appearing in regular inputs
        [TxOutRef]
l | Just TxOutRef
oRefM' <- (TxOutRef -> Bool) -> [TxOutRef] -> Maybe TxOutRef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (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]
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' : [TxOutRef]
_) -> TxOutRef -> Maybe TxOutRef
forall a. a -> Maybe a
Just TxOutRef
oRefM'
updateRedeemedScript [TxOutRef]
_ User 'IsScript 'Redemption
rs = User 'IsScript 'Redemption -> Sem effs (User 'IsScript 'Redemption)
forall a. a -> Sem effs 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 ::
  (Members '[Tweak, MockChainRead, MockChainLog] effs) =>
  Sem effs ()
autoFillReferenceScripts :: forall (effs :: EffectRow).
Members '[Tweak, MockChainRead, MockChainLog] effs =>
Sem effs ()
autoFillReferenceScripts = do
  [TxOutRef]
inputsKeys <- Optic' A_Getter NoIx TxSkel [TxOutRef] -> Sem effs [TxOutRef]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak (Optic' A_Getter NoIx TxSkel [TxOutRef] -> Sem effs [TxOutRef])
-> Optic' A_Getter NoIx TxSkel [TxOutRef] -> Sem effs [TxOutRef]
forall a b. (a -> b) -> a -> b
$ 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
  -- Updating minting redeemers
  [Mint]
mints <- Optic' A_Lens NoIx TxSkel [Mint] -> Sem effs [Mint]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak (Optic' A_Lens NoIx TxSkel [Mint] -> Sem effs [Mint])
-> Optic' A_Lens NoIx TxSkel [Mint] -> Sem effs [Mint]
forall a b. (a -> b) -> a -> 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
  [Mint]
newMints <- [Mint] -> (Mint -> Sem effs Mint) -> Sem effs [Mint]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Mint]
mints ((Mint -> Sem effs Mint) -> Sem effs [Mint])
-> (Mint -> Sem effs Mint) -> Sem effs [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)
-> Sem effs (User 'IsScript 'Redemption) -> Sem effs Mint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
forall (effs :: EffectRow).
Members '[MockChainLog, MockChainRead] effs =>
[TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputsKeys User 'IsScript 'Redemption
rs
  Optic' A_Lens NoIx TxSkel [Mint] -> [Mint] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak (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) [Mint]
newMints
  -- Updating spending redeemers
  [(TxOutRef, TxSkelRedeemer)]
inputsList <- Optic' A_Getter NoIx TxSkel [(TxOutRef, TxSkelRedeemer)]
-> Sem effs [(TxOutRef, TxSkelRedeemer)]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak (Optic' A_Getter NoIx TxSkel [(TxOutRef, TxSkelRedeemer)]
 -> Sem effs [(TxOutRef, TxSkelRedeemer)])
-> Optic' A_Getter NoIx TxSkel [(TxOutRef, TxSkelRedeemer)]
-> Sem effs [(TxOutRef, TxSkelRedeemer)]
forall a b. (a -> b) -> a -> b
$ 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
  [(TxOutRef, TxSkelRedeemer)]
newInputs <- [(TxOutRef, TxSkelRedeemer)]
-> ((TxOutRef, TxSkelRedeemer)
    -> Sem effs (TxOutRef, TxSkelRedeemer))
-> Sem effs [(TxOutRef, TxSkelRedeemer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(TxOutRef, TxSkelRedeemer)]
inputsList (((TxOutRef, TxSkelRedeemer)
  -> Sem effs (TxOutRef, TxSkelRedeemer))
 -> Sem effs [(TxOutRef, TxSkelRedeemer)])
-> ((TxOutRef, TxSkelRedeemer)
    -> Sem effs (TxOutRef, TxSkelRedeemer))
-> Sem effs [(TxOutRef, TxSkelRedeemer)]
forall a b. (a -> b) -> a -> b
$ \(TxOutRef
oRef, TxSkelRedeemer
red) ->
    (TxOutRef
oRef,) (TxSkelRedeemer -> (TxOutRef, TxSkelRedeemer))
-> Sem effs TxSkelRedeemer -> Sem effs (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 -> Sem effs (Maybe VScript)
forall (effs :: EffectRow) af (is :: IxList) c.
(Member MockChainRead effs, Is af An_AffineFold) =>
Optic' af is TxSkelOut c -> TxOutRef -> Sem effs (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 -> Sem effs TxSkelRedeemer
forall a. a -> Sem effs 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)
-> Sem effs (User 'IsScript 'Redemption) -> Sem effs TxSkelRedeemer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
forall (effs :: EffectRow).
Members '[MockChainLog, MockChainRead] effs =>
[TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputsKeys (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)
  Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
-> Map TxOutRef TxSkelRedeemer -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak Lens' TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL (Map TxOutRef TxSkelRedeemer -> Sem effs ())
-> Map TxOutRef TxSkelRedeemer -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ [(TxOutRef, TxSkelRedeemer)] -> Map TxOutRef TxSkelRedeemer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TxOutRef, TxSkelRedeemer)]
newInputs
  -- Updating proposing redeemers
  [TxSkelProposal]
proposals <- Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> Sem effs [TxSkelProposal]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL
  [TxSkelProposal]
newProposals <- [TxSkelProposal]
-> (TxSkelProposal -> Sem effs TxSkelProposal)
-> Sem effs [TxSkelProposal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxSkelProposal]
proposals ((TxSkelProposal -> Sem effs TxSkelProposal)
 -> Sem effs [TxSkelProposal])
-> (TxSkelProposal -> Sem effs TxSkelProposal)
-> Sem effs [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 -> Sem effs TxSkelProposal
forall a. a -> Sem effs 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)
-> Sem effs (User 'IsScript 'Redemption) -> Sem effs TxSkelProposal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
forall (effs :: EffectRow).
Members '[MockChainLog, MockChainRead] effs =>
[TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputsKeys User 'IsScript 'Redemption
rs
  Optic' A_Lens NoIx TxSkel [TxSkelProposal]
-> [TxSkelProposal] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak Optic' A_Lens NoIx TxSkel [TxSkelProposal]
txSkelProposalsL [TxSkelProposal]
newProposals
  -- Updating widrawing redeemers
  [Withdrawal]
withdrawals <- Optic' A_Lens NoIx TxSkel [Withdrawal] -> Sem effs [Withdrawal]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak (Optic' A_Lens NoIx TxSkel [Withdrawal] -> Sem effs [Withdrawal])
-> Optic' A_Lens NoIx TxSkel [Withdrawal] -> Sem effs [Withdrawal]
forall a b. (a -> b) -> a -> 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
  [Withdrawal]
newWithdrawals <- [Withdrawal]
-> (Withdrawal -> Sem effs Withdrawal) -> Sem effs [Withdrawal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Withdrawal]
withdrawals ((Withdrawal -> Sem effs Withdrawal) -> Sem effs [Withdrawal])
-> (Withdrawal -> Sem effs Withdrawal) -> Sem effs [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 -> Sem effs Withdrawal
forall a. a -> Sem effs 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)
-> Sem effs (User 'IsScript 'Redemption) -> Sem effs Withdrawal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
forall (effs :: EffectRow).
Members '[MockChainLog, MockChainRead] effs =>
[TxOutRef]
-> User 'IsScript 'Redemption
-> Sem effs (User 'IsScript 'Redemption)
updateRedeemedScript [TxOutRef]
inputsKeys User 'IsScript 'Redemption
urs
  Optic' A_Lens NoIx TxSkel [Withdrawal]
-> [Withdrawal] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak (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) [Withdrawal]
newWithdrawals

-- * Auto filling min ada amounts

-- | Compute the required minimal ADA for a given output
getTxSkelOutMinAda ::
  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
  TxSkelOut ->
  Sem effs Integer
getTxSkelOutMinAda :: forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs Integer
getTxSkelOutMinAda TxSkelOut
txSkelOut = do
  PParams
params <- Params -> PParams
Emulator.pEmulatorPParams (Params -> PParams) -> Sem effs Params -> Sem effs PParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs 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)
-> Sem effs (TxOut CtxTx ConwayEra) -> Sem effs Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs (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 ::
  forall effs.
  (Members '[MockChainRead, MockChainLog, Error Ledger.ToCardanoError] effs) =>
  TxSkelOut ->
  Sem effs TxSkelOut
-- The auto adjustment is disabled so nothing is done here
toTxSkelOutWithMinAda :: forall (effs :: EffectRow).
Members
  '[MockChainRead, MockChainLog, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs 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 -> Sem effs TxSkelOut
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
txSkelOut
-- The auto adjustment is enabled
toTxSkelOutWithMinAda TxSkelOut
txSkelOut = do
  TxSkelOut
txSkelOut' <- TxSkelOut -> Sem effs 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 -> Sem effs () -> Sem effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Lovelace
originalAda Lovelace -> Lovelace -> Bool
forall a. Eq a => a -> a -> Bool
/= Lovelace
updatedAda) (Sem effs () -> Sem effs ()) -> Sem effs () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ MockChainLogEntry -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem effs ())
-> MockChainLogEntry -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ TxSkelOut -> Lovelace -> MockChainLogEntry
MCLogAdjustedTxSkelOut TxSkelOut
txSkelOut Lovelace
updatedAda
  TxSkelOut -> Sem effs TxSkelOut
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
txSkelOut'
  where
    go :: TxSkelOut -> Sem effs TxSkelOut
    go :: TxSkelOut -> Sem effs TxSkelOut
go TxSkelOut
skelOut = do
      -- Computing the required minimal amount of ADA in this output
      Integer
requiredAda <- TxSkelOut -> Sem effs Integer
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs 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 -> Sem effs TxSkelOut
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
skelOut
        else TxSkelOut -> Sem effs TxSkelOut
go (TxSkelOut -> Sem effs TxSkelOut)
-> TxSkelOut -> Sem effs 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 ::
  (Members '[Tweak, MockChainRead, MockChainLog, Error Ledger.ToCardanoError] effs) =>
  Sem effs ()
autoFillMinAda :: forall (effs :: EffectRow).
Members
  '[Tweak, MockChainRead, MockChainLog, Error ToCardanoError] effs =>
Sem effs ()
autoFillMinAda = do
  [TxSkelOut]
outputs <- Optic' A_Lens NoIx TxSkel [TxSkelOut] -> Sem effs [TxSkelOut]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL
  [TxSkelOut]
newOutputs <- [TxSkelOut]
-> (TxSkelOut -> Sem effs TxSkelOut) -> Sem effs [TxSkelOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxSkelOut]
outputs TxSkelOut -> Sem effs TxSkelOut
forall (effs :: EffectRow).
Members
  '[MockChainRead, MockChainLog, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs TxSkelOut
toTxSkelOutWithMinAda
  Optic' A_Lens NoIx TxSkel [TxSkelOut] -> [TxSkelOut] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL [TxSkelOut]
newOutputs