ouroboros-network
Safe HaskellNone
LanguageHaskell2010

Ouroboros.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

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 #

Enumeration of node to client protocol versions.

Constructors

NodeToClientV_16

NodeToClientV_10 -- ^ added GetChainBlockNo and GetChainPoint queries | NodeToClientV_11 -- ^ added GetRewardInfoPools Block query | NodeToClientV_12 -- ^ added LocalTxMonitor mini-protocol | NodeToClientV_13 -- ^ enabled CardanoNodeToClientVersion9, i.e., Babbage | NodeToClientV_14 -- ^ added GetPoolDistr, GetPoolState, GetSnapshots | NodeToClientV_15 -- ^ added query to NodeToClientVersionData

NodeToClientV_17

added GetProposals and GetRatifyState queries

NodeToClientV_18

added GetFuturePParams query

NodeToClientV_19

added GetLedgerPeerSnapshot

NodeToClientV_20

added QueryStakePoolDefaultVote, added MsgGetMeasures / MsgReplyGetMeasures to LocalTxMonitor

Instances

Instances details
NFData NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

Methods

rnf :: NodeToClientVersion -> () #

Bounded NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

Enum NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

Generic NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

Associated Types

type Rep NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

type Rep NodeToClientVersion = D1 ('MetaData "NodeToClientVersion" "Ouroboros.Network.NodeToClient.Version" "ouroboros-network-api-0.13.0.0-inplace" 'False) ((C1 ('MetaCons "NodeToClientV_16" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NodeToClientV_17" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NodeToClientV_18" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NodeToClientV_19" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NodeToClientV_20" 'PrefixI 'False) (U1 :: Type -> Type))))
Show NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

Eq NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

Ord NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

type Rep NodeToClientVersion 
Instance details

Defined in Ouroboros.Network.NodeToClient.Version

type Rep NodeToClientVersion = D1 ('MetaData "NodeToClientVersion" "Ouroboros.Network.NodeToClient.Version" "ouroboros-network-api-0.13.0.0-inplace" 'False) ((C1 ('MetaCons "NodeToClientV_16" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NodeToClientV_17" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NodeToClientV_18" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NodeToClientV_19" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NodeToClientV_20" 'PrefixI 'False) (U1 :: Type -> Type))))

data NetworkConnectTracers addr vNumber #

Tracer used by connectToNode (and derivatives, like connectTo or 'Ouroboros.Network.NodeToClient.connectTo).

Constructors

NetworkConnectTracers 

Fields

connectTo Source #

Arguments

:: LocalSnocket

callback constructed by withIOManager

-> 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.

connectToWithMux Source #

Arguments

:: LocalSnocket

callback constructed by withIOManager

-> 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 x)

callback which has access to negotiated protocols and mux handle created for that connection. The Async is a handle the the thread which runs runMux. The Mux handle allows schedule mini-protocols.

NOTE: when the callback returns or errors, the mux thread will be killed.

-> IO x 

A version of connectTo which exposes Mux interfaces which allows to run mini-protocols and handle their termination (e.g. restart them when they terminate or error).

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

newtype IOManager #

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

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 #

System dependent LocalSnocket

localSnocket :: IOManager -> LocalSnocket #

Create a LocalSnocket.

On Windows, there is no way to get path associated to a named pipe. To go around this, the address passed to open via LocalFamily will be referenced by LocalSocket.

newtype LocalSocket #

System dependent LocalSnocket type

Constructors

LocalSocket 

Fields

Instances

Instances details
Generic LocalSocket 
Instance details

Defined in Ouroboros.Network.Snocket

Associated Types

type Rep LocalSocket 
Instance details

Defined in Ouroboros.Network.Snocket

type Rep LocalSocket = D1 ('MetaData "LocalSocket" "Ouroboros.Network.Snocket" "ouroboros-network-framework-0.17.0.0-inplace" 'True) (C1 ('MetaCons "LocalSocket" 'PrefixI 'True) (S1 ('MetaSel ('Just "getLocalHandle") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LocalHandle)))
Show LocalSocket 
Instance details

Defined in Ouroboros.Network.Snocket

Eq LocalSocket 
Instance details

Defined in Ouroboros.Network.Snocket

type Rep LocalSocket 
Instance details

Defined in Ouroboros.Network.Snocket

type Rep LocalSocket = D1 ('MetaData "LocalSocket" "Ouroboros.Network.Snocket" "ouroboros-network-framework-0.17.0.0-inplace" 'True) (C1 ('MetaCons "LocalSocket" 'PrefixI 'True) (S1 ('MetaSel ('Just "getLocalHandle") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LocalHandle)))

newtype LocalAddress #

Local address, on Unix is associated with AF_UNIX family, on

Windows with `named-pipes`.

Constructors

LocalAddress 

Instances

Instances details
Generic LocalAddress 
Instance details

Defined in Ouroboros.Network.Snocket

Associated Types

type Rep LocalAddress 
Instance details

Defined in Ouroboros.Network.Snocket

type Rep LocalAddress = D1 ('MetaData "LocalAddress" "Ouroboros.Network.Snocket" "ouroboros-network-framework-0.17.0.0-inplace" 'True) (C1 ('MetaCons "LocalAddress" 'PrefixI 'True) (S1 ('MetaSel ('Just "getFilePath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FilePath)))
Show LocalAddress 
Instance details

Defined in Ouroboros.Network.Snocket

Eq LocalAddress 
Instance details

Defined in Ouroboros.Network.Snocket

Ord LocalAddress 
Instance details

Defined in Ouroboros.Network.Snocket

Hashable LocalAddress 
Instance details

Defined in Ouroboros.Network.Snocket

type Rep LocalAddress 
Instance details

Defined in Ouroboros.Network.Snocket

type Rep LocalAddress = D1 ('MetaData "LocalAddress" "Ouroboros.Network.Snocket" "ouroboros-network-framework-0.17.0.0-inplace" 'True) (C1 ('MetaCons "LocalAddress" 'PrefixI 'True) (S1 ('MetaSel ('Just "getFilePath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FilePath)))

Versions

newtype Versions vNum vData r #

The version map supported by the local agent keyed on the version identifier.

Each Version contains a function which takes negotiated version data and returns negotiated application (the r type variable).

If one needs to combine multiple versions the simplest way is to use one of the combinators: foldMapVersions, combineVersions or the Semigroup instance directly:

fold $ (simpleSingletonVersions ...)
      :| [ (simpleSingletonVersions ...)
         , (simpleSingletonVersions ...)
         , ...
         ]

Constructors

Versions 

Fields

Instances

Instances details
Functor (Versions vNum extra) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Version

Methods

fmap :: (a -> b) -> Versions vNum extra a -> Versions vNum extra b #

(<$) :: a -> Versions vNum extra b -> Versions vNum extra a #

Ord vNum => Semigroup (Versions vNum vData r) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Version

Methods

(<>) :: Versions vNum vData r -> Versions vNum vData r -> Versions vNum vData r #

sconcat :: NonEmpty (Versions vNum vData r) -> Versions vNum vData r #

stimes :: Integral b => b -> Versions vNum vData r -> Versions vNum vData r #

simpleSingletonVersions #

Arguments

:: vNum

version number

-> vData

proposed version data

-> (vData -> r)

callback which receives negotiated version data

-> Versions vNum vData r 

Singleton smart constructor for Versions.

foldMapVersions :: (Ord vNum, Foldable f, HasCallStack) => (x -> Versions vNum extra r) -> f x -> Versions vNum extra r #

Useful for folding multiple Versions.

A foldMap restricted to the Versions Semigroup.

PRECONDITION: f x is non-empty.

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 #

Handshake codec for the node-to-client protocol suite.

nodeToClientVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToClientVersion #

We set 16ths bit to distinguish NodeToNodeVersion and NodeToClientVersion. This way connecting wrong protocol suite will fail during Handshake negotiation

This is done in backward compatible way, so NodeToClientV_1 encoding is not changed.

Re-exports

data ConnectionId addr #

Connection is identified by local and remote address.

TODO: the type variable which this data type fills in is called peerid. We should renamed to connectionId.

Constructors

ConnectionId 

Fields

Instances

Instances details
Functor ConnectionId 
Instance details

Defined in Ouroboros.Network.ConnectionId

Methods

fmap :: (a -> b) -> ConnectionId a -> ConnectionId b #

(<$) :: a -> ConnectionId b -> ConnectionId a #

ShowProxy addr => ShowProxy (ConnectionId addr :: Type) 
Instance details

Defined in Ouroboros.Network.ConnectionId

Methods

showProxy :: Proxy (ConnectionId addr) -> String #

Generic (ConnectionId addr) 
Instance details

Defined in Ouroboros.Network.ConnectionId

Associated Types

type Rep (ConnectionId addr) 
Instance details

Defined in Ouroboros.Network.ConnectionId

type Rep (ConnectionId addr) = D1 ('MetaData "ConnectionId" "Ouroboros.Network.ConnectionId" "ouroboros-network-framework-0.17.0.0-inplace" 'False) (C1 ('MetaCons "ConnectionId" 'PrefixI 'True) (S1 ('MetaSel ('Just "localAddress") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 addr) :*: S1 ('MetaSel ('Just "remoteAddress") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 addr)))

Methods

from :: ConnectionId addr -> Rep (ConnectionId addr) x #

to :: Rep (ConnectionId addr) x -> ConnectionId addr #

Show addr => Show (ConnectionId addr) 
Instance details

Defined in Ouroboros.Network.ConnectionId

Methods

showsPrec :: Int -> ConnectionId addr -> ShowS #

show :: ConnectionId addr -> String #

showList :: [ConnectionId addr] -> ShowS #

Eq addr => Eq (ConnectionId addr) 
Instance details

Defined in Ouroboros.Network.ConnectionId

Methods

(==) :: ConnectionId addr -> ConnectionId addr -> Bool #

(/=) :: ConnectionId addr -> ConnectionId addr -> Bool #

Ord addr => Ord (ConnectionId addr)

Order first by remoteAddress then by localAddress.

Note: we relay on the fact that remoteAddress is an order preserving map (which allows us to use mapKeysMonotonic in some cases. We also relay on this particular order in liveConnections

Instance details

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) 
Instance details

Defined in Ouroboros.Network.ConnectionId

Typeable addr => NoThunks (ConnectionId addr) 
Instance details

Defined in Ouroboros.Network.ConnectionId

type Rep (ConnectionId addr) 
Instance details

Defined in Ouroboros.Network.ConnectionId

type Rep (ConnectionId addr) = D1 ('MetaData "ConnectionId" "Ouroboros.Network.ConnectionId" "ouroboros-network-framework-0.17.0.0-inplace" '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 #

A context passed to initiator mini-protocol execution for non-p2p applications.

Instances

Instances details
Functor MinimalInitiatorContext 
Instance details

Defined in Ouroboros.Network.Context

newtype ResponderContext addr #

Context passed to each responder mini-protocol execution.

Constructors

ResponderContext 

Instances

Instances details
Functor ResponderContext 
Instance details

Defined in Ouroboros.Network.Context

Methods

fmap :: (a -> b) -> ResponderContext a -> ResponderContext b #

(<$) :: a -> ResponderContext b -> ResponderContext a #

data TraceSendRecv ps where #

Structured Tracer output for runPeer and derivitives.

Constructors

TraceSendMsg :: forall ps. AnyMessage ps -> TraceSendRecv ps 
TraceRecvMsg :: forall ps. AnyMessage ps -> TraceSendRecv ps 

Instances

Instances details
Show (AnyMessage ps) => Show (TraceSendRecv ps) 
Instance details

Defined in Ouroboros.Network.Driver.Simple

data Handshake (vNumber :: k) (vParams :: k1) #

The handshake mini-protocol is used initially to agree the version and associated parameters of the protocol to use for all subsequent communication.

Instances

Instances details
ShowProxy (Handshake vNumber vParams :: Type) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

Methods

showProxy :: Proxy (Handshake vNumber vParams) -> String #

(NFData vNumber, NFData vParams) => NFData (Message (Handshake vNumber vParams) from to) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

Methods

rnf :: Message (Handshake vNumber vParams) from to -> () #

(Show vNumber, Show vParams) => Show (Message (Handshake vNumber vParams) from to) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

Methods

showsPrec :: Int -> Message (Handshake vNumber vParams) from to -> ShowS #

show :: Message (Handshake vNumber vParams) from to -> String #

showList :: [Message (Handshake vNumber vParams) from to] -> ShowS #

Protocol (Handshake vNumber vParams) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

Associated Types

type StateToken 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

type StateToken = SingHandshake :: Handshake vNumber vParams -> Type
StateTokenI ('StConfirm :: Handshake vNumber vParams) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

Methods

stateToken :: StateToken ('StConfirm :: Handshake vNumber vParams) #

StateTokenI ('StDone :: Handshake vNumber vParams) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

Methods

stateToken :: StateToken ('StDone :: Handshake vNumber vParams) #

StateTokenI ('StPropose :: Handshake vNumber vParams) 
Instance details

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) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

data Message (Handshake vNumber vParams) (from :: Handshake vNumber vParams) (to :: Handshake vNumber vParams) where
type StateToken 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

type StateToken = SingHandshake :: Handshake vNumber vParams -> Type
type StateAgency ('StConfirm :: Handshake vNumber vParams) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

type StateAgency ('StConfirm :: Handshake vNumber vParams) = 'ServerAgency
type StateAgency ('StDone :: Handshake vNumber vParams) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

type StateAgency ('StDone :: Handshake vNumber vParams) = 'NobodyAgency
type StateAgency ('StPropose :: Handshake vNumber vParams) 
Instance details

Defined in Ouroboros.Network.Protocol.Handshake.Type

type StateAgency ('StPropose :: Handshake vNumber vParams) = 'ClientAgency

type HandshakeTr ntcAddr (ntcVersion :: k) = WithBearer (ConnectionId ntcAddr) (TraceSendRecv (Handshake ntcVersion Term)) Source #