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

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

import           Control.Applicative
import           Control.Concurrent.STM
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Cont
import           Data.Bifunctor (first)
import           Data.Either
import           Data.Function
import           Data.Maybe
import           System.IO

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           Cardano.Api.Block
import           Cardano.Api.Eras
import           Cardano.Api.IPC
import           Cardano.Api.Modes


{- 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
  { LocalStateQueryExpr block point query r m a
-> ContT (ClientStAcquired block point query m r) m a
runLocalStateQueryExpr :: ContT (Net.Query.ClientStAcquired block point query m r) m a
  } deriving (a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
(a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
(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
<$ :: a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
$c<$ :: forall block point (query :: * -> *) r (m :: * -> *) a b.
a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
fmap :: (a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
$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
Functor, Functor (LocalStateQueryExpr block point query r m)
a -> LocalStateQueryExpr block point query r m a
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)
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m b
LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
LocalStateQueryExpr block point query r m (a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
(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. 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
<* :: LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m a
$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
*> :: 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 b
liftA2 :: (a -> b -> c)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
-> LocalStateQueryExpr block point query r m c
$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
<*> :: LocalStateQueryExpr block point query r m (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.
LocalStateQueryExpr block point query r m (a -> b)
-> LocalStateQueryExpr block point query r m a
-> LocalStateQueryExpr block point query r m b
pure :: a -> LocalStateQueryExpr block point query r m a
$cpure :: forall block point (query :: * -> *) r (m :: * -> *) a.
a -> LocalStateQueryExpr block point query r m a
$cp1Applicative :: forall block point (query :: * -> *) r (m :: * -> *).
Functor (LocalStateQueryExpr block point query r m)
Applicative, Applicative (LocalStateQueryExpr block point query r m)
a -> LocalStateQueryExpr block point query r m a
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)
LocalStateQueryExpr block point query r m a
-> (a -> LocalStateQueryExpr block point query r m b)
-> LocalStateQueryExpr block point query r m 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
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
return :: a -> LocalStateQueryExpr block point query r m a
$creturn :: forall block point (query :: * -> *) r (m :: * -> *) a.
a -> LocalStateQueryExpr block point query r m a
>> :: 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 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
-> (a -> LocalStateQueryExpr block point query r m b)
-> LocalStateQueryExpr block point query r m b
$cp1Monad :: forall block point (query :: * -> *) r (m :: * -> *).
Applicative (LocalStateQueryExpr block point query r m)
Monad, 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)
IO a -> LocalStateQueryExpr block point query r m a
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
liftIO :: IO a -> LocalStateQueryExpr block point query r m a
$cliftIO :: forall block point (query :: * -> *) r (m :: * -> *) a.
MonadIO m =>
IO a -> LocalStateQueryExpr block point query r m a
$cp1MonadIO :: forall block point (query :: * -> *) r (m :: * -> *).
MonadIO m =>
Monad (LocalStateQueryExpr block point query r m)
MonadIO)

-- | Execute a local state query expression.
executeLocalStateQueryExpr
  :: LocalNodeConnectInfo mode
  -> Maybe ChainPoint
  -> (NodeToClientVersion -> LocalStateQueryExpr (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
  -> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr :: LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
connectInfo Maybe ChainPoint
mpoint NodeToClientVersion
-> LocalStateQueryExpr
     (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
f = do
  TMVar (Either AcquireFailure a)
tmvResultLocalState <- IO (TMVar (Either AcquireFailure a))
forall a. IO (TMVar a)
newEmptyTMVarIO
  let waitResult :: STM (Either AcquireFailure a)
waitResult = TMVar (Either AcquireFailure a) -> STM (Either AcquireFailure a)
forall a. TMVar a -> STM a
readTMVar TMVar (Either AcquireFailure a)
tmvResultLocalState

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

  (AcquireFailure -> AcquiringFailure)
-> Either AcquireFailure a -> Either AcquiringFailure a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> AcquiringFailure
toAcquiringFailure (Either AcquireFailure a -> Either AcquiringFailure a)
-> IO (Either AcquireFailure a) -> IO (Either AcquiringFailure a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (Either AcquireFailure a) -> IO (Either AcquireFailure a)
forall a. STM a -> IO a
atomically STM (Either AcquireFailure 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.
  -> Maybe ChainPoint
  -> TMVar (Either Net.Query.AcquireFailure a)
  -> LocalStateQueryExpr (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
  -> Net.Query.LocalStateQueryClient (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
setupLocalStateQueryExpr :: STM x
-> Maybe ChainPoint
-> TMVar (Either AcquireFailure a)
-> LocalStateQueryExpr
     (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
setupLocalStateQueryExpr STM x
waitDone Maybe ChainPoint
mPointVar' TMVar (Either AcquireFailure a)
resultVar' LocalStateQueryExpr
  (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
f =
  IO
  (ClientStIdle
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall block point (query :: * -> *) (m :: * -> *) a.
m (ClientStIdle block point query m a)
-> LocalStateQueryClient block point query m a
LocalStateQueryClient (IO
   (ClientStIdle
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
 -> LocalStateQueryClient
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> (ClientStAcquiring
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
    -> IO
         (ClientStIdle
            (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> ClientStAcquiring
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientStIdle (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
 -> IO
      (ClientStIdle
         (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> (ClientStAcquiring
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
    -> ClientStIdle
         (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> ClientStAcquiring
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ChainPoint
-> ClientStAcquiring
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> ClientStIdle
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall point block (query :: * -> *) (m :: * -> *) a.
Maybe point
-> ClientStAcquiring block point query m a
-> ClientStIdle block point query m a
Net.Query.SendMsgAcquire Maybe ChainPoint
mPointVar' (ClientStAcquiring
   (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
 -> LocalStateQueryClient
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> ClientStAcquiring
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall a b. (a -> b) -> a -> b
$
    ClientStAcquiring :: forall block point (query :: * -> *) (m :: * -> *) a.
m (ClientStAcquired block point query m a)
-> (AcquireFailure -> m (ClientStIdle block point query m a))
-> ClientStAcquiring block point query m a
Net.Query.ClientStAcquiring
    { recvMsgAcquired :: IO
  (ClientStAcquired
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
Net.Query.recvMsgAcquired = ContT
  (ClientStAcquired
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
  IO
  a
-> (a
    -> IO
         (ClientStAcquired
            (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> IO
     (ClientStAcquired
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT (LocalStateQueryExpr
  (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
-> ContT
     (ClientStAcquired
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
     IO
     a
forall block point (query :: * -> *) r (m :: * -> *) a.
LocalStateQueryExpr block point query r m a
-> ContT (ClientStAcquired block point query m r) m a
runLocalStateQueryExpr LocalStateQueryExpr
  (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
f) ((a
  -> IO
       (ClientStAcquired
          (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
 -> IO
      (ClientStAcquired
         (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> (a
    -> IO
         (ClientStAcquired
            (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> IO
     (ClientStAcquired
        (BlockInMode mode) ChainPoint (QueryInMode mode) 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 AcquireFailure a)
-> Either AcquireFailure a -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquireFailure a)
resultVar' (a -> Either AcquireFailure 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 mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStAcquired
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
 -> IO
      (ClientStAcquired
         (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> ClientStAcquired
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStAcquired
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall a b. (a -> b) -> a -> b
$ IO
  (ClientStIdle
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> ClientStAcquired
     (BlockInMode mode) ChainPoint (QueryInMode mode) 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 mode) ChainPoint (QueryInMode mode) IO ())
 -> ClientStAcquired
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> ClientStAcquired
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall a b. (a -> b) -> a -> b
$ ClientStIdle (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
 -> IO
      (ClientStIdle
         (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> ClientStIdle
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall a b. (a -> b) -> a -> b
$ ()
-> ClientStIdle
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
Net.Query.SendMsgDone ()

    , recvMsgFailure :: AcquireFailure
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) 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 AcquireFailure a)
-> Either AcquireFailure a -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquireFailure a)
resultVar' (AcquireFailure -> Either AcquireFailure a
forall a b. a -> Either a b
Left 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 mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
 -> IO
      (ClientStIdle
         (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()))
-> ClientStIdle
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall a b. (a -> b) -> a -> b
$ ()
-> ClientStIdle
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
Net.Query.SendMsgDone ()
    }

-- | 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 :: QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr QueryInMode mode a
q =
  ContT (ClientStAcquired block point (QueryInMode mode) IO r) IO a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
forall block point (query :: * -> *) r (m :: * -> *) a.
ContT (ClientStAcquired block point query m r) m a
-> LocalStateQueryExpr block point query r m a
LocalStateQueryExpr (ContT (ClientStAcquired block point (QueryInMode mode) IO r) IO a
 -> LocalStateQueryExpr block point (QueryInMode mode) r IO a)
-> (((a
      -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
     -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
    -> ContT
         (ClientStAcquired block point (QueryInMode mode) IO r) IO a)
-> ((a
     -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
    -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
 -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
-> ContT
     (ClientStAcquired block point (QueryInMode mode) 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 mode) IO r))
  -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
 -> LocalStateQueryExpr block point (QueryInMode mode) r IO a)
-> ((a
     -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
    -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
forall a b. (a -> b) -> a -> b
$ \a -> IO (ClientStAcquired block point (QueryInMode mode) IO r)
f -> ClientStAcquired block point (QueryInMode mode) IO r
-> IO (ClientStAcquired block point (QueryInMode mode) IO r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired block point (QueryInMode mode) IO r
 -> IO (ClientStAcquired block point (QueryInMode mode) IO r))
-> ClientStAcquired block point (QueryInMode mode) IO r
-> IO (ClientStAcquired block point (QueryInMode mode) IO r)
forall a b. (a -> b) -> a -> b
$
    QueryInMode mode a
-> ClientStQuerying block point (QueryInMode mode) IO r a
-> ClientStAcquired block point (QueryInMode mode) 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 mode a
q (ClientStQuerying block point (QueryInMode mode) IO r a
 -> ClientStAcquired block point (QueryInMode mode) IO r)
-> ClientStQuerying block point (QueryInMode mode) IO r a
-> ClientStAcquired block point (QueryInMode mode) IO r
forall a b. (a -> b) -> a -> b
$
      ClientStQuerying :: forall block point (query :: * -> *) (m :: * -> *) a result.
(result -> m (ClientStAcquired block point query m a))
-> ClientStQuerying block point query m a result
Net.Query.ClientStQuerying
      { recvMsgResult :: a -> IO (ClientStAcquired block point (QueryInMode mode) IO r)
Net.Query.recvMsgResult = a -> IO (ClientStAcquired block point (QueryInMode mode) IO r)
f
      }

-- | A monad expression that determines what era the node is in.
determineEraExpr ::
     ConsensusModeParams mode
  -> LocalStateQueryExpr block point (QueryInMode mode) r IO AnyCardanoEra
determineEraExpr :: ConsensusModeParams mode
-> LocalStateQueryExpr
     block point (QueryInMode mode) r IO AnyCardanoEra
determineEraExpr ConsensusModeParams mode
cModeParams =
  case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
    ConsensusMode mode
ByronMode -> AnyCardanoEra
-> LocalStateQueryExpr
     block point (QueryInMode mode) r IO AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra
 -> LocalStateQueryExpr
      block point (QueryInMode mode) r IO AnyCardanoEra)
-> AnyCardanoEra
-> LocalStateQueryExpr
     block point (QueryInMode mode) r IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
    ConsensusMode mode
ShelleyMode -> AnyCardanoEra
-> LocalStateQueryExpr
     block point (QueryInMode mode) r IO AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra
 -> LocalStateQueryExpr
      block point (QueryInMode mode) r IO AnyCardanoEra)
-> AnyCardanoEra
-> LocalStateQueryExpr
     block point (QueryInMode mode) r IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
    ConsensusMode mode
CardanoMode -> QueryInMode CardanoMode AnyCardanoEra
-> LocalStateQueryExpr
     block point (QueryInMode CardanoMode) r IO AnyCardanoEra
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode CardanoMode AnyCardanoEra
 -> LocalStateQueryExpr
      block point (QueryInMode CardanoMode) r IO AnyCardanoEra)
-> QueryInMode CardanoMode AnyCardanoEra
-> LocalStateQueryExpr
     block point (QueryInMode CardanoMode) r IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode AnyCardanoEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyCardanoEra
QueryCurrentEra ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra