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

{-# OPTIONS_GHC -Wno-orphans #-}

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

import Cardano.Chain.Genesis (mainnetProtocolMagicId)
import Cardano.Crypto.ProtocolMagic (ProtocolMagicId (..))
import Control.Concurrent.Class.MonadSTM.Strict
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 Network.Socket (AddrInfo (..), AddrInfoFlag (..), PortNumber,
           SocketType (..), defaultHints, getAddrInfo)
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.DiffusionMode
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.OrphanInstances ()
import Ouroboros.Network.PeerSelection.Governor.Types
           (PeerSelectionTargets (..), makePublicPeerSelectionStateVar)
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
           (LedgerPeerSnapshot (..), LedgerPeersKind (..))
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.Server.RateLimiting (AcceptedConnectionsLimit (..))
import Ouroboros.Network.Snocket (LocalAddress (..), RemoteAddress)

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

-- | Configuration comes in two flavours depending on the `f` functor:
-- `PartialConfig` is using `Last` and `Configuration` is using an identity
-- functor `I`.
--
-- See `defaultConfiguration` for default values.
--
data Configuration' f =
  Configuration {
    -- | Path from which the `Configuration` is read.
    forall (f :: * -> *). Configuration' f -> f [Char]
dmqcConfigFile                        :: f FilePath,

    -- | Network magic for the DMQ network
    forall (f :: * -> *). Configuration' f -> f NetworkMagic
dmqcNetworkMagic                      :: f NetworkMagic,
    -- | Network magic for local connections to a cardano-node
    forall (f :: * -> *). Configuration' f -> f NetworkMagic
dmqcCardanoNetworkMagic               :: f NetworkMagic,

    -- | IPv4 address to bind to for `node-to-node` communication.
    forall (f :: * -> *). Configuration' f -> f (Maybe IPv4)
dmqcIPv4                              :: f (Maybe IPv4),
    -- | IPv6 address to bind to for `node-to-node` communication.
    forall (f :: * -> *). Configuration' f -> f (Maybe IPv6)
dmqcIPv6                              :: f (Maybe IPv6),
    -- | Port number for `node-to-node` DMQ communication.
    forall (f :: * -> *). Configuration' f -> f PortNumber
dmqcPortNumber                        :: f PortNumber,
    -- | Local socket address for `node-to-client` DMQ communication.
    forall (f :: * -> *). Configuration' f -> f LocalAddress
dmqcLocalAddress                      :: f LocalAddress,
    -- | Topology file path.
    forall (f :: * -> *). Configuration' f -> f [Char]
dmqcTopologyFile                      :: f FilePath,
    -- | Path to the `cardano-node` socket.
    forall (f :: * -> *). Configuration' f -> f [Char]
dmqcCardanoNodeSocket                 :: f FilePath,

    forall (f :: * -> *).
Configuration' f -> f AcceptedConnectionsLimit
dmqcAcceptedConnectionsLimit          :: f AcceptedConnectionsLimit,
    -- | Diffusion mode for `node-to-node` communication.
    forall (f :: * -> *). Configuration' f -> f DiffusionMode
dmqcDiffusionMode                     :: f DiffusionMode,
    -- | Node-to-node inbound connection idle timeout.
    forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcProtocolIdleTimeout               :: f DiffTime,
    -- | Churn interval for peer selection.
    forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcChurnInterval                     :: f DiffTime,
    -- | Peer sharing setting.
    forall (f :: * -> *). Configuration' f -> f PeerSharing
dmqcPeerSharing                       :: f PeerSharing,
    -- | Ledger peers are hidden behind a flag.
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcLedgerPeers                       :: f Bool,

    --
    -- Peer Selection Targets
    --

    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,

    -- | CLI only option to show version and exit.
    forall (f :: * -> *). Configuration' f -> f Bool
dmqcVersion                           :: 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,
      dmqcLocalAddress :: I LocalAddress
dmqcLocalAddress                      = LocalAddress -> I LocalAddress
forall a. a -> I a
I ([Char] -> LocalAddress
LocalAddress [Char]
"dmq-node.socket"),
      dmqcNetworkMagic :: I NetworkMagic
dmqcNetworkMagic                      = NetworkMagic -> I NetworkMagic
forall a. a -> I a
I NetworkMagic { unNetworkMagic :: Word32
unNetworkMagic = Word32
3_141_592 },
      dmqcCardanoNetworkMagic :: I NetworkMagic
dmqcCardanoNetworkMagic               =
        NetworkMagic -> I NetworkMagic
forall a. a -> I a
I (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic)
-> (ProtocolMagicId -> Word32) -> ProtocolMagicId -> NetworkMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolMagicId -> Word32
unProtocolMagicId (ProtocolMagicId -> NetworkMagic)
-> ProtocolMagicId -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
mainnetProtocolMagicId),
      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.config.json",
      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,
      dmqcCardanoNodeSocket :: I [Char]
dmqcCardanoNodeSocket                 = [Char] -> I [Char]
forall a. a -> I a
I [Char]
"cardano-node.socket",
      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,
      dmqcLedgerPeers :: I Bool
dmqcLedgerPeers                       = Bool -> I Bool
forall a. a -> I a
I Bool
False,

      -- CLI only options
      dmqcVersion :: I Bool
dmqcVersion                           = 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 ()
      dmqcLocalAddress <- Last . fmap LocalAddress <$> v .:? "LocalAddress"
      dmqcPortNumber <- Last . fmap (fromIntegral @Int) <$> v.:? "PortNumber"
      dmqcNetworkMagic <- Last . fmap NetworkMagic <$> v .:? "NetworkMagic"
      dmqcCardanoNetworkMagic <- Last . fmap NetworkMagic <$> v .:? "CardanoNetworkMagic"
      dmqcDiffusionMode <- Last <$> v .:? "DiffusionMode"
      dmqcLedgerPeers <- Last <$> v .:? "LedgerPeers"
      dmqcPeerSharing <- Last <$> v .:? "PeerSharing"
      dmqcCardanoNodeSocket <- Last <$> v .:? "CardanoNodeSocket"

      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"

      pure $
        Configuration
          { dmqcIPv4                = Last dmqcIPv4
          , dmqcIPv6                = Last dmqcIPv6
          , dmqcConfigFile          = mempty
          , dmqcTopologyFile        = mempty
          , dmqcVersion             = mempty
          , ..
          }

-- | ToJSON instance used by logging system.
--
instance ToJSON Configuration where
  toJSON :: Configuration -> Value
toJSON Configuration {I Bool
I Int
I [Char]
I (Maybe IPv4)
I (Maybe IPv6)
I PortNumber
I PeerSharing
I DiffusionMode
I AcceptedConnectionsLimit
I LocalAddress
I DiffTime
I NetworkMagic
dmqcConfigFile :: forall (f :: * -> *). Configuration' f -> f [Char]
dmqcNetworkMagic :: forall (f :: * -> *). Configuration' f -> f NetworkMagic
dmqcCardanoNetworkMagic :: forall (f :: * -> *). Configuration' f -> f NetworkMagic
dmqcIPv4 :: forall (f :: * -> *). Configuration' f -> f (Maybe IPv4)
dmqcIPv6 :: forall (f :: * -> *). Configuration' f -> f (Maybe IPv6)
dmqcPortNumber :: forall (f :: * -> *). Configuration' f -> f PortNumber
dmqcLocalAddress :: forall (f :: * -> *). Configuration' f -> f LocalAddress
dmqcTopologyFile :: forall (f :: * -> *). Configuration' f -> f [Char]
dmqcCardanoNodeSocket :: forall (f :: * -> *). Configuration' f -> f [Char]
dmqcAcceptedConnectionsLimit :: forall (f :: * -> *).
Configuration' f -> f AcceptedConnectionsLimit
dmqcDiffusionMode :: forall (f :: * -> *). Configuration' f -> f DiffusionMode
dmqcProtocolIdleTimeout :: forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcChurnInterval :: forall (f :: * -> *). Configuration' f -> f DiffTime
dmqcPeerSharing :: forall (f :: * -> *). Configuration' f -> f PeerSharing
dmqcLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcTargetOfRootPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActivePeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfKnownBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfEstablishedBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcTargetOfActiveBigLedgerPeers :: forall (f :: * -> *). Configuration' f -> f Int
dmqcVersion :: forall (f :: * -> *). Configuration' f -> f Bool
dmqcConfigFile :: I [Char]
dmqcNetworkMagic :: I NetworkMagic
dmqcCardanoNetworkMagic :: I NetworkMagic
dmqcIPv4 :: I (Maybe IPv4)
dmqcIPv6 :: I (Maybe IPv6)
dmqcPortNumber :: I PortNumber
dmqcLocalAddress :: I LocalAddress
dmqcTopologyFile :: I [Char]
dmqcCardanoNodeSocket :: I [Char]
dmqcAcceptedConnectionsLimit :: I AcceptedConnectionsLimit
dmqcDiffusionMode :: I DiffusionMode
dmqcProtocolIdleTimeout :: I DiffTime
dmqcChurnInterval :: I DiffTime
dmqcPeerSharing :: I PeerSharing
dmqcLedgerPeers :: I Bool
dmqcTargetOfRootPeers :: I Int
dmqcTargetOfKnownPeers :: I Int
dmqcTargetOfEstablishedPeers :: I Int
dmqcTargetOfActivePeers :: I Int
dmqcTargetOfKnownBigLedgerPeers :: I Int
dmqcTargetOfEstablishedBigLedgerPeers :: I Int
dmqcTargetOfActiveBigLedgerPeers :: I Int
dmqcVersion :: I Bool
..} =
    [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
"LocalAddress"                      Key -> LocalAddress -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= I LocalAddress -> LocalAddress
forall a. I a -> a
unI I LocalAddress
dmqcLocalAddress
           , 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
"CardanoNodeSocket"                 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]
dmqcCardanoNodeSocket
           , 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
"LedgerPeers"                       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
dmqcLedgerPeers
           , 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
"CardanoNetworkMagic"               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
dmqcCardanoNetworkMagic)
           ]

