Move all env-like types to Wst.Offchain.Env

src/lib/Wst/Offchain/Endpoints/Deployment.hs

@@ -1,15 +1,6 @@
-{-# LANGUAGE NamedFieldPuns #-}
-
 {-| Deploy the directory and global params
 -}
 module Wst.Offchain.Endpoints.Deployment(
-  DeploymentScripts(..),
-  deploymentScripts,
-  programmableLogicStakeCredential,
-  programmableLogicBaseCredential,
-  directoryNodePolicyId,
-  protocolParamsPolicyId,
-  globalParams,
   deployTx
 ) where
 
@@ -31,62 +22,14 @@ import Wst.Offchain.Scripts (directoryNodeMintingScript,
                              programmableLogicGlobalScript,
                              protocolParamsMintingScript, scriptPolicyIdV3)
 
-data DeploymentScripts =
-  DeploymentScripts
-    { dsTxIn :: C.TxIn -- ^ The 'txIn' that we spend when deploying the protocol params and directory set
-    , dsDirectoryMintingScript        :: PlutusScript PlutusScriptV3
-    , dsDirectorySpendingScript       :: PlutusScript PlutusScriptV3
-    , dsProtocolParamsMintingScript   :: PlutusScript PlutusScriptV3
-    , dsProgrammableLogicBaseScript   :: PlutusScript PlutusScriptV3
-    , dsProgrammableLogicGlobalScript :: PlutusScript PlutusScriptV3
-    }
-
-deploymentScripts :: C.TxIn -> DeploymentScripts
-deploymentScripts dsTxIn =
-  let dsDirectoryMintingScript        = directoryNodeMintingScript dsTxIn
-      dsProtocolParamsMintingScript   = protocolParamsMintingScript dsTxIn
-      dsDirectorySpendingScript       = directoryNodeSpendingScript (protocolParamsPolicyId result)
-      dsProgrammableLogicBaseScript   = programmableLogicBaseScript (programmableLogicStakeCredential result) -- Parameterized by the stake cred of the global script
-      dsProgrammableLogicGlobalScript = programmableLogicGlobalScript (directoryNodePolicyId result) -- Parameterized by the CS holding protocol params datum
-      result = DeploymentScripts
-                { dsTxIn
-                , dsDirectoryMintingScript
-                , dsProtocolParamsMintingScript
-                , dsProgrammableLogicBaseScript
-                , dsProgrammableLogicGlobalScript
-                , dsDirectorySpendingScript
-                }
-  in result
-
-programmableLogicStakeCredential :: DeploymentScripts -> C.StakeCredential
-programmableLogicStakeCredential =
-  C.StakeCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 . dsProgrammableLogicGlobalScript
-
-programmableLogicBaseCredential :: DeploymentScripts -> C.PaymentCredential
-programmableLogicBaseCredential =
-  C.PaymentCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 . dsProgrammableLogicBaseScript
-
-directoryNodePolicyId :: DeploymentScripts -> C.PolicyId
-directoryNodePolicyId = scriptPolicyIdV3 . dsDirectoryMintingScript
-
-protocolParamsPolicyId :: DeploymentScripts -> C.PolicyId
-protocolParamsPolicyId = scriptPolicyIdV3 . dsProtocolParamsMintingScript
-
-globalParams :: DeploymentScripts -> ProgrammableLogicGlobalParams
-globalParams scripts =
-  ProgrammableLogicGlobalParams
-    { directoryNodeCS = transPolicyId (directoryNodePolicyId scripts)
-    , progLogicCred   = transCredential (programmableLogicBaseCredential scripts) -- its the script hash of the programmable base spending script
-    }
-
 {-| 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 (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
+  let scripts = Env.directoryEnv txi
   (tx, _) <- Env.balanceTxEnv $ do
-          mintProtocolParams (globalParams scripts) txi
-          initDirectorySet (protocolParamsPolicyId scripts) txi
+          mintProtocolParams (Env.globalParams scripts) txi
+          initDirectorySet (Env.protocolParamsPolicyId scripts) txi
   pure (Convex.CoinSelection.signBalancedTxBody [] tx, txi)

src/lib/Wst/Offchain/Endpoints/Query.hs

@@ -20,7 +20,7 @@ import Data.Maybe (mapMaybe)
 import PlutusTx qualified
 import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams)
 import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..))
