-- Common things between P2P and NonP2P Diffusion modules
{-# LANGUAGE DataKinds #-}

module Ouroboros.Network.Diffusion.Common
  ( InitializationTracer (..)
  , Failure (..)
  , Tracers (..)
  , nullTracers
  , Arguments (..)
  , Applications (..)
  ) where

import           Data.ByteString.Lazy (ByteString)
import           Data.List.NonEmpty (NonEmpty)
import           Data.Typeable (Typeable)
import           Data.Void (Void)

import           Control.Exception (Exception, SomeException)
import           Control.Tracer (Tracer, nullTracer)

import           Network.Mux (MuxMode (..), MuxTrace, WithMuxBearer)

import           Ouroboros.Network.Mux (OuroborosApplication, OuroborosBundle)
import           Ouroboros.Network.NodeToClient (Versions)
import qualified Ouroboros.Network.NodeToClient as NodeToClient
import           Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit,
                     ConnectionId, DiffusionMode)
import qualified Ouroboros.Network.NodeToNode as NodeToNode
import           Ouroboros.Network.PeerSelection.LedgerPeers
                     (LedgerPeersConsensusInterface, TraceLedgerPeers)
import           Ouroboros.Network.Snocket (FileDescriptor)

-- TODO: use LocalAddress where appropriate rather than 'path'.
--
data InitializationTracer ntnAddr ntcAddr
  = RunServer (NonEmpty ntnAddr)
  | RunLocalServer ntcAddr
  | UsingSystemdSocket ntcAddr
  -- Rename as 'CreateLocalSocket'
  | CreateSystemdSocketForSnocketPath ntcAddr
  | CreatedLocalSocket ntcAddr
  | ConfiguringLocalSocket ntcAddr FileDescriptor
  | ListeningLocalSocket ntcAddr FileDescriptor
  | LocalSocketUp  ntcAddr FileDescriptor
  -- Rename as 'CreateServerSocket'
  | CreatingServerSocket ntnAddr
  | ConfiguringServerSocket ntnAddr
  | ListeningServerSocket ntnAddr
  | ServerSocketUp ntnAddr
  -- Rename as 'UnsupportedLocalSocketType'
  | UnsupportedLocalSystemdSocket ntnAddr
  -- Remove (this is impossible case), there's no systemd on Windows
  | UnsupportedReadySocketCase
  | DiffusionErrored SomeException
    deriving Int -> InitializationTracer ntnAddr ntcAddr -> ShowS
[InitializationTracer ntnAddr ntcAddr] -> ShowS
InitializationTracer ntnAddr ntcAddr -> String
(Int -> InitializationTracer ntnAddr ntcAddr -> ShowS)
-> (InitializationTracer ntnAddr ntcAddr -> String)
-> ([InitializationTracer ntnAddr ntcAddr] -> ShowS)
-> Show (InitializationTracer ntnAddr ntcAddr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ntnAddr ntcAddr.
(Show ntnAddr, Show ntcAddr) =>
Int -> InitializationTracer ntnAddr ntcAddr -> ShowS
forall ntnAddr ntcAddr.
(Show ntnAddr, Show ntcAddr) =>
[InitializationTracer ntnAddr ntcAddr] -> ShowS
forall ntnAddr ntcAddr.
(Show ntnAddr, Show ntcAddr) =>
InitializationTracer ntnAddr ntcAddr -> String
showList :: [InitializationTracer ntnAddr ntcAddr] -> ShowS
$cshowList :: forall ntnAddr ntcAddr.
(Show ntnAddr, Show ntcAddr) =>
[InitializationTracer ntnAddr ntcAddr] -> ShowS
show :: InitializationTracer ntnAddr ntcAddr -> String
$cshow :: forall ntnAddr ntcAddr.
(Show ntnAddr, Show ntcAddr) =>
InitializationTracer ntnAddr ntcAddr -> String
showsPrec :: Int -> InitializationTracer ntnAddr ntcAddr -> ShowS
$cshowsPrec :: forall ntnAddr ntcAddr.
(Show ntnAddr, Show ntcAddr) =>
Int -> InitializationTracer ntnAddr ntcAddr -> ShowS
Show

-- TODO: add a tracer for these misconfiguration
data Failure ntnAddr = UnsupportedReadySocket -- Windows only
                     | UnexpectedIPv4Address ntnAddr
                     | UnexpectedIPv6Address ntnAddr
                     | NoSocket
  deriving (Failure ntnAddr -> Failure ntnAddr -> Bool
(Failure ntnAddr -> Failure ntnAddr -> Bool)
-> (Failure ntnAddr -> Failure ntnAddr -> Bool)
-> Eq (Failure ntnAddr)
forall ntnAddr.
Eq ntnAddr =>
Failure ntnAddr -> Failure ntnAddr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Failure ntnAddr -> Failure ntnAddr -> Bool
$c/= :: forall ntnAddr.
Eq ntnAddr =>
Failure ntnAddr -> Failure ntnAddr -> Bool
== :: Failure ntnAddr -> Failure ntnAddr -> Bool
$c== :: forall ntnAddr.
Eq ntnAddr =>
Failure ntnAddr -> Failure ntnAddr -> Bool
Eq, Int -> Failure ntnAddr -> ShowS
[Failure ntnAddr] -> ShowS
Failure ntnAddr -> String
(Int -> Failure ntnAddr -> ShowS)
-> (Failure ntnAddr -> String)
-> ([Failure ntnAddr] -> ShowS)
-> Show (Failure ntnAddr)
forall ntnAddr. Show ntnAddr => Int -> Failure ntnAddr -> ShowS
forall ntnAddr. Show ntnAddr => [Failure ntnAddr] -> ShowS
forall ntnAddr. Show ntnAddr => Failure ntnAddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Failure ntnAddr] -> ShowS
$cshowList :: forall ntnAddr. Show ntnAddr => [Failure ntnAddr] -> ShowS
show :: Failure ntnAddr -> String
$cshow :: forall ntnAddr. Show ntnAddr => Failure ntnAddr -> String
showsPrec :: Int -> Failure ntnAddr -> ShowS
$cshowsPrec :: forall ntnAddr. Show ntnAddr => Int -> Failure ntnAddr -> ShowS
Show)

