{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans #-}

module Cardano.Node.Tracing.Tracers.Startup
  ( getStartupInfo
  , namesStartupInfo
  , docStartupInfo
  , ppStartupInfoTrace
  ) where

import           Prelude

import           Data.Aeson (ToJSON (..), Value (..), (.=))
import           Data.List (intercalate)
import qualified Data.Map as Map
import           Data.Text (Text, pack)
import           Data.Time (getCurrentTime)
import           Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import           Data.Version (showVersion)
import           Network.Socket (SockAddr)
import           Paths_cardano_node (version)

import qualified Cardano.Chain.Genesis as Gen
import           Cardano.Slotting.Slot (EpochSize (..))

import           Cardano.Ledger.Shelley.API as SL

import           Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket (..))
import           Ouroboros.Network.NodeToNode (DiffusionMode (..))
import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))

import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT
import           Ouroboros.Consensus.Byron.Ledger.Conversions (fromByronEpochSlots,
                   fromByronSlotLength, genesisSlotLength)
import           Ouroboros.Consensus.Cardano.Block (HardForkLedgerConfig (..))
import           Ouroboros.Consensus.Cardano.CanHardFork (ByronPartialLedgerConfig (..),
                   ShelleyPartialLedgerConfig (..))
import qualified Ouroboros.Consensus.Config as Consensus
import           Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
import           Ouroboros.Consensus.HardFork.Combinator.Degenerate (HardForkLedgerConfig (..))
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo (..))
import           Ouroboros.Consensus.Shelley.Ledger.Ledger (shelleyLedgerGenesis)

import           Cardano.Logging

import           Cardano.Api (NetworkMagic (..), SlotNo (..))
import           Cardano.Api.Protocol.Types (BlockType (..), protocolInfo)

import           Cardano.Git.Rev (gitRev)

import           Cardano.Node.Configuration.POM (NodeConfiguration, ncProtocol)
import           Cardano.Node.Configuration.Socket
import           Cardano.Node.Configuration.TopologyP2P
import           Cardano.Node.Protocol (SomeConsensusProtocol (..))
import           Cardano.Node.Startup


getStartupInfo
  :: NodeConfiguration
  -> SomeConsensusProtocol
  -> FilePath
  -> IO [StartupTrace blk]
getStartupInfo :: NodeConfiguration
-> SomeConsensusProtocol -> FilePath -> IO [StartupTrace blk]
getStartupInfo NodeConfiguration
nc (SomeConsensusProtocol BlockType blk
whichP ProtocolInfoArgs IO blk
pForInfo) FilePath
fp = do
  UTCTime
nodeStartTime <- IO UTCTime
getCurrentTime
  let cfg :: TopLevelConfig blk
cfg = ProtocolInfo IO blk -> TopLevelConfig blk
forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig (ProtocolInfo IO blk -> TopLevelConfig blk)
-> ProtocolInfo IO blk -> TopLevelConfig blk
forall a b. (a -> b) -> a -> b
$ ProtocolInfoArgs IO blk -> ProtocolInfo IO blk
forall (m :: * -> *) blk.
Protocol m blk =>
ProtocolInfoArgs m blk -> ProtocolInfo m blk
protocolInfo ProtocolInfoArgs IO blk
pForInfo
      basicInfoCommon :: StartupTrace blk
basicInfoCommon = BasicInfoCommon -> StartupTrace blk
forall blk. BasicInfoCommon -> StartupTrace blk
BICommon (BasicInfoCommon -> StartupTrace blk)
-> BasicInfoCommon -> StartupTrace blk
forall a b. (a -> b) -> a -> b
$ BasicInfoCommon :: FilePath
-> NetworkMagic
-> Text
-> Text
-> Text
-> UTCTime
-> BasicInfoCommon
BasicInfoCommon {
                biProtocol :: Text
biProtocol = FilePath -> Text
pack (FilePath -> Text) -> (Protocol -> FilePath) -> Protocol -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Protocol -> FilePath
forall a. Show a => a -> FilePath
show (Protocol -> Text) -> Protocol -> Text
forall a b. (a -> b) -> a -> b
$ NodeConfiguration -> Protocol
ncProtocol NodeConfiguration
nc
              , biVersion :: Text
biVersion  = FilePath -> Text
pack (FilePath -> Text) -> (Version -> FilePath) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> FilePath
showVersion (Version -> Text) -> Version -> Text
forall a b. (a -> b) -> a -> b
$ Version
version
              , biCommit :: Text
biCommit   = Text
gitRev
              , biNodeStartTime :: UTCTime
biNodeStartTime = UTCTime
nodeStartTime
              , biConfigPath :: FilePath
biConfigPath = FilePath
fp
              , biNetworkMagic :: NetworkMagic
biNetworkMagic = BlockConfig blk -> NetworkMagic
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> NetworkMagic
getNetworkMagic (BlockConfig blk -> NetworkMagic)
-> BlockConfig blk -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
Consensus.configBlock TopLevelConfig blk
cfg
              }
      protocolDependentItems :: [StartupTrace blk]
protocolDependentItems =
        case BlockType blk
whichP of
          BlockType blk
ByronBlockType ->
            let DegenLedgerConfig PartialLedgerConfig ByronBlock
cfgByron = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
Consensus.configLedger TopLevelConfig blk
cfg
            in [TopLevelConfig blk -> ByronPartialLedgerConfig -> StartupTrace blk
forall blk blk.
ConfigSupportsNode blk =>
TopLevelConfig blk -> ByronPartialLedgerConfig -> StartupTrace blk
getGenesisValuesByron TopLevelConfig blk
cfg PartialLedgerConfig ByronBlock
ByronPartialLedgerConfig
cfgByron]
          BlockType blk
ShelleyBlockType ->
            let DegenLedgerConfig PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
