New queryUtxo_ queryProtocolParams_ queryEraHistory_ querySystemStart…

…_ queryStakePools_ functions
IntersectMBO · Mar 30, 2023 · 1c7ce89 · 1c7ce89
1 parent bbd2cca
commit 1c7ce89
Show file tree

Hide file tree

Showing 2 changed files with 78 additions and 21 deletions.
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -751,12 +751,7 @@ module Cardano.Api (
     -- ** Monadic queries
     LocalStateQueryExpr,
     executeLocalStateQueryExpr,
-    executeLocalStateQueryExpr_,
     queryExpr,
-    queryExpr_,
-    maybeQueryExpr_,
-    determineEraExpr_,
-    getNtcVersion_,
 
     chainPointToSlotNo,
     chainPointToHeaderHash,
@@ -778,6 +773,20 @@ module Cardano.Api (
     queryStateForBalancedTx,
     renderQueryConvenienceError,
 
+    -- ** Oops-enabled monadic query support
+    executeLocalStateQueryExpr_,
+    queryExpr_,
+    maybeQueryExpr_,
+    determineEraExpr_,
+    getNtcVersion_,
+
+    -- ** Oops-enabled queries
+    queryUtxo_,
+    queryProtocolParams_,
+    queryEraHistory_,
+    queryStakePools_,
+    querySystemStart_,
+
     -- ** Constraint satisfaction functions
     getIsCardanoEraConstraint,
 

diff --git a/cardano-api/src/Cardano/Api/Convenience/Query.hs b/cardano-api/src/Cardano/Api/Convenience/Query.hs
@@ -15,6 +15,13 @@ module Cardano.Api.Convenience.Query (
     executeQueryCardanoMode,
 
     queryStateForBalancedTx,
+
+    queryUtxo_,
+    queryProtocolParams_,
+    queryEraHistory_,
+    queryStakePools_,
+    querySystemStart_,
+
     renderQueryConvenienceError,
   ) where
 
@@ -37,7 +44,8 @@ import           Cardano.Api.Convenience.Constraints
 import           Cardano.Api.Environment
 import           Cardano.Api.Eras
 import           Cardano.Api.IPC
-import           Cardano.Api.IPC.Monad (executeLocalStateQueryExpr_, queryExpr_)
+import           Cardano.Api.IPC.Monad (LocalStateQueryExpr, executeLocalStateQueryExpr_,
+                   queryExpr_)
 import           Cardano.Api.Modes
 import           Cardano.Api.NetworkId
 import           Cardano.Api.ProtocolParameters
@@ -71,6 +79,54 @@ renderQueryConvenienceError (QueryConvenienceUnsupportedNodeToClientVersion
   (UnsupportedNtcVersionError minNodeToClientVersion nodeToClientVersion)) =
   "Unsupported Node to Client version: " <> textShow minNodeToClientVersion <> " " <> textShow nodeToClientVersion
 
+queryUtxo_ :: ()
+  => OO.CouldBeF e UnsupportedNtcVersionError
+  => OO.CouldBeF e EraMismatch
+  => EraInMode era mode
+  -> ShelleyBasedEra era
+  -> [TxIn]
+  -> ExceptT (OO.Variant e) (LocalStateQueryExpr block point (QueryInMode mode) r IO) (UTxO era)
+queryUtxo_ qeInMode qSbe allTxIns = do
+  let query = QueryInEra qeInMode $ QueryInShelleyBasedEra qSbe $
+        QueryUTxO (QueryUTxOByTxIn (Set.fromList allTxIns))
+
+  queryExpr_ query & OO.onLeft @EraMismatch OO.throw
+
+queryProtocolParams_ :: ()
+  => OO.CouldBeF e UnsupportedNtcVersionError
+  => OO.CouldBeF e EraMismatch
+  => EraInMode era mode
+  -> ShelleyBasedEra era
+  -> ExceptT (OO.Variant e) (LocalStateQueryExpr block point (QueryInMode mode) r IO) ProtocolParameters
+queryProtocolParams_ qeInMode qSbe = do
+  let query = QueryInEra qeInMode $ QueryInShelleyBasedEra qSbe QueryProtocolParameters
+
+  queryExpr_ query & OO.onLeft @EraMismatch OO.throw
+
+queryEraHistory_ :: ()
+  => OO.CouldBeF e UnsupportedNtcVersionError
+  => ExceptT (OO.Variant e) (LocalStateQueryExpr block point (QueryInMode CardanoMode) r IO) (EraHistory CardanoMode)
+queryEraHistory_ = do
+  let query = QueryEraHistory CardanoModeIsMultiEra
+
+  queryExpr_ query
+
+queryStakePools_ :: ()
+  => OO.CouldBeF e UnsupportedNtcVersionError
+  => OO.CouldBeF e QueryConvenienceError
+  => EraInMode era mode
+  -> ShelleyBasedEra era
+  -> ExceptT (OO.Variant e) (LocalStateQueryExpr block point (QueryInMode mode) r IO) (Set PoolId)
+queryStakePools_ qeInMode qSbe = do
+  let query = QueryInEra qeInMode . QueryInShelleyBasedEra qSbe $ QueryStakePools
+
+  queryExpr_ query & OO.onLeft @EraMismatch (OO.throw . QueryEraMismatch)
+
+querySystemStart_ :: ()
+  => OO.CouldBeF e UnsupportedNtcVersionError
+  => ExceptT (OO.Variant e) (LocalStateQueryExpr block point (QueryInMode mode) r IO) SystemStart
+querySystemStart_ = queryExpr_ QuerySystemStart
+
 -- | A convenience function to query the relevant information, from
 -- the local node, for Cardano.Api.Convenience.Construction.constructBalancedTx
 queryStateForBalancedTx
@@ -90,25 +146,17 @@ queryStateForBalancedTx era networkId allTxIns = runExceptT $ OO.runOopsInExcept
   qeInMode <- toEraInMode era CardanoMode
     & OO.hoistMaybe (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (getIsCardanoEraConstraint era $ AnyCardanoEra era))
 
-  -- Queries
-  let utxoQuery = QueryInEra qeInMode $ QueryInShelleyBasedEra qSbe
-                    $ QueryUTxO (QueryUTxOByTxIn (Set.fromList allTxIns))
-      pparamsQuery = QueryInEra qeInMode
-                        $ QueryInShelleyBasedEra qSbe QueryProtocolParameters
-      eraHistoryQuery = QueryEraHistory CardanoModeIsMultiEra
-      systemStartQuery = QuerySystemStart
-      stakePoolsQuery = QueryInEra qeInMode . QueryInShelleyBasedEra qSbe $ QueryStakePools
-
   -- Query execution
   executeLocalStateQueryExpr_ localNodeConnInfo Nothing
-    ( do  utxo <- queryExpr_ utxoQuery & OO.onLeft @EraMismatch (OO.throw . QueryEraMismatch)
-          pparams <- queryExpr_ pparamsQuery & OO.onLeft @EraMismatch (OO.throw . QueryEraMismatch)
-          eraHistory <- queryExpr_ eraHistoryQuery
-          systemStart <- queryExpr_ systemStartQuery
-          stakePools <- queryExpr_ stakePoolsQuery & OO.onLeft @EraMismatch (OO.throw . QueryEraMismatch)
+    ( do  utxo <- queryUtxo_ qeInMode qSbe allTxIns
+          pparams <- queryProtocolParams_ qeInMode qSbe
+          eraHistory <- queryEraHistory_
+          systemStart <- querySystemStart_
+          stakePools <- queryStakePools_ qeInMode qSbe
 
           pure (utxo, pparams, eraHistory, systemStart, stakePools)
-    ) & OO.catch @AcquireFailure (OO.throw . AcqFailure . toAcquiringFailure)
+    ) & OO.catch @EraMismatch (OO.throw . QueryEraMismatch)
+      & OO.catch @AcquireFailure (OO.throw . AcqFailure . toAcquiringFailure)
       & OO.catch @UnsupportedNtcVersionError (OO.throw . QueryConvenienceUnsupportedNodeToClientVersion)
 
 -- | Query the node to determine which era it is in.