instance (Typeable ntnAddr, Show ntnAddr) => Exception (Failure ntnAddr)

-- | Common DiffusionTracers interface between P2P and NonP2P
--
data Tracers ntnAddr ntnVersion ntcAddr ntcVersion m = Tracers {
      -- | Mux tracer
      Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer
        :: Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)

      -- | Handshake protocol tracer
    , Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntnAddr ntnVersion)
dtHandshakeTracer
        :: Tracer m (NodeToNode.HandshakeTr ntnAddr ntnVersion)

      --
      -- NodeToClient tracers
      --

      -- | Mux tracer for local clients
    , Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer
        :: Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)

      -- | Handshake protocol tracer for local clients
    , Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntcAddr ntcVersion)
dtLocalHandshakeTracer
        :: Tracer m (NodeToClient.HandshakeTr ntcAddr ntcVersion)

      -- | Diffusion initialisation tracer
    , Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (InitializationTracer ntnAddr ntcAddr)
dtDiffusionInitializationTracer
        :: Tracer m (InitializationTracer ntnAddr ntcAddr)

      -- | Ledger Peers tracer
    , Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m TraceLedgerPeers
dtLedgerPeersTracer
        :: Tracer m TraceLedgerPeers
    }


nullTracers :: Applicative m
            => Tracers ntnAddr ntnVersion
                       ntcAddr ntcVersion
                       m
nullTracers :: Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
nullTracers = Tracers :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
-> Tracer m (HandshakeTr ntnAddr ntnVersion)
-> Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
-> Tracer m (HandshakeTr ntcAddr ntcVersion)
-> Tracer m (InitializationTracer ntnAddr ntcAddr)
-> Tracer m TraceLedgerPeers
-> Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
Tracers {
    dtMuxTracer :: Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer                     = Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
  , dtHandshakeTracer :: Tracer m (HandshakeTr ntnAddr ntnVersion)
dtHandshakeTracer               = Tracer m (HandshakeTr ntnAddr ntnVersion)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
  , dtLocalMuxTracer :: Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer                = Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
  , dtLocalHandshakeTracer :: Tracer m (HandshakeTr ntcAddr ntcVersion)
dtLocalHandshakeTracer          = Tracer m (HandshakeTr ntcAddr ntcVersion)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
  , dtDiffusionInitializationTracer :: Tracer m (InitializationTracer ntnAddr ntcAddr)
dtDiffusionInitializationTracer = Tracer m (InitializationTracer ntnAddr ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
  , dtLedgerPeersTracer :: Tracer m TraceLedgerPeers
dtLedgerPeersTracer             = Tracer m TraceLedgerPeers
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
  }

-- | Common DiffusionArguments interface between P2P and NonP2P
--
data Arguments ntnFd ntnAddr ntcFd ntcAddr = Arguments {
      -- | an @IPv4@ socket ready to accept connections or an @IPv4@ addresses
      --
      Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv4Address              :: Maybe (Either ntnFd ntnAddr)

      -- | an @IPV4@ socket ready to accept connections or an @IPv6@ addresses
      --
    , Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv6Address              :: Maybe (Either ntnFd ntnAddr)

      -- | an @AF_UNIX@ socket ready to accept connections or an @AF_UNIX@
      -- socket path
    , Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntcFd ntcAddr)
daLocalAddress             :: Maybe (Either ntcFd ntcAddr)

      -- | parameters for limiting number of accepted connections
      --
    , Arguments ntnFd ntnAddr ntcFd ntcAddr -> AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: AcceptedConnectionsLimit

      -- | run in initiator only mode
      --
    , Arguments ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
daMode                     :: DiffusionMode
  }

-- | Common DiffusionArguments interface between P2P and NonP2P
--
-- TODO: we need initiator only mode for blockchain explorer or a similar
-- application, there's no reason why one should run a node-to-node server for
-- it.
--
data Applications ntnAddr ntnVersion ntnVersionData
                  ntcAddr ntcVersion ntcVersionData
                  m =
  Applications {
      -- | NodeToNode initiator applications for initiator only mode.
      --
      -- TODO: we should accept one or the other, but not both:
      -- 'daApplicationInitiatorMode', 'daApplicationInitiatorResponderMode'.
      --
      Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
daApplicationInitiatorMode
        :: Versions ntnVersion
                    ntnVersionData
                    (OuroborosBundle
                      InitiatorMode ntnAddr
                      ByteString m () Void)

      -- | NodeToNode initiator & responder applications for bidirectional mode.
      --
    , Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        'InitiatorResponderMode ntnAddr ByteString m () ())
daApplicationInitiatorResponderMode
        :: Versions ntnVersion
                    ntnVersionData
                    (OuroborosBundle
                      InitiatorResponderMode ntnAddr
                      ByteString m () ())

      -- | NodeToClient responder application (server role)
      --
    , Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication
        :: Versions ntcVersion
                    ntcVersionData
                    (OuroborosApplication
                      ResponderMode ntcAddr
                      ByteString m Void ())

      -- | Interface used to get peers from the current ledger.
      --
      -- TODO: it should be in 'InterfaceExtra'
    , Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> LedgerPeersConsensusInterface m
daLedgerPeersCtx :: LedgerPeersConsensusInterface m
  }