-import Wst.Offchain.Endpoints.Deployment (DeploymentScripts (dsDirectorySpendingScript))
+import Wst.Offchain.Env (DirectoryEnv (dsDirectorySpendingScript))
 import Wst.Offchain.Scripts (protocolParamsSpendingScript)
 
 -- TODO: We should probably filter the UTxOs to check that they have the correct NFTs
@@ -36,14 +36,14 @@ data UTxO era a =
 
 {-| Find all UTxOs that make up the registry
 -}
-registryNodes :: forall era m. (MonadReader DeploymentScripts m, MonadUtxoQuery m, C.IsBabbageBasedEra era) => m [UTxO era DirectorySetNode]
+registryNodes :: forall era m. (MonadReader DirectoryEnv m, MonadUtxoQuery m, C.IsBabbageBasedEra era) => m [UTxO era DirectorySetNode]
 registryNodes =
   asks (C.PaymentCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 . dsDirectorySpendingScript)
     >>= fmap (extractUTxO @era) . utxosByPaymentCredential
 
 {-| Find the UTxO with the global params
 -}
-globalParamsNode :: forall era m. (MonadReader DeploymentScripts m, MonadUtxoQuery m, C.IsBabbageBasedEra era) => m [UTxO era ProgrammableLogicGlobalParams]
+globalParamsNode :: forall era m. (MonadReader DirectoryEnv m, MonadUtxoQuery m, C.IsBabbageBasedEra era) => m [UTxO era ProgrammableLogicGlobalParams]
 globalParamsNode = do
   let cred = C.PaymentCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 $ protocolParamsSpendingScript
   fmap (extractUTxO @era) (utxosByPaymentCredential cred)

src/lib/Wst/Offchain/Env.hs

@@ -7,20 +7,31 @@ module Wst.Offchain.Env(
   loadEnv,
   BuildTxError(..),
 
-  -- ** Using the environment
+  -- ** Using the operator environment
   selectOperatorOutput,
-  balanceTxEnv
+  balanceTxEnv,
+
+  -- * Directory environment
+  DirectoryEnv(..),
+  directoryEnv,
+  programmableLogicStakeCredential,
+  programmableLogicBaseCredential,
+  directoryNodePolicyId,
+  protocolParamsPolicyId,
+  globalParams
 ) where
 
-import Cardano.Api (UTxO)
+import Cardano.Api (PlutusScript, PlutusScriptV3, UTxO)
 import Cardano.Api qualified as C
+import Cardano.Api.Shelley qualified as C
 import Control.Monad.Except (MonadError, throwError)
 import Control.Monad.Reader (MonadReader, ask, asks)
 import Convex.BuildTx (BuildTxT)
 import Convex.BuildTx qualified as BuildTx
 import Convex.Class (MonadBlockchain, MonadUtxoQuery (..),
                      queryProtocolParameters, utxosByPaymentCredential)
 import Convex.CoinSelection qualified as CoinSelection
+import Convex.PlutusLedger.V1 (transCredential, transPolicyId)
 import Convex.Utils (mapError)
 import Convex.Utxos (BalanceChanges)
 import Convex.Utxos qualified as Utxos
@@ -29,6 +40,12 @@ import Convex.Wallet.Operator (Operator (..), PaymentExtendedKey (..),
                                operatorReturnOutput)
 import Data.Map qualified as Map
 import Data.Maybe (listToMaybe)
+import SmartTokens.Types.ProtocolParams (ProgrammableLogicGlobalParams (..))
+import Wst.Offchain.Scripts (directoryNodeMintingScript,
+                             directoryNodeSpendingScript,
+                             programmableLogicBaseScript,
+                             programmableLogicGlobalScript,
+                             protocolParamsMintingScript, scriptPolicyIdV3)
 
 {-| Information needed to build transactions
 -}
