{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- The Shelley ledger uses promoted data kinds which we have to use, but we do
-- not export any from this API. We also use them unticked as nature intended.
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

-- | Node IPC protocols
--
module Cardano.Api.IPC (
    -- * Node interaction
    -- | Operations that involve talking to a local Cardano node.
    connectToLocalNode,
    connectToLocalNodeWithVersion,
    LocalNodeConnectInfo(..),
    localConsensusMode,
    LocalNodeClientProtocols(..),
    LocalChainSyncClient(..),
    LocalNodeClientProtocolsInMode,

    -- ** Modes
    -- | TODO move to Cardano.Api
    ByronMode,
    ShelleyMode,
    CardanoMode,
    ConsensusModeParams(..),
    EpochSlots(..),

--  connectToRemoteNode,

    -- *** Chain sync protocol
    ChainSyncClient(..),
    ChainSyncClientPipelined(..),
    BlockInMode(..),

    -- *** Local tx submission
    LocalTxSubmissionClient(..),
    TxInMode(..),
    TxValidationErrorInMode(..),
    TxValidationError,
    submitTxToNodeLocal,
    SubmitResult(..),

    -- *** Local state query
    LocalStateQueryClient(..),
    AcquireFailure(..),
    QueryInMode(..),
    QueryInEra(..),
    QueryInShelleyBasedEra(..),
    queryNodeLocalState,

    EraHistory(..),
    getProgress,

    -- *** Common queries
    getLocalChainTip,

    -- *** Helpers
    --TODO: These should be exported via Cardano.Api.Mode
    ConsensusMode(..),
    consensusModeOnly,

    NodeToClientVersion(..)
  ) where

import           Prelude

import           Data.Void (Void)

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map.Strict as Map

import           Control.Concurrent.STM
import           Control.Monad (void)
import           Control.Tracer (nullTracer)

import qualified Ouroboros.Network.Block as Net
import qualified Ouroboros.Network.Mux as Net
import           Ouroboros.Network.NodeToClient (NodeToClientProtocols (..),
                   NodeToClientVersionData (..))
import qualified Ouroboros.Network.NodeToClient as Net
import           Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..))
import           Ouroboros.Network.Protocol.ChainSync.Client as Net.Sync
import           Ouroboros.Network.Protocol.ChainSync.ClientPipelined as Net.SyncP
import           Ouroboros.Network.Protocol.LocalStateQuery.Client (LocalStateQueryClient (..))
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as Net.Query
import           Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..))
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Net.Query
import           Ouroboros.Network.Protocol.LocalTxSubmission.Client (LocalTxSubmissionClient (..),
                   SubmitResult (..))
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx
import           Ouroboros.Network.Util.ShowProxy (ShowProxy (..))

import qualified Ouroboros.Consensus.Block as Consensus
import qualified Ouroboros.Consensus.Ledger.Query as Consensus
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Consensus
import qualified Ouroboros.Consensus.Network.NodeToClient as Consensus
import qualified Ouroboros.Consensus.Node.NetworkProtocolVersion as Consensus
import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus
import qualified Ouroboros.Consensus.Node.Run as Consensus

import           Cardano.Api.Block
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Modes
import           Cardano.Api.NetworkId
import           Cardano.Api.Protocol.Types
import           Cardano.Api.Query
import           Cardano.Api.TxInMode


-- ----------------------------------------------------------------------------
-- The types for the client side of the node-to-client IPC protocols
--

-- | The protocols we can use with a local node. Use in conjunction with
-- 'connectToLocalNode'.
--
-- These protocols use the types from the rest of this API. The conversion
-- to\/from the types used by the underlying wire formats is handled by
-- 'connectToLocalNode'.
--
data LocalNodeClientProtocols block point tip tx txerr query m =
     LocalNodeClientProtocols {
       LocalNodeClientProtocols block point tip tx txerr query m
-> LocalChainSyncClient block point tip m
localChainSyncClient
         :: LocalChainSyncClient block point tip m

     , LocalNodeClientProtocols block point tip tx txerr query m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
localTxSubmissionClient
         :: Maybe (LocalTxSubmissionClient tx txerr          m ())

     , LocalNodeClientProtocols block point tip tx txerr query m
-> Maybe (LocalStateQueryClient block point query m ())
localStateQueryClient
         :: Maybe (LocalStateQueryClient   block point query m ())
     }

data LocalChainSyncClient block point tip m
  = NoLocalChainSyncClient
  | LocalChainSyncClientPipelined (ChainSyncClientPipelined block point tip   m ())
  | LocalChainSyncClient          (ChainSyncClient          block point tip   m ())

-- public, exported
type LocalNodeClientProtocolsInMode mode =
       LocalNodeClientProtocols
         (BlockInMode mode)
         ChainPoint
         ChainTip
         (TxInMode mode)
         (TxValidationErrorInMode mode)
         (QueryInMode mode)
         IO

data LocalNodeConnectInfo mode =
     LocalNodeConnectInfo {
       LocalNodeConnectInfo mode -> ConsensusModeParams mode
localConsensusModeParams :: ConsensusModeParams mode,
       LocalNodeConnectInfo mode -> NetworkId
localNodeNetworkId       :: NetworkId,
       LocalNodeConnectInfo mode -> FilePath
localNodeSocketPath      :: FilePath
     }

localConsensusMode :: LocalNodeConnectInfo mode -> ConsensusMode mode
localConsensusMode :: LocalNodeConnectInfo mode -> ConsensusMode mode
localConsensusMode LocalNodeConnectInfo {ConsensusModeParams mode
localConsensusModeParams :: ConsensusModeParams mode
localConsensusModeParams :: forall mode. LocalNodeConnectInfo mode -> ConsensusModeParams mode
localConsensusModeParams} =
    ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
localConsensusModeParams

consensusModeOnly :: ConsensusModeParams mode
                  -> ConsensusMode       mode
consensusModeOnly :: ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ByronModeParams{}   = ConsensusMode mode
ConsensusMode ByronMode
ByronMode
consensusModeOnly ShelleyModeParams{} = ConsensusMode mode
ConsensusMode ShelleyMode
ShelleyMode
consensusModeOnly CardanoModeParams{} = ConsensusMode mode
ConsensusMode CardanoMode
CardanoMode


-- ----------------------------------------------------------------------------
-- Actually connect to the node
--

-- | Establish a connection to a local node and execute the given set of
-- protocol handlers.
--
connectToLocalNode :: LocalNodeConnectInfo mode
                   -> LocalNodeClientProtocolsInMode mode
                   -> IO ()
connectToLocalNode :: LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
connectToLocalNode LocalNodeConnectInfo mode
localNodeConnectInfo LocalNodeClientProtocolsInMode mode
handlers
  = LocalNodeConnectInfo mode
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
-> IO ()
forall mode.
LocalNodeConnectInfo mode
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
-> IO ()
connectToLocalNodeWithVersion LocalNodeConnectInfo mode
localNodeConnectInfo (LocalNodeClientProtocolsInMode mode
-> NodeToClientVersion -> LocalNodeClientProtocolsInMode mode
forall a b. a -> b -> a
const LocalNodeClientProtocolsInMode mode
handlers)

-- | Establish a connection to a local node and execute the given set of
-- protocol handlers parameterized on the negotiated node-to-client protocol
-- version.
--
connectToLocalNodeWithVersion :: LocalNodeConnectInfo mode
                              -> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
                              -> IO ()
connectToLocalNodeWithVersion :: LocalNodeConnectInfo mode
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
-> IO ()
connectToLocalNodeWithVersion LocalNodeConnectInfo {
                     FilePath
localNodeSocketPath :: FilePath
localNodeSocketPath :: forall mode. LocalNodeConnectInfo mode -> FilePath
localNodeSocketPath,
                     NetworkId
localNodeNetworkId :: NetworkId
localNodeNetworkId :: forall mode. LocalNodeConnectInfo mode -> NetworkId
localNodeNetworkId,
                     ConsensusModeParams mode
localConsensusModeParams :: ConsensusModeParams mode
localConsensusModeParams :: forall mode. LocalNodeConnectInfo mode -> ConsensusModeParams mode
localConsensusModeParams
                   } NodeToClientVersion -> LocalNodeClientProtocolsInMode mode
