{-# LANGUAGE DuplicateRecordFields #-}

-- | Concrete `Hydra.Network` stack dedicated to running a hydra-node.
--
-- This module provides a `withNetwork` function which is the composition of several layers in order to provide various capabilities:
--
--   * `withHeartbeat` maintains knowledge about peers' connectivity,
--   * `withReliability` deals with connections reliability, handling the case
--     of messages being dropped (but not node crash in general),
--   * `withAuthentication` handles messages' authentication and signature verification,
--   * `withOuroborosNetwork` deals with maintaining individual connections to peers and the nitty-gritty details of messages sending and retrieval.
--
-- The following diagram details the various types of messages each layer is
-- exchanging with its predecessors and successors.
--
-- @
--
--          ▲                                    │
--          │ Authenticate msg                   │ msg
--          │                                    │
-- ┌────────┴────────────────────────────────────▼──────┐
-- │                                                    │
-- │                   Heartbeat                        │
-- │        ▲                                           │
-- └────────┬────────────────────────────────────┼──────┘
--          │                                    │
--          │ Heartbeat (Authenticate msg)       │ Heartbeat msg
--          │                                    │
-- ┌────────┴───────────────┐                    │
-- │                        │                    │
-- │    FlipHeartbeats      │                    │
-- │                        │                    │
-- └────────▲───────────────┘                    │
--          │                                    │
--          │ Authenticate (Heartbeat msg)       │
--          │                                    │
-- ┌────────┴────────────────────────────────────▼──────┐
-- │                                                    │
-- │                   Reliability                      │
-- │                                                    │
-- └─────────▲───────────────────────────────────┼──────┘
--           │                                   │
--      Authenticated (ReliableMsg (Heartbeat msg))    ReliableMsg (Heartbeat msg)
--           │                                   │
-- ┌─────────┼───────────────────────────────────▼──────┐
-- │                                                    │
-- │                  Authenticate                      │
-- │                                                    │
-- └─────────▲───────────────────────────────────┼──────┘
--           │                                   │
--           │                                   │
--       Signed (ReliableMsg (Heartbeat msg))       Signed (ReliableMsg (Heartbeat msg))
--           │                                   │
-- ┌─────────┼───────────────────────────────────▼──────┐
-- │                                                    │
-- │                  Ouroboros                         │
-- │                                                    │
-- └─────────▲───────────────────────────────────┼──────┘
--           │                                   │
--           │           (bytes)                 │
--           │                                   ▼
--
-- @
module Hydra.Node.Network (
  NetworkConfiguration (..),
  withNetwork,
  withFlipHeartbeats,
  configureMessagePersistence,
  acksFile,
) where

import Hydra.Prelude hiding (fromList, replicate)

import Control.Tracer (Tracer)
import Hydra.Logging (traceWith)
import Hydra.Logging.Messages (HydraLog)
import Hydra.Logging.Messages qualified as Log
import Hydra.Network (Host (..), IP, Network (..), NetworkCallback (..), NetworkComponent, NodeId, PortNumber)
import Hydra.Network.Authenticate (Authenticated (..), Signed, withAuthentication)
import Hydra.Network.Heartbeat (Heartbeat (..), withHeartbeat)
import Hydra.Network.Message (
  Connectivity (..),
  HydraHandshakeRefused (..),
  HydraVersionedProtocolNumber (..),
  Message,
  NetworkEvent (..),
 )
import Hydra.Network.Ouroboros (HydraNetworkConfig (..), TraceOuroborosNetwork, WithHost, withOuroborosNetwork)
import Hydra.Network.Reliability (MessagePersistence, ReliableMsg, mkMessagePersistence, withReliability)
import Hydra.Node (HydraNodeLog (..))
import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..))
import Hydra.Persistence (Persistence (..), createPersistence, createPersistenceIncremental)
import Hydra.Tx (IsTx, Party, deriveParty)
import Hydra.Tx.Crypto (HydraKey, SigningKey)
import System.FilePath ((</>))

