{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

-- | This is the starting point for a module that will bring together the
-- overall node to client protocol, as a collection of mini-protocols.
--
module Ouroboros.Network.NodeToClient
  ( nodeToClientProtocols
  , NodeToClientProtocols (..)
  , NodeToClientVersion (..)
  , NodeToClientVersionData (..)
  , NetworkConnectTracers (..)
  , nullNetworkConnectTracers
  , connectTo
  , NetworkServerTracers (..)
  , nullNetworkServerTracers
  , NetworkMutableState (..)
  , newNetworkMutableState
  , newNetworkMutableStateSTM
  , cleanNetworkMutableState
  , withServer
  , NetworkClientSubcriptionTracers
  , NetworkSubscriptionTracers (..)
  , ClientSubscriptionParams (..)
  , ncSubscriptionWorker
    -- * Null Protocol Peers
  , chainSyncPeerNull
  , localStateQueryPeerNull
  , localTxSubmissionPeerNull
  , localTxMonitorPeerNull
    -- * Re-exported network interface
  , IOManager (..)
  , AssociateWithIOCP
  , withIOManager
  , LocalSnocket
  , localSnocket
  , LocalSocket (..)
  , LocalAddress (..)
    -- * Versions
  , Versions (..)
  , versionedNodeToClientProtocols
  , simpleSingletonVersions
  , foldMapVersions
  , combineVersions
    -- ** Codecs
  , nodeToClientHandshakeCodec
  , nodeToClientVersionCodec
  , nodeToClientCodecCBORTerm
    -- * Re-exports
  , ConnectionId (..)
  , LocalConnectionId
  , ErrorPolicies (..)
  , networkErrorPolicies
  , nullErrorPolicies
  , ErrorPolicy (..)
  , ErrorPolicyTrace (..)
  , WithAddr (..)
  , SuspendDecision (..)
  , TraceSendRecv (..)
  , ProtocolLimitFailure
  , Handshake
  , LocalAddresses (..)
  , SubscriptionTrace (..)
  , HandshakeTr
  ) where

import           Cardano.Prelude (FatalError)

import qualified Control.Concurrent.Async as Async
import           Control.Exception (ErrorCall, IOException)
import           Control.Monad (forever)
import           Control.Monad.Class.MonadST
import           Control.Monad.Class.MonadSTM
import           Control.Monad.Class.MonadTimer

import qualified Codec.CBOR.Read as CBOR
import qualified Codec.CBOR.Term as CBOR
import qualified Data.ByteString.Lazy as BL
import           Data.Functor.Contravariant (contramap)
import           Data.Functor.Identity (Identity (..))
import           Data.Kind (Type)
import           Data.Void (Void)

import           Network.Mux (WithMuxBearer (..))
import           Network.Mux.Types (MuxRuntimeError (..))
import           Network.TypedProtocol (Peer)
import           Network.TypedProtocol.Codec

import           Ouroboros.Network.Driver (TraceSendRecv (..))
import           Ouroboros.Network.Driver.Limits (ProtocolLimitFailure (..))
import           Ouroboros.Network.Driver.Simple (DecoderFailure)
import           Ouroboros.Network.ErrorPolicy
import           Ouroboros.Network.IOManager
import           Ouroboros.Network.Mux
import           Ouroboros.Network.NodeToClient.Version
import           Ouroboros.Network.Protocol.ChainSync.Client as ChainSync
import qualified Ouroboros.Network.Protocol.ChainSync.Type as ChainSync
import           Ouroboros.Network.Protocol.Handshake.Codec
import           Ouroboros.Network.Protocol.Handshake.Type
import           Ouroboros.Network.Protocol.Handshake.Version hiding (Accept)
import           Ouroboros.Network.Protocol.LocalStateQuery.Client as LocalStateQuery
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
import           Ouroboros.Network.Protocol.LocalTxMonitor.Client as LocalTxMonitor
import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LocalTxMonitor
import           Ouroboros.Network.Protocol.LocalTxSubmission.Client as LocalTxSubmission
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LocalTxSubmission
import           Ouroboros.Network.Snocket
import           Ouroboros.Network.Socket
import           Ouroboros.Network.Subscription.Client
                     (ClientSubscriptionParams (..))
import qualified Ouroboros.Network.Subscription.Client as Subscription
import           Ouroboros.Network.Subscription.Ip (SubscriptionTrace (..))
import           Ouroboros.Network.Subscription.Worker (LocalAddresses (..))
import           Ouroboros.Network.Tracers

-- The Handshake tracer types are simply terrible.
type HandshakeTr ntcAddr ntcVersion =
    WithMuxBearer (ConnectionId ntcAddr)
                  (TraceSendRecv (Handshake ntcVersion CBOR.Term))


-- | Recorod of node-to-client mini protocols.
--
data NodeToClientProtocols appType bytes m a b = NodeToClientProtocols {
    -- | local chain-sync mini-protocol
    --
    NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localChainSyncProtocol    :: RunMiniProtocol appType bytes m a b,

    -- | local tx-submission mini-protocol
    --
    NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localTxSubmissionProtocol :: RunMiniProtocol appType bytes m a b,

    -- | local state-query mini-protocol
    --
    NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localStateQueryProtocol   :: RunMiniProtocol appType bytes m a b,

    -- | local tx-monitor mini-protocol
    --
    NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localTxMonitorProtocol    :: RunMiniProtocol appType bytes m a b
  }


-- | 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.
--
nodeToClientProtocols
  :: (ConnectionId addr -> STM m ControlMessage -> NodeToClientProtocols appType bytes m a b)
  -> NodeToClientVersion
  -> OuroborosApplication appType addr bytes m a b
nodeToClientProtocols :: (ConnectionId addr
 -> STM m ControlMessage
 -> NodeToClientProtocols appType bytes m a b)
-> NodeToClientVersion
-> OuroborosApplication appType addr bytes m a b
nodeToClientProtocols ConnectionId addr
-> STM m ControlMessage
-> NodeToClientProtocols appType bytes m a b
protocols NodeToClientVersion
version =
    (ConnectionId addr
 -> STM m ControlMessage -> [MiniProtocol appType bytes m a b])
-> OuroborosApplication appType addr bytes m a b
forall (mode :: MuxMode) addr bytes (m :: * -> *) a b.
(ConnectionId addr
 -> ControlMessageSTM m -> [MiniProtocol mode bytes m a b])
-> OuroborosApplication mode addr bytes m a b
OuroborosApplication ((ConnectionId addr
  -> STM m ControlMessage -> [MiniProtocol appType bytes m a b])
 -> OuroborosApplication appType addr bytes m a b)
-> (ConnectionId addr
    -> STM m ControlMessage -> [MiniProtocol appType bytes m a b])
-> OuroborosApplication appType addr bytes m a b
forall a b. (a -> b) -> a -> b
$ \ConnectionId addr
connectionId STM m ControlMessage
controlMessageSTM ->
      case ConnectionId addr
-> STM m ControlMessage
-> NodeToClientProtocols appType bytes m a b
protocols ConnectionId addr
connectionId STM m ControlMessage
controlMessageSTM of
        NodeToClientProtocols {
            RunMiniProtocol appType bytes m a b
localChainSyncProtocol :: RunMiniProtocol appType bytes m a b
localChainSyncProtocol :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localChainSyncProtocol,
            RunMiniProtocol appType bytes m a b
localTxSubmissionProtocol :: RunMiniProtocol appType bytes m a b
localTxSubmissionProtocol :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localTxSubmissionProtocol,
            RunMiniProtocol appType bytes m a b
localStateQueryProtocol :: RunMiniProtocol appType bytes m a b
localStateQueryProtocol :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localStateQueryProtocol,
            RunMiniProtocol appType bytes m a b
localTxMonitorProtocol :: RunMiniProtocol appType bytes m a b
localTxMonitorProtocol :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
NodeToClientProtocols appType bytes m a b
-> RunMiniProtocol appType bytes m a b
localTxMonitorProtocol
          } ->
          [ RunMiniProtocol appType bytes m a b
-> MiniProtocol appType bytes m a b
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localChainSyncMiniProtocol RunMiniProtocol appType bytes m a b
localChainSyncProtocol
          , RunMiniProtocol appType bytes m a b
-> MiniProtocol appType bytes m a b
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localTxSubmissionMiniProtocol RunMiniProtocol appType bytes m a b
localTxSubmissionProtocol
          ] [MiniProtocol appType bytes m a b]
-> [MiniProtocol appType bytes m a b]
-> [MiniProtocol appType bytes m a b]
forall a. Semigroup a => a -> a -> a
<>
          [ RunMiniProtocol appType bytes m a b
-> MiniProtocol appType bytes m a b
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localStateQueryMiniProtocol RunMiniProtocol appType bytes m a b
localStateQueryProtocol
          ] [MiniProtocol appType bytes m a b]
-> [MiniProtocol appType bytes m a b]
-> [MiniProtocol appType bytes m a b]
forall a. Semigroup a => a -> a -> a
<>
          [ RunMiniProtocol appType bytes m a b
-> MiniProtocol appType bytes m a b
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localTxMonitorMiniProtocol RunMiniProtocol appType bytes m a b
localTxMonitorProtocol
          | NodeToClientVersion
version NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_12
          ]

  where
    localChainSyncMiniProtocol :: RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localChainSyncMiniProtocol RunMiniProtocol mode bytes m a b
localChainSyncProtocol = MiniProtocol :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocolNum
-> MiniProtocolLimits
-> RunMiniProtocol mode bytes m a b
-> MiniProtocol mode bytes m a b
MiniProtocol {
        miniProtocolNum :: MiniProtocolNum
miniProtocolNum    = Word16 -> MiniProtocolNum
MiniProtocolNum Word16
5,
        miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits = MiniProtocolLimits
maximumMiniProtocolLimits,
        miniProtocolRun :: RunMiniProtocol mode bytes m a b
miniProtocolRun    = RunMiniProtocol mode bytes m a b
localChainSyncProtocol
      }
    localTxSubmissionMiniProtocol :: RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localTxSubmissionMiniProtocol RunMiniProtocol mode bytes m a b
localTxSubmissionProtocol = MiniProtocol :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocolNum
-> MiniProtocolLimits
-> RunMiniProtocol mode bytes m a b
-> MiniProtocol mode bytes m a b
MiniProtocol {
        miniProtocolNum :: MiniProtocolNum
miniProtocolNum    = Word16 -> MiniProtocolNum
MiniProtocolNum Word16
6,
        miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits = MiniProtocolLimits
maximumMiniProtocolLimits,
        miniProtocolRun :: RunMiniProtocol mode bytes m a b
miniProtocolRun    = RunMiniProtocol mode bytes m a b
localTxSubmissionProtocol
      }
    localStateQueryMiniProtocol :: RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localStateQueryMiniProtocol RunMiniProtocol mode bytes m a b
localStateQueryProtocol = MiniProtocol :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocolNum
-> MiniProtocolLimits
-> RunMiniProtocol mode bytes m a b
-> MiniProtocol mode bytes m a b
MiniProtocol {
        miniProtocolNum :: MiniProtocolNum
miniProtocolNum    = Word16 -> MiniProtocolNum
MiniProtocolNum Word16
7,
        miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits = MiniProtocolLimits
maximumMiniProtocolLimits,
        miniProtocolRun :: RunMiniProtocol mode bytes m a b
miniProtocolRun    = RunMiniProtocol mode bytes m a b
localStateQueryProtocol
      }
    localTxMonitorMiniProtocol :: RunMiniProtocol mode bytes m a b -> MiniProtocol mode bytes m a b
localTxMonitorMiniProtocol RunMiniProtocol mode bytes m a b
localTxMonitorProtocol = MiniProtocol :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocolNum
-> MiniProtocolLimits
-> RunMiniProtocol mode bytes m a b
-> MiniProtocol mode bytes m a b
MiniProtocol {
        miniProtocolNum :: MiniProtocolNum
miniProtocolNum    = Word16 -> MiniProtocolNum
MiniProtocolNum Word16
9,
        miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits = MiniProtocolLimits
maximumMiniProtocolLimits,
        miniProtocolRun :: RunMiniProtocol mode bytes m a b
miniProtocolRun    = RunMiniProtocol mode bytes m a b
localTxMonitorProtocol
    }

maximumMiniProtocolLimits :: MiniProtocolLimits
maximumMiniProtocolLimits :: MiniProtocolLimits
maximumMiniProtocolLimits =
    MiniProtocolLimits :: Int -> MiniProtocolLimits
MiniProtocolLimits {
      maximumIngressQueue :: Int
maximumIngressQueue = Int
0xffffffff
    }


nodeToClientHandshakeCodec :: MonadST m
                           => Codec (Handshake NodeToClientVersion CBOR.Term)
                                    CBOR.DeserialiseFailure m BL.ByteString
nodeToClientHandshakeCodec :: Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  m
  ByteString
nodeToClientHandshakeCodec = CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
     (Handshake NodeToClientVersion 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) NodeToClientVersion
nodeToClientVersionCodec


-- | 'Versions' containing a single version of 'nodeToClientProtocols'.
--
versionedNodeToClientProtocols
    :: NodeToClientVersion
    -> NodeToClientVersionData
    -> (ConnectionId LocalAddress -> STM m ControlMessage -> NodeToClientProtocols appType bytes m a b)
    -> Versions NodeToClientVersion
                NodeToClientVersionData
                (OuroborosApplication appType LocalAddress bytes m a b)
versionedNodeToClientProtocols :: NodeToClientVersion
-> NodeToClientVersionData
-> (ConnectionId LocalAddress
    -> STM m ControlMessage
    -> NodeToClientProtocols appType bytes m a b)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication appType LocalAddress bytes m a b)
