{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module is expected to be imported qualified (it will clash
-- with the "Ouroboros.Network.Diffusion.P2P").
--
module Ouroboros.Network.Diffusion.NonP2P
  ( TracersExtra (..)
  , nullTracers
  , ApplicationsExtra (..)
  , ArgumentsExtra (..)
  , run
  ) where

import qualified Control.Concurrent.Async as Async
import           Control.Exception
import           Control.Tracer (Tracer, nullTracer, traceWith)
import           Data.Foldable (asum)
import           Data.Functor (void)
import           Data.Maybe (maybeToList)
import           Data.Void (Void)

import           Network.Socket (SockAddr, Socket)
import qualified Network.Socket as Socket

import           Ouroboros.Network.Snocket (LocalAddress, LocalSnocket,
                     LocalSocket (..), SocketSnocket, localSocketFileDescriptor)
import qualified Ouroboros.Network.Snocket as Snocket

import           Ouroboros.Network.Diffusion.Common hiding (nullTracers)
import           Ouroboros.Network.ErrorPolicy
import           Ouroboros.Network.IOManager
import           Ouroboros.Network.Mux
import           Ouroboros.Network.NodeToClient (NodeToClientVersion,
                     NodeToClientVersionData)
import qualified Ouroboros.Network.NodeToClient as NodeToClient
import           Ouroboros.Network.NodeToNode
                     (AcceptConnectionsPolicyTrace (..), DiffusionMode (..),
                     NodeToNodeVersion, NodeToNodeVersionData, RemoteAddress)
import qualified Ouroboros.Network.NodeToNode as NodeToNode
import           Ouroboros.Network.Socket (NetworkMutableState,
                     NetworkServerTracers (..), cleanNetworkMutableState,
                     newNetworkMutableState)
import           Ouroboros.Network.Subscription.Dns
import           Ouroboros.Network.Subscription.Ip
import           Ouroboros.Network.Subscription.Worker (LocalAddresses (..))
import           Ouroboros.Network.Tracers

-- | NonP2P DiffusionTracers Extras
--
data TracersExtra = TracersExtra {
      -- | IP subscription tracer
      --
      TracersExtra -> Tracer IO (WithIPList (SubscriptionTrace SockAddr))
dtIpSubscriptionTracer
        :: Tracer IO (WithIPList (SubscriptionTrace SockAddr))

      -- | DNS subscription tracer
      --
    , TracersExtra
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
dtDnsSubscriptionTracer
        :: Tracer IO (WithDomainName (SubscriptionTrace SockAddr))

      -- | DNS resolver tracer
      --
    , TracersExtra -> Tracer IO (WithDomainName DnsTrace)
dtDnsResolverTracer
        :: Tracer IO (WithDomainName DnsTrace)

    , TracersExtra -> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer
        :: Tracer IO (WithAddr SockAddr     ErrorPolicyTrace)

    , TracersExtra -> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
dtLocalErrorPolicyTracer
        :: Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)

      -- | Trace rate limiting of accepted connections
      --
    , TracersExtra -> Tracer IO AcceptConnectionsPolicyTrace
dtAcceptPolicyTracer
        :: Tracer IO AcceptConnectionsPolicyTrace
    }

nullTracers :: TracersExtra
nullTracers :: TracersExtra
nullTracers = TracersExtra
nonP2PNullTracers
  where
    nonP2PNullTracers :: TracersExtra
nonP2PNullTracers =
      TracersExtra :: Tracer IO (WithIPList (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
-> Tracer IO AcceptConnectionsPolicyTrace
-> TracersExtra
TracersExtra {
        dtIpSubscriptionTracer :: Tracer IO (WithIPList (SubscriptionTrace SockAddr))
dtIpSubscriptionTracer   = Tracer IO (WithIPList (SubscriptionTrace SockAddr))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtDnsSubscriptionTracer :: Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
dtDnsSubscriptionTracer  = Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtDnsResolverTracer :: Tracer IO (WithDomainName DnsTrace)
dtDnsResolverTracer      = Tracer IO (WithDomainName DnsTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtErrorPolicyTracer :: Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer      = Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtLocalErrorPolicyTracer :: Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
dtLocalErrorPolicyTracer = Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtAcceptPolicyTracer :: Tracer IO AcceptConnectionsPolicyTrace
dtAcceptPolicyTracer     = Tracer IO AcceptConnectionsPolicyTrace
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      }

-- | NonP2P extra arguments
--
data ArgumentsExtra = ArgumentsExtra {
      -- | ip subscription addresses
      --
      ArgumentsExtra -> IPSubscriptionTarget
daIpProducers  :: IPSubscriptionTarget

      -- | list of domain names to subscribe to
      --
    , ArgumentsExtra -> [DnsSubscriptionTarget]
daDnsProducers :: [DnsSubscriptionTarget]
    }

-- | NonP2P extra applications
--
newtype ApplicationsExtra = ApplicationsExtra {
      -- | Error policies
      --
      ApplicationsExtra -> ErrorPolicies
daErrorPolicies :: ErrorPolicies
    }

-- | Converts between OuroborosBundle and OuroborosApplication.
-- Useful for sharing the same Applications modes.
--
mkApp
    :: OuroborosBundle      mode addr bs m a b
    -> OuroborosApplication mode addr bs m a b
mkApp :: OuroborosBundle mode addr bs m a b
-> OuroborosApplication mode addr bs m a b
mkApp OuroborosBundle mode addr bs m a b
bundle =
    (ConnectionId addr
 -> ControlMessageSTM m -> [MiniProtocol mode bs m a b])
-> OuroborosApplication mode addr bs 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
  -> ControlMessageSTM m -> [MiniProtocol mode bs m a b])
 -> OuroborosApplication mode addr bs m a b)
-> (ConnectionId addr
    -> ControlMessageSTM m -> [MiniProtocol mode bs m a b])
-> OuroborosApplication mode addr bs m a b
forall a b. (a -> b) -> a -> b
$ \ConnectionId addr
connId ControlMessageSTM m
controlMessageSTM ->
      ((ConnectionId addr
  -> ControlMessageSTM m -> [MiniProtocol mode bs m a b])
 -> [MiniProtocol mode bs m a b])
-> OuroborosBundle mode addr bs m a b
-> [MiniProtocol mode bs m a b]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ConnectionId addr
-> ControlMessageSTM m -> [MiniProtocol mode bs m a b]
p -> ConnectionId addr
-> ControlMessageSTM m -> [MiniProtocol mode bs m a b]
p ConnectionId addr
connId ControlMessageSTM m
controlMessageSTM) OuroborosBundle mode addr bs m a b
bundle

