{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

module DMQ.NodeToNode where

import Codec.CBOR.Term qualified as CBOR
import Control.DeepSeq (NFData)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import System.Random (mkStdGen)

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadMVar (MonadMVar)
import Control.Concurrent.Class.MonadSTM (MonadSTM (..))
import Control.Monad.Class.MonadAsync (MonadAsync)
import Control.Monad.Class.MonadFork (MonadFork, MonadThread, labelThisThread)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadMask, MonadThrow)
import Control.Monad.Class.MonadTimer.SI (MonadTimer)
import Control.Tracer (Tracer, nullTracer)
import Data.ByteString.Lazy qualified as BL
import Data.Hashable (Hashable)
import Data.Void (Void)

import Network.Mux (Mode (..))
import Network.Mux qualified as Mx
import Network.TypedProtocol.Codec (Codec)

import DMQ.Diffusion.NodeKernel (NodeKernel (..))

-- TODO: remove this dependency
import Cardano.Network.NodeToNode (addSafetyMargin, keepAliveMiniProtocolNum,
           peerSharingMiniProtocolNum)

import Ouroboros.Network.BlockFetch.ClientRegistry (bracketKeepAliveClient)
import Ouroboros.Network.Channel (Channel)
import Ouroboros.Network.CodecCBORTerm (CodecCBORTerm (..))
import Ouroboros.Network.ConnectionId (ConnectionId (..))
import Ouroboros.Network.ConnectionManager.Types (DataFlow (..))
import Ouroboros.Network.Context (ExpandedInitiatorContext (..),
           ResponderContext (..))
import Ouroboros.Network.Driver.Limits (runPeerWithLimits)
import Ouroboros.Network.Driver.Simple (TraceSendRecv)
import Ouroboros.Network.Handshake.Acceptable (Accept (..), Acceptable (..))
import Ouroboros.Network.Handshake.Queryable (Queryable (..))
import Ouroboros.Network.KeepAlive (KeepAliveInterval (..), keepAliveClient,
           keepAliveServer)
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolCb (..),
           MiniProtocolLimits (..), OuroborosBundle,
           OuroborosBundleWithExpandedCtx, RunMiniProtocol (..),
           StartOnDemandOrEagerly (..), TemperatureBundle (..),
           WithProtocolTemperature (..))
import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..))
import Ouroboros.Network.NodeToNode.Version qualified as NTN
import Ouroboros.Network.PeerSelection (PeerSharing (..))
import Ouroboros.Network.PeerSharing (bracketPeerSharingClient,
           peerSharingClient, peerSharingServer)
import Ouroboros.Network.Protocol.Handshake (Handshake, HandshakeArguments (..))
import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec,
           codecHandshake, timeLimitsHandshake)
import Ouroboros.Network.Protocol.KeepAlive.Client (keepAliveClientPeer)
import Ouroboros.Network.Protocol.KeepAlive.Codec (byteLimitsKeepAlive,
           codecKeepAlive_v2, timeLimitsKeepAlive)
import Ouroboros.Network.Protocol.KeepAlive.Server (keepAliveServerPeer)
import Ouroboros.Network.Protocol.KeepAlive.Type (KeepAlive)
import Ouroboros.Network.Protocol.Limits (ProtocolSizeLimits,
           ProtocolTimeLimits)
import Ouroboros.Network.Protocol.PeerSharing.Client (peerSharingClientPeer)
import Ouroboros.Network.Protocol.PeerSharing.Codec (byteLimitsPeerSharing,
           codecPeerSharing, timeLimitsPeerSharing)
import Ouroboros.Network.Protocol.PeerSharing.Server (peerSharingServerPeer)
import Ouroboros.Network.Protocol.PeerSharing.Type qualified as Protocol


data NodeToNodeVersion =
  NodeToNodeV_1
  deriving (NodeToNodeVersion -> NodeToNodeVersion -> Bool
(NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> Eq NodeToNodeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
== :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c/= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
/= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
Eq, Eq NodeToNodeVersion
Eq NodeToNodeVersion =>
(NodeToNodeVersion -> NodeToNodeVersion -> Ordering)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> Bool)
-> (NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion)
-> (NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion)
-> Ord NodeToNodeVersion
NodeToNodeVersion -> NodeToNodeVersion -> Bool
NodeToNodeVersion -> NodeToNodeVersion -> Ordering
NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NodeToNodeVersion -> NodeToNodeVersion -> Ordering
compare :: NodeToNodeVersion -> NodeToNodeVersion -> Ordering
$c< :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
< :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c<= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
<= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c> :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
> :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$c>= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
>= :: NodeToNodeVersion -> NodeToNodeVersion -> Bool
$cmax :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
max :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
$cmin :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
min :: NodeToNodeVersion -> NodeToNodeVersion -> NodeToNodeVersion
Ord, Int -> NodeToNodeVersion
NodeToNodeVersion -> Int
NodeToNodeVersion -> [NodeToNodeVersion]
NodeToNodeVersion -> NodeToNodeVersion
NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
(NodeToNodeVersion -> NodeToNodeVersion)
-> (NodeToNodeVersion -> NodeToNodeVersion)
-> (Int -> NodeToNodeVersion)
-> (NodeToNodeVersion -> Int)
-> (NodeToNodeVersion -> [NodeToNodeVersion])
-> (NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion])
-> (NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion])
-> (NodeToNodeVersion
    -> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion])