clients =
    (IOManager -> IO ()) -> IO ()
WithIOManager
Net.withIOManager ((IOManager -> IO ()) -> IO ()) -> (IOManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOManager
iomgr ->
      LocalSnocket
-> NetworkConnectTracers LocalAddress NodeToClientVersion
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO () Void)
-> FilePath
-> IO ()
forall a b.
LocalSnocket
-> NetworkConnectTracers LocalAddress NodeToClientVersion
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO a b)
-> FilePath
-> IO ()
Net.connectTo
        (IOManager -> FilePath -> LocalSnocket
Net.localSnocket IOManager
iomgr FilePath
localNodeSocketPath)
        NetworkConnectTracers :: forall addr vNumber.
Tracer IO (WithMuxBearer (ConnectionId addr) MuxTrace)
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
-> NetworkConnectTracers addr vNumber
Net.NetworkConnectTracers {
          nctMuxTracer :: Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
Net.nctMuxTracer       = Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer,
          nctHandshakeTracer :: Tracer
  IO
  (WithMuxBearer
     (ConnectionId LocalAddress)
     (TraceSendRecv (Handshake NodeToClientVersion Term)))
Net.nctHandshakeTracer = Tracer
  IO
  (WithMuxBearer
     (ConnectionId LocalAddress)
     (TraceSendRecv (Handshake NodeToClientVersion Term)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        }
        Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication
     'InitiatorMode LocalAddress ByteString IO () Void)
versionedProtocls
        FilePath
localNodeSocketPath
  where
    versionedProtocls :: Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication
     'InitiatorMode LocalAddress ByteString IO () Void)
versionedProtocls =
      -- First convert from the mode-parametrised view of things to the
      -- block-parametrised view and then do the final setup for the versioned
      -- bundles of mini-protocols.
      case ConsensusModeParams mode
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
-> LocalNodeClientParams
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusModeParams mode
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
-> LocalNodeClientParams
mkLocalNodeClientParams ConsensusModeParams mode
localConsensusModeParams NodeToClientVersion -> LocalNodeClientProtocolsInMode mode
clients of
        LocalNodeClientParams ProtocolClientInfoArgs block
ptcl NodeToClientVersion -> LocalNodeClientProtocolsForBlock block
clients' ->
          NetworkId
-> ProtocolClientInfoArgs block
-> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO () Void)
forall block.
(ShowQuery (Query block), ProtocolClient block) =>
NetworkId
-> ProtocolClientInfoArgs block
-> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO () Void)
mkVersionedProtocols NetworkId
localNodeNetworkId ProtocolClientInfoArgs block
ptcl NodeToClientVersion -> LocalNodeClientProtocolsForBlock block
clients'


mkVersionedProtocols :: forall block.
                        ( Consensus.ShowQuery (Consensus.Query block),
                          ProtocolClient block
                        )
                     => NetworkId
                     -> ProtocolClientInfoArgs block
                     -> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
                     -> Net.Versions
                          Net.NodeToClientVersion
                          Net.NodeToClientVersionData
                          (Net.OuroborosApplication
                             Net.InitiatorMode
                             Net.LocalAddress
                             LBS.ByteString IO () Void)
