{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}

module Cardano.Api.IPC.Monad
  ( LocalStateQueryExpr
  , executeLocalStateQueryExpr
  , queryExpr
  )
where

import           Cardano.Api.Block
import           Cardano.Api.IPC
import           Cardano.Api.IPC.Version

import           Cardano.Ledger.Shelley.Scripts ()
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as Net.Query
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Net.Query

import           Control.Concurrent.STM
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           Control.Monad.Trans.Cont

{- HLINT ignore "Use const" -}
{- HLINT ignore "Use let" -}

-- | Monadic type for constructing local state query expressions.
--
-- Use 'queryExpr' in a do block to construct queries of this type and convert
-- the expression to a 'Net.Query.LocalStateQueryClient' with 'setupLocalStateQueryExpr'.
--
-- Some consideration was made to use Applicative instead of Monad as the abstraction in
-- order to support pipelining, but we actually have a fair amount of code where the next
-- query depends on the result of the former and therefore actually need Monad.
--
-- 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
  { forall block point (query :: * -> *) r (m :: * -> *) a.
LocalStateQueryExpr block point query r m a
-> ReaderT
     NodeToClientVersion
     (ContT (ClientStAcquired block point query m r) m)
     a
runLocalStateQueryExpr
      :: ReaderT NodeToClientVersion (ContT (Net.Query.ClientStAcquired block point query m r) m) a
  }
  deriving ((forall a b.
 (a -> b)
 -> LocalStateQueryExpr block point query r m a
 -> LocalStateQueryExpr block point query r m b)
-> (forall a b.
    a
    -> LocalStateQueryExpr block point query r m b
    -> LocalStateQueryExpr block point query r m a)
-> Functor (LocalStateQueryExpr block point query r m)
forall a b.
a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
forall a b.
(a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
forall block point (query :: * -> *) r (m :: * -> *) a b.
a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
forall block point (query :: * -> *) r (m :: * -> *) a b.
(a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall block point (query :: * -> *) r (m :: * -> *) a b.
(a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
fmap :: forall a b.
(a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
$c<$ :: forall block point (query :: * -> *) r (m :: * -> *) a b.
a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
<$ :: forall a b.
a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
Functor, Functor (LocalStateQueryExpr block point query r m)
Functor (LocalStateQueryExpr block point query r m) =>
(forall a. a -> LocalStateQueryExpr block point query r m a)
-> (forall a b.
    LocalStateQueryExpr block point query r m (a -> b)
    -> LocalStateQueryExpr block point query r m a
    -> LocalStateQueryExpr block point query r m b)
-> (forall a b c.
    (a -> b -> c)
    -> LocalStateQueryExpr block point query r m a
    -> LocalStateQueryExpr block point query r m b
    -> LocalStateQueryExpr block point query r m c)
-> (forall a b.
    LocalStateQueryExpr block point query r m a
    -> LocalStateQueryExpr block point query r m b
    -> LocalStateQueryExpr block point query r m b)
-> (forall a b.
    LocalStateQueryExpr block point query r m a
    -> LocalStateQueryExpr block point query r m b
    -> LocalStateQueryExpr block point query r m a)
-> Applicative (LocalStateQueryExpr block point query r m)
forall a. a -> LocalStateQueryExpr block point query r m a
forall a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
forall a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
forall a b.
LocalStateQueryExpr block point query r m (a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
forall a b c.
(a -> b -> c)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m c
forall block point (query :: * -> *) r (m :: * -> *).
Functor (LocalStateQueryExpr block point query r m)
forall block point (query :: * -> *) r (m :: * -> *) a.
a -> LocalStateQueryExpr block point query r m a
forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m (a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
forall block point (query :: * -> *) r (m :: * -> *) a b c.
(a -> b -> c)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall block point (query :: * -> *) r (m :: * -> *) a.
a -> LocalStateQueryExpr block point query r m a
pure :: forall a. a -> LocalStateQueryExpr block point query r m a
$c<*> :: forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m (a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
<*> :: forall a b.
LocalStateQueryExpr block point query r m (a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
$cliftA2 :: forall block point (query :: * -> *) r (m :: * -> *) a b c.
(a -> b -> c)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m c
liftA2 :: forall a b c.
(a -> b -> c)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m c
$c*> :: forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
*> :: forall a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
$c<* :: forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
<* :: forall a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
Applicative, Applicative (LocalStateQueryExpr block point query r m)
Applicative (LocalStateQueryExpr block point query r m) =>
(forall a b.
 LocalStateQueryExpr block point query r m a
 -> (a -> LocalStateQueryExpr block point query r m b)
 -> LocalStateQueryExpr block point query r m b)
-> (forall a b.
    LocalStateQueryExpr block point query r m a
    -> LocalStateQueryExpr block point query r m b
    -> LocalStateQueryExpr block point query r m b)
-> (forall a. a -> LocalStateQueryExpr block point query r m a)
-> Monad (LocalStateQueryExpr block point query r m)
forall a. a -> LocalStateQueryExpr block point query r m a
forall a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
forall a b.
LocalStateQueryExpr block point query r m a
-> (a -> LocalStateQueryExpr block point query r m b)
-> LocalStateQueryExpr block point query r m b
forall block point (query :: * -> *) r (m :: * -> *).
Applicative (LocalStateQueryExpr block point query r m)
forall block point (query :: * -> *) r (m :: * -> *) a.
a -> LocalStateQueryExpr block point query r m a
forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> (a -> LocalStateQueryExpr block point query r m b)
-> LocalStateQueryExpr block point query r m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> (a -> LocalStateQueryExpr block point query r m b)
-> LocalStateQueryExpr block point query r m b
>>= :: forall a b.
LocalStateQueryExpr block point query r m a
-> (a -> LocalStateQueryExpr block point query r m b)
-> LocalStateQueryExpr block point query r m b
$c>> :: forall block point (query :: * -> *) r (m :: * -> *) a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
>> :: forall a b.
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
$creturn :: forall block point (query :: * -> *) r (m :: * -> *) a.
a -> LocalStateQueryExpr block point query r m a
return :: forall a. a -> LocalStateQueryExpr block point query r m a
Monad, MonadReader NodeToClientVersion, Monad (LocalStateQueryExpr block point query r m)
Monad (LocalStateQueryExpr block point query r m) =>
(forall a. IO a -> LocalStateQueryExpr block point query r m a)
-> MonadIO (LocalStateQueryExpr block point query r m)
forall a. IO a -> LocalStateQueryExpr block point query r m a
forall block point (query :: * -> *) r (m :: * -> *).
MonadIO m =>
Monad (LocalStateQueryExpr block point query r m)
forall block point (query :: * -> *) r (m :: * -> *) a.
MonadIO m =>
IO a -> LocalStateQueryExpr block point query r m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall block point (query :: * -> *) r (m :: * -> *) a.
MonadIO m =>
IO a -> LocalStateQueryExpr block point query r m a
liftIO :: forall a. IO a -> LocalStateQueryExpr block point query r m a
MonadIO)

-- | Execute a local state query expression.
executeLocalStateQueryExpr
  :: ()
  => LocalNodeConnectInfo
  -> Net.Query.Target ChainPoint
  -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
  -> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr :: forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
connectInfo Target ChainPoint
target LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
f = do
  TMVar (Either AcquiringFailure a)
tmvResultLocalState <- IO (TMVar (Either AcquiringFailure a))
forall a. IO (TMVar a)
newEmptyTMVarIO
  let waitResult :: STM (Either AcquiringFailure a)
waitResult = TMVar (Either AcquiringFailure a)
-> STM (Either AcquiringFailure a)
forall a. TMVar a -> STM a
readTMVar TMVar (Either AcquiringFailure a)
tmvResultLocalState

  LocalNodeConnectInfo
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode) -> IO ()
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode) -> m ()
connectToLocalNodeWithVersion
    LocalNodeConnectInfo
connectInfo
    ( \NodeToClientVersion
ntcVersion ->
        LocalNodeClientProtocols
          { localChainSyncClient :: LocalChainSyncClient BlockInMode ChainPoint ChainTip IO
localChainSyncClient = LocalChainSyncClient BlockInMode ChainPoint ChainTip IO
forall block point tip (m :: * -> *).
LocalChainSyncClient block point tip m
NoLocalChainSyncClient
          , localStateQueryClient :: Maybe
  (LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ())
localStateQueryClient =
              LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
-> Maybe
     (LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ())
forall a. a -> Maybe a
Just (LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
 -> Maybe
      (LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()))
-> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
-> Maybe
     (LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ())
forall a b. (a -> b) -> a -> b
$ STM (Either AcquiringFailure a)
-> Target ChainPoint
-> TMVar (Either AcquiringFailure a)
-> NodeToClientVersion
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
forall x a.
STM x
-> Target ChainPoint
-> TMVar (Either AcquiringFailure a)
-> NodeToClientVersion
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
setupLocalStateQueryExpr STM (Either AcquiringFailure a)
waitResult Target ChainPoint
target TMVar (Either AcquiringFailure a)
tmvResultLocalState NodeToClientVersion
ntcVersion LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
f
          , localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     TxInMode TxValidationErrorInCardanoMode IO ())
localTxSubmissionClient = Maybe
  (LocalTxSubmissionClient
     TxInMode TxValidationErrorInCardanoMode IO ())
forall a. Maybe a
Nothing
          , localTxMonitoringClient :: Maybe (LocalTxMonitorClient TxIdInMode TxInMode SlotNo IO ())
localTxMonitoringClient = Maybe (LocalTxMonitorClient TxIdInMode TxInMode SlotNo IO ())
forall a. Maybe a
Nothing
          }
    )

  STM (Either AcquiringFailure a) -> IO (Either AcquiringFailure a)
forall a. STM a -> IO a
atomically STM (Either AcquiringFailure a)
waitResult

-- | Use 'queryExpr' in a do block to construct monadic local state queries.
setupLocalStateQueryExpr
  :: STM x
  -- ^ An STM expression that only returns when all protocols are complete.
  -- Protocols must wait until 'waitDone' returns because premature exit will
  -- cause other incomplete protocols to abort which may lead to deadlock.
  -> Net.Query.Target ChainPoint
  -> TMVar (Either AcquiringFailure a)
  -> NodeToClientVersion
  -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
  -> Net.Query.LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
setupLocalStateQueryExpr :: forall x a.
STM x
-> Target ChainPoint
-> TMVar (Either AcquiringFailure a)
-> NodeToClientVersion
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
setupLocalStateQueryExpr STM x
waitDone Target ChainPoint
mPointVar' TMVar (Either AcquiringFailure a)
resultVar' NodeToClientVersion
ntcVersion LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
f =
  IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
-> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
forall block point (query :: * -> *) (m :: * -> *) a.
m (ClientStIdle block point query m a)
-> LocalStateQueryClient block point query m a
LocalStateQueryClient (IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
 -> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ())
-> (ClientStAcquiring BlockInMode ChainPoint QueryInMode IO ()
    -> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ()))
-> ClientStAcquiring BlockInMode ChainPoint QueryInMode IO ()
-> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
 -> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ()))
-> (ClientStAcquiring BlockInMode ChainPoint QueryInMode IO ()
    -> ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
-> ClientStAcquiring BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target ChainPoint
-> ClientStAcquiring BlockInMode ChainPoint QueryInMode IO ()
-> ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
forall point block (query :: * -> *) (m :: * -> *) a.
Target point
-> ClientStAcquiring block point query m a
-> ClientStIdle block point query m a
Net.Query.SendMsgAcquire Target ChainPoint
mPointVar' (ClientStAcquiring BlockInMode ChainPoint QueryInMode IO ()
 -> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ())
-> ClientStAcquiring BlockInMode ChainPoint QueryInMode IO ()
-> LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
forall a b. (a -> b) -> a -> b
$
    Net.Query.ClientStAcquiring
      { recvMsgAcquired :: IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ())
Net.Query.recvMsgAcquired = ContT
  (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()) IO a
-> (a
    -> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()))
-> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ())
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (ReaderT
  NodeToClientVersion
  (ContT
     (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()) IO)
  a
-> NodeToClientVersion
-> ContT
     (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()) IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> ReaderT
     NodeToClientVersion
     (ContT
        (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()) IO)
     a
forall block point (query :: * -> *) r (m :: * -> *) a.
LocalStateQueryExpr block point query r m a
-> ReaderT
     NodeToClientVersion
     (ContT (ClientStAcquired block point query m r) m)
     a
runLocalStateQueryExpr LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
f) NodeToClientVersion
ntcVersion) ((a
  -> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()))
 -> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()))