cfgShelley = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
Consensus.configLedger TopLevelConfig blk
cfg
            in [Text
-> ShelleyPartialLedgerConfig StandardShelley -> StartupTrace blk
forall era blk.
Text -> ShelleyPartialLedgerConfig era -> StartupTrace blk
getGenesisValues Text
"Shelley" PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
ShelleyPartialLedgerConfig StandardShelley
cfgShelley]
          BlockType blk
CardanoBlockType ->
            let CardanoLedgerConfig PartialLedgerConfig ByronBlock
cfgByron PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
cfgShelley PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
cfgAllegra
                                    PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
cfgMary PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
cfgAlonzo PartialLedgerConfig
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
cfgBabbage = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
Consensus.configLedger TopLevelConfig blk
cfg
            in TopLevelConfig blk -> ByronPartialLedgerConfig -> StartupTrace blk
forall blk blk.
ConfigSupportsNode blk =>
TopLevelConfig blk -> ByronPartialLedgerConfig -> StartupTrace blk
getGenesisValuesByron TopLevelConfig blk
cfg PartialLedgerConfig ByronBlock
ByronPartialLedgerConfig
cfgByron
               StartupTrace blk -> [StartupTrace blk] -> [StartupTrace blk]
forall a. a -> [a] -> [a]
: Text
-> ShelleyPartialLedgerConfig StandardShelley -> StartupTrace blk
forall era blk.
Text -> ShelleyPartialLedgerConfig era -> StartupTrace blk
getGenesisValues  Text
"Shelley" PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
ShelleyPartialLedgerConfig StandardShelley
cfgShelley
               StartupTrace blk -> [StartupTrace blk] -> [StartupTrace blk]
forall a. a -> [a] -> [a]
: Text
-> ShelleyPartialLedgerConfig (AllegraEra StandardCrypto)
-> StartupTrace blk
forall era blk.
Text -> ShelleyPartialLedgerConfig era -> StartupTrace blk
getGenesisValues  Text
"Allegra" PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
ShelleyPartialLedgerConfig (AllegraEra StandardCrypto)
cfgAllegra
               StartupTrace blk -> [StartupTrace blk] -> [StartupTrace blk]
forall a. a -> [a] -> [a]
: Text
-> ShelleyPartialLedgerConfig (MaryEra StandardCrypto)
-> StartupTrace blk
forall era blk.
Text -> ShelleyPartialLedgerConfig era -> StartupTrace blk
getGenesisValues  Text
"Mary"    PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
ShelleyPartialLedgerConfig (MaryEra StandardCrypto)
cfgMary
               StartupTrace blk -> [StartupTrace blk] -> [StartupTrace blk]
forall a. a -> [a] -> [a]
: Text
-> ShelleyPartialLedgerConfig (AlonzoEra StandardCrypto)
-> StartupTrace blk
forall era blk.
Text -> ShelleyPartialLedgerConfig era -> StartupTrace blk
getGenesisValues  Text
"Alonzo"  PartialLedgerConfig
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
ShelleyPartialLedgerConfig (AlonzoEra StandardCrypto)
cfgAlonzo
               StartupTrace blk -> [StartupTrace blk] -> [StartupTrace blk]
forall a. a -> [a] -> [a]
: [Text
-> ShelleyPartialLedgerConfig (BabbageEra StandardCrypto)
-> StartupTrace blk
forall era blk.
Text -> ShelleyPartialLedgerConfig era -> StartupTrace blk
getGenesisValues Text
"Babbage" PartialLedgerConfig
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
ShelleyPartialLedgerConfig (BabbageEra StandardCrypto)
cfgBabbage]
  [StartupTrace blk] -> IO [StartupTrace blk]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StartupTrace blk
basicInfoCommon StartupTrace blk -> [StartupTrace blk] -> [StartupTrace blk]
forall a. a -> [a] -> [a]
: [StartupTrace blk]
protocolDependentItems)
    where
      getGenesisValues :: Text -> ShelleyPartialLedgerConfig era -> StartupTrace blk
getGenesisValues Text
era ShelleyPartialLedgerConfig era
config =
        let genesis :: ShelleyGenesis era
genesis = ShelleyLedgerConfig era -> ShelleyGenesis era
forall era. ShelleyLedgerConfig era -> ShelleyGenesis era
shelleyLedgerGenesis (ShelleyLedgerConfig era -> ShelleyGenesis era)
-> ShelleyLedgerConfig era -> ShelleyGenesis era
forall a b. (a -> b) -> a -> b
$ ShelleyPartialLedgerConfig era -> ShelleyLedgerConfig era
forall era.
ShelleyPartialLedgerConfig era -> ShelleyLedgerConfig era
shelleyLedgerConfig ShelleyPartialLedgerConfig era
config
        in BasicInfoShelleyBased -> StartupTrace blk