-> Enum NodeToNodeVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NodeToNodeVersion -> NodeToNodeVersion
succ :: NodeToNodeVersion -> NodeToNodeVersion
$cpred :: NodeToNodeVersion -> NodeToNodeVersion
pred :: NodeToNodeVersion -> NodeToNodeVersion
$ctoEnum :: Int -> NodeToNodeVersion
toEnum :: Int -> NodeToNodeVersion
$cfromEnum :: NodeToNodeVersion -> Int
fromEnum :: NodeToNodeVersion -> Int
$cenumFrom :: NodeToNodeVersion -> [NodeToNodeVersion]
enumFrom :: NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromThen :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromThen :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromTo :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromTo :: NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
$cenumFromThenTo :: NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
enumFromThenTo :: NodeToNodeVersion
-> NodeToNodeVersion -> NodeToNodeVersion -> [NodeToNodeVersion]
Enum, NodeToNodeVersion
NodeToNodeVersion -> NodeToNodeVersion -> Bounded NodeToNodeVersion
forall a. a -> a -> Bounded a
$cminBound :: NodeToNodeVersion
minBound :: NodeToNodeVersion
$cmaxBound :: NodeToNodeVersion
maxBound :: NodeToNodeVersion
Bounded, Int -> NodeToNodeVersion -> ShowS
[NodeToNodeVersion] -> ShowS
NodeToNodeVersion -> String
(Int -> NodeToNodeVersion -> ShowS)
-> (NodeToNodeVersion -> String)
-> ([NodeToNodeVersion] -> ShowS)
-> Show NodeToNodeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeToNodeVersion -> ShowS
showsPrec :: Int -> NodeToNodeVersion -> ShowS
$cshow :: NodeToNodeVersion -> String
show :: NodeToNodeVersion -> String
$cshowList :: [NodeToNodeVersion] -> ShowS
showList :: [NodeToNodeVersion] -> ShowS
Show, (forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x)
-> (forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion)
-> Generic NodeToNodeVersion
forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion
forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x
from :: forall x. NodeToNodeVersion -> Rep NodeToNodeVersion x
$cto :: forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion
to :: forall x. Rep NodeToNodeVersion x -> NodeToNodeVersion
Generic, NodeToNodeVersion -> ()
(NodeToNodeVersion -> ()) -> NFData NodeToNodeVersion
forall a. (a -> ()) -> NFData a
$crnf :: NodeToNodeVersion -> ()
rnf :: NodeToNodeVersion -> ()
NFData)

nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec = CodecCBORTerm { NodeToNodeVersion -> Term
encodeTerm :: NodeToNodeVersion -> Term
encodeTerm :: NodeToNodeVersion -> Term
encodeTerm, Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm :: Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm :: Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm }
  where
    encodeTerm :: NodeToNodeVersion -> Term
encodeTerm NodeToNodeVersion
NodeToNodeV_1 = Int -> Term
CBOR.TInt Int
1

    decodeTerm :: Term -> Either (Text, Maybe Int) NodeToNodeVersion
decodeTerm (CBOR.TInt Int
1) = NodeToNodeVersion -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. b -> Either a b
Right NodeToNodeVersion
NodeToNodeV_1
    decodeTerm (CBOR.TInt Int
n) = (Text, Maybe Int) -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. a -> Either a b
Left ( String -> Text
T.pack String
"decode NodeToNodeVersion: unknown tag: "
                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
                                    , Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
                                    )
    decodeTerm Term
_ = (Text, Maybe Int) -> Either (Text, Maybe Int) NodeToNodeVersion
forall a b. a -> Either a b
Left ( String -> Text
T.pack String
"decode NodeToNodeVersion: unexpected term"
                        , Maybe Int
forall a. Maybe a
Nothing)

-- | Version data for NodeToNode protocols
--
-- This data type is inpired by the one defined in 'ouroboros-network-api',
-- however, it is redefined here to tie it to our custom `NodeToNodeVersion`
-- and to avoid divergences.
--
data NodeToNodeVersionData = NodeToNodeVersionData
  { NodeToNodeVersionData -> NetworkMagic
networkMagic  :: !NetworkMagic
  , NodeToNodeVersionData -> DiffusionMode
diffusionMode :: !DiffusionMode
  , NodeToNodeVersionData -> PeerSharing
peerSharing   :: !PeerSharing
  , NodeToNodeVersionData -> Bool
query         :: !Bool
  }
  deriving (Int -> NodeToNodeVersionData -> ShowS
[NodeToNodeVersionData] -> ShowS
NodeToNodeVersionData -> String
(Int -> NodeToNodeVersionData -> ShowS)
-> (NodeToNodeVersionData -> String)
-> ([NodeToNodeVersionData] -> ShowS)
-> Show NodeToNodeVersionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeToNodeVersionData -> ShowS
showsPrec :: Int -> NodeToNodeVersionData -> ShowS
$cshow :: NodeToNodeVersionData -> String
show :: NodeToNodeVersionData -> String
$cshowList :: [NodeToNodeVersionData] -> ShowS
showList :: [NodeToNodeVersionData] -> ShowS
Show, NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
(NodeToNodeVersionData -> NodeToNodeVersionData -> Bool)
-> (NodeToNodeVersionData -> NodeToNodeVersionData -> Bool)
-> Eq NodeToNodeVersionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
== :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
$c/= :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
/= :: NodeToNodeVersionData -> NodeToNodeVersionData -> Bool
Eq)

instance Acceptable NodeToNodeVersionData where
    -- | Check that both side use the same 'networkMagic'.  Choose smaller one
    -- from both 'diffusionMode's, e.g. if one is running in 'InitiatorOnlyMode'
    -- agree on it. Agree on the same 'PeerSharing' value, if the negotiated
    -- diffusion mode is 'InitiatorAndResponder', otherwise default to
    -- 'PeerSharingDisabled'.
    acceptableVersion :: NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
acceptableVersion NodeToNodeVersionData
local NodeToNodeVersionData
remote
      | NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
local NetworkMagic -> NetworkMagic -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
remote
      = let acceptedDiffusionMode :: DiffusionMode
acceptedDiffusionMode = NodeToNodeVersionData -> DiffusionMode
diffusionMode NodeToNodeVersionData
local DiffusionMode -> DiffusionMode -> DiffusionMode
forall a. Ord a => a -> a -> a
`min` NodeToNodeVersionData -> DiffusionMode
diffusionMode NodeToNodeVersionData
remote
         in NodeToNodeVersionData -> Accept NodeToNodeVersionData
forall vData. vData -> Accept vData
Accept NodeToNodeVersionData
              { networkMagic :: NetworkMagic
networkMagic  = NodeToNodeVersionData -> NetworkMagic
networkMagic NodeToNodeVersionData
local
              , diffusionMode :: DiffusionMode
diffusionMode = DiffusionMode
acceptedDiffusionMode
              , peerSharing :: PeerSharing
peerSharing   = case DiffusionMode
acceptedDiffusionMode of
                                  DiffusionMode
InitiatorAndResponderDiffusionMode ->
                                    NodeToNodeVersionData -> PeerSharing
peerSharing NodeToNodeVersionData
local PeerSharing -> PeerSharing -> PeerSharing
forall a. Semigroup a => a -> a -> a
<> NodeToNodeVersionData -> PeerSharing
peerSharing NodeToNodeVersionData
remote
                                  DiffusionMode
InitiatorOnlyDiffusionMode         ->
                                    PeerSharing
PeerSharingDisabled
              , query :: Bool
query         = NodeToNodeVersionData -> Bool
query NodeToNodeVersionData
local Bool -> Bool -> Bool
|| NodeToNodeVersionData -> Bool
query NodeToNodeVersionData
remote
              }
      | Bool