-- | An alias for logging messages output by network component.
-- The type is made complicated because the various subsystems use part of the tracer only.
type LogEntry tx msg = HydraLog tx (WithHost (TraceOuroborosNetwork (Signed (ReliableMsg (Heartbeat msg)))))

-- | Configuration for a `Node` network layer.
data NetworkConfiguration m = NetworkConfiguration
  { forall {k} (m :: k). NetworkConfiguration m -> FilePath
persistenceDir :: FilePath
  -- ^ Persistence directory
  , forall {k} (m :: k). NetworkConfiguration m -> SigningKey HydraKey
signingKey :: SigningKey HydraKey
  -- ^ This node's signing key. This is used to sign messages sent to peers.
  , forall {k} (m :: k). NetworkConfiguration m -> [Party]
otherParties :: [Party]
  -- ^ The list of peers `Party` known to this node.
  , forall {k} (m :: k). NetworkConfiguration m -> IP
host :: IP
  -- ^ IP address to listen on for incoming connections.
  , forall {k} (m :: k). NetworkConfiguration m -> PortNumber
port :: PortNumber
  -- ^ Port to listen on.
  , forall {k} (m :: k). NetworkConfiguration m -> [Host]
peers :: [Host]
  -- ^ Addresses and ports of remote peers.
  , forall {k} (m :: k). NetworkConfiguration m -> NodeId
nodeId :: NodeId
  -- ^ This node's id.
  }

currentHydraVersionedProtocol :: HydraVersionedProtocolNumber
currentHydraVersionedProtocol :: HydraVersionedProtocolNumber
currentHydraVersionedProtocol = Natural -> HydraVersionedProtocolNumber
MkHydraVersionedProtocolNumber Natural
1

-- | 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 (LogEntry tx (Message tx)) ->
  -- | The network configuration
  NetworkConfiguration IO ->
  -- | Produces a `NetworkComponent` that can send `msg` and consumes `Authenticated` @msg@.
  NetworkComponent IO (NetworkEvent (Message tx)) (Message tx) ()
withNetwork :: forall tx.
IsTx tx =>
Tracer IO (LogEntry tx (Message tx))
-> NetworkConfiguration IO
-> NetworkComponent IO (NetworkEvent (Message tx)) (Message tx) ()
withNetwork Tracer IO (LogEntry tx (Message tx))
tracer NetworkConfiguration IO
configuration NetworkCallback (NetworkEvent (Message tx)) IO
callback Network IO (Message tx) -> IO ()
action = do
  let localHost :: Host
localHost = Host{$sel:hostname:Host :: Text
hostname = IP -> Text
forall b a. (Show a, IsString b) => a -> b
show IP
host, PortNumber
port :: PortNumber
$sel:port:Host :: PortNumber
port}
      me :: Party
me = SigningKey HydraKey -> Party
deriveParty SigningKey HydraKey
signingKey
      numberOfParties :: Int
numberOfParties = [Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Party] -> Int) -> [Party] -> Int
forall a b. (a -> b) -> a -> b
$ Party
me Party -> [Party] -> [Party]
forall a. a -> [a] -> [a]
: [Party]
otherParties
  MessagePersistence IO (Message tx)
messagePersistence <- Tracer IO (HydraNodeLog tx)
-> FilePath -> Int -> IO (MessagePersistence IO (Message tx))
forall (m :: * -> *) msg tx.
(MonadIO m, MonadThrow m, FromJSON msg, ToJSON msg, MonadSTM m,
 MonadThread m, MonadThrow (STM m)) =>
Tracer m (HydraNodeLog tx)
-> FilePath -> Int -> m (MessagePersistence m msg)
configureMessagePersistence ((HydraNodeLog tx -> LogEntry tx (Message tx))
-> Tracer IO (LogEntry tx (Message tx))
-> Tracer IO (HydraNodeLog tx)
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog tx -> LogEntry tx (Message tx)
forall tx net. HydraNodeLog tx -> HydraLog tx net
Log.Node Tracer IO (LogEntry tx (Message tx))
tracer) FilePath
persistenceDir Int
numberOfParties

  let reliability :: NetworkComponent
  IO
  (Heartbeat (Authenticated (Message tx)))
  (Heartbeat (Message tx))
  ()
