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

module Ouroboros.Network.Diffusion.Common
  ( DiffusionTracer (..)
  , 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.Concurrent.Class.MonadSTM.Strict
import Control.Exception (Exception, SomeException)
import Control.Tracer (Tracer, nullTracer)

import Network.Mux qualified as Mx

import Ouroboros.Network.Mux (OuroborosApplicationWithMinimalCtx,
           OuroborosBundleWithExpandedCtx)
import Ouroboros.Network.NodeToClient (Versions)
import Ouroboros.Network.NodeToClient qualified as NodeToClient
import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit, ConnectionId,
           DiffusionMode)
import Ouroboros.Network.NodeToNode qualified as NodeToNode
import Ouroboros.Network.PeerSelection.Governor.Types (PublicPeerSelectionState)
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
           (LedgerPeersConsensusInterface)
import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
import Ouroboros.Network.Snocket (FileDescriptor)
import Ouroboros.Network.Socket (SystemdSocketTracer)

-- | The 'DiffusionTracer' logs
--
-- * diffusion initialisation messages
-- * terminal errors thrown by diffusion
--
data DiffusionTracer 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
  | SystemdSocketConfiguration SystemdSocketTracer
    deriving Int -> DiffusionTracer ntnAddr ntcAddr -> ShowS
[DiffusionTracer ntnAddr ntcAddr] -> ShowS
DiffusionTracer ntnAddr ntcAddr -> String
(Int -> DiffusionTracer ntnAddr ntcAddr -> ShowS)
-> (DiffusionTracer ntnAddr ntcAddr -> String)
-> ([DiffusionTracer ntnAddr ntcAddr] -> ShowS)
-> Show (DiffusionTracer ntnAddr ntcAddr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ntnAddr ntcAddr.
(Show ntcAddr, Show ntnAddr) =>
Int -> DiffusionTracer ntnAddr ntcAddr -> ShowS
forall ntnAddr ntcAddr.
(Show ntcAddr, Show ntnAddr) =>
[DiffusionTracer ntnAddr ntcAddr] -> ShowS
forall ntnAddr ntcAddr.
(Show ntcAddr, Show ntnAddr) =>
DiffusionTracer ntnAddr ntcAddr -> String
$cshowsPrec :: forall ntnAddr ntcAddr.
(Show ntcAddr, Show ntnAddr) =>
Int -> DiffusionTracer ntnAddr ntcAddr -> ShowS
showsPrec :: Int -> DiffusionTracer ntnAddr ntcAddr -> ShowS
$cshow :: forall ntnAddr ntcAddr.
(Show ntcAddr, Show ntnAddr) =>
DiffusionTracer ntnAddr ntcAddr -> String
show :: DiffusionTracer ntnAddr ntcAddr -> String
$cshowList :: forall ntnAddr ntcAddr.
(Show ntcAddr, Show ntnAddr) =>
[DiffusionTracer ntnAddr ntcAddr] -> ShowS
showList :: [DiffusionTracer ntnAddr ntcAddr] -> ShowS
Show

-- TODO: add a tracer for these misconfiguration
data Failure where
  UnsupportedReadySocket :: Failure
  UnexpectedIPv4Address  :: forall ntnAddr. (Show ntnAddr, Typeable ntnAddr) => ntnAddr -> Failure
  UnexpectedIPv6Address  :: forall ntnAddr. (Show ntnAddr, Typeable ntnAddr) => ntnAddr -> Failure
  NoSocket               :: Failure
  DiffusionError         :: SomeException -> Failure

deriving instance Show Failure
instance Exception Failure

-- | Common DiffusionTracers interface between P2P and NonP2P
--
data Tracers ntnAddr ntnVersion ntcAddr ntcVersion m = Tracers {
      -- | Mux tracer
      forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer
        :: Tracer m (Mx.WithBearer (ConnectionId ntnAddr) Mx.Trace)

      -- | Handshake protocol tracer
    , forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
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
    , forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer
        :: Tracer m (Mx.WithBearer (ConnectionId ntcAddr) Mx.Trace)

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

      -- | Diffusion initialisation tracer
    , forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer
        :: Tracer m (DiffusionTracer ntnAddr ntcAddr)
    }


nullTracers :: Applicative m
            => Tracers ntnAddr ntnVersion
                       ntcAddr ntcVersion
                       m
nullTracers :: forall (m :: * -> *) ntnAddr ntnVersion ntcAddr ntcVersion.
Applicative m =>
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
nullTracers = Tracers {
    dtMuxTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer            = Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
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 (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer       = Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
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
  , dtDiffusionTracer :: Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer      = Tracer m (DiffusionTracer ntnAddr ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
  }

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

      -- | an @IPv6@ socket ready to accept connections or an @IPv6@ addresses
      --
    , forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m 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
    , forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntcFd ntcAddr)
daLocalAddress             :: Maybe (Either ntcFd ntcAddr)

      -- | parameters for limiting number of accepted connections
      --
    , forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr -> AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: AcceptedConnectionsLimit

      -- | run in initiator only mode
      --
    , forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
daMode                     :: DiffusionMode

      -- | public peer selection state
      --
      -- It is created outside of diffusion, since it is needed to create some
      -- apps (e.g. peer sharing).
      --
    , forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> StrictTVar m (PublicPeerSelectionState ntnAddr)
daPublicPeerSelectionVar   :: StrictTVar m (PublicPeerSelectionState ntnAddr)
  }


-- | Versioned mini-protocol bundles run on a negotiated connection.
--
data Applications ntnAddr ntnVersion ntnVersionData
                  ntcAddr ntcVersion ntcVersionData
                  m a =
  Applications {
      -- | NodeToNode initiator applications for initiator only mode.
      --
      -- TODO: we should accept one or the other, but not both:
      -- 'daApplicationInitiatorMode', 'daApplicationInitiatorResponderMode'.
      --
      -- Even in non-p2p mode we use p2p apps.
      forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorMode ntnAddr ByteString m a Void)
daApplicationInitiatorMode
        :: Versions ntnVersion
                    ntnVersionData
                      (OuroborosBundleWithExpandedCtx
                      Mx.InitiatorMode ntnAddr
                      ByteString m a Void)

      -- | NodeToNode initiator & responder applications for bidirectional mode.
      --
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorResponderMode ntnAddr ByteString m a ())
daApplicationInitiatorResponderMode
           -- Peer Sharing result computation callback
        :: Versions ntnVersion
                    ntnVersionData
                    (OuroborosBundleWithExpandedCtx
                      Mx.InitiatorResponderMode ntnAddr
                      ByteString m a ())

      -- | NodeToClient responder application (server role)
      --
      -- Because p2p mode does not infect local connections we we use non-p2p
      -- apps.
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplicationWithMinimalCtx
        'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication
        :: Versions ntcVersion
                    ntcVersionData
                     (OuroborosApplicationWithMinimalCtx
                      Mx.ResponderMode ntcAddr
                      ByteString m Void ())

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

      -- | Callback provided by consensus to inform it if the node is
      -- connected to only local roots or also some external peers.
      --
      -- This is useful in order for the Bootstrap State Machine to
      -- simply refuse to transition from TooOld to YoungEnough while
      -- it only has local peers.
      --
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> OutboundConnectionsState -> STM m ()
daUpdateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
  }