otherwise
      = Text -> Accept NodeToNodeVersionData
forall vData. Text -> Accept vData
Refuse (Text -> Accept NodeToNodeVersionData)
-> Text -> Accept NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"version data mismatch: "
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeToNodeVersionData -> String
forall a. Show a => a -> String
show NodeToNodeVersionData
local
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeToNodeVersionData -> String
forall a. Show a => a -> String
show NodeToNodeVersionData
remote

instance Queryable NodeToNodeVersionData where
    queryVersion :: NodeToNodeVersionData -> Bool
queryVersion = NodeToNodeVersionData -> Bool
query

nodeToNodeCodecCBORTerm :: NodeToNodeVersion
                        -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm :: NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm =
  \case
    NodeToNodeVersion
NodeToNodeV_1 -> CodecCBORTerm Text NodeToNodeVersionData
v1

  where
    v1 :: CodecCBORTerm Text NodeToNodeVersionData
v1 = CodecCBORTerm { encodeTerm :: NodeToNodeVersionData -> Term
encodeTerm = NodeToNodeVersionData -> Term
encodeTerm1, decodeTerm :: Term -> Either Text NodeToNodeVersionData
decodeTerm = Term -> Either Text NodeToNodeVersionData
decodeTerm1 }

    encodeTerm1 :: NodeToNodeVersionData -> CBOR.Term
    encodeTerm1 :: NodeToNodeVersionData -> Term
encodeTerm1 NodeToNodeVersionData { NetworkMagic
networkMagic :: NodeToNodeVersionData -> NetworkMagic
networkMagic :: NetworkMagic
networkMagic, DiffusionMode
diffusionMode :: NodeToNodeVersionData -> DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode, PeerSharing
peerSharing :: NodeToNodeVersionData -> PeerSharing
peerSharing :: PeerSharing
peerSharing, Bool
query :: NodeToNodeVersionData -> Bool
query :: Bool
query }
      = [Term] -> Term
CBOR.TList
          [ Int -> Term
CBOR.TInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> Word32
unNetworkMagic NetworkMagic
networkMagic)
          , Bool -> Term
CBOR.TBool (case DiffusionMode
diffusionMode of
                         DiffusionMode
InitiatorOnlyDiffusionMode         -> Bool
True
                         DiffusionMode
InitiatorAndResponderDiffusionMode -> Bool
False)
          , Int -> Term
CBOR.TInt (case PeerSharing
peerSharing of
                         PeerSharing
PeerSharingDisabled -> Int
0
                         PeerSharing
PeerSharingEnabled  -> Int
1)
          , Bool -> Term
CBOR.TBool Bool
query
          ]

    decodeTerm1 :: CBOR.Term -> Either Text NodeToNodeVersionData
    decodeTerm1 :: Term -> Either Text NodeToNodeVersionData
decodeTerm1 (CBOR.TList [CBOR.TInt Int
x, CBOR.TBool Bool
diffusionMode, CBOR.TInt Int
peerSharing, CBOR.TBool Bool
query])
      | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
      , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffffffff
      , Just PeerSharing
ps <- case Int
peerSharing of
                    Int
0 -> PeerSharing -> Maybe PeerSharing
forall a. a -> Maybe a
Just PeerSharing
PeerSharingDisabled
                    Int
1 -> PeerSharing -> Maybe PeerSharing
forall a. a -> Maybe a
Just PeerSharing
PeerSharingEnabled
                    Int
_ -> Maybe PeerSharing
forall a. Maybe a
Nothing
      = NodeToNodeVersionData -> Either Text NodeToNodeVersionData
forall a b. b -> Either a b
Right
          NodeToNodeVersionData {
              networkMagic :: NetworkMagic
networkMagic = Word32 -> NetworkMagic
NetworkMagic (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x),
              diffusionMode :: DiffusionMode
diffusionMode = if Bool
diffusionMode
                              then DiffusionMode
InitiatorOnlyDiffusionMode
                              else DiffusionMode
InitiatorAndResponderDiffusionMode,
              peerSharing :: PeerSharing
peerSharing = PeerSharing
ps,
              query :: Bool
query = Bool
query
            }
      | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xffffffff
      = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"networkMagic out of bound: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
x
      | Bool
otherwise -- peerSharing < 0 || peerSharing > 1
      = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"peerSharing is out of bound: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
peerSharing
    decodeTerm1 Term
t
      = Text -> Either Text NodeToNodeVersionData
forall a b. a -> Either a b
Left (Text -> Either Text NodeToNodeVersionData)
-> Text -> Either Text NodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"unknown encoding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
t

ntnDataFlow :: NodeToNodeVersionData -> DataFlow
ntnDataFlow :: NodeToNodeVersionData -> DataFlow
ntnDataFlow NodeToNodeVersionData { DiffusionMode
diffusionMode :: NodeToNodeVersionData -> DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode } =
  case DiffusionMode
diffusionMode of
    DiffusionMode
InitiatorAndResponderDiffusionMode -> DataFlow
Duplex
    DiffusionMode
InitiatorOnlyDiffusionMode         -> DataFlow
Unidirectional

-- | Map between DMQ NTNVersion and Ouroboros NTNVersion
--
-- Useful for reusing codecs and other functions
--
mapNtNDMQtoOuroboros :: NodeToNodeVersion -> NTN.NodeToNodeVersion
mapNtNDMQtoOuroboros :: NodeToNodeVersion -> NodeToNodeVersion
mapNtNDMQtoOuroboros NodeToNodeVersion
_ = NodeToNodeVersion
forall a. Bounded a => a
maxBound

type ClientApp addr bytes m a =
     NodeToNodeVersion
  -> ExpandedInitiatorContext addr m
  -> Channel m bytes
  -> m (a, Maybe bytes)

type ServerApp addr bytes m a =
     NodeToNodeVersion
  -> ResponderContext addr
  -> Channel m bytes
  -> m (a, Maybe bytes)