reliability =
        NetworkComponent
  IO
  (Authenticated (Heartbeat (Message tx)))
  (Heartbeat (Message tx))
  ()
-> NetworkComponent
     IO
     (Heartbeat (Authenticated (Message tx)))
     (Heartbeat (Message tx))
     ()
forall (m :: * -> *) inbound outbound a.
NetworkComponent m (Authenticated (Heartbeat inbound)) outbound a
-> NetworkComponent
     m (Heartbeat (Authenticated inbound)) outbound a
withFlipHeartbeats (NetworkComponent
   IO
   (Authenticated (Heartbeat (Message tx)))
   (Heartbeat (Message tx))
   ()
 -> NetworkComponent
      IO
      (Heartbeat (Authenticated (Message tx)))
      (Heartbeat (Message tx))
      ())
-> NetworkComponent
     IO
     (Authenticated (Heartbeat (Message tx)))
     (Heartbeat (Message tx))
     ()
-> NetworkComponent
     IO
     (Heartbeat (Authenticated (Message tx)))
     (Heartbeat (Message tx))
     ()
forall a b. (a -> b) -> a -> b
$
          Tracer IO ReliabilityLog
-> MessagePersistence IO (Message tx)
-> Party
-> [Party]
-> NetworkComponent
     IO
     (Authenticated (ReliableMsg (Heartbeat (Message tx))))
     (ReliableMsg (Heartbeat (Message tx)))
     ()
-> NetworkComponent
     IO
     (Authenticated (Heartbeat (Message tx)))
     (Heartbeat (Message tx))
     ()
forall (m :: * -> *) outbound inbound a.
(MonadThrow (STM m), MonadThrow m, MonadAsync m) =>
Tracer m ReliabilityLog
-> MessagePersistence m outbound
-> Party
-> [Party]
-> NetworkComponent
     m
     (Authenticated (ReliableMsg (Heartbeat inbound)))
     (ReliableMsg (Heartbeat outbound))
     a
-> NetworkComponent
     m (Authenticated (Heartbeat inbound)) (Heartbeat outbound) a
withReliability ((ReliabilityLog -> LogEntry tx (Message tx))
-> Tracer IO (LogEntry tx (Message tx)) -> Tracer IO ReliabilityLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap ReliabilityLog -> LogEntry tx (Message tx)
forall tx net. ReliabilityLog -> HydraLog tx net
Log.Reliability Tracer IO (LogEntry tx (Message tx))
tracer) MessagePersistence IO (Message tx)
messagePersistence Party
me [Party]
otherParties (NetworkComponent
   IO
   (Authenticated (ReliableMsg (Heartbeat (Message tx))))
   (ReliableMsg (Heartbeat (Message tx)))
   ()
 -> NetworkComponent
      IO
      (Authenticated (Heartbeat (Message tx)))
      (Heartbeat (Message tx))
      ())
-> NetworkComponent
     IO
     (Authenticated (ReliableMsg (Heartbeat (Message tx))))
     (ReliableMsg (Heartbeat (Message tx)))
     ()
-> NetworkComponent
     IO
     (Authenticated (Heartbeat (Message tx)))
     (Heartbeat (Message tx))
     ()
forall a b. (a -> b) -> a -> b
$
            Tracer IO AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent
     IO
     (Signed (ReliableMsg (Heartbeat (Message tx))))
     (Signed (ReliableMsg (Heartbeat (Message tx))))
     ()
