Add some query endpoints

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

@@ -26,6 +26,7 @@ import Wst.Offchain.BuildTx.ProtocolParams (mintProtocolParams)
 import Wst.Offchain.Endpoints.Env (BuildTxEnv, BuildTxError)
 import Wst.Offchain.Endpoints.Env qualified as Env
 import Wst.Offchain.Scripts (directoryNodeMintingScript,
+                             directoryNodeSpendingScript,
                              programmableLogicBaseScript,
                              programmableLogicGlobalScript,
                              protocolParamsMintingScript, scriptPolicyIdV3)
@@ -34,6 +35,7 @@ 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
@@ -43,6 +45,7 @@ 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
@@ -51,6 +54,7 @@ deploymentScripts dsTxIn =
                 , dsProtocolParamsMintingScript
                 , dsProgrammableLogicBaseScript
                 , dsProgrammableLogicGlobalScript
+                , dsDirectorySpendingScript
                 }
   in result
 

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

@@ -0,0 +1,31 @@
+{-| Look up outputs at script addresses
+-}
+module Wst.Offchain.Endpoints.Query(
+  registryNodes,
+  globalParamsNode
+) where
+
+import Cardano.Api qualified as C
+import Control.Monad.Reader (MonadReader, asks)
+import Convex.Class (MonadUtxoQuery, utxosByPaymentCredential)
+import Convex.Utxos (toApiUtxo)
+import Data.Map qualified as Map
+import Wst.Offchain.Endpoints.Deployment (DeploymentScripts (dsDirectorySpendingScript))
+import Wst.Offchain.Scripts (protocolParamsSpendingScript)
+
+-- TODO: We should probably filter the UTxOs to check that they have the correct NFTs,
+--       and we should parse the inline datums
+
+{-| Find all UTxOs that make up the registry
+-}
+registryNodes :: forall era m. (MonadReader DeploymentScripts m, MonadUtxoQuery m, C.IsBabbageBasedEra era) => m [(C.TxIn, C.TxOut C.CtxUTxO era)]
+registryNodes =
+  asks (C.PaymentCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 . dsDirectorySpendingScript)
+    >>= fmap (Map.toList . C.unUTxO . toApiUtxo @era) . utxosByPaymentCredential
+
+{-| Find the UTxO with the global params
+-}
+globalParamsNode :: forall era m. (MonadReader DeploymentScripts m, MonadUtxoQuery m, C.IsBabbageBasedEra era) => m [(C.TxIn, C.TxOut C.CtxUTxO era)]
+globalParamsNode = do
+  let cred = C.PaymentCredentialByScript . C.hashScript . C.PlutusScript C.PlutusScriptV3 $ protocolParamsSpendingScript
+  fmap (Map.toList . C.unUTxO . toApiUtxo @era) $ utxosByPaymentCredential cred

src/test/Wst/Test/UnitTest.hs

@@ -5,21 +5,34 @@ module Wst.Test.UnitTest(
 
 import Cardano.Api qualified as C
 import Control.Monad (void)
+import Control.Monad.Reader (runReaderT)
 import Convex.Class (MonadBlockchain (sendTx), MonadUtxoQuery)
 import Convex.MockChain.Utils (mockchainSucceeds)
 import Convex.Utils (failOnError)
 import Convex.Wallet.Operator (signTxOperator)
 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.Test.Env (admin, asAdmin)
 
 tests :: TestTree
 tests = testGroup "unit tests"
   [ testCase "deploy directory and global params" (mockchainSucceeds deployDirectorySet)
   ]
 
-deployDirectorySet :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m ()
+deployDirectorySet :: (MonadUtxoQuery m, MonadBlockchain C.ConwayEra m, MonadFail m) => m C.TxIn
 deployDirectorySet = failOnError $ asAdmin @C.ConwayEra $ do
-  (tx, _txI) <- Endpoints.deployTx
+  (tx, txI) <- Endpoints.deployTx
   void $ sendTx $ signTxOperator admin tx
+  flip runReaderT (Endpoints.deploymentScripts txI) $ do
+    Query.registryNodes @C.ConwayEra
+      >>= void . expectSingleton "registry output"
+    Query.globalParamsNode @C.ConwayEra
+      >>= void . expectSingleton "global params output"
+  pure txI
+
+expectSingleton :: MonadFail m => String -> [a] -> m a
+expectSingleton msg = \case
+  [a] -> pure a
+  ls  -> fail $ "Expected a single " ++ msg ++ " but found " ++ show (length ls)

src/wst-poc.cabal

@@ -78,6 +78,7 @@ library
     Wst.Offchain.BuildTx.TransferLogic
     Wst.Offchain.Endpoints.Deployment
     Wst.Offchain.Endpoints.Env
+    Wst.Offchain.Endpoints.Query
     Wst.Offchain.Scripts
     Wst.Onchain
     Wst.Server