forall blk. BasicInfoShelleyBased -> StartupTrace blk
BIShelley (BasicInfoShelleyBased -> StartupTrace blk)
-> BasicInfoShelleyBased -> StartupTrace blk
forall a b. (a -> b) -> a -> b
$ BasicInfoShelleyBased :: Text
-> UTCTime
-> NominalDiffTime
-> Word64
-> Word64
-> BasicInfoShelleyBased
BasicInfoShelleyBased {
            bisEra :: Text
bisEra               = Text
era
          , bisSystemStartTime :: UTCTime
bisSystemStartTime   = ShelleyGenesis era -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
SL.sgSystemStart ShelleyGenesis era
genesis
          , bisSlotLength :: NominalDiffTime
bisSlotLength        = SlotLength -> NominalDiffTime
WCT.getSlotLength (SlotLength -> NominalDiffTime)
-> (NominalDiffTime -> SlotLength)
-> NominalDiffTime
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> SlotLength
WCT.mkSlotLength
                                      (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
SL.sgSlotLength ShelleyGenesis era
genesis
          , bisEpochLength :: Word64
bisEpochLength       = EpochSize -> Word64
unEpochSize (EpochSize -> Word64)
-> (ShelleyGenesis era -> EpochSize)
-> ShelleyGenesis era
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength (ShelleyGenesis era -> Word64) -> ShelleyGenesis era -> Word64
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era
genesis
          , bisSlotsPerKESPeriod :: Word64
bisSlotsPerKESPeriod = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSlotsPerKESPeriod ShelleyGenesis era
genesis
        }
      getGenesisValuesByron :: TopLevelConfig blk -> ByronPartialLedgerConfig -> StartupTrace blk
getGenesisValuesByron TopLevelConfig blk
cfg ByronPartialLedgerConfig
config =
        let genesis :: LedgerConfig ByronBlock
genesis = ByronPartialLedgerConfig -> LedgerConfig ByronBlock
byronLedgerConfig ByronPartialLedgerConfig
config
        in BasicInfoByron -> StartupTrace blk
forall blk. BasicInfoByron -> StartupTrace blk
BIByron (BasicInfoByron -> StartupTrace blk)
-> BasicInfoByron -> StartupTrace blk
forall a b. (a -> b) -> a -> b
$ BasicInfoByron :: UTCTime -> NominalDiffTime -> Word64 -> BasicInfoByron
BasicInfoByron {
            bibSystemStartTime :: UTCTime
bibSystemStartTime = SystemStart -> UTCTime
WCT.getSystemStart (SystemStart -> UTCTime)
-> (BlockConfig blk -> SystemStart) -> BlockConfig blk -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig blk -> SystemStart
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> SystemStart
getSystemStart
                                  (BlockConfig blk -> UTCTime) -> BlockConfig blk -> UTCTime
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
Consensus.configBlock TopLevelConfig blk
cfg
          , bibSlotLength :: NominalDiffTime
bibSlotLength      = SlotLength -> NominalDiffTime
WCT.getSlotLength (SlotLength -> NominalDiffTime)
-> (Natural -> SlotLength) -> Natural -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> SlotLength
fromByronSlotLength
                                  (Natural -> NominalDiffTime) -> Natural -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Config -> Natural
genesisSlotLength LedgerConfig ByronBlock
Config
genesis
          , bibEpochLength :: Word64
bibEpochLength     = EpochSize -> Word64
unEpochSize (EpochSize -> Word64)
-> (EpochSlots -> EpochSize) -> EpochSlots -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochSlots -> EpochSize
fromByronEpochSlots
                                  (EpochSlots -> Word64) -> EpochSlots -> Word64
forall a b. (a -> b) -> a -> b
$ Config -> EpochSlots
Gen.configEpochSlots LedgerConfig ByronBlock
Config
genesis
          }

--------------------------------------------------------------------------------
-- StartupInfo Tracer
--------------------------------------------------------------------------------

namesStartupInfo :: StartupTrace blk -> [Text]
namesStartupInfo :: StartupTrace blk -> [Text]
namesStartupInfo = \case
  StartupInfo {}                            -> [Text
"StartupInfo"]
  StartupP2PInfo {}                         -> [Text
"StartupP2PInfo"]
  StartupTime {}                            -> [Text
"StartupTime"]
  StartupNetworkMagic {}                    -> [Text
"StartupNetworkMagic"]
  StartupSocketConfigError {}               -> [Text
"StartupSocketConfigError"]
  StartupDBValidation {}                    -> [Text
"StartupDBValidation"]
  NetworkConfigUpdate {}                    -> [Text
"NetworkConfigUpdate"]
  StartupTrace blk
NetworkConfigUpdateUnsupported            -> [Text
"NetworkConfigUpdateUnsupported"]
  NetworkConfigUpdateError {}               -> [Text
"NetworkConfigUpdateError"]
  NetworkConfig {}                          -> [Text
"NetworkConfig"]
  P2PWarning {}                             -> [Text
"P2PWarning"]
  P2PWarningDevelopementNetworkProtocols {} -> [Text
"P2PWarningDevelopementNetworkProtocols"]
  WarningDevelopmentNetworkProtocols {}     -> [Text
"WarningDevelopmentNetworkProtocols"]
  BICommon {}                               -> [Text
"Common"]
  BIShelley {}                              -> [Text
"ShelleyBased"]
  BIByron {}                                -> [Text
"Byron"]
  BINetwork {}                              -> [Text
"Network"]

instance ( Show (BlockNodeToNodeVersion blk)
         , Show (BlockNodeToClientVersion blk)
         )
        => LogFormatting (StartupTrace blk) where
  forHuman :: StartupTrace blk -> Text
forHuman = StartupTrace blk -> Text
forall blk.
(Show (BlockNodeToNodeVersion blk),
 Show (BlockNodeToClientVersion blk)) =>
StartupTrace blk -> Text
ppStartupInfoTrace

  forMachine :: DetailLevel -> StartupTrace blk -> Object
forMachine DetailLevel
dtal (StartupInfo [SocketOrSocketInfo SockAddr SockAddr]
addresses
                                 Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
localSocket
                                 Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions
                                 Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions)
      = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat (
        [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StartupInfo"
        , Key
"nodeAddresses" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [FilePath] -> Value
forall a. ToJSON a => a -> Value
toJSON ((SocketOrSocketInfo SockAddr SockAddr -> FilePath)
-> [SocketOrSocketInfo SockAddr SockAddr] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SocketOrSocketInfo SockAddr SockAddr -> FilePath
ppN2NSocketInfo [SocketOrSocketInfo SockAddr SockAddr]
addresses)
        , Key
"localSocket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= case Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
localSocket of
              Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
Nothing -> Value
Null
              Just SocketOrSocketInfo LocalSocket LocalAddress
a  -> Text -> Value
String (FilePath -> Text
pack (FilePath -> Text)
-> (SocketOrSocketInfo LocalSocket LocalAddress -> FilePath)
-> SocketOrSocketInfo LocalSocket LocalAddress
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketOrSocketInfo LocalSocket LocalAddress -> FilePath
ppN2CSocketInfo (SocketOrSocketInfo LocalSocket LocalAddress -> Text)
-> SocketOrSocketInfo LocalSocket LocalAddress -> Text
forall a b. (a -> b) -> a -> b
$ SocketOrSocketInfo LocalSocket LocalAddress
a)
        ]
        [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++
        case DetailLevel
dtal of
          DetailLevel
DMaximum ->
            [ Key
"nodeToNodeVersions" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                [FilePath] -> Value
forall a. ToJSON a => a -> Value
toJSON (((NodeToNodeVersion, BlockNodeToNodeVersion blk) -> FilePath)
-> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (NodeToNodeVersion, BlockNodeToNodeVersion blk) -> FilePath
forall a. Show a => a -> FilePath
show ([(NodeToNodeVersion, BlockNodeToNodeVersion blk)] -> [FilePath])
-> (Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
    -> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)])
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map NodeToNodeVersion (BlockNodeToNodeVersion blk) -> [FilePath])
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk) -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions)
            , Key