-> (a
    -> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()))
-> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ())
forall a b. (a -> b) -> a -> b
$ \a
result -> do
          STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar (Either AcquiringFailure a)
-> Either AcquiringFailure a -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquiringFailure a)
resultVar' (a -> Either AcquiringFailure a
forall a b. b -> Either a b
Right a
result)
          IO x -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO x -> IO ()) -> IO x -> IO ()
forall a b. (a -> b) -> a -> b
$ STM x -> IO x
forall a. STM a -> IO a
atomically STM x
waitDone -- Wait for all protocols to complete before exiting.
          ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()
 -> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()))
-> ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStAcquired BlockInMode ChainPoint QueryInMode IO ())
forall a b. (a -> b) -> a -> b
$ IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
-> ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()
forall (m :: * -> *) block point (query :: * -> *) a.
m (ClientStIdle block point query m a)
-> ClientStAcquired block point query m a
Net.Query.SendMsgRelease (IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
 -> ClientStAcquired BlockInMode ChainPoint QueryInMode IO ())
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
-> ClientStAcquired BlockInMode ChainPoint QueryInMode IO ()
forall a b. (a -> b) -> a -> b
$ ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
 -> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ()))
-> ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
Net.Query.SendMsgDone ()
      , recvMsgFailure :: AcquireFailure
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
Net.Query.recvMsgFailure = \AcquireFailure
failure -> do
          STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar (Either AcquiringFailure a)