@@ -71,3 +88,54 @@ balanceTxEnv btx = do
   txBuilder <- BuildTx.execBuildTxT $ btx >> BuildTx.setMinAdaDepositAll params
   output <- operatorReturnOutput bteOperator
   mapError BalancingError (CoinSelection.balanceTx mempty output (Utxos.fromApiUtxo bteOperatorUtxos) txBuilder CoinSelection.TrailingChange)
+
+{-| Scripts relatd to managing the token policy directory.
+All of the scripts and their hashes are determined by the 'TxIn'.
+-}
+data DirectoryEnv =
+  DirectoryEnv
+    { dsTxIn :: C.TxIn -- ^ The 'txIn' that we spend when deploying the protocol params and directory set
+    , dsDirectoryMintingScript        :: PlutusScript PlutusScriptV3
+    , dsDirectorySpendingScript       :: PlutusScript PlutusScriptV3
+    , dsProtocolParamsMintingScript   :: PlutusScript PlutusScriptV3
+    , dsProgrammableLogicBaseScript   :: PlutusScript PlutusScriptV3
+    , dsProgrammableLogicGlobalScript :: PlutusScript PlutusScriptV3
+    }
+
+directoryEnv :: C.TxIn -> DirectoryEnv
+directoryEnv dsTxIn =
+  let dsDirectoryMintingScript        = directoryNodeMintingScript dsTxIn
+      dsProtocolParamsMintingScript   = protocolParamsMintingScript dsTxIn
+      dsDirectorySpendingScript       = directoryNodeSpendingScript (protocolParamsPolicyId result)
+      dsProgrammableLogicBaseScript   = programmableLogicBaseScript (programmableLogicStakeCredential result) -- Parameterized by the stake cred of the global script
+      dsProgrammableLogicGlobalScript = programmableLogicGlobalScript (directoryNodePolicyId result) -- Parameterized by the CS holding protocol params datum
+      result = DirectoryEnv
+                { dsTxIn
+                , dsDirectoryMintingScript
+                , dsProtocolParamsMintingScript
+                , dsProgrammableLogicBaseScript
+                , dsProgrammableLogicGlobalScript
+                , dsDirectorySpendingScript
+                }
+  in result
+
+programmableLogicStakeCredential :: DirectoryEnv -> C.StakeCredential
+programmableLogicStakeCredential =
+  C.StakeCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 . dsProgrammableLogicGlobalScript
+
+programmableLogicBaseCredential :: DirectoryEnv -> C.PaymentCredential
+programmableLogicBaseCredential =
+  C.PaymentCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 . dsProgrammableLogicBaseScript
+
+directoryNodePolicyId :: DirectoryEnv -> C.PolicyId
+directoryNodePolicyId = scriptPolicyIdV3 . dsDirectoryMintingScript
+
+protocolParamsPolicyId :: DirectoryEnv -> C.PolicyId
+protocolParamsPolicyId = scriptPolicyIdV3 . dsProtocolParamsMintingScript
+
+globalParams :: DirectoryEnv -> ProgrammableLogicGlobalParams
+globalParams scripts =
+  ProgrammableLogicGlobalParams
+    { directoryNodeCS = transPolicyId (directoryNodePolicyId scripts)
+    , progLogicCred   = transCredential (programmableLogicBaseCredential scripts) -- its the script hash of the programmable base spending script
+    }

src/test/Wst/Test/UnitTest.hs

@@ -14,6 +14,7 @@ import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase)
 import Wst.Offchain.Endpoints.Deployment qualified as Endpoints
 import Wst.Offchain.Endpoints.Query qualified as Query
+import Wst.Offchain.Env qualified as Env
 import Wst.Test.Env (admin, asAdmin)
 
 tests :: TestTree
@@ -25,7 +26,7 @@ deployDirectorySet :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFai
 deployDirectorySet = failOnError $ asAdmin @C.ConwayEra $ do
   (tx, txI) <- Endpoints.deployTx
   void $ sendTx $ signTxOperator admin tx
-  flip runReaderT (Endpoints.deploymentScripts txI) $ do
+  flip runReaderT (Env.directoryEnv txI) $ do
     Query.registryNodes @C.ConwayEra
       >>= void . expectSingleton "registry output"
     Query.globalParamsNode @C.ConwayEra