-- | 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.Configuration.readConfigurationFile: "
                           [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
  :: Configuration
  -> NetworkTopology NoExtraConfig NoExtraFlags
  -> StrictTVar IO (Maybe (LedgerPeerSnapshot BigLedgerPeers))
  -> IO (Diffusion.Configuration NoExtraFlags IO ntnFd RemoteAddress ntcFd LocalAddress)
mkDiffusionConfiguration :: forall ntnFd ntcFd.
Configuration
-> NetworkTopology NoExtraConfig NoExtraFlags
-> StrictTVar IO (Maybe (LedgerPeerSnapshot BigLedgerPeers))
-> IO
     (Configuration
        NoExtraFlags IO ntnFd RemoteAddress ntcFd LocalAddress)
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
  , dmqcLocalAddress :: forall (f :: * -> *). Configuration' f -> f LocalAddress
dmqcLocalAddress                      = I LocalAddress
localAddress
  , 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
  }
  StrictTVar IO (Maybe (LedgerPeerSnapshot BigLedgerPeers))
ledgerBigPeersVar = 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

    return $
      Diffusion.Configuration {
        Diffusion.dcIPv4Address              = Right <$> addrIPv4
      , Diffusion.dcIPv6Address              = Right <$> addrIPv6
      , Diffusion.dcLocalAddress             = Just (Right localAddress)
      , 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 ledgerBigPeersVar
      , 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
            }


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"