data Apps addr bKA bPS m a b =
  Apps {
    -- | Start a keep-alive client.
    forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ClientApp addr bKA m a
aKeepAliveClient   :: ClientApp addr bKA m a

    -- | Start a keep-alive server.
  , forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ServerApp addr bKA m b
aKeepAliveServer   :: ServerApp addr bKA m b

    -- | Start a peer-sharing client.
  , forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ClientApp addr bPS m a
aPeerSharingClient :: ClientApp addr bPS m a

    -- | Start a peer-sharing server.
  , forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ServerApp addr bPS m b
aPeerSharingServer :: ServerApp addr bPS m b
  }

ntnApps
  :: forall m addr .
    ( Alternative (STM m)
    , MonadAsync m
    , MonadFork m
    , MonadMask m
    , MonadMVar m
    , MonadST m
    , MonadThread m
    , MonadThrow (STM m)
    , MonadTimer m
    , Ord addr
    , Hashable addr
    )
 => NodeKernel addr m
 -> Codecs addr m
 -> LimitsAndTimeouts addr
 -> Apps addr BL.ByteString BL.ByteString m () ()
ntnApps :: forall (m :: * -> *) addr.
(Alternative (STM m), MonadAsync m, MonadFork m, MonadMask m,
 MonadMVar m, MonadST m, MonadThread m, MonadThrow (STM m),
 MonadTimer m, Ord addr, Hashable addr) =>
NodeKernel addr m
-> Codecs addr m
-> LimitsAndTimeouts addr
-> Apps addr ByteString ByteString m () ()
ntnApps NodeKernel {
          FetchClientRegistry (ConnectionId addr) () () m
fetchClientRegistry :: FetchClientRegistry (ConnectionId addr) () () m
fetchClientRegistry :: forall ntnAddr (m :: * -> *).
NodeKernel ntnAddr m
-> FetchClientRegistry (ConnectionId ntnAddr) () () m
fetchClientRegistry
        , PeerSharingRegistry addr m
peerSharingRegistry :: PeerSharingRegistry addr m
peerSharingRegistry :: forall ntnAddr (m :: * -> *).
NodeKernel ntnAddr m -> PeerSharingRegistry ntnAddr m
peerSharingRegistry
        , PeerSharingAPI addr StdGen m
peerSharingAPI :: PeerSharingAPI addr StdGen m
peerSharingAPI :: forall ntnAddr (m :: * -> *).
NodeKernel ntnAddr m -> PeerSharingAPI ntnAddr StdGen m
peerSharingAPI
        }
        Codecs {
          Codec KeepAlive DeserialiseFailure m ByteString
keepAliveCodec :: Codec KeepAlive DeserialiseFailure m ByteString
keepAliveCodec :: forall addr (m :: * -> *).
Codecs addr m -> Codec KeepAlive DeserialiseFailure m ByteString
keepAliveCodec
        , Codec (PeerSharing addr) DeserialiseFailure m ByteString
peerSharingCodec :: Codec (PeerSharing addr) DeserialiseFailure m ByteString
peerSharingCodec :: forall addr (m :: * -> *).
Codecs addr m
-> Codec (PeerSharing addr) DeserialiseFailure m ByteString
peerSharingCodec
        }
        LimitsAndTimeouts {
          ProtocolSizeLimits KeepAlive ByteString
keepAliveSizeLimits :: ProtocolSizeLimits KeepAlive ByteString
keepAliveSizeLimits :: forall addr.
LimitsAndTimeouts addr -> ProtocolSizeLimits KeepAlive ByteString
keepAliveSizeLimits
        , ProtocolTimeLimits KeepAlive
keepAliveTimeLimits :: ProtocolTimeLimits KeepAlive
keepAliveTimeLimits :: forall addr. LimitsAndTimeouts addr -> ProtocolTimeLimits KeepAlive
keepAliveTimeLimits
        , ProtocolTimeLimits (PeerSharing addr)
peerSharingTimeLimits :: ProtocolTimeLimits (PeerSharing addr)
peerSharingTimeLimits :: forall addr.
LimitsAndTimeouts addr -> ProtocolTimeLimits (PeerSharing addr)
peerSharingTimeLimits
        , ProtocolSizeLimits (PeerSharing addr) ByteString
peerSharingSizeLimits :: ProtocolSizeLimits (PeerSharing addr) ByteString
peerSharingSizeLimits :: forall addr.
LimitsAndTimeouts addr
-> ProtocolSizeLimits (PeerSharing addr) ByteString
peerSharingSizeLimits
        } =
  Apps {
    ClientApp addr ByteString m ()
aKeepAliveClient :: ClientApp addr ByteString m ()
aKeepAliveClient :: ClientApp addr ByteString m ()
aKeepAliveClient
  , ServerApp addr ByteString m ()
forall ntnAddr.
NodeToNodeVersion
-> ResponderContext ntnAddr
-> Channel m ByteString
-> m ((), Maybe ByteString)
aKeepAliveServer :: ServerApp addr ByteString m ()
aKeepAliveServer :: forall ntnAddr.
NodeToNodeVersion
-> ResponderContext ntnAddr
-> Channel m ByteString
-> m ((), Maybe ByteString)
aKeepAliveServer
  , ClientApp addr ByteString m ()
aPeerSharingClient :: ClientApp addr ByteString m ()
aPeerSharingClient :: ClientApp addr ByteString m ()
aPeerSharingClient
  , ServerApp addr ByteString m ()
aPeerSharingServer :: ServerApp addr ByteString m ()
aPeerSharingServer :: ServerApp addr ByteString m ()
aPeerSharingServer
  }
  where
    aKeepAliveClient
      :: NodeToNodeVersion
      -> ExpandedInitiatorContext addr m
      -> Channel m BL.ByteString
      -> m ((), Maybe BL.ByteString)
    aKeepAliveClient :: ClientApp addr ByteString m ()
aKeepAliveClient NodeToNodeVersion
_version
                     ExpandedInitiatorContext {
                       eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId   = ConnectionId addr
them
                     , eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
                     }
                     Channel m ByteString
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveClient"
      let kacApp :: StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> m ((), Maybe ByteString)
kacApp StrictTVar m (Map (ConnectionId addr) PeerGSV)
dqCtx =
            Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive DeserialiseFailure m ByteString