versionedNodeToClientProtocols NodeToClientVersion
versionNumber NodeToClientVersionData
versionData ConnectionId LocalAddress
-> STM m ControlMessage
-> NodeToClientProtocols appType bytes m a b
protocols =
    NodeToClientVersion
-> NodeToClientVersionData
-> OuroborosApplication appType LocalAddress bytes m a b
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication appType LocalAddress bytes m a b)
forall vNum vData r. vNum -> vData -> r -> Versions vNum vData r
simpleSingletonVersions
      NodeToClientVersion
versionNumber
      NodeToClientVersionData
versionData
      ((ConnectionId LocalAddress
 -> STM m ControlMessage
 -> NodeToClientProtocols appType bytes m a b)
-> NodeToClientVersion
-> OuroborosApplication appType LocalAddress bytes m a b
forall addr (m :: * -> *) (appType :: MuxMode) bytes a b.
(ConnectionId addr
 -> STM m ControlMessage
 -> NodeToClientProtocols appType bytes m a b)
-> NodeToClientVersion
-> OuroborosApplication appType addr bytes m a b
nodeToClientProtocols ConnectionId LocalAddress
-> STM m ControlMessage
-> NodeToClientProtocols appType bytes m a b
protocols NodeToClientVersion
versionNumber)

-- | A specialised version of 'Ouroboros.Network.Socket.connectToNode'.  It is
-- a general purpose function which can connect using any version of the
-- protocol.  This is mostly useful for future enhancements.
--
connectTo
  :: LocalSnocket
  -- ^ callback constructed by 'Ouroboros.Network.IOManager.withIOManager'
  -> NetworkConnectTracers LocalAddress NodeToClientVersion
  -> Versions NodeToClientVersion
              NodeToClientVersionData
              (OuroborosApplication InitiatorMode LocalAddress BL.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
  -> IO ()
connectTo :: LocalSnocket
-> NetworkConnectTracers LocalAddress NodeToClientVersion
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO a b)
-> FilePath
-> IO ()
connectTo LocalSnocket
snocket NetworkConnectTracers LocalAddress NodeToClientVersion
tracers Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication
     'InitiatorMode LocalAddress ByteString IO a b)