-> Either AcquiringFailure a -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquiringFailure a)
resultVar' (AcquiringFailure -> Either AcquiringFailure a
forall a b. a -> Either a b
Left (AcquireFailure -> AcquiringFailure
toAcquiringFailure AcquireFailure
failure))
          IO x -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO x -> IO ()) -> IO x -> IO ()
forall a b. (a -> b) -> a -> b
$ STM x -> IO x
forall a. STM a -> IO a
atomically STM x
waitDone -- Wait for all protocols to complete before exiting.
          ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
 -> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ()))
-> ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
-> IO (ClientStIdle BlockInMode ChainPoint QueryInMode IO ())
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle BlockInMode ChainPoint QueryInMode IO ()
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
Net.Query.SendMsgDone ()
      }

-- | Get the node server's Node-to-Client version.
getNtcVersion :: LocalStateQueryExpr block point QueryInMode r IO NodeToClientVersion
getNtcVersion :: forall block point r.
LocalStateQueryExpr
  block point QueryInMode r IO NodeToClientVersion
getNtcVersion = ReaderT
  NodeToClientVersion
  (ContT (ClientStAcquired block point QueryInMode IO r) IO)
  NodeToClientVersion
-> LocalStateQueryExpr
     block point QueryInMode r IO NodeToClientVersion