"nodeToClientVersions" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                [FilePath] -> Value
forall a. ToJSON a => a -> Value
toJSON (((NodeToClientVersion, BlockNodeToClientVersion blk) -> FilePath)
-> [(NodeToClientVersion, BlockNodeToClientVersion blk)]
-> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (NodeToClientVersion, BlockNodeToClientVersion blk) -> FilePath
forall a. Show a => a -> FilePath
show ([(NodeToClientVersion, BlockNodeToClientVersion blk)]
 -> [FilePath])
-> (Map NodeToClientVersion (BlockNodeToClientVersion blk)
    -> [(NodeToClientVersion, BlockNodeToClientVersion blk)])
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> [(NodeToClientVersion, BlockNodeToClientVersion blk)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map NodeToClientVersion (BlockNodeToClientVersion blk)
 -> [FilePath])
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions)
            ]
          DetailLevel
_ ->
            [ Key
"maxNodeToNodeVersion" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                case Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> Maybe
     ((NodeToNodeVersion, BlockNodeToNodeVersion blk),
      Map NodeToNodeVersion (BlockNodeToNodeVersion blk))
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions of
                  Maybe
  ((NodeToNodeVersion, BlockNodeToNodeVersion blk),
   Map NodeToNodeVersion (BlockNodeToNodeVersion blk))
Nothing     -> Text -> Value
String Text
"no-supported-version"
                  Just ((NodeToNodeVersion, BlockNodeToNodeVersion blk)
v, Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
_) -> Text -> Value
String (FilePath -> Text
pack (FilePath -> Text)
-> ((NodeToNodeVersion, BlockNodeToNodeVersion blk) -> FilePath)
-> (NodeToNodeVersion, BlockNodeToNodeVersion blk)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeToNodeVersion, BlockNodeToNodeVersion blk) -> FilePath
forall a. Show a => a -> FilePath
show ((NodeToNodeVersion, BlockNodeToNodeVersion blk) -> Text)
-> (NodeToNodeVersion, BlockNodeToNodeVersion blk) -> Text
forall a b. (a -> b) -> a -> b
$ (NodeToNodeVersion, BlockNodeToNodeVersion blk)
v)
            , Key
"maxNodeToClientVersion" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                case Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> Maybe
     ((NodeToClientVersion, BlockNodeToClientVersion blk),
      Map NodeToClientVersion (BlockNodeToClientVersion blk))
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions of
                  Maybe
  ((NodeToClientVersion, BlockNodeToClientVersion blk),
   Map NodeToClientVersion (BlockNodeToClientVersion blk))
Nothing     -> Text -> Value
String Text
"no-supported-version"
                  Just ((NodeToClientVersion, BlockNodeToClientVersion blk)
v, Map NodeToClientVersion (BlockNodeToClientVersion blk)
_) -> Text -> Value
String (FilePath -> Text
pack (FilePath -> Text)
-> ((NodeToClientVersion, BlockNodeToClientVersion blk)
    -> FilePath)
-> (NodeToClientVersion, BlockNodeToClientVersion blk)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeToClientVersion, BlockNodeToClientVersion blk) -> FilePath
forall a. Show a => a -> FilePath
show ((NodeToClientVersion, BlockNodeToClientVersion blk) -> Text)
-> (NodeToClientVersion, BlockNodeToClientVersion blk) -> Text
forall a b. (a -> b) -> a -> b
$ (NodeToClientVersion, BlockNodeToClientVersion blk)
v)
            ])
  forMachine DetailLevel
_dtal (StartupP2PInfo DiffusionMode
diffusionMode) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StartupP2PInfo"
               , Key
"diffusionMode" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (DiffusionMode -> Text
forall a. Show a => a -> Text
showT DiffusionMode
diffusionMode) ]
  forMachine DetailLevel
_dtal (StartupTime UTCTime
time) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StartupTime"
               , Key
"startupTime" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ( Int -> Text
forall a. Show a => a -> Text
showT
                                         (Int -> Text) -> (UTCTime -> Int) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling :: POSIXTime -> Int)
                                         (NominalDiffTime -> Int)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds
                                         (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime
time
                                         )
               ]
  forMachine DetailLevel
_dtal (StartupNetworkMagic NetworkMagic
networkMagic) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StartupNetworkMagic"
               , Key
"networkMagic" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT (Word32 -> Text)
-> (NetworkMagic -> Word32) -> NetworkMagic -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkMagic -> Word32
unNetworkMagic
                                          (NetworkMagic -> Text) -> NetworkMagic -> Text
forall a b. (a -> b) -> a -> b
$ NetworkMagic
networkMagic) ]
  forMachine DetailLevel
_dtal (StartupSocketConfigError SocketConfigError
err) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StartupSocketConfigError"
               , Key
