module Cooked.MockChain.MinAda
( toTxSkelOutWithMinAda,
toTxSkelWithMinAda,
getTxSkelOutMinAda,
)
where
import Cardano.Api qualified as Cardano
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Api.Shelley qualified as Cardano
import Cardano.Ledger.Shelley.Core qualified as Shelley
import Cardano.Node.Emulator qualified as Emulator
import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
import Control.Monad.Except
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx
import Cooked.Skeleton
import Optics.Core
import Plutus.Script.Utils.Ada qualified as Script
import Plutus.Script.Utils.Value qualified as Script
getTxSkelOutMinAda :: Emulator.Params -> TxSkelOut -> Either GenerateTxError Integer
getTxSkelOutMinAda :: Params -> TxSkelOut -> Either GenerateTxError Integer
getTxSkelOutMinAda Emulator.Params {NetworkId
PParams
EpochSize
TransitionConfig
SlotConfig
pSlotConfig :: SlotConfig
pEmulatorPParams :: PParams
pNetworkId :: NetworkId
pEpochSize :: EpochSize
pConfig :: TransitionConfig
pSlotConfig :: Params -> SlotConfig
pEmulatorPParams :: Params -> PParams
pNetworkId :: Params -> NetworkId
pEpochSize :: Params -> EpochSize
pConfig :: Params -> TransitionConfig
..} TxSkelOut
txSkelOut =
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
pEmulatorPParams
(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.
(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)
-> Either GenerateTxError (TxOut CtxTx ConwayEra)
-> Either GenerateTxError Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkId
-> TxSkelOut -> Either GenerateTxError (TxOut CtxTx ConwayEra)
generateTxOut NetworkId
pNetworkId TxSkelOut
txSkelOut
toTxSkelOutWithMinAda :: Emulator.Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
toTxSkelOutWithMinAda :: Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
toTxSkelOutWithMinAda Params
params TxSkelOut
txSkelOut = do
let Script.Lovelace Integer
oldAda = TxSkelOut
txSkelOut TxSkelOut -> Optic' A_Lens NoIx TxSkelOut Ada -> Ada
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 Ada Ada
-> Optic' A_Lens NoIx TxSkelOut Ada
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 Ada Ada
Script.adaL
Integer
requiredAda <- Params -> TxSkelOut -> Either GenerateTxError Integer
getTxSkelOutMinAda Params
params TxSkelOut
txSkelOut
if Integer
oldAda Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
requiredAda
then Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
toTxSkelOutWithMinAda Params
params (TxSkelOut -> Either GenerateTxError TxSkelOut)
-> TxSkelOut -> Either GenerateTxError TxSkelOut
forall a b. (a -> b) -> a -> b
$ TxSkelOut
txSkelOut TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut Value
txSkelOutValueL Lens' TxSkelOut Value
-> Optic A_Lens NoIx Value Value Ada Ada
-> Optic' A_Lens NoIx TxSkelOut Ada
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 Ada Ada
Script.adaL Optic' A_Lens NoIx TxSkelOut Ada -> Ada -> 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 -> Ada
Script.Lovelace Integer
requiredAda
else TxSkelOut -> Either GenerateTxError TxSkelOut
forall a. a -> Either GenerateTxError a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSkelOut
txSkelOut
toTxSkelWithMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
toTxSkelWithMinAda :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m TxSkel
toTxSkelWithMinAda TxSkel
skel = do
Params
theParams <- m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
case (TxSkelOut -> Either GenerateTxError TxSkelOut)
-> [TxSkelOut] -> Either GenerateTxError [TxSkelOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
toTxSkelOutWithMinAda Params
theParams) ([TxSkelOut] -> Either GenerateTxError [TxSkelOut])
-> [TxSkelOut] -> Either GenerateTxError [TxSkelOut]
forall a b. (a -> b) -> a -> b
$ TxSkel
skel TxSkel -> Optic' A_Lens NoIx TxSkel [TxSkelOut] -> [TxSkelOut]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL of
Left GenerateTxError
err -> MockChainError -> m TxSkel
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m TxSkel) -> MockChainError -> m TxSkel
forall a b. (a -> b) -> a -> b
$ GenerateTxError -> MockChainError
MCEGenerationError GenerateTxError
err
Right [TxSkelOut]
newTxSkelOuts -> 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
skel TxSkel -> (TxSkel -> TxSkel) -> TxSkel
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL Optic' A_Lens NoIx 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