mkVersionedProtocols :: NetworkId
-> ProtocolClientInfoArgs block
-> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO () Void)
mkVersionedProtocols NetworkId
networkid ProtocolClientInfoArgs block
ptcl NodeToClientVersion -> LocalNodeClientProtocolsForBlock block
unversionedClients =
     --TODO: really we should construct specific combinations of
     -- protocols for the versions we know about, with different protocol
     -- versions taking different sets of typed client protocols.
    ((NodeToClientVersion, BlockNodeToClientVersion block)
 -> Versions
      NodeToClientVersion
      NodeToClientVersionData
      (OuroborosApplication
         'InitiatorMode LocalAddress ByteString IO () Void))
-> [(NodeToClientVersion, BlockNodeToClientVersion block)]
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO () Void)
forall vNum (f :: * -> *) x extra r.
(Ord vNum, Foldable f, HasCallStack) =>
(x -> Versions vNum extra r) -> f x -> Versions vNum extra r
Net.foldMapVersions
      (\(NodeToClientVersion
ptclVersion, BlockNodeToClientVersion block
ptclBlockVersion) ->
          NodeToClientVersion
-> NodeToClientVersionData
-> (ConnectionId LocalAddress
    -> STM IO ControlMessage
    -> NodeToClientProtocols 'InitiatorMode ByteString IO () Void)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO () Void)
forall (m :: * -> *) (appType :: MuxMode) bytes a b.
NodeToClientVersion
-> NodeToClientVersionData
-> (ConnectionId LocalAddress
    -> STM m ControlMessage
    -> NodeToClientProtocols appType bytes m a b)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication appType LocalAddress bytes m a b)
Net.versionedNodeToClientProtocols
            NodeToClientVersion
ptclVersion
            NodeToClientVersionData :: NetworkMagic -> NodeToClientVersionData
NodeToClientVersionData {
              networkMagic :: NetworkMagic
networkMagic = NetworkId -> NetworkMagic
toNetworkMagic NetworkId
networkid
            }
            (\ConnectionId LocalAddress
_connid STM IO ControlMessage
_ctl -> LocalNodeClientProtocolsForBlock block
-> BlockNodeToClientVersion block
-> NodeToClientVersion
-> NodeToClientProtocols 'InitiatorMode ByteString IO () Void
protocols (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block
unversionedClients NodeToClientVersion
ptclVersion) BlockNodeToClientVersion block
ptclBlockVersion NodeToClientVersion
ptclVersion))
      (Map NodeToClientVersion (BlockNodeToClientVersion block)
-> [(NodeToClientVersion, BlockNodeToClientVersion block)]
forall k a. Map k a -> [(k, a)]
Map.toList (Proxy block
-> Map NodeToClientVersion (BlockNodeToClientVersion block)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
Consensus.supportedNodeToClientVersions Proxy block
proxy))
  where
    proxy :: Proxy block
    proxy :: Proxy block
proxy = Proxy block
forall k (t :: k). Proxy t
Proxy

    protocols :: LocalNodeClientProtocolsForBlock block
              -> Consensus.BlockNodeToClientVersion block
              -> NodeToClientVersion
              -> NodeToClientProtocols Net.InitiatorMode LBS.ByteString IO () Void
    protocols :: LocalNodeClientProtocolsForBlock block
-> BlockNodeToClientVersion block
-> NodeToClientVersion
-> NodeToClientProtocols 'InitiatorMode ByteString IO () Void
protocols
      LocalNodeClientProtocolsForBlock {
        LocalChainSyncClient block (Point block) (Tip block) IO
localChainSyncClientForBlock :: forall block.
LocalNodeClientProtocolsForBlock block
-> LocalChainSyncClient block (Point block) (Tip block) IO
localChainSyncClientForBlock :: LocalChainSyncClient block (Point block) (Tip block) IO
localChainSyncClientForBlock,
        Maybe
  (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
localTxSubmissionClientForBlock :: forall block.
LocalNodeClientProtocolsForBlock block
-> Maybe
     (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
localTxSubmissionClientForBlock :: Maybe
  (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
localTxSubmissionClientForBlock,
        Maybe
  (LocalStateQueryClient block (Point block) (Query block) IO ())
localStateQueryClientForBlock :: forall block.
LocalNodeClientProtocolsForBlock block
-> Maybe
     (LocalStateQueryClient block (Point block) (Query block) IO ())
localStateQueryClientForBlock :: Maybe
  (LocalStateQueryClient block (Point block) (Query block) IO ())
localStateQueryClientForBlock
      }
      BlockNodeToClientVersion block
ptclBlockVersion
      NodeToClientVersion
ptclVersion =
        NodeToClientProtocols :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> NodeToClientProtocols appType bytes m a b
NodeToClientProtocols {
          localChainSyncProtocol :: RunMiniProtocol 'InitiatorMode ByteString IO () Void
localChainSyncProtocol =
            MuxPeer ByteString IO ()
-> RunMiniProtocol 'InitiatorMode ByteString IO () Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
Net.InitiatorProtocolOnly (MuxPeer ByteString IO ()
 -> RunMiniProtocol 'InitiatorMode ByteString IO () Void)
-> MuxPeer ByteString IO ()
-> RunMiniProtocol 'InitiatorMode ByteString IO () Void
forall a b. (a -> b) -> a -> b
$ case LocalChainSyncClient block (Point block) (Tip block) IO
localChainSyncClientForBlock of
              LocalChainSyncClient block (Point block) (Tip block) IO
NoLocalChainSyncClient
                -> Tracer
  IO (TraceSendRecv (ChainSync block (Point block) (Tip block)))
-> Codec
     (ChainSync block (Point block) (Tip block))
     DeserialiseFailure
     IO
     ByteString
-> Peer
     (ChainSync block (Point block) (Tip block)) 'AsClient 'StIdle IO ()
-> MuxPeer ByteString IO ()
forall (pr :: PeerRole) ps (st :: ps) failure bytes (m :: * -> *)
       a.
(Show failure, forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> MuxPeer bytes m a
Net.MuxPeer Tracer
  IO (TraceSendRecv (ChainSync block (Point block) (Tip block)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer Codec
  (ChainSync block (Point block) (Tip block))
  DeserialiseFailure
  IO
  ByteString
cChainSyncCodec Peer
  (ChainSync block (Point block) (Tip block)) 'AsClient 'StIdle IO ()
forall header point tip (m :: * -> *) a.
MonadTimer m =>
Peer (ChainSync header point tip) 'AsClient 'StIdle m a
Net.chainSyncPeerNull
              LocalChainSyncClient ChainSyncClient block (Point block) (Tip block) IO ()
client
                -> Tracer
  IO (TraceSendRecv (ChainSync block (Point block) (Tip block)))
-> Codec
     (ChainSync block (Point block) (Tip block))
     DeserialiseFailure
     IO
     ByteString
-> Peer
     (ChainSync block (Point block) (Tip block)) 'AsClient 'StIdle IO ()
-> MuxPeer ByteString IO ()
forall (pr :: PeerRole) ps (st :: ps) failure bytes (m :: * -> *)
       a.
(Show failure, forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> MuxPeer bytes m a
Net.MuxPeer
                      Tracer
  IO (TraceSendRecv (ChainSync block (Point block) (Tip block)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                      Codec
  (ChainSync block (Point block) (Tip block))
  DeserialiseFailure
  IO
  ByteString
cChainSyncCodec
                      (ChainSyncClient block (Point block) (Tip block) IO ()
-> Peer
     (ChainSync block (Point block) (Tip block)) 'AsClient 'StIdle IO ()
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
Net.Sync.chainSyncClientPeer ChainSyncClient block (Point block) (Tip block) IO ()
client)
              LocalChainSyncClientPipelined ChainSyncClientPipelined block (Point block) (Tip block) IO ()
clientPipelined
                -> Tracer
  IO (TraceSendRecv (ChainSync block (Point block) (Tip block)))
-> Codec
     (ChainSync block (Point block) (Tip block))
     DeserialiseFailure
     IO
     ByteString
-> PeerPipelined
     (ChainSync block (Point block) (Tip block)) 'AsClient 'StIdle IO ()
-> MuxPeer ByteString IO ()
forall (pr :: PeerRole) ps (st :: ps) failure bytes (m :: * -> *)
       a.
(Show failure, forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> PeerPipelined ps pr st m a
-> MuxPeer bytes m a
Net.MuxPeerPipelined
                      Tracer
  IO (TraceSendRecv (ChainSync block (Point block) (Tip block)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                      Codec
  (ChainSync block (Point block) (Tip block))
  DeserialiseFailure
  IO
  ByteString
cChainSyncCodec
                      (ChainSyncClientPipelined block (Point block) (Tip block) IO ()
-> PeerPipelined
     (ChainSync block (Point block) (Tip block)) 'AsClient 'StIdle IO ()
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClientPipelined header point tip m a
-> PeerPipelined (ChainSync header point tip) 'AsClient 'StIdle m a
Net.SyncP.chainSyncClientPeerPipelined ChainSyncClientPipelined block (Point block) (Tip block) IO ()
clientPipelined)

        , localTxSubmissionProtocol :: RunMiniProtocol 'InitiatorMode ByteString IO () Void
localTxSubmissionProtocol =
            MuxPeer ByteString IO ()
-> RunMiniProtocol 'InitiatorMode ByteString IO () Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
Net.InitiatorProtocolOnly (MuxPeer ByteString IO ()
 -> RunMiniProtocol 'InitiatorMode ByteString IO () Void)
-> MuxPeer ByteString IO ()
-> RunMiniProtocol 'InitiatorMode ByteString IO () Void
forall a b. (a -> b) -> a -> b
$
              Tracer
  IO
  (TraceSendRecv
     (LocalTxSubmission (GenTx block) (ApplyTxErr block)))
-> Codec
     (LocalTxSubmission (GenTx block) (ApplyTxErr block))
     DeserialiseFailure
     IO
     ByteString
-> Peer
     (LocalTxSubmission (GenTx block) (ApplyTxErr block))
     'AsClient
     'StIdle
     IO
     ()
-> MuxPeer ByteString IO ()
forall (pr :: PeerRole) ps (st :: ps) failure bytes (m :: * -> *)
       a.
(Show failure, forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> MuxPeer bytes m a
Net.MuxPeer
                Tracer
  IO
  (TraceSendRecv
     (LocalTxSubmission (GenTx block) (ApplyTxErr block)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                Codec
  (LocalTxSubmission (GenTx block) (ApplyTxErr block))
  DeserialiseFailure
  IO
  ByteString
cTxSubmissionCodec
                (Peer
  (LocalTxSubmission (GenTx block) (ApplyTxErr block))
  'AsClient
  'StIdle
  IO
  ()
-> (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ()
    -> Peer
         (LocalTxSubmission (GenTx block) (ApplyTxErr block))
         'AsClient
         'StIdle
         IO
         ())
-> Maybe
     (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
-> Peer
     (LocalTxSubmission (GenTx block) (ApplyTxErr block))
     'AsClient
     'StIdle
     IO
     ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Peer
  (LocalTxSubmission (GenTx block) (ApplyTxErr block))
  'AsClient
  'StIdle
  IO
  ()
forall tx reject (m :: * -> *) a.
MonadTimer m =>
Peer (LocalTxSubmission tx reject) 'AsClient 'StIdle m a
Net.localTxSubmissionPeerNull
                       LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ()
-> Peer
     (LocalTxSubmission (GenTx block) (ApplyTxErr block))
     'AsClient
     'StIdle
     IO
     ()
forall tx reject (m :: * -> *) a.
Monad m =>
LocalTxSubmissionClient tx reject m a
-> Peer (LocalTxSubmission tx reject) 'AsClient 'StIdle m a
Net.Tx.localTxSubmissionClientPeer
                       Maybe
  (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
localTxSubmissionClientForBlock)

        , localStateQueryProtocol :: RunMiniProtocol 'InitiatorMode ByteString IO () Void
localStateQueryProtocol =
            MuxPeer ByteString IO ()
-> RunMiniProtocol 'InitiatorMode ByteString IO () Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
Net.InitiatorProtocolOnly (MuxPeer ByteString IO ()
 -> RunMiniProtocol 'InitiatorMode ByteString IO () Void)
-> MuxPeer ByteString IO ()
-> RunMiniProtocol 'InitiatorMode ByteString IO () Void
forall a b. (a -> b) -> a -> b
$
              Tracer
  IO
  (TraceSendRecv (LocalStateQuery block (Point block) (Query block)))
-> Codec
     (LocalStateQuery block (Point block) (Query block))
     DeserialiseFailure
     IO
     ByteString
-> Peer
     (LocalStateQuery block (Point block) (Query block))
     'AsClient
     'StIdle
     IO
     ()
-> MuxPeer ByteString IO ()
forall (pr :: PeerRole) ps (st :: ps) failure bytes (m :: * -> *)
       a.
(Show failure, forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> MuxPeer bytes m a
Net.MuxPeer
                Tracer
  IO
  (TraceSendRecv (LocalStateQuery block (Point block) (Query block)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                Codec
  (LocalStateQuery block (Point block) (Query block))
  DeserialiseFailure
  IO
  ByteString
cStateQueryCodec
                (Peer
  (LocalStateQuery block (Point block) (Query block))
  'AsClient
  'StIdle
  IO
  ()
-> (LocalStateQueryClient block (Point block) (Query block) IO ()
    -> Peer
         (LocalStateQuery block (Point block) (Query block))
         'AsClient
         'StIdle
         IO
         ())
-> Maybe
     (LocalStateQueryClient block (Point block) (Query block) IO ())
-> Peer
     (LocalStateQuery block (Point block) (Query block))
     'AsClient
     'StIdle
     IO
     ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Peer
  (LocalStateQuery block (Point block) (Query block))
  'AsClient
  'StIdle
  IO
  ()
forall block point (query :: * -> *) (m :: * -> *) a.
MonadTimer m =>
Peer (LocalStateQuery block point query) 'AsClient 'StIdle m a
Net.localStateQueryPeerNull
                       LocalStateQueryClient block (Point block) (Query block) IO ()
-> Peer
     (LocalStateQuery block (Point block) (Query block))
     'AsClient
     'StIdle
     IO
     ()
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryClient block point query m a
-> Peer (LocalStateQuery block point query) 'AsClient 'StIdle m a
Net.Query.localStateQueryClientPeer
                       Maybe
  (LocalStateQueryClient block (Point block) (Query block) IO ())
localStateQueryClientForBlock)
        }
      where
        Consensus.Codecs {
          Codec
  (ChainSync block (Point block) (Tip block))
  DeserialiseFailure
  IO
  ByteString
cChainSyncCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ.
Codecs' blk serialisedBlk e m bCS bTX bSQ
-> Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
cChainSyncCodec :: Codec
  (ChainSync block (Point block) (Tip block))
  DeserialiseFailure
  IO
  ByteString
Consensus.cChainSyncCodec,
          Codec
  (LocalTxSubmission (GenTx block) (ApplyTxErr block))
  DeserialiseFailure
  IO
  ByteString
cTxSubmissionCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ.
Codecs' blk serialisedBlk e m bCS bTX bSQ
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cTxSubmissionCodec :: Codec
  (LocalTxSubmission (GenTx block) (ApplyTxErr block))
  DeserialiseFailure
  IO
  ByteString
Consensus.cTxSubmissionCodec,
          Codec
  (LocalStateQuery block (Point block) (Query block))
  DeserialiseFailure
  IO
  ByteString
cStateQueryCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ.
Codecs' blk serialisedBlk e m bCS bTX bSQ
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cStateQueryCodec :: Codec
  (LocalStateQuery block (Point block) (Query block))
  DeserialiseFailure
  IO
  ByteString
Consensus.cStateQueryCodec
        } = CodecConfig block
-> BlockNodeToClientVersion block
-> NodeToClientVersion
-> Codecs'
     block block DeserialiseFailure IO ByteString ByteString ByteString
forall (m :: * -> *) blk.
(MonadST m, SerialiseNodeToClientConstraints blk,
 ShowQuery (BlockQuery blk)) =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> ClientCodecs blk m
Consensus.clientCodecs CodecConfig block
codecConfig BlockNodeToClientVersion block
ptclBlockVersion NodeToClientVersion
ptclVersion

    codecConfig :: Consensus.CodecConfig block
    codecConfig :: CodecConfig block
codecConfig = ProtocolClientInfo block -> CodecConfig block
forall b. ProtocolClientInfo b -> CodecConfig b
Consensus.pClientInfoCodecConfig
                    (ProtocolClientInfoArgs block -> ProtocolClientInfo block
forall blk.
ProtocolClient blk =>
ProtocolClientInfoArgs blk -> ProtocolClientInfo blk
protocolClientInfo ProtocolClientInfoArgs block
ptcl)


-- | This type defines the boundary between the mode-parametrised style used in
-- this API and the block-parametrised style used by the underlying network
-- and consensus libraries.
--
-- This interface itself is in the block-parametrised style, with the block
-- type itself being an hidden\/existential type.
--
-- It bundles together all the necessary class instances, the consensus
-- protocol client identifier, and the set of client side mini-protocol
-- handlers for the node-to-client protocol.
--
data LocalNodeClientParams where
     LocalNodeClientParams
       :: (Consensus.SerialiseNodeToClientConstraints block,
           Consensus.SupportedNetworkProtocolVersion block,
           ShowProxy block, ShowProxy (Consensus.ApplyTxErr block),
           ShowProxy (Consensus.GenTx block), ShowProxy (Consensus.Query block),
           Consensus.ShowQuery (Consensus.Query block),
           ProtocolClient block
           )
       => ProtocolClientInfoArgs block
       -> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
       -> LocalNodeClientParams

data LocalNodeClientProtocolsForBlock block =
     LocalNodeClientProtocolsForBlock {
       LocalNodeClientProtocolsForBlock block
-> LocalChainSyncClient block (Point block) (Tip block) IO
localChainSyncClientForBlock
         :: LocalChainSyncClient  block
                                  (Consensus.Point block)
                                  (Net.Tip         block)
                                   IO

     , LocalNodeClientProtocolsForBlock block
-> Maybe
     (LocalStateQueryClient block (Point block) (Query block) IO ())
localStateQueryClientForBlock
         :: Maybe (LocalStateQueryClient  block
                                         (Consensus.Point block)
                                         (Consensus.Query block)
                                          IO ())

     , LocalNodeClientProtocolsForBlock block
-> Maybe
     (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
localTxSubmissionClientForBlock
         :: Maybe (LocalTxSubmissionClient (Consensus.GenTx      block)
                                           (Consensus.ApplyTxErr block)
                                            IO ())
     }


-- | Convert from the mode-parametrised style to the block-parametrised style.
--
mkLocalNodeClientParams :: forall mode block.
                           ConsensusBlockForMode mode ~ block
                        => ConsensusModeParams mode
                        -> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
                        -> LocalNodeClientParams
mkLocalNodeClientParams :: ConsensusModeParams mode
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
-> LocalNodeClientParams
mkLocalNodeClientParams ConsensusModeParams mode
modeparams NodeToClientVersion -> LocalNodeClientProtocolsInMode mode
clients =
    -- For each of the possible consensus modes we pick the concrete block type
    -- (by picking the appropriate 'ProtocolClient' value).
    --
    -- Though it is not immediately visible, this point where we use
    -- 'LocalNodeClientParams' is also where we pick up the necessary class
    -- instances. This works because in each case we have a monomorphic block
    -- type and the instances are all in scope. This is why the use of
    -- LocalNodeClientParams is repeated within each branch of the case:
    -- because it is only within each branch that the GADT match makes the
    -- block type monomorphic.
    --
    case ConsensusModeParams mode
modeparams of
      ByronModeParams EpochSlots
epochSlots ->
        ProtocolClientInfoArgs ByronBlockHFC
-> (NodeToClientVersion
    -> LocalNodeClientProtocolsForBlock ByronBlockHFC)
-> LocalNodeClientParams
forall block.
(SerialiseNodeToClientConstraints block,
 SupportedNetworkProtocolVersion block, ShowProxy block,
 ShowProxy (ApplyTxErr block), ShowProxy (GenTx block),
 ShowProxy (Query block), ShowQuery (Query block),
 ProtocolClient block) =>
ProtocolClientInfoArgs block
-> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
-> LocalNodeClientParams
LocalNodeClientParams
          (EpochSlots -> ProtocolClientInfoArgs ByronBlockHFC
ProtocolClientInfoArgsByron EpochSlots
epochSlots)
          (ConsensusMode ByronMode
-> LocalNodeClientProtocolsInMode ByronMode
-> LocalNodeClientProtocolsForBlock ByronBlockHFC
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode
-> LocalNodeClientProtocolsInMode mode
-> LocalNodeClientProtocolsForBlock block
convLocalNodeClientProtocols ConsensusMode ByronMode
ByronMode (LocalNodeClientProtocolsInMode ByronMode
 -> LocalNodeClientProtocolsForBlock ByronBlockHFC)
-> (NodeToClientVersion
    -> LocalNodeClientProtocolsInMode ByronMode)
-> NodeToClientVersion
-> LocalNodeClientProtocolsForBlock ByronBlockHFC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeToClientVersion -> LocalNodeClientProtocolsInMode mode
NodeToClientVersion -> LocalNodeClientProtocolsInMode ByronMode
clients)

      ConsensusModeParams mode
ShelleyModeParams ->
        ProtocolClientInfoArgs (ShelleyBlockHFC StandardShelley)
-> (NodeToClientVersion
    -> LocalNodeClientProtocolsForBlock
         (ShelleyBlockHFC StandardShelley))
-> LocalNodeClientParams
forall block.
(SerialiseNodeToClientConstraints block,
 SupportedNetworkProtocolVersion block, ShowProxy block,
 ShowProxy (ApplyTxErr block), ShowProxy (GenTx block),
 ShowProxy (Query block), ShowQuery (Query block),
 ProtocolClient block) =>
ProtocolClientInfoArgs block
-> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
-> LocalNodeClientParams
LocalNodeClientParams
          ProtocolClientInfoArgs (ShelleyBlockHFC StandardShelley)
ProtocolClientInfoArgsShelley
          (ConsensusMode ShelleyMode
-> LocalNodeClientProtocolsInMode ShelleyMode
-> LocalNodeClientProtocolsForBlock
     (ShelleyBlockHFC StandardShelley)
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode
-> LocalNodeClientProtocolsInMode mode
-> LocalNodeClientProtocolsForBlock block
convLocalNodeClientProtocols ConsensusMode ShelleyMode
ShelleyMode (LocalNodeClientProtocolsInMode ShelleyMode
 -> LocalNodeClientProtocolsForBlock
      (ShelleyBlockHFC StandardShelley))
-> (NodeToClientVersion
    -> LocalNodeClientProtocolsInMode ShelleyMode)
-> NodeToClientVersion
-> LocalNodeClientProtocolsForBlock
     (ShelleyBlockHFC StandardShelley)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeToClientVersion -> LocalNodeClientProtocolsInMode mode
NodeToClientVersion -> LocalNodeClientProtocolsInMode ShelleyMode
clients)

      CardanoModeParams EpochSlots
epochSlots ->
        ProtocolClientInfoArgs (CardanoBlock StandardCrypto)
-> (NodeToClientVersion
    -> LocalNodeClientProtocolsForBlock (CardanoBlock StandardCrypto))
-> LocalNodeClientParams
forall block.
(SerialiseNodeToClientConstraints block,
 SupportedNetworkProtocolVersion block, ShowProxy block,
 ShowProxy (ApplyTxErr block), ShowProxy (GenTx block),
 ShowProxy (Query block), ShowQuery (Query block),
 ProtocolClient block) =>
ProtocolClientInfoArgs block
-> (NodeToClientVersion -> LocalNodeClientProtocolsForBlock block)
-> LocalNodeClientParams
LocalNodeClientParams
          (EpochSlots -> ProtocolClientInfoArgs (CardanoBlock StandardCrypto)
ProtocolClientInfoArgsCardano EpochSlots
epochSlots)
          (ConsensusMode CardanoMode
-> LocalNodeClientProtocolsInMode CardanoMode
-> LocalNodeClientProtocolsForBlock (CardanoBlock StandardCrypto)
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode
-> LocalNodeClientProtocolsInMode mode
-> LocalNodeClientProtocolsForBlock block
convLocalNodeClientProtocols ConsensusMode CardanoMode
CardanoMode (LocalNodeClientProtocolsInMode CardanoMode
 -> LocalNodeClientProtocolsForBlock (CardanoBlock StandardCrypto))
-> (NodeToClientVersion
    -> LocalNodeClientProtocolsInMode CardanoMode)
-> NodeToClientVersion
-> LocalNodeClientProtocolsForBlock (CardanoBlock StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeToClientVersion -> LocalNodeClientProtocolsInMode mode
NodeToClientVersion -> LocalNodeClientProtocolsInMode CardanoMode
clients)


convLocalNodeClientProtocols :: forall mode block.
                                ConsensusBlockForMode mode ~ block
                             => ConsensusMode mode
                             -> LocalNodeClientProtocolsInMode mode
                             -> LocalNodeClientProtocolsForBlock block
convLocalNodeClientProtocols :: ConsensusMode mode
-> LocalNodeClientProtocolsInMode mode
-> LocalNodeClientProtocolsForBlock block
convLocalNodeClientProtocols
    ConsensusMode mode
mode
    LocalNodeClientProtocols {
      LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO
localChainSyncClient :: LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO
localChainSyncClient :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalNodeClientProtocols block point tip tx txerr query m
-> LocalChainSyncClient block point tip m
localChainSyncClient,
      Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
localTxSubmissionClient :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalNodeClientProtocols block point tip tx txerr query m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
localTxSubmissionClient,
      Maybe
  (LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
localStateQueryClient :: Maybe
  (LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
localStateQueryClient :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalNodeClientProtocols block point tip tx txerr query m
-> Maybe (LocalStateQueryClient block point query m ())
localStateQueryClient
    } =
    LocalNodeClientProtocolsForBlock :: forall block.
LocalChainSyncClient block (Point block) (Tip block) IO
-> Maybe
     (LocalStateQueryClient block (Point block) (Query block) IO ())
-> Maybe
     (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
-> LocalNodeClientProtocolsForBlock block
LocalNodeClientProtocolsForBlock {
      localChainSyncClientForBlock :: LocalChainSyncClient block (Point block) (Tip block) IO
localChainSyncClientForBlock    = case LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO
localChainSyncClient of
        LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO
NoLocalChainSyncClient -> LocalChainSyncClient block (Point block) (Tip block) IO
forall block point tip (m :: * -> *).
LocalChainSyncClient block point tip m
NoLocalChainSyncClient
        LocalChainSyncClientPipelined ChainSyncClientPipelined
  (BlockInMode mode) ChainPoint ChainTip IO ()
clientPipelined -> ChainSyncClientPipelined block (Point block) (Tip block) IO ()
-> LocalChainSyncClient block (Point block) (Tip block) IO
forall block point tip (m :: * -> *).
ChainSyncClientPipelined block point tip m ()
-> LocalChainSyncClient block point tip m
LocalChainSyncClientPipelined (ChainSyncClientPipelined block (Point block) (Tip block) IO ()
 -> LocalChainSyncClient block (Point block) (Tip block) IO)
-> ChainSyncClientPipelined block (Point block) (Tip block) IO ()
-> LocalChainSyncClient block (Point block) (Tip block) IO
forall a b. (a -> b) -> a -> b
$ ConsensusMode mode
-> ChainSyncClientPipelined
     (BlockInMode mode) ChainPoint ChainTip IO ()
-> ChainSyncClientPipelined block (Point block) (Tip block) IO ()
forall mode block (m :: * -> *) a.
(ConsensusBlockForMode mode ~ block, Functor m) =>
ConsensusMode mode
-> ChainSyncClientPipelined
     (BlockInMode mode) ChainPoint ChainTip m a
-> ChainSyncClientPipelined block (Point block) (Tip block) m a
convLocalChainSyncClientPipelined ConsensusMode mode
mode ChainSyncClientPipelined
  (BlockInMode mode) ChainPoint ChainTip IO ()
clientPipelined
        LocalChainSyncClient ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
client -> ChainSyncClient block (Point block) (Tip block) IO ()
-> LocalChainSyncClient block (Point block) (Tip block) IO
forall block point tip (m :: * -> *).
ChainSyncClient block point tip m ()
-> LocalChainSyncClient block point tip m
LocalChainSyncClient (ChainSyncClient block (Point block) (Tip block) IO ()
 -> LocalChainSyncClient block (Point block) (Tip block) IO)
-> ChainSyncClient block (Point block) (Tip block) IO ()
-> LocalChainSyncClient block (Point block) (Tip block) IO
forall a b. (a -> b) -> a -> b
$ ConsensusMode mode
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
-> ChainSyncClient block (Point block) (Tip block) IO ()
forall mode block (m :: * -> *) a.
(ConsensusBlockForMode mode ~ block, Functor m) =>
ConsensusMode mode
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip m a
-> ChainSyncClient block (Point block) (Tip block) m a
convLocalChainSyncClient ConsensusMode mode
mode ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
client,

      localTxSubmissionClientForBlock :: Maybe
  (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
localTxSubmissionClientForBlock = ConsensusMode mode
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
-> LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ()
forall mode block (m :: * -> *) a.
(ConsensusBlockForMode mode ~ block, Functor m) =>
ConsensusMode mode
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) m a
-> LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) m a
convLocalTxSubmissionClient ConsensusMode mode
mode (LocalTxSubmissionClient
   (TxInMode mode) (TxValidationErrorInMode mode) IO ()
 -> LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
-> Maybe
     (LocalTxSubmissionClient
        (TxInMode mode) (TxValidationErrorInMode mode) IO ())
-> Maybe
     (LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                          Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
localTxSubmissionClient,

      localStateQueryClientForBlock :: Maybe
  (LocalStateQueryClient block (Point block) (Query block) IO ())
localStateQueryClientForBlock   = ConsensusMode mode
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> LocalStateQueryClient block (Point block) (Query block) IO ()
forall mode block (m :: * -> *) a.
(ConsensusBlockForMode mode ~ block, Functor m) =>
ConsensusMode mode
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) m a
-> LocalStateQueryClient block (Point block) (Query block) m a
convLocalStateQueryClient ConsensusMode mode
mode (LocalStateQueryClient
   (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
 -> LocalStateQueryClient block (Point block) (Query block) IO ())
-> Maybe
     (LocalStateQueryClient
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> Maybe
     (LocalStateQueryClient block (Point block) (Query block) IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                          Maybe
  (LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
localStateQueryClient
    }


convLocalChainSyncClient
  :: forall mode block m a.
     (ConsensusBlockForMode mode ~ block, Functor m)
  => ConsensusMode mode
  -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip m a
  -> ChainSyncClient block (Net.Point block) (Net.Tip block) m a
convLocalChainSyncClient :: ConsensusMode mode
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip m a
-> ChainSyncClient block (Point block) (Tip block) m a
convLocalChainSyncClient ConsensusMode mode
mode =
    (ChainPoint -> Point block)
-> (Point block -> ChainPoint)
-> (block -> BlockInMode mode)
-> (Tip block -> ChainTip)
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip m a
-> ChainSyncClient block (Point block) (Tip block) m a
forall header header' point point' tip tip' (m :: * -> *) a.
Functor m =>
(point -> point')
-> (point' -> point)
-> (header' -> header)
-> (tip' -> tip)
-> ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
Net.Sync.mapChainSyncClient
      (ConsensusMode mode
-> ChainPoint -> Point (ConsensusBlockForMode mode)
forall mode.
ConsensusMode mode
-> ChainPoint -> Point (ConsensusBlockForMode mode)
toConsensusPointInMode ConsensusMode mode
mode)
      (ConsensusMode mode
-> Point (ConsensusBlockForMode mode) -> ChainPoint
forall mode.
ConsensusMode mode
-> Point (ConsensusBlockForMode mode) -> ChainPoint
fromConsensusPointInMode ConsensusMode mode
mode)
      (ConsensusMode mode -> block -> BlockInMode mode
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode -> block -> BlockInMode mode
fromConsensusBlock ConsensusMode mode
mode)
      (ConsensusMode mode -> Tip block -> ChainTip
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode -> Tip block -> ChainTip
fromConsensusTip ConsensusMode mode
mode)

convLocalChainSyncClientPipelined
  :: forall mode block m a.
     (ConsensusBlockForMode mode ~ block, Functor m)
  => ConsensusMode mode
  -> ChainSyncClientPipelined (BlockInMode mode) ChainPoint ChainTip m a
  -> ChainSyncClientPipelined block (Net.Point block) (Net.Tip block) m a
convLocalChainSyncClientPipelined :: ConsensusMode mode
-> ChainSyncClientPipelined
     (BlockInMode mode) ChainPoint ChainTip m a
-> ChainSyncClientPipelined block (Point block) (Tip block) m a
convLocalChainSyncClientPipelined ConsensusMode mode
mode =
  (ChainPoint -> Point block)
-> (Point block -> ChainPoint)
-> (block -> BlockInMode mode)
-> (Tip block -> ChainTip)
-> ChainSyncClientPipelined
     (BlockInMode mode) ChainPoint ChainTip m a
-> ChainSyncClientPipelined block (Point block) (Tip block) m a
forall header header' point point' tip tip' (m :: * -> *) a.
Functor m =>
(point -> point')
-> (point' -> point)
-> (header' -> header)
-> (tip' -> tip)
-> ChainSyncClientPipelined header point tip m a
-> ChainSyncClientPipelined header' point' tip' m a
mapChainSyncClientPipelined
    (ConsensusMode mode
-> ChainPoint -> Point (ConsensusBlockForMode mode)
forall mode.
ConsensusMode mode
-> ChainPoint -> Point (ConsensusBlockForMode mode)
toConsensusPointInMode ConsensusMode mode
mode)
    (ConsensusMode mode
-> Point (ConsensusBlockForMode mode) -> ChainPoint
forall mode.
ConsensusMode mode
-> Point (ConsensusBlockForMode mode) -> ChainPoint
fromConsensusPointInMode ConsensusMode mode
mode)
    (ConsensusMode mode -> block -> BlockInMode mode
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode -> block -> BlockInMode mode
fromConsensusBlock ConsensusMode mode
mode)
    (ConsensusMode mode -> Tip block -> ChainTip
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode -> Tip block -> ChainTip
fromConsensusTip ConsensusMode mode
mode)

convLocalTxSubmissionClient
  :: forall mode block m a.
     (ConsensusBlockForMode mode ~ block, Functor m)
  => ConsensusMode mode
  -> LocalTxSubmissionClient (TxInMode mode) (TxValidationErrorInMode mode) m a
  -> LocalTxSubmissionClient (Consensus.GenTx block)
                             (Consensus.ApplyTxErr block) m a
convLocalTxSubmissionClient :: ConsensusMode mode
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) m a
-> LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) m a
convLocalTxSubmissionClient ConsensusMode mode
mode =
    (TxInMode mode -> GenTx block)
-> (ApplyTxErr block -> TxValidationErrorInMode mode)
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) m a
-> LocalTxSubmissionClient (GenTx block) (ApplyTxErr block) m a
forall tx tx' reject reject' (m :: * -> *) a.
Functor m =>
(tx -> tx')
-> (reject' -> reject)
-> LocalTxSubmissionClient tx reject m a
-> LocalTxSubmissionClient tx' reject' m a
Net.Tx.mapLocalTxSubmissionClient
      TxInMode mode -> GenTx block
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
TxInMode mode -> GenTx block
toConsensusGenTx
      (ConsensusMode mode
-> ApplyTxErr block -> TxValidationErrorInMode mode
forall mode block.
(ConsensusBlockForMode mode ~ block) =>
ConsensusMode mode
-> ApplyTxErr block -> TxValidationErrorInMode mode
fromConsensusApplyTxErr ConsensusMode mode
mode)


convLocalStateQueryClient
  :: forall mode block m a.
     (ConsensusBlockForMode mode ~ block, Functor m)
  => ConsensusMode mode
  -> LocalStateQueryClient (BlockInMode mode) ChainPoint (QueryInMode mode) m a
  -> LocalStateQueryClient block (Consensus.Point block)
                           (Consensus.Query block) m a
convLocalStateQueryClient :: ConsensusMode mode
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) m a
-> LocalStateQueryClient block (Point block) (Query block) m a
convLocalStateQueryClient ConsensusMode mode
mode =
    (ChainPoint -> Point block)
-> (forall result. QueryInMode mode result -> Some (Query block))
-> (forall result result'.
    QueryInMode mode result
    -> Query block result' -> result' -> result)
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) m a
-> LocalStateQueryClient block (Point block) (Query block) m a
forall block block' point point' (query :: * -> *)
       (query' :: * -> *) (m :: * -> *) a.
Functor m =>
(point -> point')
-> (forall result. query result -> Some query')
-> (forall result result'.
    query result -> query' result' -> result' -> result)
-> LocalStateQueryClient block point query m a
-> LocalStateQueryClient block' point' query' m a
Net.Query.mapLocalStateQueryClient
      (ConsensusMode mode
-> ChainPoint -> Point (ConsensusBlockForMode mode)
forall mode.
ConsensusMode mode
-> ChainPoint -> Point (ConsensusBlockForMode mode)
toConsensusPointInMode ConsensusMode mode
mode)
      forall result. QueryInMode mode result -> Some (Query block)
forall mode block result.
(ConsensusBlockForMode mode ~ block) =>
QueryInMode mode result -> Some (Query block)
toConsensusQuery
      forall result result'.
QueryInMode mode result -> Query block result' -> result' -> result
forall mode block result result'.
(ConsensusBlockForMode mode ~ block) =>
QueryInMode mode result -> Query block result' -> result' -> result
fromConsensusQueryResult


-- ----------------------------------------------------------------------------
-- Wrappers for specific protocol use-cases
--

--TODO: change this query to be just a protocol client handler to be used with
-- connectToLocalNode. This would involve changing connectToLocalNode to be
-- able to return protocol handler results properly.

-- | Establish a connection to a node and execute a single query using the
-- local state query protocol.
--
queryNodeLocalState :: forall mode result.
                       LocalNodeConnectInfo mode
                    -> Maybe ChainPoint
                    -> QueryInMode mode result
                    -> IO (Either Net.Query.AcquireFailure result)
queryNodeLocalState :: LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo mode
connctInfo Maybe ChainPoint
mpoint QueryInMode mode result
query = do
    TMVar (Either AcquireFailure result)
resultVar <- IO (TMVar (Either AcquireFailure result))
forall a. IO (TMVar a)
newEmptyTMVarIO
    LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
forall mode.
LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
connectToLocalNode
      LocalNodeConnectInfo mode
connctInfo
      LocalNodeClientProtocols :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalChainSyncClient block point tip m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
-> Maybe (LocalStateQueryClient block point query m ())
-> LocalNodeClientProtocols block point tip tx 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 (Maybe ChainPoint
-> TMVar (Either AcquireFailure result)
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
singleQuery Maybe ChainPoint
mpoint TMVar (Either AcquireFailure result)
resultVar),
        localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
localTxSubmissionClient = Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
forall a. Maybe a
Nothing
      }
    STM (Either AcquireFailure result)
-> IO (Either AcquireFailure result)
forall a. STM a -> IO a
atomically (TMVar (Either AcquireFailure result)
-> STM (Either AcquireFailure result)
forall a. TMVar a -> STM a
takeTMVar TMVar (Either AcquireFailure result)
resultVar)
  where
    singleQuery
      :: Maybe ChainPoint
      -> TMVar (Either Net.Query.AcquireFailure result)
      -> Net.Query.LocalStateQueryClient (BlockInMode mode) ChainPoint
                                         (QueryInMode mode) IO ()
    singleQuery :: Maybe ChainPoint
-> TMVar (Either AcquireFailure result)
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
singleQuery Maybe ChainPoint
mPointVar' TMVar (Either AcquireFailure result)
resultVar' =
      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 ())
-> IO
     (ClientStIdle
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
forall a b. (a -> b) -> a -> b
$ do
      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
$
        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 ()
 -> ClientStIdle
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> ClientStAcquiring
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
-> ClientStIdle
     (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 =
              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
$ QueryInMode mode result
-> ClientStQuerying
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO () result
-> ClientStAcquired
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
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 result
query (ClientStQuerying
   (BlockInMode mode) ChainPoint (QueryInMode mode) IO () result
 -> ClientStAcquired
      (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
-> ClientStQuerying
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO () result
-> ClientStAcquired
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ()
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 :: result
-> IO
     (ClientStAcquired
        (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
Net.Query.recvMsgResult = \result
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 result)
-> Either AcquireFailure result -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquireFailure result)
resultVar' (result -> Either AcquireFailure result
forall a b. b -> Either a b
Right result
result)

                    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 result)
-> Either AcquireFailure result -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either AcquireFailure result)
resultVar' (AcquireFailure -> Either AcquireFailure result
forall a b. a -> Either a b
Left AcquireFailure
failure)
              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 ()
          }

submitTxToNodeLocal :: forall mode.
                       LocalNodeConnectInfo mode
                    -> TxInMode mode
                    -> IO (Net.Tx.SubmitResult (TxValidationErrorInMode mode))
submitTxToNodeLocal :: LocalNodeConnectInfo mode
-> TxInMode mode
-> IO (SubmitResult (TxValidationErrorInMode mode))
submitTxToNodeLocal LocalNodeConnectInfo mode
connctInfo TxInMode mode
tx = do
    TMVar (SubmitResult (TxValidationErrorInMode mode))
resultVar <- IO (TMVar (SubmitResult (TxValidationErrorInMode mode)))
forall a. IO (TMVar a)
newEmptyTMVarIO
    LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
forall mode.
LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
connectToLocalNode
      LocalNodeConnectInfo mode
connctInfo
      LocalNodeClientProtocols :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalChainSyncClient block point tip m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
-> Maybe (LocalStateQueryClient block point query m ())
-> LocalNodeClientProtocols block point tip tx 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,
        localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
localTxSubmissionClient = LocalTxSubmissionClient
  (TxInMode mode) (TxValidationErrorInMode mode) IO ()
-> Maybe
     (LocalTxSubmissionClient
        (TxInMode mode) (TxValidationErrorInMode mode) IO ())
forall a. a -> Maybe a
Just (TMVar (SubmitResult (TxValidationErrorInMode mode))
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
localTxSubmissionClientSingle TMVar (SubmitResult (TxValidationErrorInMode mode))
resultVar),
        localStateQueryClient :: Maybe
  (LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
localStateQueryClient   = Maybe
  (LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall a. Maybe a
Nothing
      }
    STM (SubmitResult (TxValidationErrorInMode mode))
-> IO (SubmitResult (TxValidationErrorInMode mode))
forall a. STM a -> IO a
atomically (TMVar (SubmitResult (TxValidationErrorInMode mode))
-> STM (SubmitResult (TxValidationErrorInMode mode))
forall a. TMVar a -> STM a
takeTMVar TMVar (SubmitResult (TxValidationErrorInMode mode))
resultVar)
  where
    localTxSubmissionClientSingle
      :: TMVar (Net.Tx.SubmitResult (TxValidationErrorInMode mode))
      -> Net.Tx.LocalTxSubmissionClient (TxInMode mode)
                                        (TxValidationErrorInMode mode)
                                        IO ()
    localTxSubmissionClientSingle :: TMVar (SubmitResult (TxValidationErrorInMode mode))
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
localTxSubmissionClientSingle TMVar (SubmitResult (TxValidationErrorInMode mode))
resultVar =
      IO
  (LocalTxClientStIdle
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
forall tx reject (m :: * -> *) a.
m (LocalTxClientStIdle tx reject m a)
-> LocalTxSubmissionClient tx reject m a
LocalTxSubmissionClient (IO
   (LocalTxClientStIdle
      (TxInMode mode) (TxValidationErrorInMode mode) IO ())
 -> LocalTxSubmissionClient
      (TxInMode mode) (TxValidationErrorInMode mode) IO ())
-> IO
     (LocalTxClientStIdle
        (TxInMode mode) (TxValidationErrorInMode mode) IO ())
-> LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
forall a b. (a -> b) -> a -> b
$
        LocalTxClientStIdle
  (TxInMode mode) (TxValidationErrorInMode mode) IO ()
-> IO
     (LocalTxClientStIdle
        (TxInMode mode) (TxValidationErrorInMode mode) IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTxClientStIdle
   (TxInMode mode) (TxValidationErrorInMode mode) IO ()
 -> IO
      (LocalTxClientStIdle
         (TxInMode mode) (TxValidationErrorInMode mode) IO ()))
-> LocalTxClientStIdle
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
-> IO
     (LocalTxClientStIdle
        (TxInMode mode) (TxValidationErrorInMode mode) IO ())
forall a b. (a -> b) -> a -> b
$ TxInMode mode
-> (SubmitResult (TxValidationErrorInMode mode)
    -> IO
         (LocalTxClientStIdle
            (TxInMode mode) (TxValidationErrorInMode mode) IO ()))
-> LocalTxClientStIdle
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
forall tx reject (m :: * -> *) a.
tx
-> (SubmitResult reject -> m (LocalTxClientStIdle tx reject m a))
-> LocalTxClientStIdle tx reject m a
Net.Tx.SendMsgSubmitTx TxInMode mode
tx ((SubmitResult (TxValidationErrorInMode mode)
  -> IO
       (LocalTxClientStIdle
          (TxInMode mode) (TxValidationErrorInMode mode) IO ()))
 -> LocalTxClientStIdle
      (TxInMode mode) (TxValidationErrorInMode mode) IO ())
-> (SubmitResult (TxValidationErrorInMode mode)
    -> IO
         (LocalTxClientStIdle
            (TxInMode mode) (TxValidationErrorInMode mode) IO ()))
-> LocalTxClientStIdle
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
forall a b. (a -> b) -> a -> b
$ \SubmitResult (TxValidationErrorInMode mode)
result -> do
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar (SubmitResult (TxValidationErrorInMode mode))
-> SubmitResult (TxValidationErrorInMode mode) -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (SubmitResult (TxValidationErrorInMode mode))
resultVar SubmitResult (TxValidationErrorInMode mode)
result
        LocalTxClientStIdle
  (TxInMode mode) (TxValidationErrorInMode mode) IO ()
-> IO
     (LocalTxClientStIdle
        (TxInMode mode) (TxValidationErrorInMode mode) IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (()
-> LocalTxClientStIdle
     (TxInMode mode) (TxValidationErrorInMode mode) IO ()
forall a tx reject (m :: * -> *).
a -> LocalTxClientStIdle tx reject m a
Net.Tx.SendMsgDone ())

-- ----------------------------------------------------------------------------
-- Get tip as 'ChainPoint'
--


getLocalChainTip :: LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip :: LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip LocalNodeConnectInfo mode
localNodeConInfo = do
    TMVar ChainTip
resultVar <- IO (TMVar ChainTip)
forall a. IO (TMVar a)
newEmptyTMVarIO
    LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
forall mode.
LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
connectToLocalNode
      LocalNodeConnectInfo mode
localNodeConInfo
      LocalNodeClientProtocols :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalChainSyncClient block point tip m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
-> Maybe (LocalStateQueryClient block point query m ())
-> LocalNodeClientProtocols block point tip tx txerr query m
LocalNodeClientProtocols
        { localChainSyncClient :: LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO
localChainSyncClient = ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO
forall block point tip (m :: * -> *).
ChainSyncClient block point tip m ()
-> LocalChainSyncClient block point tip m
LocalChainSyncClient (ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
 -> LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO)
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO
forall a b. (a -> b) -> a -> b
$ TMVar ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall mode.
TMVar ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
chainSyncGetCurrentTip TMVar ChainTip
resultVar
        , localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
localTxSubmissionClient = Maybe
  (LocalTxSubmissionClient
     (TxInMode mode) (TxValidationErrorInMode mode) IO ())
forall a. Maybe a
Nothing
        , localStateQueryClient :: Maybe
  (LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
localStateQueryClient = Maybe
  (LocalStateQueryClient
     (BlockInMode mode) ChainPoint (QueryInMode mode) IO ())
forall a. Maybe a
Nothing
        }
    STM ChainTip -> IO ChainTip
forall a. STM a -> IO a
atomically (STM ChainTip -> IO ChainTip) -> STM ChainTip -> IO ChainTip
forall a b. (a -> b) -> a -> b
$ TMVar ChainTip -> STM ChainTip
forall a. TMVar a -> STM a
takeTMVar TMVar ChainTip
resultVar

chainSyncGetCurrentTip
  :: forall mode. TMVar ChainTip
  -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
chainSyncGetCurrentTip :: TMVar ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
chainSyncGetCurrentTip TMVar ChainTip
tipVar =
  IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
 -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ())
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
clientStIdle
 where
  clientStIdle :: Net.Sync.ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
  clientStIdle :: ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
clientStIdle =
    ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ())
-> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> m (ClientStNext header point tip m a)
-> ClientStIdle header point tip m a
Net.Sync.SendMsgRequestNext ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
clientStNext (ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
clientStNext)

  clientStNext :: Net.Sync.ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
  clientStNext :: ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
clientStNext = ClientStNext :: forall header point tip (m :: * -> *) a.
(header -> tip -> ChainSyncClient header point tip m a)
-> (point -> tip -> ChainSyncClient header point tip m a)
-> ClientStNext header point tip m a
Net.Sync.ClientStNext
    { recvMsgRollForward :: BlockInMode mode
-> ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
Net.Sync.recvMsgRollForward = \BlockInMode mode
_block ChainTip
tip -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
 -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ())
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ do
        IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar ChainTip -> ChainTip -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar ChainTip
tipVar ChainTip
tip
        ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
 -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()))
-> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
forall a header point tip (m :: * -> *).
a -> ClientStIdle header point tip m a
Net.Sync.SendMsgDone ()
    , recvMsgRollBackward :: ChainPoint
-> ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
Net.Sync.recvMsgRollBackward = \ChainPoint
_point ChainTip
tip -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
 -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ())
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ do
        IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar ChainTip -> ChainTip -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar ChainTip
tipVar ChainTip
tip
        ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
 -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()))
-> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
forall a header point tip (m :: * -> *).
a -> ClientStIdle header point tip m a
Net.Sync.SendMsgDone ()
    }