-> ProtocolSizeLimits KeepAlive ByteString
-> ProtocolTimeLimits KeepAlive
-> Channel m ByteString
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
-> m ((), Maybe ByteString)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
              Tracer m (TraceSendRecv KeepAlive)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
              Codec KeepAlive DeserialiseFailure m ByteString
keepAliveCodec
              ProtocolSizeLimits KeepAlive ByteString
keepAliveSizeLimits
              ProtocolTimeLimits KeepAlive
keepAliveTimeLimits
              Channel m ByteString
channel
              (Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
 -> m ((), Maybe ByteString))
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
-> m ((), Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ KeepAliveClient m ()
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
forall (m :: * -> *) a.
MonadThrow m =>
KeepAliveClient m a -> Client KeepAlive 'NonPipelined 'StClient m a
keepAliveClientPeer
              (KeepAliveClient m ()
 -> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ())
-> KeepAliveClient m ()
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceKeepAliveClient (ConnectionId addr))
-> StdGen
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
forall (m :: * -> *) peer.
(MonadTimer m, Ord peer) =>
Tracer m (TraceKeepAliveClient peer)
-> StdGen
-> ControlMessageSTM m
-> peer
-> StrictTVar m (Map peer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
keepAliveClient Tracer m (TraceKeepAliveClient (ConnectionId addr))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                                (Int -> StdGen
mkStdGen Int
0)
                                ControlMessageSTM m
controlMessageSTM
                                ConnectionId addr
them
                                StrictTVar m (Map (ConnectionId addr) PeerGSV)
dqCtx
                                (DiffTime -> KeepAliveInterval
KeepAliveInterval DiffTime
10)

      ((), trailing) <- FetchClientRegistry (ConnectionId addr) () () m
-> ConnectionId addr
-> (StrictTVar m (Map (ConnectionId addr) PeerGSV)
    -> m ((), Maybe ByteString))
-> m ((), Maybe ByteString)
forall (m :: * -> *) a peer header block.
(MonadSTM m, MonadFork m, MonadMask m, Ord peer) =>
FetchClientRegistry peer header block m
-> peer -> (StrictTVar m (Map peer PeerGSV) -> m a) -> m a
bracketKeepAliveClient FetchClientRegistry (ConnectionId addr) () () m
fetchClientRegistry ConnectionId addr
them StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> m ((), Maybe ByteString)
kacApp
      return ((), trailing)

    aKeepAliveServer
      :: NodeToNodeVersion
      -> ResponderContext ntnAddr
      -> Channel m BL.ByteString
      -> m ((), Maybe BL.ByteString)
    aKeepAliveServer :: forall ntnAddr.
NodeToNodeVersion
-> ResponderContext ntnAddr
-> Channel m ByteString
-> m ((), Maybe ByteString)
aKeepAliveServer NodeToNodeVersion
_version
                     ResponderContext {
                       rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId ntnAddr
_them
                     }
                     Channel m ByteString
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveServer"
      Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive DeserialiseFailure m ByteString
-> ProtocolSizeLimits KeepAlive ByteString
-> ProtocolTimeLimits KeepAlive
-> Channel m ByteString
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
-> m ((), Maybe ByteString)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        Tracer m (TraceSendRecv KeepAlive)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        Codec KeepAlive DeserialiseFailure m ByteString
keepAliveCodec
        ProtocolSizeLimits KeepAlive ByteString
keepAliveSizeLimits
        ProtocolTimeLimits KeepAlive
keepAliveTimeLimits
        Channel m ByteString
channel
        (Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
 -> m ((), Maybe ByteString))
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
-> m ((), Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m ()
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Server KeepAlive 'NonPipelined 'StClient m a
keepAliveServerPeer
        (KeepAliveServer m ()
 -> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ())
-> KeepAliveServer m ()
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer

    aPeerSharingClient
      :: NodeToNodeVersion
      -> ExpandedInitiatorContext addr m
      -> Channel m BL.ByteString
      -> m ((), Maybe BL.ByteString)
    aPeerSharingClient :: ClientApp addr ByteString m ()
aPeerSharingClient NodeToNodeVersion
_version
                       ExpandedInitiatorContext {
                         eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId   = ConnectionId addr
them
                       , eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
                       }
                       Channel m ByteString
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingClient"
      PeerSharingRegistry addr m
-> addr
-> (PeerSharingController addr m -> m ((), Maybe ByteString))
-> m ((), Maybe ByteString)
forall peer (m :: * -> *) a.
(Ord peer, MonadSTM m, MonadThrow m) =>
PeerSharingRegistry peer m
-> peer -> (PeerSharingController peer m -> m a) -> m a
bracketPeerSharingClient PeerSharingRegistry addr m
peerSharingRegistry (ConnectionId addr -> addr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId addr
them)
        ((PeerSharingController addr m -> m ((), Maybe ByteString))
 -> m ((), Maybe ByteString))
-> (PeerSharingController addr m -> m ((), Maybe ByteString))
-> m ((), Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \PeerSharingController addr m
controller -> do
          psClient <- ControlMessageSTM m
-> PeerSharingController addr m -> m (PeerSharingClient addr m ())
forall (m :: * -> *) peer.
(Alternative (STM m), MonadMVar m, MonadSTM m, MonadThrow m) =>
ControlMessageSTM m
-> PeerSharingController peer m -> m (PeerSharingClient peer m ())
peerSharingClient ControlMessageSTM m
controlMessageSTM PeerSharingController addr m
controller
          ((), trailing) <- runPeerWithLimits
            nullTracer
            peerSharingCodec
            peerSharingSizeLimits
            peerSharingTimeLimits
            channel
            (peerSharingClientPeer psClient)
          return ((), trailing)

    aPeerSharingServer
      :: NodeToNodeVersion
      -> ResponderContext addr
      -> Channel m BL.ByteString
      -> m ((), Maybe BL.ByteString)
    aPeerSharingServer :: ServerApp addr ByteString m ()
aPeerSharingServer NodeToNodeVersion
_version
                       ResponderContext {
                         rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addr
_them
                       }
                       Channel m ByteString
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingServer"
      Tracer m (TraceSendRecv (PeerSharing addr))
-> Codec (PeerSharing addr) DeserialiseFailure m ByteString
-> ProtocolSizeLimits (PeerSharing addr) ByteString
-> ProtocolTimeLimits (PeerSharing addr)
-> Channel m ByteString
-> Peer (PeerSharing addr) 'AsServer 'NonPipelined 'StIdle m ()
-> m ((), Maybe ByteString)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        Tracer m (TraceSendRecv (PeerSharing addr))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        Codec (PeerSharing addr) DeserialiseFailure m ByteString
peerSharingCodec
        ProtocolSizeLimits (PeerSharing addr) ByteString
peerSharingSizeLimits
        ProtocolTimeLimits (PeerSharing addr)
peerSharingTimeLimits
        Channel m ByteString
channel
        (Peer (PeerSharing addr) 'AsServer 'NonPipelined 'StIdle m ()
 -> m ((), Maybe ByteString))
-> Peer (PeerSharing addr) 'AsServer 'NonPipelined 'StIdle m ()
-> m ((), Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ PeerSharingServer addr m
-> Peer (PeerSharing addr) 'AsServer 'NonPipelined 'StIdle m ()
forall (m :: * -> *) peerAddress.
Monad m =>
PeerSharingServer peerAddress m
-> Server (PeerSharing peerAddress) 'NonPipelined 'StIdle m ()
peerSharingServerPeer
        (PeerSharingServer addr m
 -> Peer (PeerSharing addr) 'AsServer 'NonPipelined 'StIdle m ())
-> PeerSharingServer addr m
-> Peer (PeerSharing addr) 'AsServer 'NonPipelined 'StIdle m ()
forall a b. (a -> b) -> a -> b
$ PeerSharingAPI addr StdGen m -> PeerSharingServer addr m
forall (m :: * -> *) peer s.
(MonadSTM m, MonadMonotonicTime m, Hashable peer, RandomGen s) =>
PeerSharingAPI peer s m -> PeerSharingServer peer m
peerSharingServer PeerSharingAPI addr StdGen m
peerSharingAPI


data Protocols appType initiatorCtx responderCtx bytes m a b =
  Protocols {
    -- | keep-alive mini-protocol
    --
    forall (appType :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
Protocols appType initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
keepAliveProtocol   :: RunMiniProtocol appType initiatorCtx responderCtx bytes m a b

    -- | peer sharing mini-protocol
    --
  , forall (appType :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
Protocols appType initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
peerSharingProtocol :: RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
  }

nodeToNodeProtocols
  :: LimitsAndTimeouts addr
  -> Protocols appType initiatorCtx responderCtx bytes m a b
  -> NodeToNodeVersion
  -- ^ negotiated version number
  -> NodeToNodeVersionData
  -- ^ negotiated version data
  -> OuroborosBundle appType initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols :: forall addr (appType :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
LimitsAndTimeouts addr
-> Protocols appType initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundle appType initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols LimitsAndTimeouts {
                      MiniProtocolLimits
keepAliveLimits :: MiniProtocolLimits
keepAliveLimits :: forall addr. LimitsAndTimeouts addr -> MiniProtocolLimits
keepAliveLimits
                    , MiniProtocolLimits
peerSharingLimits :: MiniProtocolLimits
peerSharingLimits :: forall addr. LimitsAndTimeouts addr -> MiniProtocolLimits
peerSharingLimits
                    }
                    Protocols {
                      RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
keepAliveProtocol :: forall (appType :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
Protocols appType initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
keepAliveProtocol :: RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
keepAliveProtocol
                    , RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
peerSharingProtocol :: forall (appType :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
Protocols appType initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
peerSharingProtocol :: RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
peerSharingProtocol
                    }
                    NodeToNodeVersion
_version
                    NodeToNodeVersionData {
                      PeerSharing
peerSharing :: NodeToNodeVersionData -> PeerSharing
peerSharing :: PeerSharing
peerSharing
                    }
                    =
    WithProtocolTemperature
  'Hot [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> WithProtocolTemperature
     'Warm [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> WithProtocolTemperature
     'Established
     [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> TemperatureBundle
     [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
TemperatureBundle
      -- Hot protocols: 'chain-sync', 'block-fetch' and 'tx-submission'.
      ([MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> WithProtocolTemperature
     'Hot [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
forall a. a -> WithProtocolTemperature 'Hot a
WithHot [])

      -- Warm protocols: reserved for 'tip-sample'.
      ([MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> WithProtocolTemperature
     'Warm [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm [])

      -- Established protocols: 'keep-alive'.
      ([MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> WithProtocolTemperature
     'Established
     [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished ([MiniProtocol appType initiatorCtx responderCtx bytes m a b]
 -> WithProtocolTemperature
      'Established
      [MiniProtocol appType initiatorCtx responderCtx bytes m a b])
-> [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> WithProtocolTemperature
     'Established
     [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
forall a b. (a -> b) -> a -> b
$
        MiniProtocol {
          -- TODO: we SHOULDN'T use cardano keep alive mini-protocol number
          miniProtocolNum :: MiniProtocolNum
miniProtocolNum    = MiniProtocolNum
keepAliveMiniProtocolNum
        , miniProtocolStart :: StartOnDemandOrEagerly
miniProtocolStart  = StartOnDemandOrEagerly
StartOnDemandAny
        , miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits = MiniProtocolLimits
keepAliveLimits
        , miniProtocolRun :: RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
miniProtocolRun    = RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
keepAliveProtocol
        }
        MiniProtocol appType initiatorCtx responderCtx bytes m a b
-> [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
-> [MiniProtocol appType initiatorCtx responderCtx bytes m a b]
forall a. a -> [a] -> [a]
: case PeerSharing
peerSharing of
            PeerSharing
PeerSharingEnabled ->
              [ MiniProtocol {
                  -- TODO: we SHOULDN'T use cardano peer sharing mini-protocol number
                  miniProtocolNum :: MiniProtocolNum
miniProtocolNum    = MiniProtocolNum
peerSharingMiniProtocolNum
                , miniProtocolStart :: StartOnDemandOrEagerly
miniProtocolStart  = StartOnDemandOrEagerly
StartOnDemand
                , miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits = MiniProtocolLimits
peerSharingLimits
                , miniProtocolRun :: RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
miniProtocolRun    = RunMiniProtocol appType initiatorCtx responderCtx bytes m a b
peerSharingProtocol
                }
              ]
            PeerSharing
PeerSharingDisabled ->
              []
      )

initiatorProtocols
  :: LimitsAndTimeouts addr
  -> Apps addr bytes bytes m a b
  -> NodeToNodeVersion
  -> NodeToNodeVersionData
  -> OuroborosBundleWithExpandedCtx 'InitiatorMode addr bytes m a Void
initiatorProtocols :: forall addr bytes (m :: * -> *) a b.
LimitsAndTimeouts addr
-> Apps addr bytes bytes m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode addr bytes m a Void
initiatorProtocols LimitsAndTimeouts addr
limitsAndTimeouts
                   Apps {
                     ClientApp addr bytes m a
aKeepAliveClient :: forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ClientApp addr bKA m a
aKeepAliveClient :: ClientApp addr bytes m a
aKeepAliveClient
                   , ClientApp addr bytes m a
aPeerSharingClient :: forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ClientApp addr bPS m a
aPeerSharingClient :: ClientApp addr bytes m a
aPeerSharingClient
                   }
                   NodeToNodeVersion
version =
  LimitsAndTimeouts addr
-> Protocols
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     Void
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundle
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     Void
forall addr (appType :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
LimitsAndTimeouts addr
-> Protocols appType initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundle appType initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
    LimitsAndTimeouts addr
limitsAndTimeouts
    (Protocols {
      keepAliveProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  bytes
  m
  a
  Void
keepAliveProtocol =
        MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m
 -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (ClientApp addr bytes m a
aKeepAliveClient NodeToNodeVersion
version))
    , peerSharingProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  bytes
  m
  a
  Void
peerSharingProtocol =
        MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m
 -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (ClientApp addr bytes m a
aPeerSharingClient NodeToNodeVersion
version))
    })
    NodeToNodeVersion
version

initiatorAndResponderProtocols
  :: LimitsAndTimeouts addr
  -> Apps addr bytes bytes m a b
  -> NodeToNodeVersion
  -> NodeToNodeVersionData
  -> OuroborosBundleWithExpandedCtx 'InitiatorResponderMode addr bytes m a b
initiatorAndResponderProtocols :: forall addr bytes (m :: * -> *) a b.
LimitsAndTimeouts addr
-> Apps addr bytes bytes m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode addr bytes m a b
initiatorAndResponderProtocols LimitsAndTimeouts addr
limitsAndTimeouts
                               Apps {
                                 ClientApp addr bytes m a
aKeepAliveClient :: forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ClientApp addr bKA m a
aKeepAliveClient :: ClientApp addr bytes m a
aKeepAliveClient
                               , ServerApp addr bytes m b
aKeepAliveServer :: forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ServerApp addr bKA m b
aKeepAliveServer :: ServerApp addr bytes m b
aKeepAliveServer
                               , ClientApp addr bytes m a
aPeerSharingClient :: forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ClientApp addr bPS m a
aPeerSharingClient :: ClientApp addr bytes m a
aPeerSharingClient
                               , ServerApp addr bytes m b
aPeerSharingServer :: forall addr bKA bPS (m :: * -> *) a b.
Apps addr bKA bPS m a b -> ServerApp addr bPS m b
aPeerSharingServer :: ServerApp addr bytes m b
aPeerSharingServer
                               }
                               NodeToNodeVersion
version =
  LimitsAndTimeouts addr
-> Protocols
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundle
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     b
forall addr (appType :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
LimitsAndTimeouts addr
-> Protocols appType initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundle appType initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
    LimitsAndTimeouts addr
limitsAndTimeouts
    (Protocols {
      keepAliveProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  bytes
  m
  a
  b
keepAliveProtocol =
        MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
-> MiniProtocolCb (ResponderContext addr) bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     b
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
           ((ExpandedInitiatorContext addr m
 -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (ClientApp addr bytes m a
aKeepAliveClient NodeToNodeVersion
version))
           ((ResponderContext addr -> Channel m bytes -> m (b, Maybe bytes))
-> MiniProtocolCb (ResponderContext addr) bytes m b
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (ServerApp addr bytes m b
aKeepAliveServer NodeToNodeVersion
version))
    , peerSharingProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  bytes
  m
  a
  b
peerSharingProtocol =
        MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
-> MiniProtocolCb (ResponderContext addr) bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     bytes
     m
     a
     b
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
           ((ExpandedInitiatorContext addr m
 -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) bytes m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (ClientApp addr bytes m a
aPeerSharingClient NodeToNodeVersion
version))
           ((ResponderContext addr -> Channel m bytes -> m (b, Maybe bytes))
-> MiniProtocolCb (ResponderContext addr) bytes m b
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (ServerApp addr bytes m b
aPeerSharingServer NodeToNodeVersion
version))
    })
    NodeToNodeVersion
version

data Codecs addr m =
  Codecs {
    forall addr (m :: * -> *).
Codecs addr m -> Codec KeepAlive DeserialiseFailure m ByteString
keepAliveCodec   :: Codec KeepAlive
                          CBOR.DeserialiseFailure m BL.ByteString
  , forall addr (m :: * -> *).
Codecs addr m
-> Codec (PeerSharing addr) DeserialiseFailure m ByteString
peerSharingCodec :: Codec (Protocol.PeerSharing addr)
                          CBOR.DeserialiseFailure m BL.ByteString
  }

dmqCodecs :: MonadST m
          => (addr -> CBOR.Encoding)
          -> (forall s. CBOR.Decoder s addr)
          -> Codecs addr m
dmqCodecs :: forall (m :: * -> *) addr.
MonadST m =>
(addr -> Encoding) -> (forall s. Decoder s addr) -> Codecs addr m
dmqCodecs addr -> Encoding
encodeAddr forall s. Decoder s addr
decodeAddr =
  Codecs {
    keepAliveCodec :: Codec KeepAlive DeserialiseFailure m ByteString
keepAliveCodec   = Codec KeepAlive DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec KeepAlive DeserialiseFailure m ByteString
codecKeepAlive_v2
  , peerSharingCodec :: Codec (PeerSharing addr) DeserialiseFailure m ByteString
peerSharingCodec = (addr -> Encoding)
-> (forall s. Decoder s addr)
-> Codec (PeerSharing addr) DeserialiseFailure m ByteString
forall (m :: * -> *) peerAddress.
MonadST m =>
(peerAddress -> Encoding)
-> (forall s. Decoder s peerAddress)
-> Codec (PeerSharing peerAddress) DeserialiseFailure m ByteString
codecPeerSharing addr -> Encoding
encodeAddr Decoder s addr
forall s. Decoder s addr
decodeAddr
  }

data LimitsAndTimeouts addr =
  LimitsAndTimeouts {
    -- keep-alive
    forall addr. LimitsAndTimeouts addr -> MiniProtocolLimits
keepAliveLimits
      :: MiniProtocolLimits
  , forall addr.
LimitsAndTimeouts addr -> ProtocolSizeLimits KeepAlive ByteString
keepAliveSizeLimits
      :: ProtocolSizeLimits KeepAlive BL.ByteString
  , forall addr. LimitsAndTimeouts addr -> ProtocolTimeLimits KeepAlive
keepAliveTimeLimits
      :: ProtocolTimeLimits KeepAlive

    -- peer sharing
  , forall addr. LimitsAndTimeouts addr -> MiniProtocolLimits
peerSharingLimits
      :: MiniProtocolLimits
  , forall addr.
LimitsAndTimeouts addr -> ProtocolTimeLimits (PeerSharing addr)
peerSharingTimeLimits
      :: ProtocolTimeLimits (Protocol.PeerSharing addr)
  , forall addr.
LimitsAndTimeouts addr
-> ProtocolSizeLimits (PeerSharing addr) ByteString
peerSharingSizeLimits
      :: ProtocolSizeLimits (Protocol.PeerSharing addr) BL.ByteString
  }

dmqLimitsAndTimeouts :: LimitsAndTimeouts addr
dmqLimitsAndTimeouts :: forall addr. LimitsAndTimeouts addr
dmqLimitsAndTimeouts =
  LimitsAndTimeouts {
    keepAliveLimits :: MiniProtocolLimits
keepAliveLimits     =
      MiniProtocolLimits {
        -- One small outstanding message.
        maximumIngressQueue :: Int
maximumIngressQueue = Int -> Int
addSafetyMargin Int
1280
      }

  , keepAliveTimeLimits :: ProtocolTimeLimits KeepAlive
keepAliveTimeLimits = ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive
  , keepAliveSizeLimits :: ProtocolSizeLimits KeepAlive ByteString
keepAliveSizeLimits = (ByteString -> Word) -> ProtocolSizeLimits KeepAlive ByteString
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length)

  , peerSharingLimits :: MiniProtocolLimits
peerSharingLimits   =
      MiniProtocolLimits {
        -- This protocol does not need to be pipelined and a peer can only ask
        -- for a maximum of 255 peers each time. Hence a reply can have up to
        -- 255 IP (IPv4 or IPv6) addresses so 255 * 16 = 4080. TCP has an initial
        -- window size of 4 and a TCP segment is 1440, which gives us 4 * 1440 =
        -- 5760 bytes to fit into a single RTT. So setting the maximum ingress
        -- queue to be a single RTT should be enough to cover for CBOR overhead.
        maximumIngressQueue :: Int
maximumIngressQueue = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1440
      }
  , peerSharingTimeLimits :: ProtocolTimeLimits (PeerSharing addr)
peerSharingTimeLimits = ProtocolTimeLimits (PeerSharing addr)
forall peerAddress. ProtocolTimeLimits (PeerSharing peerAddress)
timeLimitsPeerSharing
  , peerSharingSizeLimits :: ProtocolSizeLimits (PeerSharing addr) ByteString
peerSharingSizeLimits = (ByteString -> Word)
-> ProtocolSizeLimits (PeerSharing addr) ByteString
forall peerAddress bytes.
(bytes -> Word)
-> ProtocolSizeLimits (PeerSharing peerAddress) bytes
byteLimitsPeerSharing (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length)
  }

type HandshakeTr ntnAddr = Mx.WithBearer (ConnectionId ntnAddr) (TraceSendRecv (Handshake NodeToNodeVersion CBOR.Term))

ntnHandshakeArguments
  :: MonadST m
  => Tracer m (HandshakeTr ntnAddr)
  -> HandshakeArguments
      (ConnectionId ntnAddr)
      NodeToNodeVersion
      NodeToNodeVersionData
      m
ntnHandshakeArguments :: forall (m :: * -> *) ntnAddr.
MonadST m =>
Tracer m (HandshakeTr ntnAddr)
-> HandshakeArguments
     (ConnectionId ntnAddr) NodeToNodeVersion NodeToNodeVersionData m
ntnHandshakeArguments Tracer m (HandshakeTr ntnAddr)
tracer =
  HandshakeArguments {
    haHandshakeTracer :: Tracer m (HandshakeTr ntnAddr)
haHandshakeTracer  = Tracer m (HandshakeTr ntnAddr)
tracer
  , haBearerTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) BearerTrace)
haBearerTracer     = Tracer m (WithBearer (ConnectionId ntnAddr) BearerTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer -- TODO
  , haHandshakeCodec :: Codec
  (Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
haHandshakeCodec   = CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
     (Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec
  , haVersionDataCodec :: VersionDataCodec Term NodeToNodeVersion NodeToNodeVersionData
haVersionDataCodec = (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> VersionDataCodec Term NodeToNodeVersion NodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm
  , haAcceptVersion :: NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
haAcceptVersion    = NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
  , haQueryVersion :: NodeToNodeVersionData -> Bool
haQueryVersion     = NodeToNodeVersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion
  , haTimeLimits :: ProtocolTimeLimits (Handshake NodeToNodeVersion Term)
haTimeLimits       = ProtocolTimeLimits (Handshake NodeToNodeVersion Term)
forall {k} (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
timeLimitsHandshake
  }

stdVersionDataNTN :: NetworkMagic
                  -> DiffusionMode
                  -> PeerSharing
                  -> NodeToNodeVersionData
stdVersionDataNTN :: NetworkMagic
-> DiffusionMode -> PeerSharing -> NodeToNodeVersionData
stdVersionDataNTN NetworkMagic
networkMagic DiffusionMode
diffusionMode PeerSharing
peerSharing =
  NodeToNodeVersionData
    { NetworkMagic
networkMagic :: NetworkMagic
networkMagic :: NetworkMagic
networkMagic
    , DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode
    , PeerSharing
peerSharing :: PeerSharing
peerSharing :: PeerSharing
peerSharing
    , query :: Bool
query = Bool
False
    }