{-# LANGUAGE DuplicateRecordFields #-}

-- | Concrete `Hydra.Network` stack used in a hydra-node.
--
-- This module provides a `withNetwork` function which is the composition of several layers in order to provide various capabilities:
--
--   * `withAuthentication` handles messages' authentication and signature verification
--   * `withEtcdNetwork` uses an 'etcd' cluster to implement reliable broadcast
--
-- The following diagram details the various types of messages each layer is
-- exchanging with its predecessors and successors.
--
-- @
--
--           ▲
--           │                        │
--       Authenticated msg           msg
--           │                        │
--           │                        │
-- ┌─────────┼────────────────────────▼──────┐
-- │                                         │
-- │               Authenticate              │
-- │                                         │
-- └─────────▲────────────────────────┼──────┘
--           │                        │
--           │                        │
--          msg                      msg
--           │                        │
-- ┌─────────┼────────────────────────▼──────┐
-- │                                         │
-- │                   Etcd                  │
-- │                                         │
-- └─────────▲────────────────────────┼──────┘
--           │                        │
--           │        (bytes)         │
--           │                        ▼
--
-- @
module Hydra.Node.Network (
  NetworkConfiguration (..),
  withNetwork,
  NetworkLog,
) where

import Hydra.Prelude hiding (fromList, replicate)

import Control.Tracer (Tracer)
import Hydra.Network (NetworkComponent, NetworkConfiguration (..), ProtocolVersion (..))
import Hydra.Network.Authenticate (AuthLog, Authenticated, withAuthentication)
import Hydra.Network.Etcd (EtcdLog, withEtcdNetwork)
import Hydra.Network.Message (Message)
import Hydra.Tx (IsTx)

-- | Starts the network layer of a node, passing configured `Network` to its continuation.
withNetwork ::
  forall tx.
  IsTx tx =>
  -- | Tracer to use for logging messages.
  Tracer IO NetworkLog ->
  -- | The network configuration
  NetworkConfiguration ->
  -- | Produces a `NetworkComponent` that can send `msg` and consumes `Authenticated` @msg@.
  NetworkComponent IO (Authenticated (Message tx)) (Message tx) ()
withNetwork :: forall tx.
IsTx tx =>
Tracer IO NetworkLog
-> NetworkConfiguration
-> NetworkComponent IO (Authenticated (Message tx)) (Message tx) ()
withNetwork Tracer IO NetworkLog
tracer NetworkConfiguration
conf NetworkCallback (Authenticated (Message tx)) IO
callback Network IO (Message tx) -> IO ()
action = do
  Tracer IO AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent
     IO (Signed (Message tx)) (Signed (Message tx)) ()
-> NetworkComponent IO (Authenticated (Message tx)) (Message tx) ()
forall inbound outbound (m :: * -> *) a.
(SignableRepresentation inbound, ToJSON inbound,
 SignableRepresentation outbound) =>
Tracer m AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent m (Signed inbound) (Signed outbound) a
-> NetworkComponent m (Authenticated inbound) outbound a
withAuthentication
    ((AuthLog -> NetworkLog)
-> Tracer IO NetworkLog -> Tracer IO AuthLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap AuthLog -> NetworkLog
Authenticate Tracer IO NetworkLog
tracer)
    SigningKey HydraKey
signingKey
    [Party]
otherParties
    (Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent
     IO (Signed (Message tx)) (Signed (Message tx)) ()
forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork ((EtcdLog -> NetworkLog)
-> Tracer IO NetworkLog -> Tracer IO EtcdLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap EtcdLog -> NetworkLog
Etcd Tracer IO NetworkLog
tracer) ProtocolVersion
currentNetworkProtocolVersion NetworkConfiguration
conf)
    NetworkCallback (Authenticated (Message tx)) IO
callback
    Network IO (Message tx) -> IO ()
action
 where
  NetworkConfiguration{SigningKey HydraKey
signingKey :: SigningKey HydraKey
$sel:signingKey:NetworkConfiguration :: NetworkConfiguration -> SigningKey HydraKey
signingKey, [Party]
otherParties :: [Party]
$sel:otherParties:NetworkConfiguration :: NetworkConfiguration -> [Party]
otherParties} = NetworkConfiguration
conf

-- | The latest hydra network protocol version. Used to identify
-- incompatibilities ahead of time.
currentNetworkProtocolVersion :: ProtocolVersion
currentNetworkProtocolVersion :: ProtocolVersion
currentNetworkProtocolVersion = Natural -> ProtocolVersion
ProtocolVersion Natural
1

-- * Tracing

data NetworkLog
  = Authenticate AuthLog
  | Etcd EtcdLog
  deriving stock (NetworkLog -> NetworkLog -> Bool
(NetworkLog -> NetworkLog -> Bool)
-> (NetworkLog -> NetworkLog -> Bool) -> Eq NetworkLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NetworkLog -> NetworkLog -> Bool
== :: NetworkLog -> NetworkLog -> Bool
$c/= :: NetworkLog -> NetworkLog -> Bool
/= :: NetworkLog -> NetworkLog -> Bool
Eq, Int -> NetworkLog -> ShowS
[NetworkLog] -> ShowS
NetworkLog -> String
(Int -> NetworkLog -> ShowS)
-> (NetworkLog -> String)
-> ([NetworkLog] -> ShowS)
-> Show NetworkLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NetworkLog -> ShowS
showsPrec :: Int -> NetworkLog -> ShowS
$cshow :: NetworkLog -> String
show :: NetworkLog -> String
$cshowList :: [NetworkLog] -> ShowS
showList :: [NetworkLog] -> ShowS
Show, (forall x. NetworkLog -> Rep NetworkLog x)
-> (forall x. Rep NetworkLog x -> NetworkLog) -> Generic NetworkLog
forall x. Rep NetworkLog x -> NetworkLog
forall x. NetworkLog -> Rep NetworkLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NetworkLog -> Rep NetworkLog x
from :: forall x. NetworkLog -> Rep NetworkLog x
$cto :: forall x. Rep NetworkLog x -> NetworkLog
to :: forall x. Rep NetworkLog x -> NetworkLog
Generic)
  deriving anyclass ([NetworkLog] -> Value
[NetworkLog] -> Encoding
NetworkLog -> Bool
NetworkLog -> Value
NetworkLog -> Encoding
(NetworkLog -> Value)
-> (NetworkLog -> Encoding)
-> ([NetworkLog] -> Value)
-> ([NetworkLog] -> Encoding)
-> (NetworkLog -> Bool)
-> ToJSON NetworkLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NetworkLog -> Value
toJSON :: NetworkLog -> Value
$ctoEncoding :: NetworkLog -> Encoding
toEncoding :: NetworkLog -> Encoding
$ctoJSONList :: [NetworkLog] -> Value
toJSONList :: [NetworkLog] -> Value
$ctoEncodingList :: [NetworkLog] -> Encoding
toEncodingList :: [NetworkLog] -> Encoding
$comitField :: NetworkLog -> Bool
omitField :: NetworkLog -> Bool
ToJSON)

instance Arbitrary NetworkLog where
  arbitrary :: Gen NetworkLog
arbitrary = Gen NetworkLog
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary
  shrink :: NetworkLog -> [NetworkLog]
shrink = NetworkLog -> [NetworkLog]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink