module Cooked.MockChain.GenerateTx.Withdrawals (toWithdrawals) where import Cardano.Api qualified as Cardano 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 Control.Monad import Cooked.Conversion import Cooked.MockChain.BlockChain import Cooked.MockChain.GenerateTx.Common import Cooked.MockChain.GenerateTx.Witness import Cooked.Skeleton import Data.Map qualified as Map import Ledger.Tx.CardanoAPI qualified as Ledger import Plutus.Script.Utils.Ada qualified as Script toWithdrawals :: (MonadBlockChainBalancing m) => TxSkelWithdrawals -> m (Cardano.TxWithdrawals Cardano.BuildTx Cardano.ConwayEra) toWithdrawals :: forall (m :: * -> *). MonadBlockChainBalancing m => TxSkelWithdrawals -> m (TxWithdrawals BuildTx ConwayEra) toWithdrawals (TxSkelWithdrawals -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))] forall k a. Map k a -> [(k, a)] Map.toList -> []) = TxWithdrawals BuildTx ConwayEra -> m (TxWithdrawals BuildTx ConwayEra) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return TxWithdrawals BuildTx ConwayEra forall build era. TxWithdrawals build era Cardano.TxWithdrawalsNone toWithdrawals (TxSkelWithdrawals -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))] forall k a. Map k a -> [(k, a)] Map.toList -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))] withdrawals) = ([(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> TxWithdrawals BuildTx ConwayEra) -> m [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> m (TxWithdrawals BuildTx ConwayEra) forall a b. (a -> b) -> m a -> m b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (ShelleyBasedEra ConwayEra -> [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> TxWithdrawals BuildTx ConwayEra forall era build. ShelleyBasedEra era -> [(StakeAddress, Coin, BuildTxWith build (Witness WitCtxStake era))] -> TxWithdrawals build era Cardano.TxWithdrawals ShelleyBasedEra ConwayEra Cardano.ShelleyBasedEraConway) (m [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> m (TxWithdrawals BuildTx ConwayEra)) -> m [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> m (TxWithdrawals BuildTx ConwayEra) forall a b. (a -> b) -> a -> b $ [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))] -> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada)) -> m (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))) -> m [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))] withdrawals (((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada)) -> m (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))) -> m [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]) -> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada)) -> m (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))) -> m [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] forall a b. (a -> b) -> a -> b $ \(Either (Versioned Script) PubKeyHash staker, (TxSkelRedeemer red, Script.Lovelace Integer n)) -> do (Witness WitCtxStake ConwayEra witness, StakeCredential sCred) <- case Either (Versioned Script) PubKeyHash staker of Right PubKeyHash pkh -> do StakeCredential sCred <- String -> Either ToCardanoError StakeCredential -> m StakeCredential forall (m :: * -> *) a. MonadError MockChainError m => String -> Either ToCardanoError a -> m a throwOnToCardanoError String "toWithdrawals: unable to translate pkh stake credential" (Either ToCardanoError StakeCredential -> m StakeCredential) -> Either ToCardanoError StakeCredential -> m StakeCredential forall a b. (a -> b) -> a -> b $ Hash StakeKey -> StakeCredential Cardano.StakeCredentialByKey (Hash StakeKey -> StakeCredential) -> Either ToCardanoError (Hash StakeKey) -> Either ToCardanoError StakeCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> PubKeyHash -> Either ToCardanoError (Hash StakeKey) Ledger.toCardanoStakeKeyHash PubKeyHash pkh (Witness WitCtxStake ConwayEra, StakeCredential) -> m (Witness WitCtxStake ConwayEra, StakeCredential) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (KeyWitnessInCtx WitCtxStake -> Witness WitCtxStake ConwayEra forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era Cardano.KeyWitness KeyWitnessInCtx WitCtxStake Cardano.KeyWitnessForStakeAddr, StakeCredential sCred) Left Versioned Script script -> do Witness WitCtxStake ConwayEra witness <- ScriptWitnessInCtx WitCtxStake -> ScriptWitness WitCtxStake ConwayEra -> Witness WitCtxStake ConwayEra forall witctx era. ScriptWitnessInCtx witctx -> ScriptWitness witctx era -> Witness witctx era Cardano.ScriptWitness ScriptWitnessInCtx WitCtxStake Cardano.ScriptWitnessForStakeAddr (ScriptWitness WitCtxStake ConwayEra -> Witness WitCtxStake ConwayEra) -> m (ScriptWitness WitCtxStake ConwayEra) -> m (Witness WitCtxStake ConwayEra) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Versioned Script -> TxSkelRedeemer -> ScriptDatum WitCtxStake -> m (ScriptWitness WitCtxStake ConwayEra) forall (m :: * -> *) a b. (MonadBlockChainBalancing m, ToVersionedScript a) => a -> TxSkelRedeemer -> ScriptDatum b -> m (ScriptWitness b ConwayEra) toScriptWitness Versioned Script script TxSkelRedeemer red ScriptDatum WitCtxStake Cardano.NoScriptDatumForStake StakeCredential sCred <- String -> Either ToCardanoError StakeCredential -> m StakeCredential forall (m :: * -> *) a. MonadError MockChainError m => String -> Either ToCardanoError a -> m a throwOnToCardanoError String "toWithdrawals: unable to translate script stake credential" (Either ToCardanoError StakeCredential -> m StakeCredential) -> Either ToCardanoError StakeCredential -> m StakeCredential forall a b. (a -> b) -> a -> b $ ScriptHash -> StakeCredential Cardano.StakeCredentialByScript (ScriptHash -> StakeCredential) -> Either ToCardanoError ScriptHash -> Either ToCardanoError StakeCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ScriptHash -> Either ToCardanoError ScriptHash Ledger.toCardanoScriptHash (Versioned Script -> ScriptHash forall a. ToScriptHash a => a -> ScriptHash toScriptHash Versioned Script script) (Witness WitCtxStake ConwayEra, StakeCredential) -> m (Witness WitCtxStake ConwayEra, StakeCredential) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Witness WitCtxStake ConwayEra witness, StakeCredential sCred) NetworkId networkId <- Params -> NetworkId Emulator.pNetworkId (Params -> NetworkId) -> m Params -> m NetworkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m Params forall (m :: * -> *). MonadBlockChainBalancing m => m Params getParams (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)) -> m (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (NetworkId -> StakeCredential -> StakeAddress Cardano.makeStakeAddress NetworkId networkId StakeCredential sCred, Integer -> Coin Cardano.Coin Integer n, Witness WitCtxStake ConwayEra -> BuildTxWith BuildTx (Witness WitCtxStake ConwayEra) forall a. a -> BuildTxWith BuildTx a Cardano.BuildTxWith Witness WitCtxStake ConwayEra witness)