-> NetworkComponent
     IO
     (Authenticated (ReliableMsg (Heartbeat (Message tx))))
     (ReliableMsg (Heartbeat (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 -> LogEntry tx (Message tx))
-> Tracer IO (LogEntry tx (Message tx)) -> 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 -> LogEntry tx (Message tx)
forall tx net. AuthLog -> HydraLog tx net
Log.Authentication Tracer IO (LogEntry tx (Message tx))
tracer) SigningKey HydraKey
signingKey [Party]
otherParties (NetworkComponent
   IO
   (Signed (ReliableMsg (Heartbeat (Message tx))))
   (Signed (ReliableMsg (Heartbeat (Message tx))))
   ()
 -> NetworkComponent
      IO
      (Authenticated (ReliableMsg (Heartbeat (Message tx))))
      (ReliableMsg (Heartbeat (Message tx)))
      ())
-> NetworkComponent
     IO
     (Signed (ReliableMsg (Heartbeat (Message tx))))
     (Signed (ReliableMsg (Heartbeat (Message tx))))
     ()
-> NetworkComponent
     IO
     (Authenticated (ReliableMsg (Heartbeat (Message tx))))
     (ReliableMsg (Heartbeat (Message tx)))
     ()
forall a b. (a -> b) -> a -> b
$
              Tracer
  IO
  (WithHost
     (TraceOuroborosNetwork
        (Signed (ReliableMsg (Heartbeat (Message tx))))))
-> HydraNetworkConfig
-> (HydraHandshakeRefused -> IO ())
-> NetworkComponent
     IO
     (Signed (ReliableMsg (Heartbeat (Message tx))))
     (Signed (ReliableMsg (Heartbeat (Message tx))))
     ()
forall inbound outbound.
(ToCBOR outbound, FromCBOR outbound, ToCBOR inbound,
 FromCBOR inbound) =>
Tracer IO (WithHost (TraceOuroborosNetwork outbound))
-> HydraNetworkConfig
-> (HydraHandshakeRefused -> IO ())
-> NetworkComponent IO inbound outbound ()
withOuroborosNetwork
                ((WithHost
   (TraceOuroborosNetwork
      (Signed (ReliableMsg (Heartbeat (Message tx)))))
 -> LogEntry tx (Message tx))
-> Tracer IO (LogEntry tx (Message tx))
-> Tracer
     IO
     (WithHost
        (TraceOuroborosNetwork
           (Signed (ReliableMsg (Heartbeat (Message tx))))))
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap WithHost
  (TraceOuroborosNetwork
     (Signed (ReliableMsg (Heartbeat (Message tx)))))
-> LogEntry tx (Message tx)
forall tx net. net -> HydraLog tx net
Log.Network Tracer IO (LogEntry tx (Message tx))
tracer)
                HydraNetworkConfig
                  { $sel:protocolVersion:HydraNetworkConfig :: HydraVersionedProtocolNumber
protocolVersion = HydraVersionedProtocolNumber
currentHydraVersionedProtocol
                  , Host
localHost :: Host
$sel:localHost:HydraNetworkConfig :: Host
localHost
                  , $sel:remoteHosts:HydraNetworkConfig :: [Host]
remoteHosts = [Host]
peers
                  }
                ( \HydraHandshakeRefused{Host
remoteHost :: Host
$sel:remoteHost:HydraHandshakeRefused :: HydraHandshakeRefused -> Host
remoteHost, HydraVersionedProtocolNumber
ourVersion :: HydraVersionedProtocolNumber
$sel:ourVersion:HydraHandshakeRefused :: HydraHandshakeRefused -> HydraVersionedProtocolNumber
ourVersion, KnownHydraVersions
theirVersions :: KnownHydraVersions
$sel:theirVersions:HydraHandshakeRefused :: HydraHandshakeRefused -> KnownHydraVersions
theirVersions} ->
                    NetworkEvent (Message tx) -> IO ()
deliver (NetworkEvent (Message tx) -> IO ())
-> (Connectivity -> NetworkEvent (Message tx))
-> Connectivity
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connectivity -> NetworkEvent (Message tx)
forall msg. Connectivity -> NetworkEvent msg
ConnectivityEvent (Connectivity -> IO ()) -> Connectivity -> IO ()
forall a b. (a -> b) -> a -> b
$ HandshakeFailure{Host
remoteHost :: Host
$sel:remoteHost:Connected :: Host
remoteHost, HydraVersionedProtocolNumber
ourVersion :: HydraVersionedProtocolNumber
$sel:ourVersion:Connected :: HydraVersionedProtocolNumber
ourVersion, KnownHydraVersions
theirVersions :: KnownHydraVersions
$sel:theirVersions:Connected :: KnownHydraVersions
theirVersions}
                )

  NodeId
-> NetworkComponent
     IO
     (Heartbeat (Authenticated (Message tx)))
     (Heartbeat (Message tx))
     ()
-> NetworkComponent
     IO
     (Either Connectivity (Authenticated (Message tx)))
     (Message tx)
     ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId NetworkComponent
  IO
  (Heartbeat (Authenticated (Message tx)))
  (Heartbeat (Message tx))
  ()
reliability (NetworkCallback{$sel:deliver:NetworkCallback :: Either Connectivity (Authenticated (Message tx)) -> IO ()
deliver = NetworkEvent (Message tx) -> IO ()
deliver (NetworkEvent (Message tx) -> IO ())
-> (Either Connectivity (Authenticated (Message tx))
    -> NetworkEvent (Message tx))
-> Either Connectivity (Authenticated (Message tx))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Connectivity (Authenticated (Message tx))
-> NetworkEvent (Message tx)
mapHeartbeat}) ((Network IO (Message tx) -> IO ()) -> IO ())
-> (Network IO (Message tx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network{Message tx -> IO ()
broadcast :: Message tx -> IO ()
$sel:broadcast:Network :: forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast} ->
    Network IO (Message tx) -> IO ()
action
      Network
        { $sel:broadcast:Network :: Message tx -> IO ()
broadcast = \Message tx
msg -> do
            Message tx -> IO ()
broadcast Message tx
msg
            NetworkEvent (Message tx) -> IO ()
deliver (ReceivedMessage{$sel:sender:ConnectivityEvent :: Party
sender = SigningKey HydraKey -> Party
deriveParty SigningKey HydraKey
signingKey, Message tx
msg :: Message tx
msg :: Message tx
msg})
        }
 where
  NetworkCallback{NetworkEvent (Message tx) -> IO ()
deliver :: NetworkEvent (Message tx) -> IO ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver} = NetworkCallback (NetworkEvent (Message tx)) IO
callback

  NetworkConfiguration{FilePath
$sel:persistenceDir:NetworkConfiguration :: forall {k} (m :: k). NetworkConfiguration m -> FilePath
persistenceDir :: FilePath
persistenceDir, SigningKey HydraKey
$sel:signingKey:NetworkConfiguration :: forall {k} (m :: k). NetworkConfiguration m -> SigningKey HydraKey
signingKey :: SigningKey HydraKey
signingKey, [Party]
$sel:otherParties:NetworkConfiguration :: forall {k} (m :: k). NetworkConfiguration m -> [Party]
otherParties :: [Party]
otherParties, IP
$sel:host:NetworkConfiguration :: forall {k} (m :: k). NetworkConfiguration m -> IP
host :: IP
host, PortNumber
$sel:port:NetworkConfiguration :: forall {k} (m :: k). NetworkConfiguration m -> PortNumber
port :: PortNumber
port, [Host]
$sel:peers:NetworkConfiguration :: forall {k} (m :: k). NetworkConfiguration m -> [Host]
peers :: [Host]
peers, NodeId
$sel:nodeId:NetworkConfiguration :: forall {k} (m :: k). NetworkConfiguration m -> NodeId
nodeId :: NodeId
nodeId} = NetworkConfiguration IO
configuration

  mapHeartbeat :: Either Connectivity (Authenticated (Message tx)) -> NetworkEvent (Message tx)
  mapHeartbeat :: Either Connectivity (Authenticated (Message tx))
-> NetworkEvent (Message tx)
mapHeartbeat = \case
    Left Connectivity
connectivity -> Connectivity -> NetworkEvent (Message tx)
forall msg. Connectivity -> NetworkEvent msg
ConnectivityEvent Connectivity
connectivity
    Right (Authenticated{Message tx
payload :: Message tx
$sel:payload:Authenticated :: forall msg. Authenticated msg -> msg
payload, Party
party :: Party
$sel:party:Authenticated :: forall msg. Authenticated msg -> Party
party}) -> ReceivedMessage{$sel:sender:ConnectivityEvent :: Party
sender = Party
party, msg :: Message tx
msg = Message tx
payload}

-- | Create `MessagePersistence` handle to be used by `Reliability` network layer.
--
-- This function will `throw` a `ParameterMismatch` exception if:
--
--   * Some state already exists and is loaded,
--   * The number of parties is not the same as the number of acknowledgments saved.
configureMessagePersistence ::
  (MonadIO m, MonadThrow m, FromJSON msg, ToJSON msg, MonadSTM m, MonadThread m, MonadThrow (STM m)) =>
  Tracer m (HydraNodeLog tx) ->
  FilePath ->
  Int ->
  m (MessagePersistence m msg)
configureMessagePersistence :: forall (m :: * -> *) msg tx.
(MonadIO m, MonadThrow m, FromJSON msg, ToJSON msg, MonadSTM m,
 MonadThread m, MonadThrow (STM m)) =>
Tracer m (HydraNodeLog tx)
-> FilePath -> Int -> m (MessagePersistence m msg)
configureMessagePersistence Tracer m (HydraNodeLog tx)
tracer FilePath
persistenceDir Int
numberOfParties = do
  PersistenceIncremental (Heartbeat msg) m
msgPersistence <- FilePath -> m (PersistenceIncremental (Heartbeat msg) m)
forall a (m :: * -> *).
(MonadIO m, MonadThrow m, MonadSTM m, MonadThread m,
 MonadThrow (STM m)) =>
FilePath -> m (PersistenceIncremental a m)
createPersistenceIncremental (FilePath -> m (PersistenceIncremental (Heartbeat msg) m))
-> FilePath -> m (PersistenceIncremental (Heartbeat msg) m)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
storedMessagesFile FilePath
persistenceDir
  ackPersistence :: Persistence (Vector Int) m
ackPersistence@Persistence{FromJSON (Vector Int) => m (Maybe (Vector Int))
load :: FromJSON (Vector Int) => m (Maybe (Vector Int))
$sel:load:Persistence :: forall a (m :: * -> *).
Persistence a m -> FromJSON a => m (Maybe a)
load} <- FilePath -> m (Persistence (Vector Int) m)
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
FilePath -> m (Persistence a m)
createPersistence (FilePath -> m (Persistence (Vector Int) m))
-> FilePath -> m (Persistence (Vector Int) m)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
acksFile FilePath
persistenceDir
  Maybe (Vector Int)
mAcks <- m (Maybe (Vector Int))
FromJSON (Vector Int) => m (Maybe (Vector Int))
load
  Persistence (Vector Int) m
ackPersistence' <- case (Vector Int -> Bool) -> Maybe (Vector Int) -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Vector Int
acks -> Vector Int -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Int
acks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numberOfParties) Maybe (Vector Int)
mAcks of
    Just Bool
False -> do
      let paramsMismatch :: [ParamMismatch]
paramsMismatch = [SavedNetworkPartiesInconsistent{Int
numberOfParties :: Int
$sel:numberOfParties:ContestationPeriodMismatch :: Int
numberOfParties}]
      Tracer m (HydraNodeLog tx) -> HydraNodeLog tx -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (HydraNodeLog tx)
tracer ([ParamMismatch] -> HydraNodeLog tx
forall tx. [ParamMismatch] -> HydraNodeLog tx
Misconfiguration [ParamMismatch]
paramsMismatch)
      ParameterMismatch -> m (Persistence (Vector Int) m)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ParameterMismatch -> m (Persistence (Vector Int) m))
-> ParameterMismatch -> m (Persistence (Vector Int) m)
forall a b. (a -> b) -> a -> b
$ [ParamMismatch] -> ParameterMismatch
ParameterMismatch [ParamMismatch]
paramsMismatch
    Maybe Bool
_ -> Persistence (Vector Int) m -> m (Persistence (Vector Int) m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Persistence (Vector Int) m
ackPersistence
  MessagePersistence m msg -> m (MessagePersistence m msg)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessagePersistence m msg -> m (MessagePersistence m msg))
-> MessagePersistence m msg -> m (MessagePersistence m msg)
forall a b. (a -> b) -> a -> b
$ Int
-> PersistenceIncremental (Heartbeat msg) m
-> Persistence (Vector Int) m
-> MessagePersistence m msg
forall (m :: * -> *) msg.
(MonadThrow m, FromJSON msg, ToJSON msg) =>
Int
-> PersistenceIncremental (Heartbeat msg) m
-> Persistence (Vector Int) m
-> MessagePersistence m msg
mkMessagePersistence Int
numberOfParties PersistenceIncremental (Heartbeat msg) m
msgPersistence Persistence (Vector Int) m
ackPersistence'

withFlipHeartbeats ::
  NetworkComponent m (Authenticated (Heartbeat inbound)) outbound a ->
  NetworkComponent m (Heartbeat (Authenticated inbound)) outbound a
withFlipHeartbeats :: forall (m :: * -> *) inbound outbound a.
NetworkComponent m (Authenticated (Heartbeat inbound)) outbound a
-> NetworkComponent
     m (Heartbeat (Authenticated inbound)) outbound a
withFlipHeartbeats NetworkComponent m (Authenticated (Heartbeat inbound)) outbound a
withBaseNetwork NetworkCallback{Heartbeat (Authenticated inbound) -> m ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Heartbeat (Authenticated inbound) -> m ()
deliver} =
  NetworkComponent m (Authenticated (Heartbeat inbound)) outbound a
withBaseNetwork NetworkCallback{$sel:deliver:NetworkCallback :: Authenticated (Heartbeat inbound) -> m ()
deliver = Authenticated (Heartbeat inbound) -> m ()
unwrapHeartbeats}
 where
  unwrapHeartbeats :: Authenticated (Heartbeat inbound) -> m ()
unwrapHeartbeats = \case
    Authenticated (Data NodeId
nid inbound
msg) Party
party -> Heartbeat (Authenticated inbound) -> m ()
deliver (Heartbeat (Authenticated inbound) -> m ())
-> Heartbeat (Authenticated inbound) -> m ()
forall a b. (a -> b) -> a -> b
$ NodeId
-> Authenticated inbound -> Heartbeat (Authenticated inbound)
forall msg. NodeId -> msg -> Heartbeat msg
Data NodeId
nid (inbound -> Party -> Authenticated inbound
forall msg. msg -> Party -> Authenticated msg
Authenticated inbound
msg Party
party)
    Authenticated (Ping NodeId
nid) Party
_ -> Heartbeat (Authenticated inbound) -> m ()
deliver (Heartbeat (Authenticated inbound) -> m ())
-> Heartbeat (Authenticated inbound) -> m ()
forall a b. (a -> b) -> a -> b
$ NodeId -> Heartbeat (Authenticated inbound)
forall msg. NodeId -> Heartbeat msg
Ping NodeId
nid

-- | Where are the messages stored, relative to given directory.
storedMessagesFile :: FilePath -> FilePath
storedMessagesFile :: FilePath -> FilePath
storedMessagesFile = (FilePath -> FilePath -> FilePath
</> FilePath
"network-messages")

-- | Where is the acknowledgments vector stored, relative to given directory.
acksFile :: FilePath -> FilePath
acksFile :: FilePath -> FilePath
acksFile = (FilePath -> FilePath -> FilePath
</> FilePath
"acks")