forall block point (query :: * -> *) r (m :: * -> *) a.
ReaderT
  NodeToClientVersion
  (ContT (ClientStAcquired block point query m r) m)
  a
-> LocalStateQueryExpr block point query r m a
LocalStateQueryExpr ReaderT
  NodeToClientVersion
  (ContT (ClientStAcquired block point QueryInMode IO r) IO)
  NodeToClientVersion
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Use 'queryExpr' in a do block to construct monadic local state queries.
queryExpr
  :: QueryInMode a
  -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr :: forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr QueryInMode a
q = do
  let minNtcVersion :: NodeToClientVersion
minNtcVersion = QueryInMode a -> NodeToClientVersion
forall a. NodeToClientVersionOf a => a -> NodeToClientVersion
nodeToClientVersionOf QueryInMode a
q
  NodeToClientVersion
ntcVersion <- LocalStateQueryExpr
  block point QueryInMode r IO NodeToClientVersion
forall block point r.
LocalStateQueryExpr
  block point QueryInMode r IO NodeToClientVersion
getNtcVersion
  if NodeToClientVersion
ntcVersion NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
minNtcVersion
    then (a -> Either UnsupportedNtcVersionError a)
-> LocalStateQueryExpr block point QueryInMode r IO a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
forall a b.
(a -> b)
-> LocalStateQueryExpr block point QueryInMode r IO a
-> LocalStateQueryExpr block point QueryInMode r IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either UnsupportedNtcVersionError a
forall a b. b -> Either a b
Right (LocalStateQueryExpr block point QueryInMode r IO a
 -> LocalStateQueryExpr
      block point QueryInMode r IO (Either UnsupportedNtcVersionError a))
