New functions queryExpr_, determineEraExpr_ and getNtcVersion_ which …

…are oops versions of other functions with the same name without the underscore.
IntersectMBO · Mar 31, 2023 · ad44dad · ad44dad
1 parent 786ca7e
commit ad44dad
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 0 deletions.
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -659,6 +659,7 @@ module Cardano.Api (
 
     UnsupportedNtcVersionError(..),
 
+    MinNodeToClientVersion,
     AcquireFailure(..),
 
     -- *** Local tx monitoring
@@ -750,7 +751,9 @@ module Cardano.Api (
     executeLocalStateQueryExpr,
     executeLocalStateQueryExpr_,
     queryExpr,
+    queryExpr_,
     determineEraExpr,
+    determineEraExpr_,
 
     chainPointToSlotNo,
     chainPointToHeaderHash,

diff --git a/cardano-api/src/Cardano/Api/IPC.hs b/cardano-api/src/Cardano/Api/IPC.hs
@@ -82,6 +82,8 @@ module Cardano.Api.IPC (
 
     UnsupportedNtcVersionError(..),
 
+    MinNodeToClientVersion,
+
     -- ** Error types
     AcquireFailure(..),
   ) where

diff --git a/cardano-api/src/Cardano/Api/IPC/Monad.hs b/cardano-api/src/Cardano/Api/IPC/Monad.hs
@@ -11,7 +11,9 @@ module Cardano.Api.IPC.Monad
   , executeLocalStateQueryExpr
   , executeLocalStateQueryExpr_
   , queryExpr
+  , queryExpr_
   , determineEraExpr
+  , determineEraExpr_
 
   , NodeToClientVersionOf (..)
   ) where
@@ -143,3 +145,32 @@ determineEraExpr cModeParams = runExceptT $
     ByronMode -> return $ AnyCardanoEra ByronEra
     ShelleyMode -> return $ AnyCardanoEra ShelleyEra
     CardanoMode -> ExceptT $ queryExpr $ QueryCurrentEra CardanoModeIsMultiEra
+
+-- | Lift a query value into a monadic query expression.
+-- Use 'queryExpr_' in a do block to construct monadic local state queries.
+queryExpr_ :: ()
+  => e `CouldBe` UnsupportedNtcVersionError
+  => QueryInMode mode a
+  -> ExceptT (Variant e) (LocalStateQueryExpr block point (QueryInMode mode) r IO) a
+queryExpr_ q = do
+  let minNtcVersion = nodeToClientVersionOf q
+  ntcVersion <- lift getNtcVersion
+  if ntcVersion >= minNtcVersion
+    then lift
+      $ LocalStateQueryExpr $ ReaderT $ \_ -> ContT $ \f -> pure $
+        Net.Query.SendMsgQuery q $
+          Net.Query.ClientStQuerying
+          { Net.Query.recvMsgResult = f
+          }
+    else OO.throw $ UnsupportedNtcVersionError minNtcVersion ntcVersion
+
+-- | A monadic expresion that determines what era the node is in.
+determineEraExpr_ :: ()
+  => e `CouldBe` UnsupportedNtcVersionError
+  => ConsensusModeParams mode
+  -> ExceptT (Variant e) (LocalStateQueryExpr block point (QueryInMode mode) r IO) AnyCardanoEra
+determineEraExpr_ cModeParams =
+  case consensusModeOnly cModeParams of
+    ByronMode -> return $ AnyCardanoEra ByronEra
+    ShelleyMode -> return $ AnyCardanoEra ShelleyEra
+    CardanoMode -> queryExpr_ $ QueryCurrentEra CardanoModeIsMultiEra