{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE NumericUnderscores         #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuantifiedConstraints      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE UndecidableInstances       #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module DMQ.Configuration
  ( Configuration' (..)
  , PartialConfig
  , Configuration
  , I (..)
  , readConfigurationFileOrError
  , mkDiffusionConfiguration
  , defaultSigDecisionPolicy
  , defaultConfiguration
  , NoExtraConfig (..)
  , NoExtraFlags (..)
  ) where

import Control.Concurrent.Class.MonadSTM (MonadSTM (..))
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI (DiffTime)
import Data.Act
import Data.Act.Generic (gpact)
import Data.Aeson
import Data.Aeson.Types (parseFail)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Functor.Identity
import Data.IP
import Data.List.NonEmpty qualified as NonEmpty
import Data.Monoid (Last (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Generic.Data (gmappend, gmempty)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Network.Socket (AddrInfo (..), AddrInfoFlag (..), PortNumber,
           SocketType (..), defaultHints, getAddrInfo)
import System.Directory qualified as Directory
import System.FilePath qualified as FilePath
import System.IO.Error (isDoesNotExistError)
import Text.Read (readMaybe)

import Ouroboros.Network.Diffusion.Configuration (BlockProducerOrRelay (..),
           defaultAcceptedConnectionsLimit, defaultDeadlineChurnInterval,
           defaultDeadlineTargets, defaultProtocolIdleTimeout,
           defaultTimeWaitTimeout)
import Ouroboros.Network.Diffusion.Topology (NetworkTopology (..),
           producerAddresses)
import Ouroboros.Network.Diffusion.Types qualified as Diffusion
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..))
import Ouroboros.Network.OrphanInstances ()
import Ouroboros.Network.PeerSelection.Governor.Types
           (PeerSelectionTargets (..), makePublicPeerSelectionStateVar)
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
           (LedgerPeerSnapshot (..))
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.Server.RateLimiting (AcceptedConnectionsLimit (..))
import Ouroboros.Network.Snocket (RemoteAddress)
import Ouroboros.Network.TxSubmission.Inbound.V2 (TxDecisionPolicy (..))

import DMQ.Configuration.Topology (NoExtraConfig (..), NoExtraFlags (..),
           readPeerSnapshotFileOrError)

-- | Configuration comes in two flavours paramemtrised by `f` functor:
-- `PartialConfig` is using `Last` and `Configuration` is using an identity
-- functor `I`.
--
data Configuration' f =
  Configuration {
    forall (f :: * -> *). Configuration' f -> f (Maybe IPv4)
dmqcIPv4                                       :: f (Maybe IPv4),
    forall (f :: * -> *). Configuration' f -> f (Maybe IPv6)
dmqcIPv6                                       :: f (Maybe IPv6),
    forall (f :: * -> *). Configuration' f -> f PortNumber
dmqcPortNumber                                 :: f PortNumber,
    forall (f :: * -> *). Configuration' f -> f [Char]
dmqcConfigFile                                 :: f FilePath,
    forall (f :: * -> *). Configuration' f -> f [Char]
dmqcTopologyFile                               :: f FilePath,
    forall (f :: * -> *).
Configuration' f -> f AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit                   :: f AcceptedConnectionsLimit,
    forall (f :: * -> *). Configuration' f -> f DiffusionMode
dmqcDiffusionMode                              :: f DiffusionMode,
    forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfRootPeers                          :: f Int,
    forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownPeers                         :: f Int,
    forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedPeers                   :: f Int,
    forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActivePeers                        :: f Int,
    forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownBigLedgerPeers                :: f Int,
    forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedBigLedgerPeers          :: f Int,
    forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActiveBigLedgerPeers               :: f Int,
    forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcProtocolIdleTimeout                        :: f DiffTime,
    forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcChurnInterval                              :: f DiffTime,
    forall (f :: * -> *). Configuration' f -> f PeerSharing
dmqcPeerSharing                                :: f PeerSharing,
    forall (f :: * -> *). Configuration' f -> f NetworkMagic
dmqcNetworkMagic                               :: f NetworkMagic,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcPrettyLog                                  :: f Bool,

    forall (f :: * -> *). Configuration' f -> f Bool
dmqcMuxTracer                                  :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcChannelTracer                              :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcBearerTracer                               :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcHandshakeTracer                            :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalMuxTracer                             :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalChannelTracer                         :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalBearerTracer                          :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalHandshakeTracer                       :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcDiffusionTracer                            :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcTraceLocalRootPeersTracer                  :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcTracePublicRootPeersTracer                 :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcTraceLedgerPeersTracer                     :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcTracePeerSelectionTracer                   :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcTraceChurnCounters                         :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcDebugPeerSelectionInitiatorTracer          :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcDebugPeerSelectionInitiatorResponderTracer :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcTracePeerSelectionCounters                 :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcPeerSelectionActionsTracer                 :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcConnectionManagerTracer                    :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcConnectionManagerTransitionTracer          :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcServerTracer                               :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcInboundGovernorTracer                      :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcInboundGovernorTransitionTracer            :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalConnectionManagerTracer               :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalServerTracer                          :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalInboundGovernorTracer                 :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcDnsTracer                                  :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcSigSubmissionClientTracer                  :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcSigSubmissionServerTracer                  :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcKeepAliveClientTracer                      :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcKeepAliveServerTracer                      :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcPeerSharingClientTracer                    :: f Bool,
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcPeerSharingServerTracer                    :: f Bool
  }
  deriving (forall x. Configuration' f -> Rep (Configuration' f) x)