"error" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (SocketConfigError -> Text
forall a. Show a => a -> Text
showT SocketConfigError
err) ]
  forMachine DetailLevel
_dtal StartupTrace blk
StartupDBValidation =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StartupDBValidation"
               , Key
"message" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"start db validation" ]
  forMachine DetailLevel
_dtal StartupTrace blk
NetworkConfigUpdate =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NetworkConfigUpdate"
               , Key
"message" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"network configuration update" ]
  forMachine DetailLevel
_dtal StartupTrace blk
NetworkConfigUpdateUnsupported =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NetworkConfigUpdate"
              , Key
"message" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"network topology reconfiguration is not supported in non-p2p mode" ]
  forMachine DetailLevel
_dtal (NetworkConfigUpdateError Text
err) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NetworkConfigUpdateError"
               , Key
"error" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
err ]
  forMachine DetailLevel
_dtal (NetworkConfig [(Int, Map RelayAccessPoint PeerAdvertise)]
localRoots [RelayAccessPoint]
publicRoots UseLedgerAfter
useLedgerAfter) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NetworkConfig"
               , Key
"localRoots" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Int, Map RelayAccessPoint PeerAdvertise)] -> Value
forall a. ToJSON a => a -> Value
toJSON [(Int, Map RelayAccessPoint PeerAdvertise)]
localRoots
               , Key
"publicRoots" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [RelayAccessPoint] -> Value
forall a. ToJSON a => a -> Value
toJSON [RelayAccessPoint]
publicRoots
               , Key
"useLedgerAfter" Key -> UseLedger -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UseLedgerAfter -> UseLedger
UseLedger UseLedgerAfter
useLedgerAfter
               ]
  forMachine DetailLevel
_dtal StartupTrace blk
P2PWarning =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"P2PWarning"
               , Key
"message" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
p2pWarningMessage ]
  forMachine DetailLevel
_dtal StartupTrace blk
P2PWarningDevelopementNetworkProtocols =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"P2PWarningDevelopementNetworkProtocols"
               , Key
"message" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
p2pWarningDevelopmentNetworkProtocolsMessage ]
  forMachine DetailLevel
_ver (WarningDevelopmentNetworkProtocols [NodeToNodeVersion]
ntnVersions [NodeToClientVersion]
ntcVersions) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"WarningDevelopmentNetworkProtocols"
               , Key
"message" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"enabled development network protocols"
               , Key
"nodeToNodeDevelopmentVersions" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([NodeToNodeVersion] -> Text
forall a. Show a => a -> Text
showT [NodeToNodeVersion]
ntnVersions)
               , Key
"nodeToClientDevelopmentVersions" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([NodeToClientVersion] -> Text
forall a. Show a => a -> Text
showT [NodeToClientVersion]
ntcVersions)
               ]
  forMachine DetailLevel
_dtal (BINetwork BasicInfoNetwork {[SocketOrSocketInfo SockAddr SockAddr]
[DnsSubscriptionTarget]
DiffusionMode
IPSubscriptionTarget
niIpProducers :: BasicInfoNetwork -> IPSubscriptionTarget
niDnsProducers :: BasicInfoNetwork -> [DnsSubscriptionTarget]
niDiffusionMode :: BasicInfoNetwork -> DiffusionMode
niAddresses :: BasicInfoNetwork -> [SocketOrSocketInfo SockAddr SockAddr]
niIpProducers :: IPSubscriptionTarget
niDnsProducers :: [DnsSubscriptionTarget]
niDiffusionMode :: DiffusionMode
niAddresses :: [SocketOrSocketInfo SockAddr SockAddr]
..}) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BasicInfoNetwork"
               , Key
"addresses" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([SocketOrSocketInfo SockAddr SockAddr] -> Text
forall a. Show a => a -> Text
showT [SocketOrSocketInfo SockAddr SockAddr]
niAddresses)
               , Key
"diffusionMode"  Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (DiffusionMode -> Text
forall a. Show a => a -> Text
showT DiffusionMode
niDiffusionMode)
               , Key
"dnsProducers" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([DnsSubscriptionTarget] -> Text
forall a. Show a => a -> Text
showT [DnsSubscriptionTarget]
niDnsProducers)
               , Key
"ipProducers" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (IPSubscriptionTarget -> Text
forall a. Show a => a -> Text
showT IPSubscriptionTarget
niIpProducers)
               ]
  forMachine DetailLevel
_dtal (BIByron BasicInfoByron {Word64
UTCTime
NominalDiffTime
bibEpochLength :: Word64
bibSlotLength :: NominalDiffTime
bibSystemStartTime :: UTCTime
bibEpochLength :: BasicInfoByron -> Word64
bibSlotLength :: BasicInfoByron -> NominalDiffTime
bibSystemStartTime :: BasicInfoByron -> UTCTime
..}) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BasicInfoByron"
               , Key
"systemStartTime" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (UTCTime -> Text
forall a. Show a => a -> Text
showT UTCTime
bibSystemStartTime)
               , Key
"slotLength"  Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (NominalDiffTime -> Text
forall a. Show a => a -> Text
showT NominalDiffTime
bibSlotLength)
               , Key
"epochLength" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
showT Word64
bibEpochLength)
               ]
  forMachine DetailLevel
_dtal (BIShelley BasicInfoShelleyBased {Word64
Text
UTCTime
NominalDiffTime
bisSlotsPerKESPeriod :: Word64
bisEpochLength :: Word64
bisSlotLength :: NominalDiffTime
bisSystemStartTime :: UTCTime
bisEra :: Text
bisSlotsPerKESPeriod :: BasicInfoShelleyBased -> Word64
bisEpochLength :: BasicInfoShelleyBased -> Word64
bisSlotLength :: BasicInfoShelleyBased -> NominalDiffTime
bisSystemStartTime :: BasicInfoShelleyBased -> UTCTime
bisEra :: BasicInfoShelleyBased -> Text
..}) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BasicInfoShelleyBased"
               , Key
