| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Cardano.Network.NodeToClient
Description
This is the starting point for a module that will bring together the overall node to client protocol, as a collection of mini-protocols.
Synopsis
- nodeToClientProtocols :: forall (appType :: Mode) addr bytes (m :: Type -> Type) a b. NodeToClientProtocols appType addr bytes m a b -> NodeToClientVersion -> NodeToClientVersionData -> OuroborosApplicationWithMinimalCtx appType addr bytes m a b
- data NodeToClientProtocols (appType :: Mode) ntcAddr bytes (m :: Type -> Type) a b = NodeToClientProtocols {
- localChainSyncProtocol :: RunMiniProtocolWithMinimalCtx appType ntcAddr bytes m a b
- localTxSubmissionProtocol :: RunMiniProtocolWithMinimalCtx appType ntcAddr bytes m a b
- localStateQueryProtocol :: RunMiniProtocolWithMinimalCtx appType ntcAddr bytes m a b
- localTxMonitorProtocol :: RunMiniProtocolWithMinimalCtx appType ntcAddr bytes m a b
- data NodeToClientVersion
- data NodeToClientVersionData = NodeToClientVersionData {
- networkMagic :: !NetworkMagic
- query :: !Bool
- data NetworkConnectTracers addr vNumber = NetworkConnectTracers {
- nctMuxTracers :: TracersWithBearer (ConnectionId addr) IO
- nctHandshakeTracer :: Tracer IO (WithBearer (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
- nullNetworkConnectTracers :: NetworkConnectTracers addr vNumber
- connectTo :: LocalSnocket -> NetworkConnectTracers LocalAddress NodeToClientVersion -> Versions NodeToClientVersion NodeToClientVersionData (OuroborosApplicationWithMinimalCtx 'InitiatorMode LocalAddress ByteString IO a Void) -> FilePath -> IO (Either SomeException a)
- connectToWithMux :: LocalSnocket -> NetworkConnectTracers LocalAddress NodeToClientVersion -> Versions NodeToClientVersion NodeToClientVersionData (OuroborosApplicationWithMinimalCtx 'InitiatorMode LocalAddress ByteString IO a b) -> FilePath -> (ConnectionId LocalAddress -> NodeToClientVersion -> NodeToClientVersionData -> OuroborosApplicationWithMinimalCtx 'InitiatorMode LocalAddress ByteString IO a b -> Mux 'InitiatorMode IO -> Async IO () -> IO x) -> IO x
- chainSyncPeerNull :: forall header point tip (m :: Type -> Type) a. MonadDelay m => Client (ChainSync header point tip) 'NonPipelined ('StIdle :: ChainSync header point tip) m a
- localStateQueryPeerNull :: forall block point (query :: Type -> Type) (m :: Type -> Type) a. MonadDelay m => Client (LocalStateQuery block point query) ('StIdle :: LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type) m a
- localTxSubmissionPeerNull :: forall tx reject (m :: Type -> Type) a. MonadDelay m => Client (LocalTxSubmission tx reject) 'NonPipelined ('StIdle :: LocalTxSubmission tx reject) m a
- localTxMonitorPeerNull :: forall txid tx slot (m :: Type -> Type) a. MonadDelay m => Client (LocalTxMonitor txid tx slot) 'NonPipelined ('StIdle :: LocalTxMonitor txid tx slot) m a
- newtype IOManager = IOManager {
- associateWithIOManager :: forall hole. hole -> IO ()
- type AssociateWithIOCP = IOManager
- withIOManager :: WithIOManager
- type LocalSnocket = Snocket IO LocalSocket LocalAddress
- localSnocket :: IOManager -> LocalSnocket
- newtype LocalSocket = LocalSocket {
- getLocalHandle :: LocalHandle
- newtype LocalAddress = LocalAddress {}
- type LocalConnectionId = ConnectionId LocalAddress
- newtype Versions vNum vData r = Versions {
- getVersions :: Map vNum (Version vData r)
- versionedNodeToClientProtocols :: forall (appType :: Mode) bytes (m :: Type -> Type) a b. NodeToClientVersion -> NodeToClientVersionData -> NodeToClientProtocols appType LocalAddress bytes m a b -> Versions NodeToClientVersion NodeToClientVersionData (OuroborosApplicationWithMinimalCtx appType LocalAddress bytes m a b)
- simpleSingletonVersions :: vNum -> vData -> (vData -> r) -> Versions vNum vData r
- foldMapVersions :: (Ord vNum, Foldable f, HasCallStack) => (x -> Versions vNum extra r) -> f x -> Versions vNum extra r
- combineVersions :: (Ord vNum, Foldable f, HasCallStack) => f (Versions vNum extra r) -> Versions vNum extra r
- nodeToClientHandshakeCodec :: forall (m :: Type -> Type). MonadST m => Codec (Handshake NodeToClientVersion Term) DeserialiseFailure m ByteString
- nodeToClientVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
- nodeToClientCodecCBORTerm :: NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
- data ConnectionId addr = ConnectionId {
- localAddress :: !addr
- remoteAddress :: !addr
- newtype MinimalInitiatorContext addr = MinimalInitiatorContext {
- micConnectionId :: ConnectionId addr
- newtype ResponderContext addr = ResponderContext {
- rcConnectionId :: ConnectionId addr
- data TraceSendRecv ps where
- TraceSendMsg :: forall ps. AnyMessage ps -> TraceSendRecv ps
- TraceRecvMsg :: forall ps. AnyMessage ps -> TraceSendRecv ps
- data ProtocolLimitFailure
- data Handshake (vNumber :: k) (vParams :: k1)
Documentation
nodeToClientProtocols :: forall (appType :: Mode) addr bytes (m :: Type -> Type) a b. NodeToClientProtocols appType addr bytes m a b -> NodeToClientVersion -> NodeToClientVersionData -> OuroborosApplicationWithMinimalCtx appType addr bytes m a b Source #
Make an OuroborosApplication for the bundle of mini-protocols that
make up the overall node-to-client protocol.
This function specifies the wire format protocol numbers as well as the
protocols that run for each NodeToClientVersion.
They are chosen to not overlap with the node to node protocol numbers. This is not essential for correctness, but is helpful to allow a single shared implementation of tools that can analyse both protocols, e.g. wireshark plugins.
data NodeToClientProtocols (appType :: Mode) ntcAddr bytes (m :: Type -> Type) a b Source #
Record of node-to-client mini protocols.
Constructors
| NodeToClientProtocols | |
Fields
| |
data NodeToClientVersion #
Constructors
| NodeToClientV_16 | |
| NodeToClientV_17 | |
| NodeToClientV_18 | |
| NodeToClientV_19 | |
| NodeToClientV_20 | |
| NodeToClientV_21 | |
| NodeToClientV_22 | |
| NodeToClientV_23 |
Instances
data NodeToClientVersionData #
Constructors
| NodeToClientVersionData | |
Fields
| |
Instances
| Show NodeToClientVersionData | |
Defined in Cardano.Network.NodeToClient.Version Methods showsPrec :: Int -> NodeToClientVersionData -> ShowS # show :: NodeToClientVersionData -> String # showList :: [NodeToClientVersionData] -> ShowS # | |
| Eq NodeToClientVersionData | |
Defined in Cardano.Network.NodeToClient.Version Methods (==) :: NodeToClientVersionData -> NodeToClientVersionData -> Bool # (/=) :: NodeToClientVersionData -> NodeToClientVersionData -> Bool # | |
| Acceptable NodeToClientVersionData | |
Defined in Cardano.Network.NodeToClient.Version Methods acceptableVersion :: NodeToClientVersionData -> NodeToClientVersionData -> Accept NodeToClientVersionData | |
| Queryable NodeToClientVersionData | |
Defined in Cardano.Network.NodeToClient.Version Methods | |
data NetworkConnectTracers addr vNumber #
Constructors
| NetworkConnectTracers | |
Fields
| |
nullNetworkConnectTracers :: NetworkConnectTracers addr vNumber #
Arguments
| :: LocalSnocket | callback constructed by |
| -> NetworkConnectTracers LocalAddress NodeToClientVersion | |
| -> Versions NodeToClientVersion NodeToClientVersionData (OuroborosApplicationWithMinimalCtx 'InitiatorMode LocalAddress ByteString IO a Void) | A dictionary of protocol versions & applications to run on an established connection. The application to run will be chosen by initial handshake protocol (the highest shared version will be chosen). |
| -> FilePath | path of the unix socket or named pipe |
| -> IO (Either SomeException a) |
A specialised version of connectToNode. It is
a general purpose function which can connect using any version of the
protocol. This is mostly useful for future enhancements.
Arguments
| :: LocalSnocket | callback constructed by |
| -> NetworkConnectTracers LocalAddress NodeToClientVersion | |
| -> Versions NodeToClientVersion NodeToClientVersionData (OuroborosApplicationWithMinimalCtx 'InitiatorMode LocalAddress ByteString IO a b) | A dictionary of protocol versions & applications to run on an established connection. The application to run will be chosen by initial handshake protocol (the highest shared version will be chosen). |
| -> FilePath | path of the unix socket or named pipe |
| -> (ConnectionId LocalAddress -> NodeToClientVersion -> NodeToClientVersionData -> OuroborosApplicationWithMinimalCtx 'InitiatorMode LocalAddress ByteString IO a b -> Mux 'InitiatorMode IO -> Async IO () -> IO x) | callback which has access to negotiated protocols and mux handle created for
that connection. The NOTE: when the callback returns or errors, the mux thread will be killed. |
| -> IO x |
Null Protocol Peers
chainSyncPeerNull :: forall header point tip (m :: Type -> Type) a. MonadDelay m => Client (ChainSync header point tip) 'NonPipelined ('StIdle :: ChainSync header point tip) m a Source #
localStateQueryPeerNull :: forall block point (query :: Type -> Type) (m :: Type -> Type) a. MonadDelay m => Client (LocalStateQuery block point query) ('StIdle :: LocalStateQuery block point query) (State :: LocalStateQuery block point query -> Type) m a Source #
localTxSubmissionPeerNull :: forall tx reject (m :: Type -> Type) a. MonadDelay m => Client (LocalTxSubmission tx reject) 'NonPipelined ('StIdle :: LocalTxSubmission tx reject) m a Source #
localTxMonitorPeerNull :: forall txid tx slot (m :: Type -> Type) a. MonadDelay m => Client (LocalTxMonitor txid tx slot) 'NonPipelined ('StIdle :: LocalTxMonitor txid tx slot) m a Source #
Re-exported network interface
This is public api to interact with the io manager; On Windows IOManager
holds associateWithIOCompletionPort;
on other platforms IOManager can run over any type, and thus is
guaranteed to be no-op.
Constructors
| IOManager | |
Fields
| |
type AssociateWithIOCP = IOManager #
withIOManager :: WithIOManager #
withIOManager allows to do asynchronous io on Windows hiding the
differences between posix and Win32.
It starts an io manger thread, which should be only one running at a time, so
the best place to call it is very close to the main function and last for
duration of the application.
Async IO operations which are using the iocp port should not leak
out-side of withIOManager. They will be silently cancelled when
withIOManager exists. In particular one should not return IOManager
from withIOManager.
type LocalSnocket = Snocket IO LocalSocket LocalAddress #
localSnocket :: IOManager -> LocalSnocket #
newtype LocalSocket #
Constructors
| LocalSocket | |
Fields
| |
Instances
| Generic LocalSocket | |||||
Defined in Ouroboros.Network.Snocket Associated Types
| |||||
| Show LocalSocket | |||||
Defined in Ouroboros.Network.Snocket Methods showsPrec :: Int -> LocalSocket -> ShowS # show :: LocalSocket -> String # showList :: [LocalSocket] -> ShowS # | |||||
| Eq LocalSocket | |||||
Defined in Ouroboros.Network.Snocket | |||||
| type Rep LocalSocket | |||||
Defined in Ouroboros.Network.Snocket type Rep LocalSocket = D1 ('MetaData "LocalSocket" "Ouroboros.Network.Snocket" "ouroboros-network-0.23.0.0-inplace-framework" 'True) (C1 ('MetaCons "LocalSocket" 'PrefixI 'True) (S1 ('MetaSel ('Just "getLocalHandle") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LocalHandle))) | |||||
newtype LocalAddress #
Constructors
| LocalAddress | |
Fields | |
Instances
| Generic LocalAddress | |||||
Defined in Ouroboros.Network.Snocket Associated Types
| |||||
| Show LocalAddress | |||||
Defined in Ouroboros.Network.Snocket Methods showsPrec :: Int -> LocalAddress -> ShowS # show :: LocalAddress -> String # showList :: [LocalAddress] -> ShowS # | |||||
| Eq LocalAddress | |||||
Defined in Ouroboros.Network.Snocket | |||||
| Ord LocalAddress | |||||
Defined in Ouroboros.Network.Snocket Methods compare :: LocalAddress -> LocalAddress -> Ordering # (<) :: LocalAddress -> LocalAddress -> Bool # (<=) :: LocalAddress -> LocalAddress -> Bool # (>) :: LocalAddress -> LocalAddress -> Bool # (>=) :: LocalAddress -> LocalAddress -> Bool # max :: LocalAddress -> LocalAddress -> LocalAddress # min :: LocalAddress -> LocalAddress -> LocalAddress # | |||||
| Hashable LocalAddress | |||||
Defined in Ouroboros.Network.Snocket | |||||
| type Rep LocalAddress | |||||
Defined in Ouroboros.Network.Snocket type Rep LocalAddress = D1 ('MetaData "LocalAddress" "Ouroboros.Network.Snocket" "ouroboros-network-0.23.0.0-inplace-framework" 'True) (C1 ('MetaCons "LocalAddress" 'PrefixI 'True) (S1 ('MetaSel ('Just "getFilePath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FilePath))) | |||||
Versions
newtype Versions vNum vData r #
Constructors
| Versions | |
Fields
| |
versionedNodeToClientProtocols :: forall (appType :: Mode) bytes (m :: Type -> Type) a b. NodeToClientVersion -> NodeToClientVersionData -> NodeToClientProtocols appType LocalAddress bytes m a b -> Versions NodeToClientVersion NodeToClientVersionData (OuroborosApplicationWithMinimalCtx appType LocalAddress bytes m a b) Source #
Versions containing a single version of nodeToClientProtocols.
simpleSingletonVersions :: vNum -> vData -> (vData -> r) -> Versions vNum vData r #
foldMapVersions :: (Ord vNum, Foldable f, HasCallStack) => (x -> Versions vNum extra r) -> f x -> Versions vNum extra r #
combineVersions :: (Ord vNum, Foldable f, HasCallStack) => f (Versions vNum extra r) -> Versions vNum extra r #
Codecs
nodeToClientHandshakeCodec :: forall (m :: Type -> Type). MonadST m => Codec (Handshake NodeToClientVersion Term) DeserialiseFailure m ByteString #
nodeToClientVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToClientVersion #
nodeToClientCodecCBORTerm :: NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData #
Re-exports
data ConnectionId addr #
Constructors
| ConnectionId | |
Fields
| |
Instances
| Functor ConnectionId | |||||
Defined in Ouroboros.Network.ConnectionId Methods fmap :: (a -> b) -> ConnectionId a -> ConnectionId b # (<$) :: a -> ConnectionId b -> ConnectionId a # | |||||
| ShowProxy addr => ShowProxy (ConnectionId addr :: Type) | |||||
Defined in Ouroboros.Network.ConnectionId Methods showProxy :: Proxy (ConnectionId addr) -> String | |||||
| Generic (ConnectionId addr) | |||||
Defined in Ouroboros.Network.ConnectionId Associated Types
Methods from :: ConnectionId addr -> Rep (ConnectionId addr) x # to :: Rep (ConnectionId addr) x -> ConnectionId addr # | |||||
| Show addr => Show (ConnectionId addr) | |||||
Defined in Ouroboros.Network.ConnectionId Methods showsPrec :: Int -> ConnectionId addr -> ShowS # show :: ConnectionId addr -> String # showList :: [ConnectionId addr] -> ShowS # | |||||
| Eq addr => Eq (ConnectionId addr) | |||||
Defined in Ouroboros.Network.ConnectionId Methods (==) :: ConnectionId addr -> ConnectionId addr -> Bool # (/=) :: ConnectionId addr -> ConnectionId addr -> Bool # | |||||
| Ord addr => Ord (ConnectionId addr) | |||||
Defined in Ouroboros.Network.ConnectionId Methods compare :: ConnectionId addr -> ConnectionId addr -> Ordering # (<) :: ConnectionId addr -> ConnectionId addr -> Bool # (<=) :: ConnectionId addr -> ConnectionId addr -> Bool # (>) :: ConnectionId addr -> ConnectionId addr -> Bool # (>=) :: ConnectionId addr -> ConnectionId addr -> Bool # max :: ConnectionId addr -> ConnectionId addr -> ConnectionId addr # min :: ConnectionId addr -> ConnectionId addr -> ConnectionId addr # | |||||
| Hashable a => Hashable (ConnectionId a) | |||||
Defined in Ouroboros.Network.ConnectionId | |||||
| Typeable addr => NoThunks (ConnectionId addr) | |||||
Defined in Ouroboros.Network.ConnectionId Methods noThunks :: Context -> ConnectionId addr -> IO (Maybe ThunkInfo) # wNoThunks :: Context -> ConnectionId addr -> IO (Maybe ThunkInfo) # showTypeOf :: Proxy (ConnectionId addr) -> String # | |||||
| type Rep (ConnectionId addr) | |||||
Defined in Ouroboros.Network.ConnectionId type Rep (ConnectionId addr) = D1 ('MetaData "ConnectionId" "Ouroboros.Network.ConnectionId" "ouroboros-network-0.23.0.0-inplace-framework" 'False) (C1 ('MetaCons "ConnectionId" 'PrefixI 'True) (S1 ('MetaSel ('Just "localAddress") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 addr) :*: S1 ('MetaSel ('Just "remoteAddress") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 addr))) | |||||
newtype MinimalInitiatorContext addr #
Constructors
| MinimalInitiatorContext | |
Fields
| |
Instances
| Functor MinimalInitiatorContext | |
Defined in Ouroboros.Network.Context Methods fmap :: (a -> b) -> MinimalInitiatorContext a -> MinimalInitiatorContext b # (<$) :: a -> MinimalInitiatorContext b -> MinimalInitiatorContext a # | |
newtype ResponderContext addr #
Constructors
| ResponderContext | |
Fields
| |
Instances
| Functor ResponderContext | |
Defined in Ouroboros.Network.Context Methods fmap :: (a -> b) -> ResponderContext a -> ResponderContext b # (<$) :: a -> ResponderContext b -> ResponderContext a # | |
data TraceSendRecv ps where #
Constructors
| TraceSendMsg :: forall ps. AnyMessage ps -> TraceSendRecv ps | |
| TraceRecvMsg :: forall ps. AnyMessage ps -> TraceSendRecv ps |
Instances
| Show (AnyMessage ps) => Show (TraceSendRecv ps) | |
Defined in Ouroboros.Network.Driver.Simple Methods showsPrec :: Int -> TraceSendRecv ps -> ShowS # show :: TraceSendRecv ps -> String # showList :: [TraceSendRecv ps] -> ShowS # | |
data ProtocolLimitFailure #
Instances
| Exception ProtocolLimitFailure | |
Defined in Ouroboros.Network.Protocol.Limits | |
| Show ProtocolLimitFailure | |
Defined in Ouroboros.Network.Protocol.Limits Methods showsPrec :: Int -> ProtocolLimitFailure -> ShowS # show :: ProtocolLimitFailure -> String # showList :: [ProtocolLimitFailure] -> ShowS # | |
data Handshake (vNumber :: k) (vParams :: k1) #
Instances
| ShowProxy (Handshake vNumber vParams :: Type) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type | |||||
| (NFData vNumber, NFData vParams) => NFData (Message (Handshake vNumber vParams) from to) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type | |||||
| (Show vNumber, Show vParams) => Show (Message (Handshake vNumber vParams) from to) | |||||
| Protocol (Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type Associated Types
| |||||
| StateTokenI ('StConfirm :: Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type Methods stateToken :: StateToken ('StConfirm :: Handshake vNumber vParams) # | |||||
| StateTokenI ('StDone :: Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type Methods stateToken :: StateToken ('StDone :: Handshake vNumber vParams) # | |||||
| StateTokenI ('StPropose :: Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type Methods stateToken :: StateToken ('StPropose :: Handshake vNumber vParams) # | |||||
| data Message (Handshake vNumber vParams) (from :: Handshake vNumber vParams) (to :: Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type data Message (Handshake vNumber vParams) (from :: Handshake vNumber vParams) (to :: Handshake vNumber vParams) where
| |||||
| type StateToken | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type | |||||
| type StateAgency ('StConfirm :: Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type | |||||
| type StateAgency ('StDone :: Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type | |||||
| type StateAgency ('StPropose :: Handshake vNumber vParams) | |||||
Defined in Ouroboros.Network.Protocol.Handshake.Type | |||||