diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 879c03e..a81ca02 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -23,8 +23,8 @@ import Convex.PlutusLedger.V1 (transCredential, transPolicyId) import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams (..)) import Wst.Offchain.BuildTx.DirectorySet (initDirectorySet) import Wst.Offchain.BuildTx.ProtocolParams (mintProtocolParams) -import Wst.Offchain.Endpoints.Env (BuildTxEnv, BuildTxError) -import Wst.Offchain.Endpoints.Env qualified as Env +import Wst.Offchain.Env (BuildTxError, OperatorEnv) +import Wst.Offchain.Env qualified as Env import Wst.Offchain.Scripts (directoryNodeMintingScript, directoryNodeSpendingScript, programmableLogicBaseScript, @@ -82,7 +82,7 @@ globalParams scripts = {-| Build a transaction that deploys the directory and global params. Returns the transaction and the 'TxIn' that was selected for the one-shot NFTs. -} -deployTx :: (MonadReader (BuildTxEnv era) m, MonadBlockchain era m, MonadError (BuildTxError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => m (C.Tx era, C.TxIn) +deployTx :: (MonadReader (OperatorEnv era) m, MonadBlockchain era m, MonadError (BuildTxError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => m (C.Tx era, C.TxIn) deployTx = do (txi, _) <- Env.selectOperatorOutput let scripts = deploymentScripts txi diff --git a/src/lib/Wst/Offchain/Endpoints/Env.hs b/src/lib/Wst/Offchain/Env.hs similarity index 79% rename from src/lib/Wst/Offchain/Endpoints/Env.hs rename to src/lib/Wst/Offchain/Env.hs index 68b5e36..b3dde92 100644 --- a/src/lib/Wst/Offchain/Endpoints/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -1,12 +1,13 @@ {-# LANGUAGE NamedFieldPuns #-} {-| Transaction building environment -} -module Wst.Offchain.Endpoints.Env( - BuildTxEnv(..), +module Wst.Offchain.Env( + -- * Operator environment + OperatorEnv(..), loadEnv, BuildTxError(..), - -- * Using the environment + -- ** Using the environment selectOperatorOutput, balanceTxEnv ) where @@ -31,15 +32,15 @@ import Data.Maybe (listToMaybe) {-| Information needed to build transactions -} -data BuildTxEnv era = - BuildTxEnv +data OperatorEnv era = + OperatorEnv { bteOperator :: Operator Verification , bteOperatorUtxos :: UTxO era -- ^ UTxOs owned by the operator, available for spending } -{-| Populate the 'BuildTxEnv' with UTxOs locked by the verification key +{-| Populate the 'OperatorEnv' with UTxOs locked by the verification key -} -loadEnv :: (MonadUtxoQuery m, C.IsBabbageBasedEra era) => C.VerificationKey C.PaymentKey -> Maybe (C.VerificationKey C.StakeKey) -> m (BuildTxEnv era) +loadEnv :: (MonadUtxoQuery m, C.IsBabbageBasedEra era) => C.VerificationKey C.PaymentKey -> Maybe (C.VerificationKey C.StakeKey) -> m (OperatorEnv era) loadEnv verificationKey oStakeKey = do let bteOperator = Operator @@ -47,7 +48,7 @@ loadEnv verificationKey oStakeKey = do , oStakeKey } bteOperatorUtxos <- Utxos.toApiUtxo <$> utxosByPaymentCredential (operatorPaymentCredential bteOperator) - pure BuildTxEnv{bteOperator, bteOperatorUtxos} + pure OperatorEnv{bteOperator, bteOperatorUtxos} data BuildTxError era = OperatorNoUTxOs -- ^ The operator does not have any UTxOs @@ -56,16 +57,16 @@ data BuildTxError era = {-| Select an output owned by the operator -} -selectOperatorOutput :: (MonadReader (BuildTxEnv era) m, MonadError (BuildTxError era) m) => m (C.TxIn, C.TxOut C.CtxUTxO era) +selectOperatorOutput :: (MonadReader (OperatorEnv era) m, MonadError (BuildTxError era) m) => m (C.TxIn, C.TxOut C.CtxUTxO era) selectOperatorOutput = asks (listToMaybe . Map.toList . C.unUTxO . bteOperatorUtxos) >>= \case Nothing -> throwError OperatorNoUTxOs Just k -> pure k {-| Balance a transaction using the operator's funds and return output -} -balanceTxEnv :: forall era a m. (MonadBlockchain era m, MonadReader (BuildTxEnv era) m, MonadError (BuildTxError era) m, C.IsBabbageBasedEra era) => BuildTxT era m a -> m (C.BalancedTxBody era, BalanceChanges) +balanceTxEnv :: forall era a m. (MonadBlockchain era m, MonadReader (OperatorEnv era) m, MonadError (BuildTxError era) m, C.IsBabbageBasedEra era) => BuildTxT era m a -> m (C.BalancedTxBody era, BalanceChanges) balanceTxEnv btx = do - BuildTxEnv{bteOperatorUtxos, bteOperator} <- ask + OperatorEnv{bteOperatorUtxos, bteOperator} <- ask params <- queryProtocolParameters txBuilder <- BuildTx.execBuildTxT $ btx >> BuildTx.setMinAdaDepositAll params output <- operatorReturnOutput bteOperator diff --git a/src/test/Wst/Test/Env.hs b/src/test/Wst/Test/Env.hs index f4142ec..1f160dc 100644 --- a/src/test/Wst/Test/Env.hs +++ b/src/test/Wst/Test/Env.hs @@ -12,8 +12,8 @@ import Convex.Wallet qualified as Wallet import Convex.Wallet.MockWallet (w1) import Convex.Wallet.Operator (Operator (..), PaymentExtendedKey (..), Signing) import Convex.Wallet.Operator qualified as Operator -import Wst.Offchain.Endpoints.Env (BuildTxEnv) -import Wst.Offchain.Endpoints.Env qualified as Env +import Wst.Offchain.Env (OperatorEnv) +import Wst.Offchain.Env qualified as Env {-| Key used for actions of the stableoin issuer / operator. -} @@ -26,7 +26,7 @@ admin = {-| Run an action using the "admin" key. Deploying the system, minting stablecoins, etc. -} -asAdmin :: forall era m a. (MonadUtxoQuery m, C.IsBabbageBasedEra era) => ReaderT (BuildTxEnv era) m a -> m a +asAdmin :: forall era m a. (MonadUtxoQuery m, C.IsBabbageBasedEra era) => ReaderT (OperatorEnv era) m a -> m a asAdmin action = do env <- Env.loadEnv (Operator.verificationKey $ Operator.oPaymentKey admin) (Operator.oStakeKey admin) runReaderT action env diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index 3dfeaed..267e853 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -77,8 +77,8 @@ library Wst.Offchain.BuildTx.ProtocolParams Wst.Offchain.BuildTx.TransferLogic Wst.Offchain.Endpoints.Deployment - Wst.Offchain.Endpoints.Env Wst.Offchain.Endpoints.Query + Wst.Offchain.Env Wst.Offchain.Scripts Wst.Onchain Wst.Server