"era"  Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
bisEra
               , Key
"systemStartTime" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (UTCTime -> Text
forall a. Show a => a -> Text
showT UTCTime
bisSystemStartTime)
               , Key
"slotLength"  Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (NominalDiffTime -> Text
forall a. Show a => a -> Text
showT NominalDiffTime
bisSlotLength)
               , Key
"epochLength" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
showT Word64
bisEpochLength)
               , Key
"slotsPerKESPeriod" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
showT Word64
bisSlotsPerKESPeriod)
               ]
  forMachine DetailLevel
_dtal (BICommon BasicInfoCommon {FilePath
NetworkMagic
Text
UTCTime
biNodeStartTime :: UTCTime
biCommit :: Text
biVersion :: Text
biProtocol :: Text
biNetworkMagic :: NetworkMagic
biConfigPath :: FilePath
biNetworkMagic :: BasicInfoCommon -> NetworkMagic
biConfigPath :: BasicInfoCommon -> FilePath
biNodeStartTime :: BasicInfoCommon -> UTCTime
biCommit :: BasicInfoCommon -> Text
biVersion :: BasicInfoCommon -> Text
biProtocol :: BasicInfoCommon -> Text
..}) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BasicInfoCommon"
               , Key
"configPath" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (FilePath -> Text
pack FilePath
biConfigPath)
               , Key
"networkMagic"  Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (NetworkMagic -> Text
forall a. Show a => a -> Text
showT NetworkMagic
biNetworkMagic)
               , Key
"protocol" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
biProtocol
               , Key
"version" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
biVersion
               , Key
"commit" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
biCommit
               , Key
"nodeStartTime" Key -> UTCTime -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime
biNodeStartTime
               ]

-- | Pretty print 'StartupInfoTrace'
--
ppStartupInfoTrace :: ( Show (BlockNodeToNodeVersion blk)
                      , Show (BlockNodeToClientVersion blk)
                      )
                   => StartupTrace blk
                   -> Text
ppStartupInfoTrace :: StartupTrace blk -> Text
ppStartupInfoTrace (StartupInfo [SocketOrSocketInfo SockAddr SockAddr]
addresses
                                Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
localSocket
                                Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions
                                Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions)
  = FilePath -> Text
pack
  (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n"
    [ FilePath
"node addresses:          " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((SocketOrSocketInfo SockAddr SockAddr -> FilePath)
-> [SocketOrSocketInfo SockAddr SockAddr] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SocketOrSocketInfo SockAddr SockAddr -> FilePath
ppN2NSocketInfo [SocketOrSocketInfo SockAddr SockAddr]
addresses)
    , FilePath
"local socket:            " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
-> (SocketOrSocketInfo LocalSocket LocalAddress -> FilePath)
-> Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"NONE" SocketOrSocketInfo LocalSocket LocalAddress -> FilePath
ppN2CSocketInfo Maybe (SocketOrSocketInfo LocalSocket LocalAddress)
localSocket
    , FilePath
"node-to-node versions:\n"
       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n"
          (((NodeToNodeVersion, BlockNodeToNodeVersion blk) -> FilePath)
-> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(NodeToNodeVersion
v, BlockNodeToNodeVersion blk
bv) -> NodeToNodeVersion -> FilePath
forall a. Show a => a -> FilePath
show NodeToNodeVersion
v FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\t" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BlockNodeToNodeVersion blk -> FilePath
forall a. Show a => a -> FilePath
show BlockNodeToNodeVersion blk
bv)
        ([(NodeToNodeVersion, BlockNodeToNodeVersion blk)] -> [FilePath])
-> (Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
    -> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)])
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)]
forall k a. Map k a -> [(k, a)]
Map.assocs
        (Map NodeToNodeVersion (BlockNodeToNodeVersion blk) -> [FilePath])
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk) -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions)
    , FilePath
"node-to-client versions:\n"
       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n"
          (((NodeToClientVersion, BlockNodeToClientVersion blk) -> FilePath)
-> [(NodeToClientVersion, BlockNodeToClientVersion blk)]
-> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(NodeToClientVersion
v, BlockNodeToClientVersion blk
bv) -> NodeToClientVersion -> FilePath
forall a. Show a => a -> FilePath
show NodeToClientVersion
v FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\t" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BlockNodeToClientVersion blk -> FilePath
forall a. Show a => a -> FilePath
show BlockNodeToClientVersion blk
bv)
        ([(NodeToClientVersion, BlockNodeToClientVersion blk)]
 -> [FilePath])
-> (Map NodeToClientVersion (BlockNodeToClientVersion blk)
    -> [(NodeToClientVersion, BlockNodeToClientVersion blk)])
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> [(NodeToClientVersion, BlockNodeToClientVersion blk)]
forall k a. Map k a -> [(k, a)]
Map.assocs
        (Map NodeToClientVersion (BlockNodeToClientVersion blk)
 -> [FilePath])
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions)
    ]

ppStartupInfoTrace (StartupP2PInfo DiffusionMode
diffusionMode) =
        case DiffusionMode
diffusionMode of
          DiffusionMode
InitiatorAndResponderDiffusionMode -> Text
"initiator and responder diffusion mode"
          DiffusionMode
InitiatorOnlyDiffusionMode         -> Text
"initaitor only diffusion mode"

ppStartupInfoTrace (StartupTime UTCTime
time) =
  Text
"startup time: "
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( Int -> Text
forall a. Show a => a -> Text
showT
       (Int -> Text) -> (UTCTime -> Int) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling :: POSIXTime -> Int)
       (NominalDiffTime -> Int)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds
       (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime
time
     )
ppStartupInfoTrace (StartupNetworkMagic NetworkMagic
networkMagic) =
  Text
