Add ReaderT of NtcVersion to LocalStateQueryExpr

IntersectMBO · Jan 16, 2023 · bb1ab4b · bb1ab4b
1 parent 5e85d20
commit bb1ab4b
Showing 1 changed file with 7 additions and 5 deletions.
diff --git a/cardano-api/src/Cardano/Api/IPC/Monad.hs b/cardano-api/src/Cardano/Api/IPC/Monad.hs
@@ -14,6 +14,7 @@ import           Control.Concurrent.STM
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Cont
+import           Control.Monad.Trans.Reader (ReaderT(..), runReaderT)
 import           Data.Bifunctor (first)
 import           Data.Either
 import           Data.Function
@@ -45,7 +46,7 @@ import           Cardano.Api.Modes
 -- In order to make pipelining still possible we can explore the use of Selective Functors
 -- which would allow us to straddle both worlds.
 newtype LocalStateQueryExpr block point query r m a = LocalStateQueryExpr
-  { runLocalStateQueryExpr :: ContT (Net.Query.ClientStAcquired block point query m r) m a
+  { runLocalStateQueryExpr :: ReaderT NodeToClientVersion (ContT (Net.Query.ClientStAcquired block point query m r) m) a
   } deriving (Functor, Applicative, Monad, MonadIO)
 
 -- | Execute a local state query expression.
@@ -63,7 +64,7 @@ executeLocalStateQueryExpr connectInfo mpoint f = do
     (\ntcVersion ->
       LocalNodeClientProtocols
       { localChainSyncClient    = NoLocalChainSyncClient
-      , localStateQueryClient   = Just $ setupLocalStateQueryExpr waitResult mpoint tmvResultLocalState (f ntcVersion)
+      , localStateQueryClient   = Just $ setupLocalStateQueryExpr waitResult mpoint tmvResultLocalState ntcVersion (f ntcVersion)
       , localTxSubmissionClient = Nothing
       , localTxMonitoringClient = Nothing
       }
@@ -79,12 +80,13 @@ setupLocalStateQueryExpr ::
      -- cause other incomplete protocols to abort which may lead to deadlock.
   -> Maybe ChainPoint
   -> TMVar (Either Net.Query.AcquireFailure a)
+  -> NodeToClientVersion
   -> LocalStateQueryExpr (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
   -> Net.Query.LocalStateQueryClient (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-setupLocalStateQueryExpr waitDone mPointVar' resultVar' f =
+setupLocalStateQueryExpr waitDone mPointVar' resultVar' ntcVersion f =
   LocalStateQueryClient . pure . Net.Query.SendMsgAcquire mPointVar' $
     Net.Query.ClientStAcquiring
-    { Net.Query.recvMsgAcquired = runContT (runLocalStateQueryExpr f) $ \result -> do
+    { Net.Query.recvMsgAcquired = runContT (runReaderT (runLocalStateQueryExpr f) ntcVersion) $ \result -> do
         atomically $ putTMVar resultVar' (Right result)
         void $ atomically waitDone -- Wait for all protocols to complete before exiting.
         pure $ Net.Query.SendMsgRelease $ pure $ Net.Query.SendMsgDone ()
@@ -98,7 +100,7 @@ setupLocalStateQueryExpr waitDone mPointVar' resultVar' f =
 -- | Use 'queryExpr' in a do block to construct monadic local state queries.
 queryExpr :: QueryInMode mode a -> LocalStateQueryExpr block point (QueryInMode mode) r IO a
 queryExpr q =
-  LocalStateQueryExpr . ContT $ \f -> pure $
+  LocalStateQueryExpr . ReaderT $ \_ -> ContT $ \f -> pure $
     Net.Query.SendMsgQuery q $
       Net.Query.ClientStQuerying
       { Net.Query.recvMsgResult = f