versions FilePath
path =
    LocalSnocket
-> Codec
     (Handshake NodeToClientVersion Term)
     DeserialiseFailure
     IO
     ByteString
-> ProtocolTimeLimits (Handshake NodeToClientVersion Term)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
-> NetworkConnectTracers LocalAddress NodeToClientVersion
-> (NodeToClientVersionData
    -> NodeToClientVersionData -> Accept NodeToClientVersionData)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'InitiatorMode LocalAddress ByteString IO a b)
-> Maybe LocalAddress
-> LocalAddress
-> IO ()
forall (appType :: MuxMode) vNumber vData fd addr a b.
(Ord vNumber, Typeable vNumber, Show vNumber,
 HasInitiator appType ~ 'True) =>
Snocket IO fd addr
-> Codec (Handshake vNumber Term) DeserialiseFailure IO ByteString
-> ProtocolTimeLimits (Handshake vNumber Term)
-> VersionDataCodec Term vNumber vData
-> NetworkConnectTracers addr vNumber
-> (vData -> vData -> Accept vData)
-> Versions
     vNumber vData (OuroborosApplication appType addr ByteString IO a b)
-> Maybe addr
-> addr
-> IO ()
connectToNode LocalSnocket
snocket
                  Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  IO
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  m
  ByteString
nodeToClientHandshakeCodec
                  ProtocolTimeLimits (Handshake NodeToClientVersion Term)
forall k (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
noTimeLimitsHandshake
                  ((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
                  NetworkConnectTracers LocalAddress NodeToClientVersion
tracers
                  NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
                  Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication
     'InitiatorMode LocalAddress ByteString IO a b)
versions
                  Maybe LocalAddress
forall a. Maybe a
Nothing
                  (FilePath -> LocalAddress
localAddressFromPath FilePath
path)


-- | A specialised version of 'Ouroboros.Network.Socket.withServerNode'.
--
-- Comments to 'Ouroboros.Network.NodeToNode.withServer' apply here as well.
--
withServer
  :: LocalSnocket
  -> NetworkServerTracers LocalAddress NodeToClientVersion
  -> NetworkMutableState LocalAddress
  -> LocalSocket
  -> Versions NodeToClientVersion
              NodeToClientVersionData
              (OuroborosApplication ResponderMode LocalAddress BL.ByteString IO a b)
  -> ErrorPolicies
  -> IO Void
withServer :: LocalSnocket
-> NetworkServerTracers LocalAddress NodeToClientVersion
-> NetworkMutableState LocalAddress
-> LocalSocket
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'ResponderMode LocalAddress ByteString IO a b)
-> ErrorPolicies
-> IO Void
withServer LocalSnocket
sn NetworkServerTracers LocalAddress NodeToClientVersion
tracers NetworkMutableState LocalAddress
networkState LocalSocket
sd Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication
     'ResponderMode LocalAddress ByteString IO a b)
versions ErrorPolicies
errPolicies =
  LocalSnocket
-> NetworkServerTracers LocalAddress NodeToClientVersion
-> NetworkMutableState LocalAddress
-> AcceptedConnectionsLimit
-> LocalSocket
-> Codec
     (Handshake NodeToClientVersion Term)
     DeserialiseFailure
     IO
     ByteString
-> ProtocolTimeLimits (Handshake NodeToClientVersion Term)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
-> (NodeToClientVersionData
    -> NodeToClientVersionData -> Accept NodeToClientVersionData)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (SomeResponderApplication LocalAddress ByteString IO b)
-> ErrorPolicies
-> (LocalAddress -> Async Void -> IO Void)
-> IO Void
forall vNumber vData t fd addr b.
(Ord vNumber, Typeable vNumber, Show vNumber, Ord addr) =>
Snocket IO fd addr
-> NetworkServerTracers addr vNumber
-> NetworkMutableState addr
-> AcceptedConnectionsLimit
-> fd
-> Codec (Handshake vNumber Term) DeserialiseFailure IO ByteString
-> ProtocolTimeLimits (Handshake vNumber Term)
-> VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions
     vNumber vData (SomeResponderApplication addr ByteString IO b)
-> ErrorPolicies
-> (addr -> Async Void -> IO t)
-> IO t
withServerNode'
    LocalSnocket
sn
    NetworkServerTracers LocalAddress NodeToClientVersion
tracers
    NetworkMutableState LocalAddress
networkState
    (Word32 -> Word32 -> DiffTime -> AcceptedConnectionsLimit
AcceptedConnectionsLimit Word32
forall a. Bounded a => a
maxBound Word32
forall a. Bounded a => a
maxBound DiffTime
0)
    LocalSocket
sd
    Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  IO
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  m
  ByteString
nodeToClientHandshakeCodec
    ProtocolTimeLimits (Handshake NodeToClientVersion Term)
forall k (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
noTimeLimitsHandshake
    ((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
    NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
    (OuroborosApplication 'ResponderMode LocalAddress ByteString IO a b
-> SomeResponderApplication LocalAddress ByteString IO b
forall (appType :: MuxMode) addr bytes (m :: * -> *) a b.
(HasResponder appType ~ 'True) =>
OuroborosApplication appType addr bytes m a b
-> SomeResponderApplication addr bytes m b
SomeResponderApplication (OuroborosApplication 'ResponderMode LocalAddress ByteString IO a b
 -> SomeResponderApplication LocalAddress ByteString IO b)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'ResponderMode LocalAddress ByteString IO a b)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (SomeResponderApplication LocalAddress ByteString IO b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication
     'ResponderMode LocalAddress ByteString IO a b)
versions)
    ErrorPolicies
errPolicies
    (\LocalAddress
_ Async Void
async -> Async Void -> IO Void
forall a. Async a -> IO a
Async.wait Async Void
async)

type NetworkClientSubcriptionTracers
    = NetworkSubscriptionTracers Identity LocalAddress NodeToClientVersion


-- | 'ncSubscriptionWorker' which starts given application versions on each
-- established connection.
--
ncSubscriptionWorker
    :: forall mode x y.
       ( HasInitiator mode ~ True
       )
    => LocalSnocket
    -> NetworkClientSubcriptionTracers
    -> NetworkMutableState LocalAddress
    -> ClientSubscriptionParams ()
    -> Versions
        NodeToClientVersion
        NodeToClientVersionData
        (OuroborosApplication mode LocalAddress BL.ByteString IO x y)
    -> IO Void
ncSubscriptionWorker :: LocalSnocket
-> NetworkClientSubcriptionTracers
-> NetworkMutableState LocalAddress
-> ClientSubscriptionParams ()
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication mode LocalAddress ByteString IO x y)
-> IO Void
ncSubscriptionWorker
  LocalSnocket
sn
  NetworkSubscriptionTracers
    { Tracer IO (Identity (SubscriptionTrace LocalAddress))
nsSubscriptionTracer :: forall (withIPList :: * -> *) addr vNumber.
NetworkSubscriptionTracers withIPList addr vNumber
-> Tracer IO (withIPList (SubscriptionTrace addr))
nsSubscriptionTracer :: Tracer IO (Identity (SubscriptionTrace LocalAddress))
nsSubscriptionTracer
    , Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
nsMuxTracer :: forall (withIPList :: * -> *) addr vNumber.
NetworkSubscriptionTracers withIPList addr vNumber
-> Tracer IO (WithMuxBearer (ConnectionId addr) MuxTrace)
nsMuxTracer :: Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
nsMuxTracer
    , Tracer
  IO
  (WithMuxBearer
     (ConnectionId LocalAddress)
     (TraceSendRecv (Handshake NodeToClientVersion Term)))
nsHandshakeTracer :: forall (withIPList :: * -> *) addr vNumber.
NetworkSubscriptionTracers withIPList addr vNumber
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
nsHandshakeTracer :: Tracer
  IO
  (WithMuxBearer
     (ConnectionId LocalAddress)
     (TraceSendRecv (Handshake NodeToClientVersion Term)))
nsHandshakeTracer
    , Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
nsErrorPolicyTracer :: forall (withIPList :: * -> *) addr vNumber.
NetworkSubscriptionTracers withIPList addr vNumber
-> Tracer IO (WithAddr addr ErrorPolicyTrace)
nsErrorPolicyTracer :: Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
nsErrorPolicyTracer
    }
  NetworkMutableState LocalAddress
networkState
  ClientSubscriptionParams ()
subscriptionParams
  Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication mode LocalAddress ByteString IO x y)
versions
    = LocalSnocket
-> Tracer IO (SubscriptionTrace LocalAddress)
-> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
-> NetworkMutableState LocalAddress
-> ClientSubscriptionParams ()
-> (LocalSocket -> IO ())
-> IO Void
forall a.
LocalSnocket
-> Tracer IO (SubscriptionTrace LocalAddress)
-> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
-> NetworkMutableState LocalAddress
-> ClientSubscriptionParams a
-> (LocalSocket -> IO a)
-> IO Void
Subscription.clientSubscriptionWorker
        LocalSnocket
sn
        (SubscriptionTrace LocalAddress
-> Identity (SubscriptionTrace LocalAddress)
forall a. a -> Identity a
Identity (SubscriptionTrace LocalAddress
 -> Identity (SubscriptionTrace LocalAddress))
-> Tracer IO (Identity (SubscriptionTrace LocalAddress))
-> Tracer IO (SubscriptionTrace LocalAddress)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Tracer IO (Identity (SubscriptionTrace LocalAddress))
nsSubscriptionTracer)
        Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
nsErrorPolicyTracer
        NetworkMutableState LocalAddress
networkState
        ClientSubscriptionParams ()
subscriptionParams
        (LocalSnocket
-> Codec
     (Handshake NodeToClientVersion Term)
     DeserialiseFailure
     IO
     ByteString
-> ProtocolTimeLimits (Handshake NodeToClientVersion Term)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
-> NetworkConnectTracers LocalAddress NodeToClientVersion
-> (NodeToClientVersionData
    -> NodeToClientVersionData -> Accept NodeToClientVersionData)
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication mode LocalAddress ByteString IO x y)
-> LocalSocket
-> IO ()
forall (appType :: MuxMode) vNumber vData fd addr a b.
(Ord vNumber, Typeable vNumber, Show vNumber,
 HasInitiator appType ~ 'True) =>
Snocket IO fd addr
-> Codec (Handshake vNumber Term) DeserialiseFailure IO ByteString
-> ProtocolTimeLimits (Handshake vNumber Term)
-> VersionDataCodec Term vNumber vData
-> NetworkConnectTracers addr vNumber
-> (vData -> vData -> Accept vData)
-> Versions
     vNumber vData (OuroborosApplication appType addr ByteString IO a b)
-> fd
-> IO ()
connectToNode'
          LocalSnocket
sn
          Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  IO
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  m
  ByteString
nodeToClientHandshakeCodec
          ProtocolTimeLimits (Handshake NodeToClientVersion Term)
forall k (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
noTimeLimitsHandshake
          ((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
          (Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId LocalAddress)
        (TraceSendRecv (Handshake NodeToClientVersion Term)))
-> NetworkConnectTracers LocalAddress NodeToClientVersion
forall addr vNumber.
Tracer IO (WithMuxBearer (ConnectionId addr) MuxTrace)
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
-> NetworkConnectTracers addr vNumber
NetworkConnectTracers Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
nsMuxTracer Tracer
  IO
  (WithMuxBearer
     (ConnectionId LocalAddress)
     (TraceSendRecv (Handshake NodeToClientVersion Term)))
nsHandshakeTracer)
          NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
          Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplication mode LocalAddress ByteString IO x y)
versions)

-- | 'ErrorPolicies' for client application.  Additional rules can be added by
-- means of a 'Semigroup' instance of 'ErrorPolicies'.
--
-- This error policies will try to preserve `subscriptionWorker`, e.g. if the
-- connect function throws an `IOException` we will suspend it for
-- a 'shortDelay', and try to re-connect.
--
-- This allows to recover from a situation where a node temporarily shutsdown,
-- or running a client application which is subscribed two more than one node
-- (possibly over network).
--
networkErrorPolicies :: ErrorPolicies
networkErrorPolicies :: ErrorPolicies
networkErrorPolicies = ErrorPolicies :: [ErrorPolicy] -> [ErrorPolicy] -> ErrorPolicies
ErrorPolicies
    { epAppErrorPolicies :: [ErrorPolicy]
epAppErrorPolicies = [
        -- Handshake client protocol error: we either did not recognise received
        -- version or we refused it.  This is only for outbound connections to
        -- a local node, thus we throw the exception.
        (HandshakeProtocolError NodeToClientVersion
 -> Maybe (SuspendDecision DiffTime))
-> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((HandshakeProtocolError NodeToClientVersion
  -> Maybe (SuspendDecision DiffTime))
 -> ErrorPolicy)
-> (HandshakeProtocolError NodeToClientVersion
    -> Maybe (SuspendDecision DiffTime))
-> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(HandshakeProtocolError NodeToClientVersion
_ :: HandshakeProtocolError NodeToClientVersion)
                -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug

        -- exception thrown by `runPeerWithLimits`
        -- trusted node send too much input
      , (ProtocolLimitFailure -> Maybe (SuspendDecision DiffTime))
-> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((ProtocolLimitFailure -> Maybe (SuspendDecision DiffTime))
 -> ErrorPolicy)
-> (ProtocolLimitFailure -> Maybe (SuspendDecision DiffTime))
-> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(ProtocolLimitFailure
_ :: ProtocolLimitFailure)
                -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug

        -- deserialisation failure of a message from a trusted node
      , (DecoderFailure -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
         ((DecoderFailure -> Maybe (SuspendDecision DiffTime))
 -> ErrorPolicy)
-> (DecoderFailure -> Maybe (SuspendDecision DiffTime))
-> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(DecoderFailure
_ :: DecoderFailure)
               -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug

      , (MuxError -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((MuxError -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy)
-> (MuxError -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(MuxError
e :: MuxError)
                -> case MuxError -> MuxErrorType
errorType MuxError
e of
                      MuxErrorType
MuxUnknownMiniProtocol       -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug
                      MuxErrorType
MuxDecodeError               -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug
                      MuxErrorType
MuxIngressQueueOverRun       -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug
                      MuxErrorType
MuxInitiatorOnly             -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug
                      MuxShutdown {}               -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug
                      MuxErrorType
MuxCleanShutdown             -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug

                      -- in case of bearer closed / or IOException we suspend
                      -- the peer for a short time
                      --
                      -- TODO: the same notes apply as to
                      -- 'NodeToNode.networkErrorPolicies'
                      MuxErrorType
MuxBearerClosed         -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just (DiffTime -> DiffTime -> SuspendDecision DiffTime
forall t. t -> t -> SuspendDecision t
SuspendPeer DiffTime
shortDelay DiffTime
shortDelay)
                      MuxIOException{}        -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just (DiffTime -> DiffTime -> SuspendDecision DiffTime
forall t. t -> t -> SuspendDecision t
SuspendPeer DiffTime
shortDelay DiffTime
shortDelay)
                      MuxErrorType
MuxSDUReadTimeout       -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just (DiffTime -> DiffTime -> SuspendDecision DiffTime
forall t. t -> t -> SuspendDecision t
SuspendPeer DiffTime
shortDelay DiffTime
shortDelay)
                      MuxErrorType
MuxSDUWriteTimeout      -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just (DiffTime -> DiffTime -> SuspendDecision DiffTime
forall t. t -> t -> SuspendDecision t
SuspendPeer DiffTime
shortDelay DiffTime
shortDelay)

      , (MuxRuntimeError -> Maybe (SuspendDecision DiffTime))
-> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((MuxRuntimeError -> Maybe (SuspendDecision DiffTime))
 -> ErrorPolicy)
-> (MuxRuntimeError -> Maybe (SuspendDecision DiffTime))
-> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(MuxRuntimeError
e :: MuxRuntimeError)
                -> case MuxRuntimeError
e of
                     ProtocolAlreadyRunning       {} -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug
                     UnknownProtocolInternalError {} -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug
                     MuxBlockedOnCompletionVar    {} -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
ourBug

        -- Error thrown by 'IOManager', this is fatal on Windows, and it will
        -- never fire on other platofrms.
      , (Void -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((Void -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy)
-> (Void -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(Void
_ :: IOManagerError)
                -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
forall t. SuspendDecision t
Throw

        -- Using 'error' throws.
      , (ErrorCall -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((ErrorCall -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy)
-> (ErrorCall -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(ErrorCall
_ :: ErrorCall)
                -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
forall t. SuspendDecision t
Throw

        -- Using 'panic' throws.
      , (FatalError -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((FatalError -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy)
-> (FatalError -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(FatalError
_ :: FatalError)
                -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
forall t. SuspendDecision t
Throw
      ]
    , epConErrorPolicies :: [ErrorPolicy]
epConErrorPolicies = [
        -- If an 'IOException' is thrown by the 'connect' call we suspend the
        -- peer for 'shortDelay' and we will try to re-connect to it after that
        -- period.
        (IOException -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy ((IOException -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy)
-> (IOException -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(IOException
_ :: IOException) -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just (SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime))
-> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a b. (a -> b) -> a -> b
$
          DiffTime -> DiffTime -> SuspendDecision DiffTime
forall t. t -> t -> SuspendDecision t
SuspendPeer DiffTime
shortDelay DiffTime
shortDelay

      , (Void -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall e.
Exception e =>
(e -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
ErrorPolicy
          ((Void -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy)
-> (Void -> Maybe (SuspendDecision DiffTime)) -> ErrorPolicy
forall a b. (a -> b) -> a -> b
$ \(Void
_ :: IOManagerError)
                -> SuspendDecision DiffTime -> Maybe (SuspendDecision DiffTime)
forall a. a -> Maybe a
Just SuspendDecision DiffTime
forall t. SuspendDecision t
Throw
      ]
    }
  where
    ourBug :: SuspendDecision DiffTime
    ourBug :: SuspendDecision DiffTime
ourBug = SuspendDecision DiffTime
forall t. SuspendDecision t
Throw

    shortDelay :: DiffTime
    shortDelay :: DiffTime
shortDelay = DiffTime
20 -- seconds

type LocalConnectionId = ConnectionId LocalAddress

--
-- Null Protocol Peers
--

chainSyncPeerNull
    :: forall (header :: Type) (point :: Type) (tip :: Type) m a. MonadTimer m
    => Peer (ChainSync.ChainSync header point tip)
            AsClient ChainSync.StIdle m a
chainSyncPeerNull :: Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncPeerNull =
    ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
ChainSync.chainSyncClientPeer
      (m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSync.ChainSyncClient m (ClientStIdle header point tip m a)
forall (m :: * -> *) a. MonadTimer m => m a
untilTheCowsComeHome )

localStateQueryPeerNull
    :: forall (block :: Type) (point :: Type) (query :: Type -> Type) m a.
       MonadTimer m
    => Peer (LocalStateQuery.LocalStateQuery block point query)
            AsClient LocalStateQuery.StIdle m a
localStateQueryPeerNull :: Peer (LocalStateQuery block point query) 'AsClient 'StIdle m a
localStateQueryPeerNull =
    LocalStateQueryClient block point query m a
-> Peer (LocalStateQuery block point query) 'AsClient 'StIdle m a
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryClient block point query m a
-> Peer (LocalStateQuery block point query) 'AsClient 'StIdle m a
LocalStateQuery.localStateQueryClientPeer
      (m (ClientStIdle block point query m a)
-> LocalStateQueryClient block point query m a
forall block point (query :: * -> *) (m :: * -> *) a.
m (ClientStIdle block point query m a)
-> LocalStateQueryClient block point query m a
LocalStateQuery.LocalStateQueryClient m (ClientStIdle block point query m a)
forall (m :: * -> *) a. MonadTimer m => m a
untilTheCowsComeHome)

localTxSubmissionPeerNull
    :: forall (tx :: Type) (reject :: Type) m a. MonadTimer m
    => Peer (LocalTxSubmission.LocalTxSubmission tx reject)
            AsClient LocalTxSubmission.StIdle m a
localTxSubmissionPeerNull :: Peer (LocalTxSubmission tx reject) 'AsClient 'StIdle m a
localTxSubmissionPeerNull =
    LocalTxSubmissionClient tx reject m a
-> Peer (LocalTxSubmission tx reject) 'AsClient 'StIdle m a
forall tx reject (m :: * -> *) a.
Monad m =>
LocalTxSubmissionClient tx reject m a
-> Peer (LocalTxSubmission tx reject) 'AsClient 'StIdle m a
LocalTxSubmission.localTxSubmissionClientPeer
      (m (LocalTxClientStIdle tx reject m a)
-> LocalTxSubmissionClient tx reject m a
forall tx reject (m :: * -> *) a.
m (LocalTxClientStIdle tx reject m a)
-> LocalTxSubmissionClient tx reject m a
LocalTxSubmission.LocalTxSubmissionClient m (LocalTxClientStIdle tx reject m a)
forall (m :: * -> *) a. MonadTimer m => m a
untilTheCowsComeHome)

localTxMonitorPeerNull
    :: forall (txid :: Type) (tx :: Type) (slot :: Type) m a. MonadTimer m
    => Peer (LocalTxMonitor.LocalTxMonitor txid tx slot)
            AsClient LocalTxMonitor.StIdle m a
localTxMonitorPeerNull :: Peer (LocalTxMonitor txid tx slot) 'AsClient 'StIdle m a
localTxMonitorPeerNull =
    LocalTxMonitorClient txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsClient 'StIdle m a
forall txid tx slot (m :: * -> *) a.
Monad m =>
LocalTxMonitorClient txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsClient 'StIdle m a
LocalTxMonitor.localTxMonitorClientPeer
      (m (ClientStIdle txid tx slot m a)
-> LocalTxMonitorClient txid tx slot m a
forall txid tx slot (m :: * -> *) a.
m (ClientStIdle txid tx slot m a)
-> LocalTxMonitorClient txid tx slot m a
LocalTxMonitor.LocalTxMonitorClient m (ClientStIdle txid tx slot m a)
forall (m :: * -> *) a. MonadTimer m => m a
untilTheCowsComeHome)

-- ;)
untilTheCowsComeHome :: MonadTimer m => m a
untilTheCowsComeHome :: m a
untilTheCowsComeHome = m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m a) -> m () -> m a
forall a b. (a -> b) -> a -> b
$ DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
43200 {- day in seconds -}