"network magic: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT (NetworkMagic -> Word32
unNetworkMagic NetworkMagic
networkMagic)

ppStartupInfoTrace (StartupSocketConfigError SocketConfigError
err) =
  FilePath -> Text
pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ SocketConfigError -> FilePath
renderSocketConfigError SocketConfigError
err

ppStartupInfoTrace StartupTrace blk
StartupDBValidation = Text
"Performing DB validation"

ppStartupInfoTrace StartupTrace blk
NetworkConfigUpdate = Text
"Performing topology configuration update"
ppStartupInfoTrace StartupTrace blk
NetworkConfigUpdateUnsupported =
  Text
"Network topology reconfiguration is not supported in non-p2p mode"
ppStartupInfoTrace (NetworkConfigUpdateError Text
err) = Text
err
ppStartupInfoTrace (NetworkConfig [(Int, Map RelayAccessPoint PeerAdvertise)]
localRoots [RelayAccessPoint]
publicRoots UseLedgerAfter
useLedgerAfter) =
    FilePath -> Text
pack
  (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n"
  [ FilePath
"\nLocal Root Groups:"
  , FilePath
"  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n  " (((Int, Map RelayAccessPoint PeerAdvertise) -> FilePath)
-> [(Int, Map RelayAccessPoint PeerAdvertise)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Map RelayAccessPoint PeerAdvertise
y) -> (Int, [(RelayAccessPoint, PeerAdvertise)]) -> FilePath
forall a. Show a => a -> FilePath
show (Int
x, Map RelayAccessPoint PeerAdvertise
-> [(RelayAccessPoint, PeerAdvertise)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map RelayAccessPoint PeerAdvertise
y))
                                    [(Int, Map RelayAccessPoint PeerAdvertise)]
localRoots)
  , FilePath
"Public Roots:"
  , FilePath
"  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n  " ((RelayAccessPoint -> FilePath) -> [RelayAccessPoint] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map RelayAccessPoint -> FilePath
forall a. Show a => a -> FilePath
show [RelayAccessPoint]
publicRoots)
  , case UseLedgerAfter
useLedgerAfter of
      UseLedgerAfter SlotNo
slotNo -> FilePath
"Get root peers from the ledger after slot "
                            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Word64 -> FilePath
forall a. Show a => a -> FilePath
show (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      UseLedgerAfter
DontUseLedger         -> FilePath
"Don't use ledger to get root peers."
  ]

ppStartupInfoTrace StartupTrace blk
P2PWarning = Text
p2pWarningMessage

ppStartupInfoTrace StartupTrace blk
P2PWarningDevelopementNetworkProtocols =
    Text
p2pWarningDevelopmentNetworkProtocolsMessage

ppStartupInfoTrace (WarningDevelopmentNetworkProtocols [NodeToNodeVersion]
ntnVersions [NodeToClientVersion]
ntcVersions) =
     Text
"enabled development network protocols: "
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [NodeToNodeVersion] -> Text
forall a. Show a => a -> Text
showT [NodeToNodeVersion]
ntnVersions
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [NodeToClientVersion] -> Text
forall a. Show a => a -> Text
showT [NodeToClientVersion]
ntcVersions

ppStartupInfoTrace (BINetwork BasicInfoNetwork {[SocketOrSocketInfo SockAddr SockAddr]
[DnsSubscriptionTarget]
DiffusionMode
IPSubscriptionTarget
niIpProducers :: IPSubscriptionTarget
niDnsProducers :: [DnsSubscriptionTarget]
niDiffusionMode :: DiffusionMode
niAddresses :: [SocketOrSocketInfo SockAddr SockAddr]
niIpProducers :: BasicInfoNetwork -> IPSubscriptionTarget
niDnsProducers :: BasicInfoNetwork -> [DnsSubscriptionTarget]
niDiffusionMode :: BasicInfoNetwork -> DiffusionMode
niAddresses :: BasicInfoNetwork -> [SocketOrSocketInfo SockAddr SockAddr]
..}) =
  Text
"Addresses " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [SocketOrSocketInfo SockAddr SockAddr] -> Text
forall a. Show a => a -> Text
showT [SocketOrSocketInfo SockAddr SockAddr]
niAddresses
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", DiffusionMode " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffusionMode -> Text
forall a. Show a => a -> Text
showT DiffusionMode
niDiffusionMode
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", DnsProducers " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [DnsSubscriptionTarget] -> Text
forall a. Show a => a -> Text
showT [DnsSubscriptionTarget]
niDnsProducers
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", IpProducers " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IPSubscriptionTarget -> Text
forall a. Show a => a -> Text
showT IPSubscriptionTarget
niIpProducers

ppStartupInfoTrace (BIByron BasicInfoByron {Word64
UTCTime
NominalDiffTime
bibEpochLength :: Word64
bibSlotLength :: NominalDiffTime
bibSystemStartTime :: UTCTime
bibEpochLength :: BasicInfoByron -> Word64
bibSlotLength :: BasicInfoByron -> NominalDiffTime
bibSystemStartTime :: BasicInfoByron -> UTCTime
..}) =
  Text
"Era Byron"
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Slot length " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall a. Show a => a -> Text
showT NominalDiffTime
bibSlotLength
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Epoch length " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
bibEpochLength

ppStartupInfoTrace (BIShelley BasicInfoShelleyBased {Word64
Text
UTCTime
NominalDiffTime
bisSlotsPerKESPeriod :: Word64
bisEpochLength :: Word64
bisSlotLength :: NominalDiffTime
bisSystemStartTime :: UTCTime
bisEra :: Text
bisSlotsPerKESPeriod :: BasicInfoShelleyBased -> Word64
bisEpochLength :: BasicInfoShelleyBased -> Word64
bisSlotLength :: BasicInfoShelleyBased -> NominalDiffTime
bisSystemStartTime :: BasicInfoShelleyBased -> UTCTime
bisEra :: BasicInfoShelleyBased -> Text
..}) =
  Text
"Era " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bisEra
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Slot length " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall a. Show a => a -> Text
showT NominalDiffTime
bisSlotLength
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Epoch length " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
bisEpochLength
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Slots per KESPeriod " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
bisSlotsPerKESPeriod

ppStartupInfoTrace (BICommon BasicInfoCommon {FilePath
NetworkMagic
Text
UTCTime
biNodeStartTime :: UTCTime
biCommit :: Text
biVersion :: Text
biProtocol :: Text
biNetworkMagic :: NetworkMagic
biConfigPath :: FilePath
biNetworkMagic :: BasicInfoCommon -> NetworkMagic
biConfigPath :: BasicInfoCommon -> FilePath
biNodeStartTime :: BasicInfoCommon -> UTCTime
biCommit :: BasicInfoCommon -> Text
biVersion :: BasicInfoCommon -> Text
biProtocol :: BasicInfoCommon -> Text
..}) =
  Text
"Config path " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack FilePath
biConfigPath
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Network magic " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NetworkMagic -> Text
forall a. Show a => a -> Text
showT NetworkMagic
biNetworkMagic
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Protocol " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
showT Text
biProtocol
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
showT Text
biVersion
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Commit " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
showT Text
biCommit
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", Node start time " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UTCTime -> Text
forall a. Show a => a -> Text
showT UTCTime
biNodeStartTime

p2pWarningMessage :: Text
p2pWarningMessage :: Text
p2pWarningMessage =
      Text
"unsupported and unverified version of "
   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`cardano-node` with peer-to-peer networking capabilities"

p2pWarningDevelopmentNetworkProtocolsMessage :: Text
p2pWarningDevelopmentNetworkProtocolsMessage :: Text
p2pWarningDevelopmentNetworkProtocolsMessage =
    Text
"peer-to-peer requires TestEnableDevelopmentNetworkProtocols to be set to True"


docStartupInfo :: Documented (StartupTrace blk)
docStartupInfo :: Documented (StartupTrace blk)
docStartupInfo = [DocMsg (StartupTrace blk)] -> Documented (StartupTrace blk)
forall a. [DocMsg a] -> Documented a
Documented [
    [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartupInfo"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartupP2PInfo"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartupTime"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartupNetworkMagic"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartupSocketConfigError"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartupDBValidation"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"NetworkConfigUpdate"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"NetworkConfigUpdateError"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"NetworkConfig"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"P2PWarning"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"P2PWarningDevelopementNetworkProtocols"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"WarningDevelopmentNetworkProtocols"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"Common"]
      []
      Text
"_biConfigPath_: is the path to the config in use. \
      \\n_biProtocol_: is the name of the protocol, e.g. \"Byron\", \"Shelley\" \
      \or \"Byron; Shelley\". \
      \\n_biVersion_: is the version of the node software running. \
      \\n_biCommit_: is the commit revision of the software running. \
      \\n_biNodeStartTime_: gives the time this node was started."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ShelleyBased"]
      []
      Text
"bisEra is the current era, e.g. \"Shelley\", \"Allegra\", \"Mary\" \
      \or \"Alonzo\". \
      \\n_bisSystemStartTime_: TODO JNF \
      \\n_bisSlotLength_: gives the length of a slot as time interval. \
      \\n_bisEpochLength_: gives the number of slots which forms an epoch. \
      \\n_bisSlotsPerKESPeriod_: gives the slots per KES period."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"Byron"]
      []
      Text
"_bibSystemStartTime_: TODO JNF \
      \\n_bibSlotLength_: gives the length of a slot as time interval. \
      \\n_bibEpochLength_: gives the number of slots which forms an epoch."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg (StartupTrace blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"Network"]
      []
      Text
"_niAddresses_: IPv4 or IPv6 socket ready to accept connections\
      \or diffusion addresses. \
      \\n_niDiffusionMode_: shows if the node runs only initiator or both\
      \initiator or responder node. \
      \\n_niDnsProducers_: shows the list of domain names to subscribe to. \
      \\n_niIpProducers_: shows the list of ip subscription addresses."
  ]

--
-- Utils
--

-- | Pretty print 'SocketOrSocketInfo'.
--
ppSocketInfo :: Show sock
             => (info -> String)
             -> SocketOrSocketInfo sock info -> String
ppSocketInfo :: (info -> FilePath) -> SocketOrSocketInfo sock info -> FilePath
ppSocketInfo  info -> FilePath
ppInfo (SocketInfo info
addr)   = info -> FilePath
ppInfo info
addr
ppSocketInfo info -> FilePath
_ppInfo (ActualSocket sock
sock) = sock -> FilePath
forall a. Show a => a -> FilePath
show sock
sock

ppN2CSocketInfo :: SocketOrSocketInfo LocalSocket LocalAddress
                -> String
ppN2CSocketInfo :: SocketOrSocketInfo LocalSocket LocalAddress -> FilePath
ppN2CSocketInfo = (LocalAddress -> FilePath)
-> SocketOrSocketInfo LocalSocket LocalAddress -> FilePath
forall sock info.
Show sock =>
(info -> FilePath) -> SocketOrSocketInfo sock info -> FilePath
ppSocketInfo LocalAddress -> FilePath
getFilePath

ppN2NSocketInfo :: SocketOrSocketInfo SockAddr SockAddr
                -> String
ppN2NSocketInfo :: SocketOrSocketInfo SockAddr SockAddr -> FilePath
ppN2NSocketInfo = (SockAddr -> FilePath)
-> SocketOrSocketInfo SockAddr SockAddr -> FilePath
forall sock info.
Show sock =>
(info -> FilePath) -> SocketOrSocketInfo sock info -> FilePath
ppSocketInfo SockAddr -> FilePath
forall a. Show a => a -> FilePath
show