module Cooked.MockChain.GenerateTx.Withdrawals ( WithdrawalsContext (..), toWithdrawals, ) where import Cardano.Api qualified as Cardano import Cardano.Api.Ledger qualified as Cardano import Cardano.Api.Shelley qualified as Cardano import Control.Monad import Control.Monad.Reader import Cooked.Conversion import Cooked.MockChain.GenerateTx.Common import Cooked.MockChain.GenerateTx.Witness import Cooked.Skeleton import Data.Map (Map) import Data.Map qualified as Map import Ledger.Tx.CardanoAPI qualified as Ledger import Plutus.Script.Utils.Ada qualified as Script import PlutusLedgerApi.V3 qualified as Api data WithdrawalsContext where WithdrawalsContext :: { WithdrawalsContext -> Map TxOutRef TxOut managedTxOuts :: Map Api.TxOutRef Api.TxOut, WithdrawalsContext -> NetworkId networkId :: Cardano.NetworkId } -> WithdrawalsContext instance Transform WithdrawalsContext (Map Api.TxOutRef Api.TxOut) where transform :: WithdrawalsContext -> Map TxOutRef TxOut transform = WithdrawalsContext -> Map TxOutRef TxOut managedTxOuts type WithdrawalsGen a = TxGen WithdrawalsContext a toWithdrawals :: TxSkelWithdrawals -> WithdrawalsGen (Cardano.TxWithdrawals Cardano.BuildTx Cardano.ConwayEra) toWithdrawals :: TxSkelWithdrawals -> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra) toWithdrawals (TxSkelWithdrawals -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))] forall k a. Map k a -> [(k, a)] Map.toList -> []) = TxWithdrawals BuildTx ConwayEra -> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra) forall a. a -> ReaderT WithdrawalsContext (Either GenerateTxError) 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) -> ReaderT WithdrawalsContext (Either GenerateTxError) [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra) forall a b. (a -> b) -> ReaderT WithdrawalsContext (Either GenerateTxError) a -> ReaderT WithdrawalsContext (Either GenerateTxError) 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) (ReaderT WithdrawalsContext (Either GenerateTxError) [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra)) -> ReaderT WithdrawalsContext (Either GenerateTxError) [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))] -> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra) forall a b. (a -> b) -> a -> b $ [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))] -> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada)) -> ReaderT WithdrawalsContext (Either GenerateTxError) (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))) -> ReaderT WithdrawalsContext (Either GenerateTxError) [(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)) -> ReaderT WithdrawalsContext (Either GenerateTxError) (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))) -> ReaderT WithdrawalsContext (Either GenerateTxError) [(StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]) -> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada)) -> ReaderT WithdrawalsContext (Either GenerateTxError) (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))) -> ReaderT WithdrawalsContext (Either GenerateTxError) [(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 -> TxGen WithdrawalsContext StakeCredential forall a context. String -> Either ToCardanoError a -> TxGen context a throwOnToCardanoError String "toWithdrawals: unable to translate pkh stake credential" (Either ToCardanoError StakeCredential -> TxGen WithdrawalsContext StakeCredential) -> Either ToCardanoError StakeCredential -> TxGen WithdrawalsContext 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) -> ReaderT WithdrawalsContext (Either GenerateTxError) (Witness WitCtxStake ConwayEra, StakeCredential) forall a. a -> ReaderT WithdrawalsContext (Either GenerateTxError) 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) -> ReaderT WithdrawalsContext (Either GenerateTxError) (ScriptWitness WitCtxStake ConwayEra) -> ReaderT WithdrawalsContext (Either GenerateTxError) (Witness WitCtxStake ConwayEra) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TxGen (Map TxOutRef TxOut) (ScriptWitness WitCtxStake ConwayEra) -> ReaderT WithdrawalsContext (Either GenerateTxError) (ScriptWitness WitCtxStake ConwayEra) forall context' context a. Transform context' context => TxGen context a -> TxGen context' a liftTxGen (Versioned Script -> TxSkelRedeemer -> ScriptDatum WitCtxStake -> TxGen (Map TxOutRef TxOut) (ScriptWitness WitCtxStake ConwayEra) forall a b. ToVersionedScript a => a -> TxSkelRedeemer -> ScriptDatum b -> WitnessGen (ScriptWitness b ConwayEra) toScriptWitness Versioned Script script TxSkelRedeemer red ScriptDatum WitCtxStake Cardano.NoScriptDatumForStake) StakeCredential sCred <- String -> Either ToCardanoError StakeCredential -> TxGen WithdrawalsContext StakeCredential forall a context. String -> Either ToCardanoError a -> TxGen context a throwOnToCardanoError String "toWithdrawals: unable to translate script stake credential" (Either ToCardanoError StakeCredential -> TxGen WithdrawalsContext StakeCredential) -> Either ToCardanoError StakeCredential -> TxGen WithdrawalsContext 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) -> ReaderT WithdrawalsContext (Either GenerateTxError) (Witness WitCtxStake ConwayEra, StakeCredential) forall a. a -> ReaderT WithdrawalsContext (Either GenerateTxError) a forall (m :: * -> *) a. Monad m => a -> m a return (Witness WitCtxStake ConwayEra witness, StakeCredential sCred) NetworkId networkId <- (WithdrawalsContext -> NetworkId) -> ReaderT WithdrawalsContext (Either GenerateTxError) NetworkId forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks WithdrawalsContext -> NetworkId networkId (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)) -> ReaderT WithdrawalsContext (Either GenerateTxError) (StakeAddress, Coin, BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)) forall a. a -> ReaderT WithdrawalsContext (Either GenerateTxError) 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)