-> (forall x. Rep (Configuration' f) x -> Configuration' f)
-> Generic (Configuration' f)
forall x. Rep (Configuration' f) x -> Configuration' f
forall x. Configuration' f -> Rep (Configuration' f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (Configuration' f) x -> Configuration' f
forall (f :: * -> *) x.
Configuration' f -> Rep (Configuration' f) x
$cfrom :: forall (f :: * -> *) x.
Configuration' f -> Rep (Configuration' f) x
from :: forall x. Configuration' f -> Rep (Configuration' f) x
$cto :: forall (f :: * -> *) x.
Rep (Configuration' f) x -> Configuration' f
to :: forall x. Rep (Configuration' f) x -> Configuration' f
Generic

instance (forall a. Semigroup (f a))
      => Semigroup (Configuration' f) where
  <> :: Configuration' f -> Configuration' f -> Configuration' f
(<>) = Configuration' f -> Configuration' f -> Configuration' f
forall a. (Generic a, Semigroup (Rep a ())) => a -> a -> a
gmappend
instance (forall a. Monoid (f a))
      => Monoid (Configuration' f) where
  mempty :: Configuration' f
mempty = Configuration' f
forall a. (Generic a, Monoid (Rep a ())) => a
gmempty

-- Using an action, eliminates the need to use `undefined`, e.g. instead of
-- transforming
-- ```
--   (defaultConfig <> configFileOptions <> cliOptions) :: PartialConfig
-- ```
-- to `Configuration` we just have
-- ```
--   (configFileOptions <> cliOptions • defaultConfig) :: Configuration
-- ```
-- without any partial functions.
--
--
instance (forall a. Act (f a) (g a))
      => Act (Configuration' f) (Configuration' g) where
  act :: Configuration' f -> Configuration' g -> Configuration' g
act = Configuration' f -> Configuration' g -> Configuration' g
forall s a.
(Generic s, Generic a, GPAct (Rep s) (Rep a)) =>
s -> a -> a
gpact

deriving instance Show Configuration
deriving instance Show PartialConfig

-- | An Identity functor, but shorter to type.
--
newtype I a = I { forall a. I a -> a
unI :: a }
  deriving stock (forall x. I a -> Rep (I a) x)
-> (forall x. Rep (I a) x -> I a) -> Generic (I a)
forall x. Rep (I a) x -> I a
forall x. I a -> Rep (I a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (I a) x -> I a
forall a x. I a -> Rep (I a) x
$cfrom :: forall a x. I a -> Rep (I a) x
from :: forall x. I a -> Rep (I a) x
$cto :: forall a x. Rep (I a) x -> I a
to :: forall x. Rep (I a) x -> I a
Generic
  deriving newtype Int -> I a -> ShowS
[I a] -> ShowS
I a -> [Char]
(Int -> I a -> ShowS)
-> (I a -> [Char]) -> ([I a] -> ShowS) -> Show (I a)
forall a. Show a => Int -> I a -> ShowS
forall a. Show a => [I a] -> ShowS
forall a. Show a => I a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> I a -> ShowS
showsPrec :: Int -> I a -> ShowS
$cshow :: forall a. Show a => I a -> [Char]
show :: I a -> [Char]
$cshowList :: forall a. Show a => [I a] -> ShowS
showList :: [I a] -> ShowS
Show
  deriving ((forall a b. (a -> b) -> I a -> I b)
-> (forall a b. a -> I b -> I a) -> Functor I
forall a b. a -> I b -> I a
forall a b. (a -> b) -> I a -> I b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> I a -> I b
fmap :: forall a b. (a -> b) -> I a -> I b
$c<$ :: forall a b. a -> I b -> I a
<$ :: forall a b. a -> I b -> I a
Functor, Functor I
Functor I =>
(forall a. a -> I a)
-> (forall a b. I (a -> b) -> I a -> I b)
-> (forall a b c. (a -> b -> c) -> I a -> I b -> I c)
-> (forall a b. I a -> I b -> I b)
-> (forall a b. I a -> I b -> I a)
-> Applicative I
forall a. a -> I a
forall a b. I a -> I b -> I a
forall a b. I a -> I b -> I b
forall a b. I (a -> b) -> I a -> I b
forall a b c. (a -> b -> c) -> I a -> I b -> I c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> I a
pure :: forall a. a -> I a
$c<*> :: forall a b. I (a -> b) -> I a -> I b
<*> :: forall a b. I (a -> b) -> I a -> I b
$cliftA2 :: forall a b c. (a -> b -> c) -> I a -> I b -> I c
liftA2 :: forall a b c. (a -> b -> c) -> I a -> I b -> I c
$c*> :: forall a b. I a -> I b -> I b
*> :: forall a b. I a -> I b -> I b
$c<* :: forall a b. I a -> I b -> I a
<* :: forall a b. I a -> I b -> I a
Applicative, Applicative I
Applicative I =>
(forall a b. I a -> (a -> I b) -> I b)
-> (forall a b. I a -> I b -> I b)
-> (forall a. a -> I a)
-> Monad I
forall a. a -> I a
forall a b. I a -> I b -> I b
forall a b. I a -> (a -> I b) -> I b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. I a -> (a -> I b) -> I b
>>= :: forall a b. I a -> (a -> I b) -> I b
$c>> :: forall a b. I a -> I b -> I b
>> :: forall a b. I a -> I b -> I b
$creturn :: forall a. a -> I a
return :: forall a. a -> I a
Monad) via Identity

-- NOTE: it would be more convenient to have a right action of `Last` on `I`,
-- but `acts` library only provides left actions.
instance Act (Last a) (I a) where
  act :: Last a -> I a -> I a
act (Last Maybe a
Nothing)  I a
i = I a
i
  act (Last (Just a
a)) I a
_ = a -> I a
forall a. a -> I a
I a
a

type Configuration = Configuration' I
type PartialConfig = Configuration' Last


-- | By using `Configuration` type we enforce that every value has a default,
-- except of IP addresses, which are using `Maybe` values.  This is needed to
-- make sure one can configure only the IP addresses which are available on the
-- system.
--
defaultConfiguration :: Configuration
defaultConfiguration :: Configuration
defaultConfiguration = Configuration {
      dmqcIPv4 :: I (Maybe IPv4)
dmqcIPv4                                       = Maybe IPv4 -> I (Maybe IPv4)
forall a. a -> I a
I Maybe IPv4
forall a. Maybe a
Nothing,
      dmqcIPv6 :: I (Maybe IPv6)
dmqcIPv6                                       = Maybe IPv6 -> I (Maybe IPv6)
forall a. a -> I a
I Maybe IPv6
forall a. Maybe a
Nothing,
      dmqcNetworkMagic :: I NetworkMagic
dmqcNetworkMagic                               = NetworkMagic -> I NetworkMagic
forall a. a -> I a
I NetworkMagic { unNetworkMagic :: Word32
unNetworkMagic = Word32
3_141_592 },
      dmqcPortNumber :: I PortNumber
dmqcPortNumber                                 = PortNumber -> I PortNumber
forall a. a -> I a
I PortNumber
3_141,
      dmqcConfigFile :: I [Char]
dmqcConfigFile                                 = [Char] -> I [Char]
forall a. a -> I a
I [Char]
"dmq.configuration.yaml",
      dmqcTopologyFile :: I [Char]
dmqcTopologyFile                               = [Char] -> I [Char]
forall a. a -> I a
I [Char]
"dmq.topology.json",
      dmqcAcceptedConnectionsLimit :: I AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit                   = AcceptedConnectionsLimit -> I AcceptedConnectionsLimit
forall a. a -> I a
I AcceptedConnectionsLimit
defaultAcceptedConnectionsLimit,
      dmqcDiffusionMode :: I DiffusionMode
dmqcDiffusionMode                              = DiffusionMode -> I DiffusionMode
forall a. a -> I a
I DiffusionMode
InitiatorAndResponderDiffusionMode,
      dmqcTargetOfRootPeers :: I Int
dmqcTargetOfRootPeers                          = Int -> I Int
forall a. a -> I a
I Int
targetNumberOfRootPeers,
      dmqcTargetOfKnownPeers :: I Int
dmqcTargetOfKnownPeers                         = Int -> I Int
forall a. a -> I a
I Int
targetNumberOfKnownPeers,
      dmqcTargetOfEstablishedPeers :: I Int
dmqcTargetOfEstablishedPeers                   = Int -> I Int
forall a. a -> I a
I Int
targetNumberOfEstablishedPeers,
      dmqcTargetOfActivePeers :: I Int
dmqcTargetOfActivePeers                        = Int -> I Int
forall a. a -> I a
I Int
targetNumberOfActivePeers,
      dmqcTargetOfKnownBigLedgerPeers :: I Int
dmqcTargetOfKnownBigLedgerPeers                = Int -> I Int
forall a. a -> I a
I Int
targetNumberOfKnownBigLedgerPeers,
      dmqcTargetOfEstablishedBigLedgerPeers :: I Int
dmqcTargetOfEstablishedBigLedgerPeers          = Int -> I Int
forall a. a -> I a
I Int
targetNumberOfEstablishedBigLedgerPeers,
      dmqcTargetOfActiveBigLedgerPeers :: I Int
dmqcTargetOfActiveBigLedgerPeers               = Int -> I Int
forall a. a -> I a
I Int
targetNumberOfActiveBigLedgerPeers,
      dmqcProtocolIdleTimeout :: I DiffTime
dmqcProtocolIdleTimeout                        = DiffTime -> I DiffTime
forall a. a -> I a
I DiffTime
defaultProtocolIdleTimeout,
      dmqcChurnInterval :: I DiffTime
dmqcChurnInterval                              = DiffTime -> I DiffTime
forall a. a -> I a
I DiffTime
defaultDeadlineChurnInterval,
      dmqcPeerSharing :: I PeerSharing
dmqcPeerSharing                                = PeerSharing -> I PeerSharing
forall a. a -> I a
I PeerSharing
PeerSharingEnabled,
      dmqcPrettyLog :: I Bool
dmqcPrettyLog                                  = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcMuxTracer :: I Bool
dmqcMuxTracer                                  = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcChannelTracer :: I Bool
dmqcChannelTracer                              = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcBearerTracer :: I Bool
dmqcBearerTracer                               = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcHandshakeTracer :: I Bool
dmqcHandshakeTracer                            = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcLocalMuxTracer :: I Bool
dmqcLocalMuxTracer                             = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcLocalChannelTracer :: I Bool
dmqcLocalChannelTracer                         = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcLocalBearerTracer :: I Bool
dmqcLocalBearerTracer                          = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcLocalHandshakeTracer :: I Bool
dmqcLocalHandshakeTracer                       = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcDiffusionTracer :: I Bool
dmqcDiffusionTracer                            = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcTraceLocalRootPeersTracer :: I Bool
dmqcTraceLocalRootPeersTracer                  = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcTracePublicRootPeersTracer :: I Bool
dmqcTracePublicRootPeersTracer                 = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcTraceLedgerPeersTracer :: I Bool
dmqcTraceLedgerPeersTracer                     = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcTracePeerSelectionTracer :: I Bool
dmqcTracePeerSelectionTracer                   = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcTraceChurnCounters :: I Bool
dmqcTraceChurnCounters                         = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcDebugPeerSelectionInitiatorTracer :: I Bool
dmqcDebugPeerSelectionInitiatorTracer          = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcDebugPeerSelectionInitiatorResponderTracer :: I Bool
dmqcDebugPeerSelectionInitiatorResponderTracer = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcTracePeerSelectionCounters :: I Bool
dmqcTracePeerSelectionCounters                 = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcPeerSelectionActionsTracer :: I Bool
dmqcPeerSelectionActionsTracer                 = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcConnectionManagerTracer :: I Bool
dmqcConnectionManagerTracer                    = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcConnectionManagerTransitionTracer :: I Bool
dmqcConnectionManagerTransitionTracer          = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcServerTracer :: I Bool
dmqcServerTracer                               = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcInboundGovernorTracer :: I Bool
dmqcInboundGovernorTracer                      = Bool -> I Bool
forall a. a -> I a
I Bool
True,
      dmqcInboundGovernorTransitionTracer :: I Bool
dmqcInboundGovernorTransitionTracer            = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcLocalConnectionManagerTracer :: I Bool
dmqcLocalConnectionManagerTracer               = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcLocalServerTracer :: I Bool
dmqcLocalServerTracer                          = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcLocalInboundGovernorTracer :: I Bool
dmqcLocalInboundGovernorTracer                 = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcDnsTracer :: I Bool
dmqcDnsTracer                                  = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcSigSubmissionClientTracer :: I Bool
dmqcSigSubmissionClientTracer                  = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcSigSubmissionServerTracer :: I Bool
dmqcSigSubmissionServerTracer                  = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcKeepAliveClientTracer :: I Bool
dmqcKeepAliveClientTracer                      = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcKeepAliveServerTracer :: I Bool
dmqcKeepAliveServerTracer                      = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcPeerSharingClientTracer :: I Bool
dmqcPeerSharingClientTracer                    = Bool -> I Bool
forall a. a -> I a
I Bool
False,
      dmqcPeerSharingServerTracer :: I Bool
dmqcPeerSharingServerTracer                    = Bool -> I Bool
forall a. a -> I a
I Bool
False
    }
  where
    PeerSelectionTargets {
      Int
targetNumberOfRootPeers :: Int
targetNumberOfRootPeers :: PeerSelectionTargets -> Int
targetNumberOfRootPeers,
      Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers,
      Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers,
      Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers,
      Int
targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers,
      Int
targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers,
      Int
targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers
    } = BlockProducerOrRelay -> PeerSelectionTargets
defaultDeadlineTargets BlockProducerOrRelay
Relay
    -- TODO: use DMQ's own default values


-- | Parsing configuration used when reading it from disk
--
instance FromJSON PartialConfig where
  parseJSON :: Value -> Parser PartialConfig
parseJSON = [Char]
-> (Object -> Parser PartialConfig)
-> Value
-> Parser PartialConfig
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"DMQConfiguration" ((Object -> Parser PartialConfig) -> Value -> Parser PartialConfig)
-> (Object -> Parser PartialConfig)
-> Value
-> Parser PartialConfig
forall a b. (a -> b) -> a -> b
$ \Object
v -> do

      dmqcIPv4 <- ([Char] -> Maybe IPv4) -> Maybe [Char] -> Maybe (Maybe IPv4)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Maybe IPv4
forall a. Read a => [Char] -> Maybe a
readMaybe (Maybe [Char] -> Maybe (Maybe IPv4))
-> Parser (Maybe [Char]) -> Parser (Maybe (Maybe IPv4))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"IPv4"
      case dmqcIPv4 of
        Just Maybe IPv4
Nothing -> [Char] -> Parser ()
forall a. [Char] -> Parser a
parseFail [Char]
"couldn't parse IPv4 address"
        Maybe (Maybe IPv4)
_            -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dmqcIPv6 <- fmap readMaybe <$> v .:? "IPv6"
      case dmqcIPv6 of
        Just Maybe IPv6
Nothing -> [Char] -> Parser ()
forall a. [Char] -> Parser a
parseFail [Char]
"couldn't parse IPv6 address"
        Maybe (Maybe IPv6)
_            -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dmqcPortNumber <- Last . fmap (fromIntegral @Int) <$> v.:? "PortNumber"
      dmqcNetworkMagic <- Last . fmap NetworkMagic <$> v .:? "NetworkMagic"
      dmqcDiffusionMode <- Last <$> v .:? "DiffusionMode"
      dmqcPeerSharing <- Last <$> v .:? "PeerSharing"

      dmqcTargetOfRootPeers                 <- Last <$> v .:? "TargetNumberOfRootPeers"
      dmqcTargetOfKnownPeers                <- Last <$> v .:? "TargetNumberOfKnownPeers"
      dmqcTargetOfEstablishedPeers          <- Last <$> v .:? "TargetNumberOfEstablishedPeers"
      dmqcTargetOfActivePeers               <- Last <$> v .:? "TargetNumberOfActivePeers"
      dmqcTargetOfKnownBigLedgerPeers       <- Last <$> v .:? "TargetNumberOfKnownBigLedgerPeers"
      dmqcTargetOfEstablishedBigLedgerPeers <- Last <$> v .:? "TargetNumberOfEstablishedBigLedgerPeers"
      dmqcTargetOfActiveBigLedgerPeers      <- Last <$> v .:? "TargetNumberOfActiveBigLedgerPeers"

      dmqcAcceptedConnectionsLimit <- Last <$> v .:? "AcceptedConnectionsLimit"
      dmqcProtocolIdleTimeout <- Last <$> v .:? "ProtocolIdleTimeout"
      dmqcChurnInterval <- Last <$> v .:? "ChurnInterval"

      dmqcPrettyLog <- Last <$> v .:? "PrettyLog"

      dmqcMuxTracer                                  <- Last <$> v .:? "MuxTracer"
      dmqcChannelTracer                              <- Last <$> v .:? "ChannelTracer"
      dmqcBearerTracer                               <- Last <$> v .:? "BearerTracer"
      dmqcHandshakeTracer                            <- Last <$> v .:? "HandshakeTracer"
      dmqcLocalMuxTracer                             <- Last <$> v .:? "LocalMuxTracer"
      dmqcLocalChannelTracer                         <- Last <$> v .:? "LocalChannelTracer"
      dmqcLocalBearerTracer                          <- Last <$> v .:? "LocalBearerTracer"
      dmqcLocalHandshakeTracer                       <- Last <$> v .:? "LocalHandshakeTracer"
      dmqcDiffusionTracer                            <- Last <$> v .:? "DiffusionTracer"
      dmqcTraceLocalRootPeersTracer                  <- Last <$> v .:? "LocalRootPeersTracer"
      dmqcTracePublicRootPeersTracer                 <- Last <$> v .:? "PublicRootPeersTracer"
      dmqcTraceLedgerPeersTracer                     <- Last <$> v .:? "LedgerPeersTracer"
      dmqcTracePeerSelectionTracer                   <- Last <$> v .:? "PeerSelectionTracer"
      dmqcTraceChurnCounters                         <- Last <$> v .:? "ChurnCounters"
      dmqcDebugPeerSelectionInitiatorTracer          <- Last <$> v .:? "DebugPeerSelectionInitiatorTracer"
      dmqcDebugPeerSelectionInitiatorResponderTracer <- Last <$> v .:? "DebugPeerSelectionInitiatorResponderTracer"
      dmqcTracePeerSelectionCounters                 <- Last <$> v .:? "PeerSelectionCounters"
      dmqcPeerSelectionActionsTracer                 <- Last <$> v .:? "PeerSelectionActionsTracer"
      dmqcConnectionManagerTracer                    <- Last <$> v .:? "ConnectionManagerTracer"
      dmqcConnectionManagerTransitionTracer          <- Last <$> v .:? "ConnectionManagerTransitionTracer"
      dmqcServerTracer                               <- Last <$> v .:? "ServerTracer"
      dmqcInboundGovernorTracer                      <- Last <$> v .:? "InboundGovernorTracer"
      dmqcInboundGovernorTransitionTracer            <- Last <$> v .:? "InboundGovernorTransitionTracer"
      dmqcLocalConnectionManagerTracer               <- Last <$> v .:? "LocalConnectionManagerTracer"
      dmqcLocalServerTracer                          <- Last <$> v .:? "LocalServerTracer"
      dmqcLocalInboundGovernorTracer                 <- Last <$> v .:? "LocalInboundGovernorTracer"
      dmqcDnsTracer                                  <- Last <$> v .:? "DnsTracer"
      dmqcSigSubmissionClientTracer                  <- Last <$> v .:? "SigSubmissionServerTracer"
      dmqcSigSubmissionServerTracer                  <- Last <$> v .:? "SigSubmissionClientTracer"
      dmqcKeepAliveClientTracer                      <- Last <$> v .:? "KeepAliveServerTracer"
      dmqcKeepAliveServerTracer                      <- Last <$> v .:? "KeepAliveClientTracer"
      dmqcPeerSharingClientTracer                    <- Last <$> v .:? "PeerSharingServerTracer"
      dmqcPeerSharingServerTracer                    <- Last <$> v .:? "PeerSharingClientTracer"

      pure $
        Configuration
          { dmqcIPv4 = Last dmqcIPv4
          , dmqcIPv6 = Last dmqcIPv6
          , dmqcPortNumber
          , dmqcConfigFile = mempty
          , dmqcTopologyFile = mempty
          , dmqcAcceptedConnectionsLimit
          , dmqcDiffusionMode
          , dmqcTargetOfRootPeers
          , dmqcTargetOfKnownPeers
          , dmqcTargetOfEstablishedPeers
          , dmqcTargetOfActivePeers
          , dmqcTargetOfKnownBigLedgerPeers
          , dmqcTargetOfEstablishedBigLedgerPeers
          , dmqcTargetOfActiveBigLedgerPeers
          , dmqcProtocolIdleTimeout
          , dmqcChurnInterval
          , dmqcPeerSharing
          , dmqcNetworkMagic
          , dmqcPrettyLog
          , dmqcMuxTracer
          , dmqcChannelTracer
          , dmqcBearerTracer
          , dmqcHandshakeTracer
          , dmqcLocalMuxTracer
          , dmqcLocalChannelTracer
          , dmqcLocalBearerTracer
          , dmqcLocalHandshakeTracer
          , dmqcDiffusionTracer
          , dmqcTraceLocalRootPeersTracer
          , dmqcTracePublicRootPeersTracer
          , dmqcTraceLedgerPeersTracer
          , dmqcTracePeerSelectionTracer
          , dmqcTraceChurnCounters
          , dmqcDebugPeerSelectionInitiatorTracer
          , dmqcDebugPeerSelectionInitiatorResponderTracer
          , dmqcTracePeerSelectionCounters
          , dmqcPeerSelectionActionsTracer
          , dmqcConnectionManagerTracer
          , dmqcConnectionManagerTransitionTracer
          , dmqcServerTracer
          , dmqcInboundGovernorTracer
          , dmqcInboundGovernorTransitionTracer
          , dmqcLocalConnectionManagerTracer
          , dmqcLocalServerTracer
          , dmqcLocalInboundGovernorTracer
          , dmqcDnsTracer
          , dmqcSigSubmissionClientTracer
          , dmqcSigSubmissionServerTracer
          , dmqcKeepAliveClientTracer
          , dmqcKeepAliveServerTracer
          , dmqcPeerSharingClientTracer
          , dmqcPeerSharingServerTracer
          }

-- | ToJSON instance used by logging system.
--
instance ToJSON Configuration where
  toJSON :: Configuration -> Value
toJSON Configuration {
      I (Maybe IPv4)
dmqcIPv4 :: forall (f :: * -> *). Configuration' f -> f (Maybe IPv4)
dmqcIPv4 :: I (Maybe IPv4)
dmqcIPv4,
      I (Maybe IPv6)
dmqcIPv6 :: forall (f :: * -> *). Configuration' f -> f (Maybe IPv6)
dmqcIPv6 :: I (Maybe IPv6)
dmqcIPv6,
      I PortNumber
dmqcPortNumber :: forall (f :: * -> *). Configuration' f -> f PortNumber
dmqcPortNumber :: I PortNumber
dmqcPortNumber,
      I [Char]
dmqcConfigFile :: forall (f :: * -> *). Configuration' f -> f [Char]
dmqcConfigFile :: I [Char]
dmqcConfigFile,
      I [Char]
dmqcTopologyFile :: forall (f :: * -> *). Configuration' f -> f [Char]
dmqcTopologyFile :: I [Char]
dmqcTopologyFile,
      I AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit :: forall (f :: * -> *).
Configuration' f -> f AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit :: I AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit,
      I DiffusionMode
dmqcDiffusionMode :: forall (f :: * -> *). Configuration' f -> f DiffusionMode
dmqcDiffusionMode :: I DiffusionMode
dmqcDiffusionMode,
      I Int
dmqcTargetOfRootPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfRootPeers :: I Int
dmqcTargetOfRootPeers,
      I Int
dmqcTargetOfKnownPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownPeers :: I Int
dmqcTargetOfKnownPeers,
      I Int
dmqcTargetOfEstablishedPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedPeers :: I Int
dmqcTargetOfEstablishedPeers,
      I Int
dmqcTargetOfActivePeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActivePeers :: I Int
dmqcTargetOfActivePeers,
      I Int
dmqcTargetOfKnownBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownBigLedgerPeers :: I Int
dmqcTargetOfKnownBigLedgerPeers,
      I Int
dmqcTargetOfEstablishedBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedBigLedgerPeers :: I Int
dmqcTargetOfEstablishedBigLedgerPeers,
      I Int
dmqcTargetOfActiveBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActiveBigLedgerPeers :: I Int
dmqcTargetOfActiveBigLedgerPeers,
      I DiffTime
dmqcProtocolIdleTimeout :: forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcProtocolIdleTimeout :: I DiffTime
dmqcProtocolIdleTimeout,
      I DiffTime
dmqcChurnInterval :: forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcChurnInterval :: I DiffTime
dmqcChurnInterval,
      I PeerSharing
dmqcPeerSharing :: forall (f :: * -> *). Configuration' f -> f PeerSharing
dmqcPeerSharing :: I PeerSharing
dmqcPeerSharing,
      I NetworkMagic
dmqcNetworkMagic :: forall (f :: * -> *). Configuration' f -> f NetworkMagic
dmqcNetworkMagic :: I NetworkMagic
dmqcNetworkMagic,
      I Bool
dmqcPrettyLog :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcPrettyLog :: I Bool
dmqcPrettyLog,
      I Bool
dmqcMuxTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcMuxTracer :: I Bool
dmqcMuxTracer,
      I Bool
dmqcChannelTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcChannelTracer :: I Bool
dmqcChannelTracer,
      I Bool
dmqcBearerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcBearerTracer :: I Bool
dmqcBearerTracer,
      I Bool
dmqcHandshakeTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcHandshakeTracer :: I Bool
dmqcHandshakeTracer,
      I Bool
dmqcLocalMuxTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalMuxTracer :: I Bool
dmqcLocalMuxTracer,
      I Bool
dmqcLocalChannelTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalChannelTracer :: I Bool
dmqcLocalChannelTracer,
      I Bool
dmqcLocalBearerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalBearerTracer :: I Bool
dmqcLocalBearerTracer,
      I Bool
dmqcLocalHandshakeTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalHandshakeTracer :: I Bool
dmqcLocalHandshakeTracer,
      I Bool
dmqcDiffusionTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcDiffusionTracer :: I Bool
dmqcDiffusionTracer,
      I Bool
dmqcTraceLocalRootPeersTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcTraceLocalRootPeersTracer :: I Bool
dmqcTraceLocalRootPeersTracer,
      I Bool
dmqcTracePublicRootPeersTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcTracePublicRootPeersTracer :: I Bool
dmqcTracePublicRootPeersTracer,
      I Bool
dmqcTraceLedgerPeersTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcTraceLedgerPeersTracer :: I Bool
dmqcTraceLedgerPeersTracer,
      I Bool
dmqcTracePeerSelectionTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcTracePeerSelectionTracer :: I Bool
dmqcTracePeerSelectionTracer,
      I Bool
dmqcTraceChurnCounters :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcTraceChurnCounters :: I Bool
dmqcTraceChurnCounters,
      I Bool
dmqcDebugPeerSelectionInitiatorTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcDebugPeerSelectionInitiatorTracer :: I Bool
dmqcDebugPeerSelectionInitiatorTracer,
      I Bool
dmqcDebugPeerSelectionInitiatorResponderTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcDebugPeerSelectionInitiatorResponderTracer :: I Bool
dmqcDebugPeerSelectionInitiatorResponderTracer,
      I Bool
dmqcTracePeerSelectionCounters :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcTracePeerSelectionCounters :: I Bool
dmqcTracePeerSelectionCounters,
      I Bool
dmqcPeerSelectionActionsTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcPeerSelectionActionsTracer :: I Bool
dmqcPeerSelectionActionsTracer,
      I Bool
dmqcConnectionManagerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcConnectionManagerTracer :: I Bool
dmqcConnectionManagerTracer,
      I Bool
dmqcConnectionManagerTransitionTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcConnectionManagerTransitionTracer :: I Bool
dmqcConnectionManagerTransitionTracer,
      I Bool
dmqcServerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcServerTracer :: I Bool
dmqcServerTracer,
      I Bool
dmqcInboundGovernorTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcInboundGovernorTracer :: I Bool
dmqcInboundGovernorTracer,
      I Bool
dmqcInboundGovernorTransitionTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcInboundGovernorTransitionTracer :: I Bool
dmqcInboundGovernorTransitionTracer,
      I Bool
dmqcLocalConnectionManagerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalConnectionManagerTracer :: I Bool
dmqcLocalConnectionManagerTracer,
      I Bool
dmqcLocalServerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalServerTracer :: I Bool
dmqcLocalServerTracer,
      I Bool
dmqcLocalInboundGovernorTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcLocalInboundGovernorTracer :: I Bool
dmqcLocalInboundGovernorTracer,
      I Bool
dmqcDnsTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcDnsTracer :: I Bool
dmqcDnsTracer,
      I Bool
dmqcSigSubmissionClientTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcSigSubmissionClientTracer :: I Bool
dmqcSigSubmissionClientTracer,
      I Bool
dmqcSigSubmissionServerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcSigSubmissionServerTracer :: I Bool
dmqcSigSubmissionServerTracer,
      I Bool
dmqcKeepAliveClientTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcKeepAliveClientTracer :: I Bool
dmqcKeepAliveClientTracer,
      I Bool
dmqcKeepAliveServerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcKeepAliveServerTracer :: I Bool
dmqcKeepAliveServerTracer,
      I Bool
dmqcPeerSharingClientTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcPeerSharingClientTracer :: I Bool
dmqcPeerSharingClientTracer,
      I Bool
dmqcPeerSharingServerTracer :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcPeerSharingServerTracer :: I Bool
dmqcPeerSharingServerTracer
    }
    =
    [Pair] -> Value
object [ Key
"IPv4"                                       Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (IPv4 -> [Char]
forall a. Show a => a -> [Char]
show (IPv4 -> [Char]) -> Maybe IPv4 -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> I (Maybe IPv4) -> Maybe IPv4
forall a. I a -> a
unI I (Maybe IPv4)
dmqcIPv4)
           , Key
"IPv6"                                       Key -> Maybe [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (IPv6 -> [Char]
forall a. Show a => a -> [Char]
show (IPv6 -> [Char]) -> Maybe IPv6 -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> I (Maybe IPv6) -> Maybe IPv6
forall a. I a -> a
unI I (Maybe IPv6)
dmqcIPv6)
           , Key
"PortNumber"                                 Key -> PortNumber -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I PortNumber -> PortNumber
forall a. I a -> a
unI I PortNumber
dmqcPortNumber
           , Key
"ConfigFile"                                 Key -> [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I [Char] -> [Char]
forall a. I a -> a
unI I [Char]
dmqcConfigFile
           , Key
"TopologyFile"                               Key -> [Char] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I [Char] -> [Char]
forall a. I a -> a
unI I [Char]
dmqcTopologyFile
           , Key
"AcceptedConnectionsLimit"                   Key -> AcceptedConnectionsLimit -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I AcceptedConnectionsLimit -> AcceptedConnectionsLimit
forall a. I a -> a
unI I AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit
           , Key
"DiffusionMode"                              Key -> DiffusionMode -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I DiffusionMode -> DiffusionMode
forall a. I a -> a
unI I DiffusionMode
dmqcDiffusionMode
           , Key
"TargetOfRootPeers"                          Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Int -> Int
forall a. I a -> a
unI I Int
dmqcTargetOfRootPeers
           , Key
"TargetOfKnownPeers"                         Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Int -> Int
forall a. I a -> a
unI I Int
dmqcTargetOfKnownPeers
           , Key
"TargetOfEstablishedPeers"                   Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Int -> Int
forall a. I a -> a
unI I Int
dmqcTargetOfEstablishedPeers
           , Key
"TargetOfActivePeers"                        Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Int -> Int
forall a. I a -> a
unI I Int
dmqcTargetOfActivePeers
           , Key
"TargetOfKnownBigLedgerPeers"                Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Int -> Int
forall a. I a -> a
unI I Int
dmqcTargetOfKnownBigLedgerPeers
           , Key
"TargetOfEstablishedBigLedgerPeers"          Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Int -> Int
forall a. I a -> a
unI I Int
dmqcTargetOfEstablishedBigLedgerPeers
           , Key
"TargetOfActiveBigLedgerPeers"               Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Int -> Int
forall a. I a -> a
unI I Int
dmqcTargetOfActiveBigLedgerPeers
           , Key
"ProtocolIdleTimeout"                        Key -> DiffTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I DiffTime -> DiffTime
forall a. I a -> a
unI I DiffTime
dmqcProtocolIdleTimeout
           , Key
"ChurnInterval"                              Key -> DiffTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I DiffTime -> DiffTime
forall a. I a -> a
unI I DiffTime
dmqcChurnInterval
           , Key
"PeerSharing"                                Key -> PeerSharing -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I PeerSharing -> PeerSharing
forall a. I a -> a
unI I PeerSharing
dmqcPeerSharing
           , Key
"NetworkMagic"                               Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkMagic -> Word32
unNetworkMagic (I NetworkMagic -> NetworkMagic
forall a. I a -> a
unI I NetworkMagic
dmqcNetworkMagic)
           , Key
"PrettyLog"                                  Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcPrettyLog
           , Key
"MuxTracer"                                  Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcMuxTracer
           , Key
"ChannelTracer"                              Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcChannelTracer
           , Key
"BearerTracer"                               Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcBearerTracer
           , Key
"HandshakeTracer"                            Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcHandshakeTracer
           , Key
"LocalMuxTracer"                             Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcLocalMuxTracer
           , Key
"LocalChannelTracer"                         Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcLocalChannelTracer
           , Key
"LocalBearerTracer"                          Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcLocalBearerTracer
           , Key
"LocalHandshakeTracer"                       Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcLocalHandshakeTracer
           , Key
"DiffusionTracer"                            Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcDiffusionTracer
           , Key
"LocalRootPeersTracer"                       Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcTraceLocalRootPeersTracer
           , Key
"PublicRootPeersTracer"                      Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcTracePublicRootPeersTracer
           , Key
"LedgerPeersTracer"                          Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcTraceLedgerPeersTracer
           , Key
"PeerSelectionTracer"                        Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcTracePeerSelectionTracer
           , Key
"ChurnCounters"                              Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcTraceChurnCounters
           , Key
"DebugPeerSelectionInitiatorTracer"          Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcDebugPeerSelectionInitiatorTracer
           , Key
"DebugPeerSelectionInitiatorResponderTracer" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcDebugPeerSelectionInitiatorResponderTracer
           , Key
"PeerSelectionCounters"                      Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcTracePeerSelectionCounters
           , Key
"PeerSelectionActionsTracer"                 Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcPeerSelectionActionsTracer
           , Key
"ConnectionManagerTracer"                    Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcConnectionManagerTracer
           , Key
"ConnectionManagerTransitionTracer"          Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcConnectionManagerTransitionTracer
           , Key
"ServerTracer"                               Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcServerTracer
           , Key
"InboundGovernorTracer"                      Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcInboundGovernorTracer
           , Key
"InboundGovernorTransitionTracer"            Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcInboundGovernorTransitionTracer
           , Key
"LocalConnectionManagerTracer"               Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcLocalConnectionManagerTracer
           , Key
"LocalServerTracer"                          Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcLocalServerTracer
           , Key
"LocalInboundGovernorTracer"                 Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcLocalInboundGovernorTracer
           , Key
"DnsTracer"                                  Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcDnsTracer
           , Key
"SigSubmissionClientTracer"                  Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcSigSubmissionClientTracer
           , Key
"SigSubmissionServerTracer"                  Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcSigSubmissionServerTracer
           , Key
"KeepAliveClientTracer"                      Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcKeepAliveClientTracer
           , Key
"KeepAliveServerTracer"                      Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcKeepAliveServerTracer
           , Key
"PeerSharingClientTracer"                    Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcPeerSharingClientTracer
           , Key
"PeerSharingServerTracer"                    Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I Bool -> Bool
forall a. I a -> a
unI I Bool
dmqcPeerSharingServerTracer
           ]

-- | Read the `DMQConfiguration` from the specified file.
--
readConfigurationFile
  :: FilePath
  -> IO (Either Text PartialConfig)
readConfigurationFile :: [Char] -> IO (Either Text PartialConfig)
readConfigurationFile [Char]
nc = do
  ebs <- IO ByteString -> IO (Either IOError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO ByteString -> IO (Either IOError ByteString))
-> IO ByteString -> IO (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile [Char]
nc
  case ebs of
    -- use the default configuration if it's not on disk
    Left IOError
e | IOError -> Bool
isDoesNotExistError IOError
e
           -> Either Text PartialConfig -> IO (Either Text PartialConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text PartialConfig -> IO (Either Text PartialConfig))
-> Either Text PartialConfig -> IO (Either Text PartialConfig)
forall a b. (a -> b) -> a -> b
$ PartialConfig -> Either Text PartialConfig
forall a b. b -> Either a b
Right PartialConfig
forall a. Monoid a => a
mempty
    Left IOError
e -> Either Text PartialConfig -> IO (Either Text PartialConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text PartialConfig -> IO (Either Text PartialConfig))
-> (Text -> Either Text PartialConfig)
-> Text
-> IO (Either Text PartialConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text PartialConfig
forall a b. a -> Either a b
Left (Text -> IO (Either Text PartialConfig))
-> Text -> IO (Either Text PartialConfig)
forall a b. (a -> b) -> a -> b
$ IOError -> Text
handler IOError
e
    Right ByteString
bs -> do
      let bs' :: LazyByteString
bs' = ByteString -> LazyByteString
LBS.fromStrict ByteString
bs
      case LazyByteString -> Either [Char] PartialConfig
forall a. FromJSON a => LazyByteString -> Either [Char] a
eitherDecode LazyByteString
bs' of
        Left [Char]
err -> Either Text PartialConfig -> IO (Either Text PartialConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text PartialConfig -> IO (Either Text PartialConfig))
-> Either Text PartialConfig -> IO (Either Text PartialConfig)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text PartialConfig
forall a b. a -> Either a b
Left ([Char] -> Text
handlerJSON [Char]
err)
        Right PartialConfig
t  -> Either Text PartialConfig -> IO (Either Text PartialConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialConfig -> Either Text PartialConfig
forall a b. b -> Either a b
Right PartialConfig
t)
  where
    handler :: IOError -> Text
    handler :: IOError -> Text
handler IOError
e = [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"DMQ.Configurations.readConfigurationFile: "
                          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> [Char]
forall e. Exception e => e -> [Char]
displayException IOError
e
    handlerJSON :: String -> Text
    handlerJSON :: [Char] -> Text
handlerJSON [Char]
err = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Is your configuration file formatted correctly? "
      , [Char] -> Text
Text.pack [Char]
err
      ]

readConfigurationFileOrError
  :: FilePath
  -> IO PartialConfig
readConfigurationFileOrError :: [Char] -> IO PartialConfig
readConfigurationFileOrError [Char]
nc =
      [Char] -> IO (Either Text PartialConfig)
readConfigurationFile [Char]
nc
  IO (Either Text PartialConfig)
-> (Either Text PartialConfig -> IO PartialConfig)
-> IO PartialConfig
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> IO PartialConfig)
-> (PartialConfig -> IO PartialConfig)
-> Either Text PartialConfig
-> IO PartialConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
err -> [Char] -> IO PartialConfig
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO PartialConfig) -> [Char] -> IO PartialConfig
forall a b. (a -> b) -> a -> b
$ [Char]
"DMQ.Topology.eeadConfigurationFile: "
                           [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
err)
             PartialConfig -> IO PartialConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

mkDiffusionConfiguration
  :: HasCallStack
  => Configuration
  -> NetworkTopology NoExtraConfig NoExtraFlags
  -> IO (Diffusion.Configuration NoExtraFlags IO ntnFd RemoteAddress ntcFd ntcAddr)
mkDiffusionConfiguration :: forall ntnFd ntcFd ntcAddr.
HasCallStack =>
Configuration
-> NetworkTopology NoExtraConfig NoExtraFlags
-> IO
     (Configuration NoExtraFlags IO ntnFd RemoteAddress ntcFd ntcAddr)
mkDiffusionConfiguration
  Configuration {
    dmqcIPv4 :: forall (f :: * -> *). Configuration' f -> f (Maybe IPv4)
dmqcIPv4                              = I Maybe IPv4
ipv4
  , dmqcIPv6 :: forall (f :: * -> *). Configuration' f -> f (Maybe IPv6)
dmqcIPv6                              = I Maybe IPv6
ipv6
  , dmqcTopologyFile :: forall (f :: * -> *). Configuration' f -> f [Char]
dmqcTopologyFile                      = I [Char]
topologyFile
  , dmqcPortNumber :: forall (f :: * -> *). Configuration' f -> f PortNumber
dmqcPortNumber                        = I PortNumber
portNumber
  , dmqcDiffusionMode :: forall (f :: * -> *). Configuration' f -> f DiffusionMode
dmqcDiffusionMode                     = I DiffusionMode
diffusionMode
  , dmqcAcceptedConnectionsLimit :: forall (f :: * -> *).
Configuration' f -> f AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit          = I AcceptedConnectionsLimit
acceptedConnectionsLimit
  , dmqcTargetOfRootPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfRootPeers                 = I Int
targetOfRootPeers
  , dmqcTargetOfKnownPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownPeers                = I Int
targetOfKnownPeers
  , dmqcTargetOfEstablishedPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedPeers          = I Int
targetOfEstablishedPeers
  , dmqcTargetOfActivePeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActivePeers               = I Int
targetOfActivePeers
  , dmqcTargetOfKnownBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownBigLedgerPeers       = I Int
targetOfKnownBigLedgerPeers
  , dmqcTargetOfEstablishedBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedBigLedgerPeers = I Int
targetOfEstablishedBigLedgerPeers
  , dmqcTargetOfActiveBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActiveBigLedgerPeers      = I Int
targetOfActiveBigLedgerPeers
  , dmqcProtocolIdleTimeout :: forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcProtocolIdleTimeout               = I DiffTime
protocolIdleTimeout
  , dmqcChurnInterval :: forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcChurnInterval                     = I DiffTime
churnInterval
  , dmqcPeerSharing :: forall (f :: * -> *). Configuration' f -> f PeerSharing
dmqcPeerSharing                       = I PeerSharing
peerSharing
  }
  nt :: NetworkTopology NoExtraConfig NoExtraFlags
nt@NetworkTopology {
    UseLedgerPeers
useLedgerPeers :: UseLedgerPeers
useLedgerPeers :: forall extraConfig extraFlags.
NetworkTopology extraConfig extraFlags -> UseLedgerPeers
useLedgerPeers
  , Maybe [Char]
peerSnapshotPath :: Maybe [Char]
peerSnapshotPath :: forall extraConfig extraFlags.
NetworkTopology extraConfig extraFlags -> Maybe [Char]
peerSnapshotPath
  } = do
    case (Maybe IPv4
ipv4, Maybe IPv6
ipv6) of
      (Maybe IPv4
Nothing, Maybe IPv6
Nothing) ->
           ConfigurationError -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO ConfigurationError
NoAddressInformation
      (Maybe IPv4, Maybe IPv6)
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    addrIPv4 <-
      case Maybe IPv4
ipv4 of
        Just IPv4
ipv4' ->
          RemoteAddress -> Maybe RemoteAddress
forall a. a -> Maybe a
Just (RemoteAddress -> Maybe RemoteAddress)
-> (NonEmpty AddrInfo -> RemoteAddress)
-> NonEmpty AddrInfo
-> Maybe RemoteAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrInfo -> RemoteAddress
addrAddress (AddrInfo -> RemoteAddress)
-> (NonEmpty AddrInfo -> AddrInfo)
-> NonEmpty AddrInfo
-> RemoteAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty AddrInfo -> AddrInfo
forall a. NonEmpty a -> a
NonEmpty.head
            (NonEmpty AddrInfo -> Maybe RemoteAddress)
-> IO (NonEmpty AddrInfo) -> IO (Maybe RemoteAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo
-> Maybe [Char] -> Maybe [Char] -> IO (NonEmpty AddrInfo)
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints)
                            ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (IPv4 -> [Char]
forall a. Show a => a -> [Char]
show IPv4
ipv4'))
                            ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (PortNumber -> [Char]
forall a. Show a => a -> [Char]
show PortNumber
portNumber))
        Maybe IPv4
Nothing -> Maybe RemoteAddress -> IO (Maybe RemoteAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RemoteAddress
forall a. Maybe a
Nothing
    addrIPv6 <-
      case ipv6 of
        Just IPv6
ipv6' ->
          RemoteAddress -> Maybe RemoteAddress
forall a. a -> Maybe a
Just (RemoteAddress -> Maybe RemoteAddress)
-> (NonEmpty AddrInfo -> RemoteAddress)
-> NonEmpty AddrInfo
-> Maybe RemoteAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrInfo -> RemoteAddress
addrAddress (AddrInfo -> RemoteAddress)
-> (NonEmpty AddrInfo -> AddrInfo)
-> NonEmpty AddrInfo
-> RemoteAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty AddrInfo -> AddrInfo
forall a. NonEmpty a -> a
NonEmpty.head
            (NonEmpty AddrInfo -> Maybe RemoteAddress)
-> IO (NonEmpty AddrInfo) -> IO (Maybe RemoteAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo
-> Maybe [Char] -> Maybe [Char] -> IO (NonEmpty AddrInfo)
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints)
                            ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (IPv6 -> [Char]
forall a. Show a => a -> [Char]
show IPv6
ipv6'))
                            ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (PortNumber -> [Char]
forall a. Show a => a -> [Char]
show PortNumber
portNumber))
        Maybe IPv6
Nothing -> Maybe RemoteAddress -> IO (Maybe RemoteAddress)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RemoteAddress
forall a. Maybe a
Nothing

    publicPeerSelectionVar <- makePublicPeerSelectionStateVar

    let (localRoots, publicRoots) = producerAddresses nt
    localRootsVar   <- newTVarIO localRoots
    publicRootsVar  <- newTVarIO publicRoots
    useLedgerVar    <- newTVarIO useLedgerPeers
    ledgerPeerSnapshotPathVar <- newTVarIO peerSnapshotPath
    topologyDir <- FilePath.takeDirectory <$> Directory.makeAbsolute topologyFile
    ledgerPeerSnapshotVar <- newTVarIO =<< updateLedgerPeerSnapshot
                                            topologyDir
                                            (readTVar ledgerPeerSnapshotPathVar)
                                            (const . pure $ ())

    return $
      Diffusion.Configuration {
        Diffusion.dcIPv4Address              = Right <$> addrIPv4
      , Diffusion.dcIPv6Address              = Right <$> addrIPv6
      , Diffusion.dcLocalAddress             = Nothing
      , Diffusion.dcAcceptedConnectionsLimit = acceptedConnectionsLimit
      , Diffusion.dcMode                     = diffusionMode
      , Diffusion.dcPublicPeerSelectionVar   = publicPeerSelectionVar
      , Diffusion.dcPeerSelectionTargets     =
          PeerSelectionTargets {
            targetNumberOfRootPeers                 = targetOfRootPeers
          , targetNumberOfKnownPeers                = targetOfKnownPeers
          , targetNumberOfEstablishedPeers          = targetOfEstablishedPeers
          , targetNumberOfActivePeers               = targetOfActivePeers
          , targetNumberOfKnownBigLedgerPeers       = targetOfKnownBigLedgerPeers
          , targetNumberOfEstablishedBigLedgerPeers = targetOfEstablishedBigLedgerPeers
          , targetNumberOfActiveBigLedgerPeers      = targetOfActiveBigLedgerPeers
          }
      , Diffusion.dcReadLocalRootPeers       = readTVar localRootsVar
      , Diffusion.dcReadPublicRootPeers      = readTVar publicRootsVar
      , Diffusion.dcReadLedgerPeerSnapshot   = readTVar ledgerPeerSnapshotVar
      , Diffusion.dcPeerSharing              = peerSharing
      , Diffusion.dcReadUseLedgerPeers       = readTVar useLedgerVar
      , Diffusion.dcProtocolIdleTimeout      = protocolIdleTimeout
      , Diffusion.dcTimeWaitTimeout          = defaultTimeWaitTimeout
      , Diffusion.dcDeadlineChurnInterval    = churnInterval
      , Diffusion.dcBulkChurnInterval        = churnInterval
      , Diffusion.dcMuxForkPolicy            = Diffusion.noBindForkPolicy -- TODO: Make option flag for responderForkPolicy
      , Diffusion.dcLocalMuxForkPolicy       = Diffusion.noBindForkPolicy -- TODO: Make option flag for responderForkPolicy
      , Diffusion.dcEgressPollInterval       = 0                          -- TODO: Make option flag for egress poll interval
      }
  where
    hints :: AddrInfo
hints = AddrInfo
defaultHints {
              addrFlags = [AI_PASSIVE, AI_ADDRCONFIG]
            , addrSocketType = Stream
            }

    updateLedgerPeerSnapshot :: HasCallStack
                             => FilePath
                             -> STM IO (Maybe FilePath)
                             -> (Maybe LedgerPeerSnapshot -> STM IO ())
                             -> IO (Maybe LedgerPeerSnapshot)
    updateLedgerPeerSnapshot :: HasCallStack =>
[Char]
-> STM IO (Maybe [Char])
-> (Maybe LedgerPeerSnapshot -> STM IO ())
-> IO (Maybe LedgerPeerSnapshot)
updateLedgerPeerSnapshot [Char]
topologyDir STM IO (Maybe [Char])
readLedgerPeerPath Maybe LedgerPeerSnapshot -> STM IO ()
writeVar = do
      mPeerSnapshotFile <- STM IO (Maybe [Char]) -> IO (Maybe [Char])
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM IO (Maybe [Char])
readLedgerPeerPath
      mLedgerPeerSnapshot <- case mPeerSnapshotFile of
        Maybe [Char]
Nothing -> Maybe LedgerPeerSnapshot -> IO (Maybe LedgerPeerSnapshot)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LedgerPeerSnapshot
forall a. Maybe a
Nothing
        Just [Char]
peerSnapshotFile | [Char] -> Bool
FilePath.isRelative [Char]
peerSnapshotFile -> do
          peerSnapshotFile' <- [Char] -> IO [Char]
Directory.makeAbsolute ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
topologyDir [Char] -> ShowS
FilePath.</> [Char]
peerSnapshotFile
          Just <$> readPeerSnapshotFileOrError peerSnapshotFile'
        Just [Char]
peerSnapshotFile ->
          LedgerPeerSnapshot -> Maybe LedgerPeerSnapshot
forall a. a -> Maybe a
Just (LedgerPeerSnapshot -> Maybe LedgerPeerSnapshot)
-> IO LedgerPeerSnapshot -> IO (Maybe LedgerPeerSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO LedgerPeerSnapshot
readPeerSnapshotFileOrError [Char]
peerSnapshotFile
      atomically . writeVar $ mLedgerPeerSnapshot
      pure mLedgerPeerSnapshot


-- TODO: review this once we know what is the size of a `Sig`.
-- TODO: parts of should be configurable
defaultSigDecisionPolicy :: TxDecisionPolicy
defaultSigDecisionPolicy :: TxDecisionPolicy
defaultSigDecisionPolicy = TxDecisionPolicy {
    maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest   = NumTxIdsToReq
10,
    maxUnacknowledgedTxIds :: NumTxIdsToReq
maxUnacknowledgedTxIds = NumTxIdsToReq
40,
    txsSizeInflightPerPeer :: SizeInBytes
txsSizeInflightPerPeer = SizeInBytes
100_000,
    maxTxsSizeInflight :: SizeInBytes
maxTxsSizeInflight     = SizeInBytes
250_000,
    txInflightMultiplicity :: Int
txInflightMultiplicity = Int
1,
    bufferedTxsMinLifetime :: DiffTime
bufferedTxsMinLifetime = DiffTime
0,
    scoreRate :: Double
scoreRate              = Double
0.1,
    scoreMax :: Double
scoreMax               = Double
15 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60
  }

data ConfigurationError =
    NoAddressInformation -- ^ dmq was not configured with IPv4 or IPv6 address
  deriving Int -> ConfigurationError -> ShowS
[ConfigurationError] -> ShowS
ConfigurationError -> [Char]
(Int -> ConfigurationError -> ShowS)
-> (ConfigurationError -> [Char])
-> ([ConfigurationError] -> ShowS)
-> Show ConfigurationError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigurationError -> ShowS
showsPrec :: Int -> ConfigurationError -> ShowS
$cshow :: ConfigurationError -> [Char]
show :: ConfigurationError -> [Char]
$cshowList :: [ConfigurationError] -> ShowS
showList :: [ConfigurationError] -> ShowS
Show

instance Exception ConfigurationError where
  displayException :: ConfigurationError -> [Char]
displayException ConfigurationError
NoAddressInformation = [Char]
"no ipv4 or ipv6 address specified, use --host-addr or --host-ipv6-addr"