-- | Converts between OuroborosBundle and OuroborosApplication.
-- Converts from InitiatorResponderMode to ResponderMode.
--
-- Useful for sharing the same Applications modes.
--
mkResponderApp
    :: OuroborosBundle      InitiatorResponderMode addr bs m a    b
    -> OuroborosApplication ResponderMode          addr bs m Void b
mkResponderApp :: OuroborosBundle 'InitiatorResponderMode addr bs m a b
-> OuroborosApplication 'ResponderMode addr bs m Void b
mkResponderApp OuroborosBundle 'InitiatorResponderMode addr bs m a b
bundle =
    (ConnectionId addr
 -> ControlMessageSTM m
 -> [MiniProtocol 'ResponderMode bs m Void b])
-> OuroborosApplication 'ResponderMode addr bs m Void 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
  -> ControlMessageSTM m
  -> [MiniProtocol 'ResponderMode bs m Void b])
 -> OuroborosApplication 'ResponderMode addr bs m Void b)
-> (ConnectionId addr
    -> ControlMessageSTM m
    -> [MiniProtocol 'ResponderMode bs m Void b])
-> OuroborosApplication 'ResponderMode addr bs m Void b
forall a b. (a -> b) -> a -> b
$ \ConnectionId addr
connId ControlMessageSTM m
controlMessageSTM ->
      ((ConnectionId addr
  -> ControlMessageSTM m
  -> [MiniProtocol 'InitiatorResponderMode bs m a b])
 -> [MiniProtocol 'ResponderMode bs m Void b])
-> OuroborosBundle 'InitiatorResponderMode addr bs m a b
-> [MiniProtocol 'ResponderMode bs m Void b]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ConnectionId addr
-> ControlMessageSTM m
-> [MiniProtocol 'InitiatorResponderMode bs m a b]
p -> (MiniProtocol 'InitiatorResponderMode bs m a b
 -> MiniProtocol 'ResponderMode bs m Void b)
-> [MiniProtocol 'InitiatorResponderMode bs m a b]
-> [MiniProtocol 'ResponderMode bs m Void b]
forall a b. (a -> b) -> [a] -> [b]
map MiniProtocol 'InitiatorResponderMode bs m a b
-> MiniProtocol 'ResponderMode bs m Void b
forall bs (m :: * -> *) a b.
MiniProtocol 'InitiatorResponderMode bs m a b
-> MiniProtocol 'ResponderMode bs m Void b
f ([MiniProtocol 'InitiatorResponderMode bs m a b]
 -> [MiniProtocol 'ResponderMode bs m Void b])
-> [MiniProtocol 'InitiatorResponderMode bs m a b]
-> [MiniProtocol 'ResponderMode bs m Void b]
forall a b. (a -> b) -> a -> b
$ ConnectionId addr
-> ControlMessageSTM m
-> [MiniProtocol 'InitiatorResponderMode bs m a b]
p ConnectionId addr
connId ControlMessageSTM m
controlMessageSTM) OuroborosBundle 'InitiatorResponderMode addr bs m a b
bundle
  where
    f :: MiniProtocol InitiatorResponderMode bs m a    b
      -> MiniProtocol ResponderMode          bs m Void b
    f :: MiniProtocol 'InitiatorResponderMode bs m a b
-> MiniProtocol 'ResponderMode bs m Void b
f MiniProtocol { MiniProtocolNum
miniProtocolNum :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum :: MiniProtocolNum
miniProtocolNum
                   , MiniProtocolLimits
miniProtocolLimits :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolLimits
miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits
                   , miniProtocolRun :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> RunMiniProtocol mode bytes m a b
miniProtocolRun = InitiatorAndResponderProtocol MuxPeer bs m a
_initiator
                                                                      MuxPeer bs m b
responder
                   } =
      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
miniProtocolNum :: MiniProtocolNum
miniProtocolNum
                   , MiniProtocolLimits
miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits
                   , miniProtocolRun :: RunMiniProtocol 'ResponderMode bs m Void b
miniProtocolRun = MuxPeer bs m b -> RunMiniProtocol 'ResponderMode bs m Void b
forall bytes (m :: * -> *) b.
MuxPeer bytes m b -> RunMiniProtocol 'ResponderMode bytes m Void b
ResponderProtocolOnly MuxPeer bs m b
responder
                   }

run
    :: Tracers
         RemoteAddress NodeToNodeVersion
         LocalAddress  NodeToClientVersion
         IO
    -> TracersExtra
    -> Arguments
         Socket      RemoteAddress
         LocalSocket LocalAddress
    -> ArgumentsExtra
    -> Applications
         RemoteAddress NodeToNodeVersion   NodeToNodeVersionData
         LocalAddress  NodeToClientVersion NodeToClientVersionData
         IO
    -> ApplicationsExtra
    -> IO ()
run :: Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> TracersExtra
-> Arguments Socket SockAddr LocalSocket LocalAddress
-> ArgumentsExtra
-> Applications
     SockAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ApplicationsExtra
-> IO ()
run Tracers
      { Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
dtMuxTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer :: Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
dtMuxTracer
      , Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
dtLocalMuxTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer :: Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
dtLocalMuxTracer
      , Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
dtHandshakeTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntnAddr ntnVersion)
dtHandshakeTracer :: Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
dtHandshakeTracer
      , Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
dtLocalHandshakeTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntcAddr ntcVersion)
dtLocalHandshakeTracer :: Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
dtLocalHandshakeTracer
      , Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (InitializationTracer ntnAddr ntcAddr)
dtDiffusionInitializationTracer :: Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
      }
    TracersExtra
      { Tracer IO (WithIPList (SubscriptionTrace SockAddr))
dtIpSubscriptionTracer :: Tracer IO (WithIPList (SubscriptionTrace SockAddr))
dtIpSubscriptionTracer :: TracersExtra -> Tracer IO (WithIPList (SubscriptionTrace SockAddr))
dtIpSubscriptionTracer
      , Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
dtDnsSubscriptionTracer :: Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
dtDnsSubscriptionTracer :: TracersExtra
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
dtDnsSubscriptionTracer
      , Tracer IO (WithDomainName DnsTrace)
dtDnsResolverTracer :: Tracer IO (WithDomainName DnsTrace)
dtDnsResolverTracer :: TracersExtra -> Tracer IO (WithDomainName DnsTrace)
dtDnsResolverTracer
      , Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer :: Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer :: TracersExtra -> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer
      , Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
dtLocalErrorPolicyTracer :: Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
dtLocalErrorPolicyTracer :: TracersExtra -> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
dtLocalErrorPolicyTracer
      , Tracer IO AcceptConnectionsPolicyTrace
dtAcceptPolicyTracer :: Tracer IO AcceptConnectionsPolicyTrace
dtAcceptPolicyTracer :: TracersExtra -> Tracer IO AcceptConnectionsPolicyTrace
dtAcceptPolicyTracer
      }
    Arguments
      { Maybe (Either Socket SockAddr)
daIPv4Address :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv4Address :: Maybe (Either Socket SockAddr)
daIPv4Address
      , Maybe (Either Socket SockAddr)
daIPv6Address :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv6Address :: Maybe (Either Socket SockAddr)
daIPv6Address
      , Maybe (Either LocalSocket LocalAddress)
daLocalAddress :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntcFd ntcAddr)
daLocalAddress :: Maybe (Either LocalSocket LocalAddress)
daLocalAddress
      , AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr -> AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: AcceptedConnectionsLimit
daAcceptedConnectionsLimit
      , daMode :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
daMode = DiffusionMode
diffusionMode
      }
     ArgumentsExtra
       { IPSubscriptionTarget
daIpProducers :: IPSubscriptionTarget
daIpProducers :: ArgumentsExtra -> IPSubscriptionTarget
daIpProducers
       , [DnsSubscriptionTarget]
daDnsProducers :: [DnsSubscriptionTarget]
daDnsProducers :: ArgumentsExtra -> [DnsSubscriptionTarget]
daDnsProducers
       }
    Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
applications
    ApplicationsExtra
      { ErrorPolicies
daErrorPolicies :: ErrorPolicies
daErrorPolicies :: ApplicationsExtra -> ErrorPolicies
daErrorPolicies } =
  IO () -> IO ()
forall a. IO a -> IO a
traceException (IO () -> IO ())
-> ((IOManager -> IO ()) -> IO ()) -> (IOManager -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOManager -> IO ()) -> IO ()
WithIOManager
withIOManager ((IOManager -> IO ()) -> IO ()) -> (IOManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOManager
iocp -> do
    let -- snocket for remote communication.
        snocket :: SocketSnocket
        snocket :: SocketSnocket
snocket = IOManager -> SocketSnocket
Snocket.socketSnocket IOManager
iocp
        localSnocket :: LocalSnocket
        localSnocket :: LocalSnocket
localSnocket = IOManager -> LocalSnocket
Snocket.localSnocket IOManager
iocp
        addresses :: [Either Socket SockAddr]
addresses = Maybe (Either Socket SockAddr) -> [Either Socket SockAddr]
forall a. Maybe a -> [a]
maybeToList Maybe (Either Socket SockAddr)
daIPv4Address
                 [Either Socket SockAddr]
-> [Either Socket SockAddr] -> [Either Socket SockAddr]
forall a. [a] -> [a] -> [a]
++ Maybe (Either Socket SockAddr) -> [Either Socket SockAddr]
forall a. Maybe a -> [a]
maybeToList Maybe (Either Socket SockAddr)
daIPv6Address

    -- networking mutable state
    NetworkMutableState SockAddr
networkState <- IO (NetworkMutableState SockAddr)
forall addr. IO (NetworkMutableState addr)
newNetworkMutableState
    NetworkMutableState LocalAddress
networkLocalState <- IO (NetworkMutableState LocalAddress)
forall addr. IO (NetworkMutableState addr)
newNetworkMutableState

    LocalAddresses SockAddr
lias <- SocketSnocket -> IO (LocalAddresses SockAddr)
getInitiatorLocalAddresses SocketSnocket
snocket

    let
        dnsSubActions :: [IO ()]
dnsSubActions = SocketSnocket
-> NetworkMutableState SockAddr
-> LocalAddresses SockAddr
-> DnsSubscriptionTarget
-> IO ()
runDnsSubscriptionWorker SocketSnocket
snocket NetworkMutableState SockAddr
networkState LocalAddresses SockAddr
lias
          (DnsSubscriptionTarget -> IO ())
-> [DnsSubscriptionTarget] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DnsSubscriptionTarget]
daDnsProducers

        serverActions :: [IO ()]
serverActions = case DiffusionMode
diffusionMode of
          DiffusionMode
InitiatorAndResponderDiffusionMode ->
            SocketSnocket
-> NetworkMutableState SockAddr -> Either Socket SockAddr -> IO ()
runServer SocketSnocket
snocket NetworkMutableState SockAddr
networkState (Either Socket SockAddr -> IO ())
-> [Either Socket SockAddr] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either Socket SockAddr]
addresses
          DiffusionMode
InitiatorOnlyDiffusionMode -> []

        localServerAction :: [IO ()]
localServerAction = LocalSnocket
-> NetworkMutableState LocalAddress
-> Either LocalSocket LocalAddress
-> IO ()
runLocalServer LocalSnocket
localSnocket NetworkMutableState LocalAddress
networkLocalState
          (Either LocalSocket LocalAddress -> IO ())
-> [Either LocalSocket LocalAddress] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Either LocalSocket LocalAddress)
-> [Either LocalSocket LocalAddress]
forall a. Maybe a -> [a]
maybeToList Maybe (Either LocalSocket LocalAddress)
daLocalAddress

        actions :: [IO ()]
actions =
          [ -- clean state thread
            NetworkMutableState SockAddr -> IO ()
forall addr. NetworkMutableState addr -> IO ()
cleanNetworkMutableState NetworkMutableState SockAddr
networkState
          , -- clean local state thread
            NetworkMutableState LocalAddress -> IO ()
forall addr. NetworkMutableState addr -> IO ()
cleanNetworkMutableState NetworkMutableState LocalAddress
networkLocalState
          , -- fork ip subscription
            SocketSnocket
-> NetworkMutableState SockAddr -> LocalAddresses SockAddr -> IO ()
runIpSubscriptionWorker SocketSnocket
snocket NetworkMutableState SockAddr
networkState LocalAddresses SockAddr
lias
          ]
          -- fork dns subscriptions
          [IO ()] -> [IO ()] -> [IO ()]
forall a. [a] -> [a] -> [a]
++ [IO ()]
dnsSubActions
          -- fork servers for remote peers
          [IO ()] -> [IO ()] -> [IO ()]
forall a. [a] -> [a] -> [a]
++ [IO ()]
serverActions
          -- fork server for local clients
          [IO ()] -> [IO ()] -> [IO ()]
forall a. [a] -> [a] -> [a]
++ [IO ()]
localServerAction

    -- Runs all threads in parallel, using Async.Concurrently's Alternative instance
    Concurrently () -> IO ()
forall a. Concurrently a -> IO a
Async.runConcurrently (Concurrently () -> IO ()) -> Concurrently () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Concurrently ()] -> Concurrently ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Concurrently ()] -> Concurrently ())
-> [Concurrently ()] -> Concurrently ()
forall a b. (a -> b) -> a -> b
$ IO () -> Concurrently ()
forall a. IO a -> Concurrently a
Async.Concurrently (IO () -> Concurrently ()) -> [IO ()] -> [Concurrently ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO ()]
actions

  where
    traceException :: IO a -> IO a
    traceException :: IO a -> IO a
traceException IO a
f = IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
f ((SomeException -> IO a) -> IO a)
-> (SomeException -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(SomeException
e :: SomeException) -> do
      Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer (SomeException -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
SomeException -> InitializationTracer ntnAddr ntcAddr
DiffusionErrored SomeException
e)
      SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
e

    --
    -- We can't share portnumber with our server since we run separate
    -- 'MuxInitiatorApplication' and 'MuxResponderApplication'
    -- applications instead of a 'MuxInitiatorAndResponderApplication'.
    -- This means we don't utilise full duplex connection.
    getInitiatorLocalAddresses :: SocketSnocket -> IO (LocalAddresses SockAddr)
    getInitiatorLocalAddresses :: SocketSnocket -> IO (LocalAddresses SockAddr)
getInitiatorLocalAddresses SocketSnocket
sn = do
        LocalAddresses SockAddr
localIpv4 <-
          case Maybe (Either Socket SockAddr)
daIPv4Address of
              Just (Right SockAddr
ipv4) -> do
                LocalAddresses SockAddr -> IO (LocalAddresses SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return LocalAddresses :: forall addr.
Maybe addr -> Maybe addr -> Maybe addr -> LocalAddresses addr
LocalAddresses
                  { laIpv4 :: Maybe SockAddr
laIpv4 = SockAddr -> Maybe SockAddr
anyIPv4Addr SockAddr
ipv4
                  , laIpv6 :: Maybe SockAddr
laIpv6 = Maybe SockAddr
forall a. Maybe a
Nothing
                  , laUnix :: Maybe SockAddr
laUnix = Maybe SockAddr
forall a. Maybe a
Nothing
                  }

              Just (Left Socket
ipv4Sock) -> do
                 SockAddr
ipv4Addrs <- SocketSnocket -> Socket -> IO SockAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr SocketSnocket
sn Socket
ipv4Sock
                 LocalAddresses SockAddr -> IO (LocalAddresses SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return LocalAddresses :: forall addr.
Maybe addr -> Maybe addr -> Maybe addr -> LocalAddresses addr
LocalAddresses
                   { laIpv4 :: Maybe SockAddr
laIpv4 = SockAddr -> Maybe SockAddr
anyIPv4Addr SockAddr
ipv4Addrs
                   , laIpv6 :: Maybe SockAddr
laIpv6 = Maybe SockAddr
forall a. Maybe a
Nothing
                   , laUnix :: Maybe SockAddr
laUnix = Maybe SockAddr
forall a. Maybe a
Nothing
                   }

              Maybe (Either Socket SockAddr)
Nothing -> do
                 LocalAddresses SockAddr -> IO (LocalAddresses SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return LocalAddresses :: forall addr.
Maybe addr -> Maybe addr -> Maybe addr -> LocalAddresses addr
LocalAddresses
                   { laIpv4 :: Maybe SockAddr
laIpv4 = Maybe SockAddr
forall a. Maybe a
Nothing
                   , laIpv6 :: Maybe SockAddr
laIpv6 = Maybe SockAddr
forall a. Maybe a
Nothing
                   , laUnix :: Maybe SockAddr
laUnix = Maybe SockAddr
forall a. Maybe a
Nothing
                   }

        LocalAddresses SockAddr
localIpv6 <-
          case Maybe (Either Socket SockAddr)
daIPv6Address of
            Just (Right SockAddr
ipv6) -> do
              LocalAddresses SockAddr -> IO (LocalAddresses SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return LocalAddresses :: forall addr.
Maybe addr -> Maybe addr -> Maybe addr -> LocalAddresses addr
LocalAddresses
                { laIpv4 :: Maybe SockAddr
laIpv4 = Maybe SockAddr
forall a. Maybe a
Nothing
                , laIpv6 :: Maybe SockAddr
laIpv6 = SockAddr -> Maybe SockAddr
anyIPv6Addr SockAddr
ipv6
                , laUnix :: Maybe SockAddr
laUnix = Maybe SockAddr
forall a. Maybe a
Nothing
                }

            Just (Left Socket
ipv6Sock) -> do
              SockAddr
ipv6Addrs <- SocketSnocket -> Socket -> IO SockAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr SocketSnocket
sn Socket
ipv6Sock
              LocalAddresses SockAddr -> IO (LocalAddresses SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return LocalAddresses :: forall addr.
Maybe addr -> Maybe addr -> Maybe addr -> LocalAddresses addr
LocalAddresses
                { laIpv4 :: Maybe SockAddr
laIpv4 = Maybe SockAddr
forall a. Maybe a
Nothing
                , laIpv6 :: Maybe SockAddr
laIpv6 = SockAddr -> Maybe SockAddr
anyIPv6Addr SockAddr
ipv6Addrs
                , laUnix :: Maybe SockAddr
laUnix = Maybe SockAddr
forall a. Maybe a
Nothing
                }

            Maybe (Either Socket SockAddr)
Nothing -> do
              LocalAddresses SockAddr -> IO (LocalAddresses SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return LocalAddresses :: forall addr.
Maybe addr -> Maybe addr -> Maybe addr -> LocalAddresses addr
LocalAddresses
                { laIpv4 :: Maybe SockAddr
laIpv4 = Maybe SockAddr
forall a. Maybe a
Nothing
                , laIpv6 :: Maybe SockAddr
laIpv6 = Maybe SockAddr
forall a. Maybe a
Nothing
                , laUnix :: Maybe SockAddr
laUnix = Maybe SockAddr
forall a. Maybe a
Nothing
                  }

        LocalAddresses SockAddr -> IO (LocalAddresses SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalAddresses SockAddr
localIpv4 LocalAddresses SockAddr
-> LocalAddresses SockAddr -> LocalAddresses SockAddr
forall a. Semigroup a => a -> a -> a
<> LocalAddresses SockAddr
localIpv6)
      where
        -- Return an IPv4 address with an emphemeral portnumber if we use IPv4
        anyIPv4Addr :: SockAddr -> Maybe SockAddr
        anyIPv4Addr :: SockAddr -> Maybe SockAddr
anyIPv4Addr Socket.SockAddrInet {} = SockAddr -> Maybe SockAddr
forall a. a -> Maybe a
Just (PortNumber -> HostAddress -> SockAddr
Socket.SockAddrInet PortNumber
0 HostAddress
0)
        anyIPv4Addr SockAddr
_                      = Maybe SockAddr
forall a. Maybe a
Nothing

        -- Return an IPv6 address with an emphemeral portnumber if we use IPv6
        anyIPv6Addr :: SockAddr -> Maybe SockAddr
        anyIPv6Addr :: SockAddr -> Maybe SockAddr
anyIPv6Addr Socket.SockAddrInet6 {} =
          SockAddr -> Maybe SockAddr
forall a. a -> Maybe a
Just (PortNumber
-> HostAddress -> HostAddress6 -> HostAddress -> SockAddr
Socket.SockAddrInet6 PortNumber
0 HostAddress
0 (HostAddress
0, HostAddress
0, HostAddress
0, HostAddress
0) HostAddress
0)
        anyIPv6Addr SockAddr
_ = Maybe SockAddr
forall a. Maybe a
Nothing

    remoteErrorPolicy, localErrorPolicy :: ErrorPolicies
    remoteErrorPolicy :: ErrorPolicies
remoteErrorPolicy = ErrorPolicies
NodeToNode.remoteNetworkErrorPolicy ErrorPolicies -> ErrorPolicies -> ErrorPolicies
forall a. Semigroup a => a -> a -> a
<> ErrorPolicies
daErrorPolicies
    localErrorPolicy :: ErrorPolicies
localErrorPolicy  = ErrorPolicies
NodeToNode.localNetworkErrorPolicy ErrorPolicies -> ErrorPolicies -> ErrorPolicies
forall a. Semigroup a => a -> a -> a
<> ErrorPolicies
daErrorPolicies

    runLocalServer :: LocalSnocket
                   -> NetworkMutableState LocalAddress
                   -> Either LocalSocket  LocalAddress
                   -> IO ()
    runLocalServer :: LocalSnocket
-> NetworkMutableState LocalAddress
-> Either LocalSocket LocalAddress
-> IO ()
runLocalServer LocalSnocket
sn NetworkMutableState LocalAddress
networkLocalState Either LocalSocket LocalAddress
localAddress =
      IO LocalSocket
-> (LocalSocket -> IO ()) -> (LocalSocket -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        IO LocalSocket
localServerInit
        LocalSocket -> IO ()
localServerCleanup
        LocalSocket -> IO ()
localServerBody
      where
        localServerInit :: IO LocalSocket
        localServerInit :: IO LocalSocket
localServerInit =
          case Either LocalSocket LocalAddress
localAddress of
#if defined(mingw32_HOST_OS)
            -- Windows uses named pipes so can't take advantage of existing sockets
            Left _ -> do
              traceWith dtDiffusionInitializationTracer UnsupportedReadySocketCase
              throwIO (UnsupportedReadySocket :: Failure RemoteAddress)
#else
            Left LocalSocket
sd -> do
              LocalAddress
addr <- LocalSnocket -> LocalSocket -> IO LocalAddress
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr LocalSnocket
sn LocalSocket
sd
              Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalAddress -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer ntnAddr ntcAddr
UsingSystemdSocket LocalAddress
addr
              LocalSocket -> IO LocalSocket
forall (m :: * -> *) a. Monad m => a -> m a
return LocalSocket
sd
#endif
            Right LocalAddress
addr -> do
              Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalAddress -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer ntnAddr ntcAddr
CreateSystemdSocketForSnocketPath LocalAddress
addr
              LocalSocket
sd <- LocalSnocket -> AddressFamily LocalAddress -> IO LocalSocket
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open
                    LocalSnocket
sn
                    (LocalSnocket -> LocalAddress -> AddressFamily LocalAddress
forall (m :: * -> *) fd addr.
Snocket m fd addr -> addr -> AddressFamily addr
Snocket.addrFamily LocalSnocket
sn LocalAddress
addr)
              Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalAddress -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer ntnAddr ntcAddr
CreatedLocalSocket LocalAddress
addr
              LocalSocket -> IO LocalSocket
forall (m :: * -> *) a. Monad m => a -> m a
return LocalSocket
sd

        -- We close the socket here, even if it was provided for us.
        localServerCleanup :: LocalSocket -> IO ()
        localServerCleanup :: LocalSocket -> IO ()
localServerCleanup = LocalSnocket -> LocalSocket -> IO ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close LocalSnocket
sn

        localServerBody :: LocalSocket -> IO ()
        localServerBody :: LocalSocket -> IO ()
localServerBody LocalSocket
sd = do
          case Either LocalSocket LocalAddress
localAddress of
               -- If a socket was provided it should be ready to accept
               Left LocalSocket
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
               Right LocalAddress
addr -> do
                 Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                  (InitializationTracer SockAddr LocalAddress -> IO ())
-> (FileDescriptor -> InitializationTracer SockAddr LocalAddress)
-> FileDescriptor
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalAddress
-> FileDescriptor -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
ConfiguringLocalSocket LocalAddress
addr
                    (FileDescriptor -> IO ()) -> IO FileDescriptor -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LocalSocket -> IO FileDescriptor
localSocketFileDescriptor LocalSocket
sd

                 LocalSnocket -> LocalSocket -> LocalAddress -> IO ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind LocalSnocket
sn LocalSocket
sd LocalAddress
addr

                 Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                  (InitializationTracer SockAddr LocalAddress -> IO ())
-> (FileDescriptor -> InitializationTracer SockAddr LocalAddress)
-> FileDescriptor
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalAddress
-> FileDescriptor -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
ListeningLocalSocket LocalAddress
addr
                    (FileDescriptor -> IO ()) -> IO FileDescriptor -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LocalSocket -> IO FileDescriptor
localSocketFileDescriptor LocalSocket
sd

                 LocalSnocket -> LocalSocket -> IO ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.listen LocalSnocket
sn LocalSocket
sd

                 Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                  (InitializationTracer SockAddr LocalAddress -> IO ())
-> (FileDescriptor -> InitializationTracer SockAddr LocalAddress)
-> FileDescriptor
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalAddress
-> FileDescriptor -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
LocalSocketUp LocalAddress
addr
                    (FileDescriptor -> IO ()) -> IO FileDescriptor -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LocalSocket -> IO FileDescriptor
localSocketFileDescriptor LocalSocket
sd

          Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
            (InitializationTracer SockAddr LocalAddress -> IO ())
-> (LocalAddress -> InitializationTracer SockAddr LocalAddress)
-> LocalAddress
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalAddress -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer ntnAddr ntcAddr
RunLocalServer (LocalAddress -> IO ()) -> IO LocalAddress -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LocalSnocket -> LocalSocket -> IO LocalAddress
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr LocalSnocket
sn LocalSocket
sd

          IO Void -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Void -> IO ()) -> IO Void -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalSnocket
-> NetworkServerTracers LocalAddress NodeToClientVersion
-> NetworkMutableState LocalAddress
-> LocalSocket
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'ResponderMode LocalAddress ByteString IO Void ())
-> ErrorPolicies
-> IO Void
forall a b.
LocalSnocket
-> NetworkServerTracers LocalAddress NodeToClientVersion
-> NetworkMutableState LocalAddress
-> LocalSocket
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'ResponderMode LocalAddress ByteString IO a b)
-> ErrorPolicies
-> IO Void
NodeToClient.withServer
            LocalSnocket
sn
            (Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
-> Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
-> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
-> Tracer IO AcceptConnectionsPolicyTrace
-> NetworkServerTracers LocalAddress NodeToClientVersion
forall addr vNumber.
Tracer IO (WithMuxBearer (ConnectionId addr) MuxTrace)
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
-> Tracer IO (WithAddr addr ErrorPolicyTrace)
-> Tracer IO AcceptConnectionsPolicyTrace
-> NetworkServerTracers addr vNumber
NetworkServerTracers
              Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
dtLocalMuxTracer
              Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
dtLocalHandshakeTracer
              Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
dtLocalErrorPolicyTracer
              Tracer IO AcceptConnectionsPolicyTrace
dtAcceptPolicyTracer)
            NetworkMutableState LocalAddress
networkLocalState
            LocalSocket
sd
            (Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplication
        'ResponderMode LocalAddress ByteString IO Void ())
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
applications)
            ErrorPolicies
localErrorPolicy

    runServer :: SocketSnocket
              -> NetworkMutableState SockAddr
              -> Either Socket.Socket SockAddr
              -> IO ()
    runServer :: SocketSnocket
-> NetworkMutableState SockAddr -> Either Socket SockAddr -> IO ()
runServer SocketSnocket
sn NetworkMutableState SockAddr
networkState Either Socket SockAddr
address =
      IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (
          case Either Socket SockAddr
address of
               Left Socket
sd -> Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sd
               Right SockAddr
addr -> do
                 Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                  (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ SockAddr -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
CreatingServerSocket SockAddr
addr
                 SocketSnocket -> AddressFamily SockAddr -> IO Socket
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open SocketSnocket
sn (SocketSnocket -> SockAddr -> AddressFamily SockAddr
forall (m :: * -> *) fd addr.
Snocket m fd addr -> addr -> AddressFamily addr
Snocket.addrFamily SocketSnocket
sn SockAddr
addr)
        )
        (SocketSnocket -> Socket -> IO ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close SocketSnocket
sn) -- We close the socket here, even if it was provided to us.
        (\Socket
sd -> do

          SockAddr
addr <- case Either Socket SockAddr
address of
               -- If a socket was provided it should be ready to accept
               Left Socket
_ -> SocketSnocket -> Socket -> IO SockAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr SocketSnocket
sn Socket
sd
               Right SockAddr
addr -> do
                 Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                  (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ SockAddr -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
ConfiguringServerSocket SockAddr
addr
                 SocketSnocket -> Socket -> SockAddr -> IO ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind SocketSnocket
sn Socket
sd SockAddr
addr
                 Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                  (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ SockAddr -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
ListeningServerSocket SockAddr
addr
                 SocketSnocket -> Socket -> IO ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.listen SocketSnocket
sn Socket
sd
                 Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer
                  (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ SockAddr -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
ServerSocketUp SockAddr
addr
                 SockAddr -> IO SockAddr
forall (m :: * -> *) a. Monad m => a -> m a
return SockAddr
addr

          Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (InitializationTracer SockAddr LocalAddress)
dtDiffusionInitializationTracer (InitializationTracer SockAddr LocalAddress -> IO ())
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty SockAddr -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
NonEmpty ntnAddr -> InitializationTracer ntnAddr ntcAddr
RunServer (SockAddr -> NonEmpty SockAddr
forall (f :: * -> *) a. Applicative f => a -> f a
pure SockAddr
addr)

          IO Void -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Void -> IO ()) -> IO Void -> IO ()
forall a b. (a -> b) -> a -> b
$ SocketSnocket
-> NetworkServerTracers SockAddr NodeToNodeVersion
-> NetworkMutableState SockAddr
-> AcceptedConnectionsLimit
-> Socket
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication
        'ResponderMode SockAddr ByteString IO Void ())
-> ErrorPolicies
-> IO Void
forall a b.
SocketSnocket
-> NetworkServerTracers SockAddr NodeToNodeVersion
-> NetworkMutableState SockAddr
-> AcceptedConnectionsLimit
-> Socket
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication 'ResponderMode SockAddr ByteString IO a b)
-> ErrorPolicies
-> IO Void
NodeToNode.withServer
            SocketSnocket
sn
            (Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
-> Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> Tracer IO AcceptConnectionsPolicyTrace
-> NetworkServerTracers SockAddr NodeToNodeVersion
forall addr vNumber.
Tracer IO (WithMuxBearer (ConnectionId addr) MuxTrace)
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
-> Tracer IO (WithAddr addr ErrorPolicyTrace)
-> Tracer IO AcceptConnectionsPolicyTrace
-> NetworkServerTracers addr vNumber
NetworkServerTracers
              Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
dtMuxTracer
              Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
dtHandshakeTracer
              Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer
              Tracer IO AcceptConnectionsPolicyTrace
dtAcceptPolicyTracer)
            NetworkMutableState SockAddr
networkState
            AcceptedConnectionsLimit
daAcceptedConnectionsLimit
            Socket
sd
            (Bundle
  (ConnectionId SockAddr
   -> STM ControlMessage
   -> [MiniProtocol 'InitiatorResponderMode ByteString IO () ()])
-> OuroborosApplication
     'ResponderMode SockAddr ByteString IO Void ()
forall addr bs (m :: * -> *) a b.
OuroborosBundle 'InitiatorResponderMode addr bs m a b
-> OuroborosApplication 'ResponderMode addr bs m Void b
mkResponderApp (Bundle
   (ConnectionId SockAddr
    -> STM ControlMessage
    -> [MiniProtocol 'InitiatorResponderMode ByteString IO () ()])
 -> OuroborosApplication
      'ResponderMode SockAddr ByteString IO Void ())
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (Bundle
        (ConnectionId SockAddr
         -> STM ControlMessage
         -> [MiniProtocol 'InitiatorResponderMode ByteString IO () ()]))
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication
        'ResponderMode SockAddr ByteString IO Void ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundle
        'InitiatorResponderMode SockAddr ByteString IO () ())
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        'InitiatorResponderMode ntnAddr ByteString m () ())
daApplicationInitiatorResponderMode Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
applications)
            ErrorPolicies
remoteErrorPolicy
        )
    runIpSubscriptionWorker :: SocketSnocket
                            -> NetworkMutableState SockAddr
                            -> LocalAddresses SockAddr
                            -> IO ()
    runIpSubscriptionWorker :: SocketSnocket
-> NetworkMutableState SockAddr -> LocalAddresses SockAddr -> IO ()
runIpSubscriptionWorker SocketSnocket
sn NetworkMutableState SockAddr
networkState LocalAddresses SockAddr
la =
      IO Void -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
        (IO Void -> IO ()) -> IO Void -> IO ()
forall a b. (a -> b) -> a -> b
$ SocketSnocket
-> NetworkIPSubscriptionTracers SockAddr NodeToNodeVersion
-> NetworkMutableState SockAddr
-> IPSubscriptionParams ()
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication
        'InitiatorMode SockAddr ByteString IO () Void)
-> IO Void
forall (mode :: MuxMode) x y.
(HasInitiator mode ~ 'True) =>
SocketSnocket
-> NetworkIPSubscriptionTracers SockAddr NodeToNodeVersion
-> NetworkMutableState SockAddr
-> IPSubscriptionParams ()
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication mode SockAddr ByteString IO x y)
-> IO Void
NodeToNode.ipSubscriptionWorker
            SocketSnocket
sn
            (Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
-> Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> Tracer IO (WithIPList (SubscriptionTrace SockAddr))
-> NetworkIPSubscriptionTracers SockAddr NodeToNodeVersion
forall (withIPList :: * -> *) addr vNumber.
Tracer IO (WithMuxBearer (ConnectionId addr) MuxTrace)
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
-> Tracer IO (WithAddr addr ErrorPolicyTrace)
-> Tracer IO (withIPList (SubscriptionTrace addr))
-> NetworkSubscriptionTracers withIPList addr vNumber
NetworkSubscriptionTracers
              Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
dtMuxTracer
              Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
dtHandshakeTracer
              Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer
              Tracer IO (WithIPList (SubscriptionTrace SockAddr))
dtIpSubscriptionTracer)
            NetworkMutableState SockAddr
networkState
            SubscriptionParams :: forall a target.
LocalAddresses SockAddr
-> (SockAddr -> Maybe DiffTime)
-> ErrorPolicies
-> target
-> SubscriptionParams a target
SubscriptionParams
              { spLocalAddresses :: LocalAddresses SockAddr
spLocalAddresses         = LocalAddresses SockAddr
la
              , spConnectionAttemptDelay :: SockAddr -> Maybe DiffTime
spConnectionAttemptDelay = Maybe DiffTime -> SockAddr -> Maybe DiffTime
forall a b. a -> b -> a
const Maybe DiffTime
forall a. Maybe a
Nothing
              , spErrorPolicies :: ErrorPolicies
spErrorPolicies          = ErrorPolicies
remoteErrorPolicy
              , spSubscriptionTarget :: IPSubscriptionTarget
spSubscriptionTarget     = IPSubscriptionTarget
daIpProducers
              }
            (Bundle
  (ConnectionId SockAddr
   -> STM ControlMessage
   -> [MiniProtocol 'InitiatorMode ByteString IO () Void])
-> OuroborosApplication
     'InitiatorMode SockAddr ByteString IO () Void
forall (mode :: MuxMode) addr bs (m :: * -> *) a b.
OuroborosBundle mode addr bs m a b
-> OuroborosApplication mode addr bs m a b
mkApp (Bundle
   (ConnectionId SockAddr
    -> STM ControlMessage
    -> [MiniProtocol 'InitiatorMode ByteString IO () Void])
 -> OuroborosApplication
      'InitiatorMode SockAddr ByteString IO () Void)
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (Bundle
        (ConnectionId SockAddr
         -> STM ControlMessage
         -> [MiniProtocol 'InitiatorMode ByteString IO () Void]))
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication
        'InitiatorMode SockAddr ByteString IO () Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundle 'InitiatorMode SockAddr ByteString IO () Void)
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
daApplicationInitiatorMode Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
applications)

    runDnsSubscriptionWorker :: SocketSnocket
                             -> NetworkMutableState SockAddr
                             -> LocalAddresses SockAddr
                             -> DnsSubscriptionTarget
                             -> IO ()
    runDnsSubscriptionWorker :: SocketSnocket
-> NetworkMutableState SockAddr
-> LocalAddresses SockAddr
-> DnsSubscriptionTarget
-> IO ()
runDnsSubscriptionWorker SocketSnocket
sn NetworkMutableState SockAddr
networkState LocalAddresses SockAddr
la DnsSubscriptionTarget
dnsProducer =
      IO Void -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
        (IO Void -> IO ()) -> IO Void -> IO ()
forall a b. (a -> b) -> a -> b
$ SocketSnocket
-> NetworkDNSSubscriptionTracers NodeToNodeVersion SockAddr
-> NetworkMutableState SockAddr
-> DnsSubscriptionParams ()
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication
        'InitiatorMode SockAddr ByteString IO () Void)
-> IO Void
forall (mode :: MuxMode) x y.
(HasInitiator mode ~ 'True) =>
SocketSnocket
-> NetworkDNSSubscriptionTracers NodeToNodeVersion SockAddr
-> NetworkMutableState SockAddr
-> DnsSubscriptionParams ()
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication mode SockAddr ByteString IO x y)
-> IO Void
NodeToNode.dnsSubscriptionWorker
            SocketSnocket
sn
            (Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
-> Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> NetworkDNSSubscriptionTracers NodeToNodeVersion SockAddr
forall vNumber addr.
Tracer IO (WithMuxBearer (ConnectionId addr) MuxTrace)
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId addr) (TraceSendRecv (Handshake vNumber Term)))
-> Tracer IO (WithAddr addr ErrorPolicyTrace)
-> Tracer IO (WithDomainName (SubscriptionTrace addr))
-> Tracer IO (WithDomainName DnsTrace)
-> NetworkDNSSubscriptionTracers vNumber addr
NetworkDNSSubscriptionTracers
              Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
dtMuxTracer
              Tracer IO (HandshakeTr SockAddr NodeToNodeVersion)
dtHandshakeTracer
              Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
dtErrorPolicyTracer
              Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
dtDnsSubscriptionTracer
              Tracer IO (WithDomainName DnsTrace)
dtDnsResolverTracer)
            NetworkMutableState SockAddr
networkState
            SubscriptionParams :: forall a target.
LocalAddresses SockAddr
-> (SockAddr -> Maybe DiffTime)
-> ErrorPolicies
-> target
-> SubscriptionParams a target
SubscriptionParams
              { spLocalAddresses :: LocalAddresses SockAddr
spLocalAddresses         = LocalAddresses SockAddr
la
              , spConnectionAttemptDelay :: SockAddr -> Maybe DiffTime
spConnectionAttemptDelay = Maybe DiffTime -> SockAddr -> Maybe DiffTime
forall a b. a -> b -> a
const Maybe DiffTime
forall a. Maybe a
Nothing
              , spErrorPolicies :: ErrorPolicies
spErrorPolicies          = ErrorPolicies
remoteErrorPolicy
              , spSubscriptionTarget :: DnsSubscriptionTarget
spSubscriptionTarget     = DnsSubscriptionTarget
dnsProducer
              }
            (Bundle
  (ConnectionId SockAddr
   -> STM ControlMessage
   -> [MiniProtocol 'InitiatorMode ByteString IO () Void])
-> OuroborosApplication
     'InitiatorMode SockAddr ByteString IO () Void
forall (mode :: MuxMode) addr bs (m :: * -> *) a b.
OuroborosBundle mode addr bs m a b
-> OuroborosApplication mode addr bs m a b
mkApp (Bundle
   (ConnectionId SockAddr
    -> STM ControlMessage
    -> [MiniProtocol 'InitiatorMode ByteString IO () Void])
 -> OuroborosApplication
      'InitiatorMode SockAddr ByteString IO () Void)
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (Bundle
        (ConnectionId SockAddr
         -> STM ControlMessage
         -> [MiniProtocol 'InitiatorMode ByteString IO () Void]))
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosApplication
        'InitiatorMode SockAddr ByteString IO () Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundle 'InitiatorMode SockAddr ByteString IO () Void)
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
daApplicationInitiatorMode Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
applications)