-> ((NodeToClientVersion
     -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
    -> LocalStateQueryExpr block point QueryInMode r IO a)
-> (NodeToClientVersion
    -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  NodeToClientVersion
  (ContT (ClientStAcquired block point QueryInMode IO r) IO)
  a
-> LocalStateQueryExpr block point QueryInMode r IO a
forall block point (query :: * -> *) r (m :: * -> *) a.
ReaderT
  NodeToClientVersion
  (ContT (ClientStAcquired block point query m r) m)
  a
-> LocalStateQueryExpr block point query r m a
LocalStateQueryExpr (ReaderT
   NodeToClientVersion
   (ContT (ClientStAcquired block point QueryInMode IO r) IO)
   a
 -> LocalStateQueryExpr block point QueryInMode r IO a)
-> ((NodeToClientVersion
     -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
    -> ReaderT
         NodeToClientVersion
         (ContT (ClientStAcquired block point QueryInMode IO r) IO)
         a)
-> (NodeToClientVersion
    -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
-> LocalStateQueryExpr block point QueryInMode r IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeToClientVersion
 -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
-> ReaderT
     NodeToClientVersion
     (ContT (ClientStAcquired block point QueryInMode IO r) IO)
     a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((NodeToClientVersion
  -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
 -> LocalStateQueryExpr
      block point QueryInMode r IO (Either UnsupportedNtcVersionError a))
-> (NodeToClientVersion
    -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
_ -> ((a -> IO (ClientStAcquired block point QueryInMode IO r))
 -> IO (ClientStAcquired block point QueryInMode IO r))
-> ContT (ClientStAcquired block point QueryInMode IO r) IO a
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((a -> IO (ClientStAcquired block point QueryInMode IO r))
  -> IO (ClientStAcquired block point QueryInMode IO r))
 -> ContT (ClientStAcquired block point QueryInMode IO r) IO a)
-> ((a -> IO (ClientStAcquired block point QueryInMode IO r))
    -> IO (ClientStAcquired block point QueryInMode IO r))
-> ContT (ClientStAcquired block point QueryInMode IO r) IO a
forall a b. (a -> b) -> a -> b
$ \a -> IO (ClientStAcquired block point QueryInMode IO r)
f ->
      ClientStAcquired block point QueryInMode IO r
-> IO (ClientStAcquired block point QueryInMode IO r)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired block point QueryInMode IO r
 -> IO (ClientStAcquired block point QueryInMode IO r))
-> ClientStAcquired block point QueryInMode IO r
-> IO (ClientStAcquired block point QueryInMode IO r)
forall a b. (a -> b) -> a -> b
$
        QueryInMode a
-> ClientStQuerying block point QueryInMode IO r a
-> ClientStAcquired block point QueryInMode IO r
forall (query :: * -> *) result block point (m :: * -> *) a.
query result
-> ClientStQuerying block point query m a result
-> ClientStAcquired block point query m a
Net.Query.SendMsgQuery QueryInMode a
q (ClientStQuerying block point QueryInMode IO r a
 -> ClientStAcquired block point QueryInMode IO r)
-> ClientStQuerying block point QueryInMode IO r a
-> ClientStAcquired block point QueryInMode IO r
forall a b. (a -> b) -> a -> b
$
          Net.Query.ClientStQuerying
            { recvMsgResult :: a -> IO (ClientStAcquired block point QueryInMode IO r)
Net.Query.recvMsgResult = a -> IO (ClientStAcquired block point QueryInMode IO r)
f
            }
    else Either UnsupportedNtcVersionError a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
forall a. a -> LocalStateQueryExpr block point QueryInMode r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnsupportedNtcVersionError -> Either UnsupportedNtcVersionError a
forall a b. a -> Either a b
Left (NodeToClientVersion
-> NodeToClientVersion -> UnsupportedNtcVersionError
UnsupportedNtcVersionError NodeToClientVersion
minNtcVersion NodeToClientVersion
ntcVersion))