Split config related code to a separate library

bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs

@@ -12,7 +12,7 @@ import           Cardano.Api (BlockType (..), ProtocolInfoArgs (..))
 
 import qualified Cardano.Ledger.Api.Transition as Ledger (tcShelleyGenesisL)
 import           Cardano.Node.Configuration.POM
-import           Cardano.Node.Handlers.Shutdown (ShutdownConfig (..))
+import           Cardano.Node.Handlers.Shutdown.Config (ShutdownConfig (..))
 import           Cardano.Node.Protocol.Cardano
 import           Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
 import           Cardano.Node.Types (ConfigYamlFilePath (..), GenesisFile,

bench/tx-generator/tx-generator.cabal

@@ -122,7 +122,7 @@ library
                       , cardano-ledger-api
                       , cardano-ledger-byron
                       , cardano-ledger-core
-                      , cardano-node
+                      , cardano-node:{cardano-configuration,cardano-node}
                       , cardano-prelude
                       , contra-tracer
                       , cborg >= 0.2.2 && < 0.3

cardano-node-chairman/cardano-node-chairman.cabal

@@ -45,7 +45,7 @@ executable cardano-node-chairman
                       , cardano-crypto-class
                       , cardano-git-rev ^>= 0.2.2
                       , cardano-ledger-core ^>= 1.18
-                      , cardano-node ^>= 10.6
+                      , cardano-node:{cardano-configuration,cardano-node} ^>= 10.6
                       , cardano-prelude
                       , containers
                       , contra-tracer

cardano-node/src/Cardano/Node/Configuration/POM.hs → cardano-node/cardano-configuration/src/Cardano/Node/Configuration/POM.hs

@@ -31,8 +31,8 @@ import qualified Cardano.Network.Diffusion.Configuration as Cardano
 import           Cardano.Network.Types (NumberOfBigLedgerPeers (..))
 import           Cardano.Node.Configuration.LedgerDB
 import           Cardano.Node.Configuration.Socket (SocketConfig (..))
-import           Cardano.Node.Handlers.Shutdown
-import           Cardano.Node.Protocol.Types (Protocol (..))
+import           Cardano.Node.Handlers.Shutdown.Config (ShutdownConfig (..))
+import           Cardano.Node.Protocol.Parsing (Protocol (..))
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config
 import           Cardano.Tracing.OrphanInstances.Network ()

cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs → cardano-node/cardano-configuration/src/Cardano/Node/Configuration/TopologyP2P.hs

@@ -44,12 +44,12 @@ import           Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)
 import           Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
 import           Cardano.Node.Configuration.NodeAddress
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
-import           Cardano.Node.Startup (StartupTrace (..))
+import           Cardano.Node.Startup.Types (StartupTrace (..))
 import           Cardano.Node.Types
 import           Cardano.Tracing.OrphanInstances.Network ()
 import           Ouroboros.Network.NodeToNode (DiffusionMode (..), PeerAdvertise (..))
 import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot (..),
-                   UseLedgerPeers (..), RelayAccessPoint (..))
+                   RelayAccessPoint (..), UseLedgerPeers (..))
 import           Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..),
                    WarmValency (..))
 
@@ -247,7 +247,7 @@ instance ToJSON adr => ToJSON (NetworkTopology adr) where
 readTopologyFile :: ()
   => forall adr. FromJSON adr
   => NodeConfiguration
-  -> CT.Tracer IO (StartupTrace blk) -> IO (Either Text (NetworkTopology adr))
+  -> CT.Tracer IO (StartupTrace blk protocolInstantiationError) -> IO (Either Text (NetworkTopology adr))
 readTopologyFile NodeConfiguration{ncTopologyFile=TopologyFile topologyFilePath, ncConsensusMode, ncProtocolFiles} tracer = runExceptT $ do
   bs <- handleIOExceptionsLiftWith handler $ BS.readFile topologyFilePath
   topology@RealNodeTopology{ntUseLedgerPeers, ntUseBootstrapPeers, ntPeerSnapshotPath} <-
@@ -340,7 +340,7 @@ readTopologyFile NodeConfiguration{ncTopologyFile=TopologyFile topologyFilePath,
 
 readTopologyFileOrError :: ()
   => forall adr. FromJSON adr
-  => NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (NetworkTopology adr)
+  => NodeConfiguration -> CT.Tracer IO (StartupTrace blk protocolInstantiationError) -> IO (NetworkTopology adr)
 readTopologyFileOrError nc tr =
       readTopologyFile nc tr
   >>= either (\err -> error $ "Cardano.Node.Configuration.TopologyP2P.readTopologyFile: "

cardano-node/cardano-configuration/src/Cardano/Node/Handlers/Shutdown/Config.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.Node.Handlers.Shutdown.Config
+  ( ShutdownOn (..)
+  , parseShutdownOn
+
+  -- * Generalised shutdown handling
+  , ShutdownConfig (..)
+  )
+where
+
+
+import           Ouroboros.Network.Block (BlockNo (..), SlotNo (..))
+
+import           Control.DeepSeq (NFData)
+import           Control.Monad (when)
+import           Data.Aeson (FromJSON, ToJSON)
+import           Data.Foldable (asum)
+import           GHC.Generics (Generic)
+import qualified Options.Applicative as Opt
+import           System.Posix.Types (Fd)
+import qualified Text.Read as Read
+
+import           Generic.Data.Orphans ()
+
+data ShutdownOn
+  = ASlot  !SlotNo
+  | ABlock !BlockNo
+  | NoShutdown
+  deriving (Generic, Eq, Show)
+
+deriving instance FromJSON ShutdownOn
+deriving instance ToJSON ShutdownOn
+deriving instance NFData ShutdownOn
+
+parseShutdownOn :: Opt.Parser ShutdownOn
+parseShutdownOn = asum
+  [ Opt.option (ASlot . SlotNo <$> bounded "SLOT") $ mconcat
+    [ Opt.long "shutdown-on-slot-synced"
+    , Opt.metavar "SLOT"
+    , Opt.help "Shut down the process after ChainDB is synced up to the specified slot"
+    , Opt.hidden
+    ]
+  , Opt.option (ABlock . BlockNo <$> bounded "BLOCK") $ mconcat
+    [ Opt.long "shutdown-on-block-synced"
+    , Opt.metavar "BLOCK"
+    , Opt.help "Shut down the process after ChainDB is synced up to the specified block"
+    , Opt.hidden
+    ]
+  , pure NoShutdown
+  ]
+  where
+    bounded :: forall a. (Bounded a, Integral a, Show a) => String -> Opt.ReadM a
+    bounded t = Opt.eitherReader $ \s -> do
+      i <- Read.readEither @Integer s
+      when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
+      when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
+      pure (fromIntegral i)
+
+data ShutdownConfig
+  = ShutdownConfig
+    { scIPC         :: !(Maybe Fd)
+    , scOnSyncLimit :: !(Maybe ShutdownOn)
+    }
+    deriving (Eq, Show)
+

cardano-node/src/Cardano/Node/Orphans.hs → cardano-node/cardano-configuration/src/Cardano/Node/Orphans.hs

@@ -11,7 +11,7 @@ import           Cardano.Api ()
 
 import           Ouroboros.Consensus.Node
 import           Ouroboros.Consensus.Node.Genesis (GenesisConfigFlags (..))
-import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots (Flag(..))
+import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots (Flag (..))
 import           Ouroboros.Network.SizeInBytes (SizeInBytes (..))
 
 import           Data.Aeson.Types

cardano-node/cardano-configuration/src/Cardano/Node/Protocol/Parsing.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Cardano.Node.Protocol.Parsing
+  ( Protocol(..)
+  ) where
+
+import           Cardano.Node.Orphans ()
+
+import           Control.DeepSeq (NFData)
+import           Data.Aeson
+import           GHC.Generics (Generic)
+
+import           NoThunks.Class (NoThunks)
+
+data Protocol = CardanoProtocol
+  deriving (Eq, Generic)
+
+instance Show Protocol where
+  show CardanoProtocol = "Byron; Shelley"
+
+deriving instance NFData Protocol
+deriving instance NoThunks Protocol
+
+instance FromJSON Protocol where
+  parseJSON =
+    withText "Protocol" $ \str -> case str of
+      "Cardano" -> pure CardanoProtocol
+      _ -> fail $ "Parsing of Protocol failed. " <> show str <> " is not a valid protocol"

cardano-node/cardano-configuration/src/Cardano/Node/Protocol/Traits.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Cardano.Node.Protocol.Traits (ConvertTxId (..)) where
+
+import qualified Cardano.Crypto.Hash as Crypto
+import qualified Cardano.Crypto.Hashing as Byron.Crypto
+import qualified Cardano.Ledger.Hashes as Ledger
+import qualified Cardano.Ledger.TxIn as Ledger
+import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
+import           Ouroboros.Consensus.Byron.Ledger.Mempool (TxId (..))
+import           Ouroboros.Consensus.HardFork.Combinator
+import           Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
+import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
+import           Ouroboros.Consensus.Shelley.Ledger.Mempool (TxId (..))
+import           Ouroboros.Consensus.Shelley.Node ()
+import           Ouroboros.Consensus.TypeFamilyWrappers
+import           Ouroboros.Consensus.Util.Orphans ()
+
+import           Data.ByteString (ByteString)
+import           Data.SOP
+
+--
+-- * TxId -> ByteString projection
+--
+-- | Convert a transaction ID to raw bytes.
+class ConvertTxId blk where
+  txIdToRawBytes :: TxId (GenTx blk) -> ByteString
+
+instance ConvertTxId ByronBlock where
+  txIdToRawBytes (ByronTxId txId) = Byron.Crypto.abstractHashToBytes txId
+  txIdToRawBytes (ByronDlgId dlgId) = Byron.Crypto.abstractHashToBytes dlgId
+  txIdToRawBytes (ByronUpdateProposalId upId) =
+    Byron.Crypto.abstractHashToBytes upId
+  txIdToRawBytes (ByronUpdateVoteId voteId) =
+    Byron.Crypto.abstractHashToBytes voteId
+
+instance ConvertTxId (ShelleyBlock protocol c) where
+  txIdToRawBytes (ShelleyTxId txId) =
+    Crypto.hashToBytes . Ledger.extractHash . Ledger.unTxId $ txId
+
+instance All ConvertTxId xs
+      => ConvertTxId (HardForkBlock xs) where
+  txIdToRawBytes =
+    hcollapse
+      . hcmap (Proxy @ConvertTxId) (K . txIdToRawBytes . unwrapGenTxId)
+      . getOneEraGenTxId
+      . getHardForkGenTxId

cardano-node/cardano-configuration/src/Cardano/Node/Startup/Types.hs

@@ -0,0 +1,149 @@
+{-# LANGUAGE DerivingStrategies #-}
+
+module Cardano.Node.Startup.Types where
+
+import qualified Cardano.Api as Api
+
+import           Cardano.Network.Diffusion (CardanoLocalRootConfig)
+import           Cardano.Node.Configuration.Socket
+import           Cardano.Node.Types (PeerSnapshotFile)
+import           Cardano.Slotting.Slot (SlotNo, WithOrigin)
+import           Ouroboros.Consensus.Cardano.Block
+import           Ouroboros.Consensus.Node.NetworkProtocolVersion (BlockNodeToClientVersion,
+                   BlockNodeToNodeVersion)
+import           Ouroboros.Network.Magic (NetworkMagic (..))
+import           Ouroboros.Network.NodeToClient (NodeToClientVersion)
+import           Ouroboros.Network.NodeToNode (DiffusionMode (..), NodeToNodeVersion, PeerAdvertise)
+import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers)
+import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint)
+import           Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency)
+
+import           Prelude
+
+import           Data.Map.Strict (Map)
+import           Data.Text (Text)
+import           Data.Time.Clock (NominalDiffTime, UTCTime)
+import           Data.Word (Word64)
+import qualified Network.Socket as Socket
+
+data StartupTrace blk protocolInstantiationError =
+  -- | Log startup information.
+  --
+    StartupInfo
+      [Socket.SockAddr]
+      -- ^ node-to-node addresses
+      (Maybe LocalSocketOrSocketInfo)
+      -- ^ node-to-client socket path
+      (Map NodeToNodeVersion (BlockNodeToNodeVersion blk))
+      -- ^ supported node-to-node versions
+      (Map NodeToClientVersion (BlockNodeToClientVersion blk))
+      -- ^ supported node-to-client versions
+
+  -- | Log peer-to-peer diffusion mode
+  | StartupP2PInfo DiffusionMode
+
+  | StartupTime UTCTime
+
+  | StartupNetworkMagic NetworkMagic
+
+  | StartupSocketConfigError SocketConfigError
+
+  | StartupDBValidation
+
+  -- | Log that the block forging is being updated
+  | BlockForgingUpdate EnabledBlockForging
+
+  -- | Protocol instantiation error when updating block forging
+  | BlockForgingUpdateError protocolInstantiationError
+
+  -- | Mismatched block type
+  | BlockForgingBlockTypeMismatch
+       Api.SomeBlockType -- ^ expected
+       Api.SomeBlockType -- ^ provided
+
+  -- | Log that the network configuration is being updated.
+  --
+  | NetworkConfigUpdate
+
+  -- | Re-configuration of network config is not supported.
+  --
+  | NetworkConfigUpdateUnsupported
+
+  -- | Log network configuration update error.
+  --
+  | NetworkConfigUpdateError Text
+
+  -- | Log network configuration update warning.
+  --
+  | NetworkConfigUpdateWarning Text
+
+  -- | Log network configuration update info.
+  --
+  | NetworkConfigUpdateInfo Text
+
+  -- | Log peer-to-peer network configuration, either on startup or when its
+  -- updated.
+  --
+  | NetworkConfig [(HotValency, WarmValency, Map RelayAccessPoint CardanoLocalRootConfig)]
+                  (Map RelayAccessPoint PeerAdvertise)
+                  UseLedgerPeers
+                  (Maybe PeerSnapshotFile)
+
+  -- | Warn when 'DisabledP2P' is set.
+  | NonP2PWarning
+
+  -- | Warn when 'ExperimentalProtocolsEnabled' is set and affects
+  -- node-to-node protocol.
+  --
+  | WarningDevelopmentNodeToNodeVersions [NodeToNodeVersion]
+
+  -- | Warn when 'ExperimentalProtocolsEnabled' is set and affects
+  -- node-to-client protocol.
+  --
+  | WarningDevelopmentNodeToClientVersions [NodeToClientVersion]
+
+  | BICommon BasicInfoCommon
+  | BIShelley BasicInfoShelleyBased
+  | BIByron BasicInfoByron
+  | BINetwork BasicInfoNetwork
+  | LedgerPeerSnapshotLoaded (Either (UseLedgerPeers, WithOrigin SlotNo) (WithOrigin SlotNo))
+  | MovedTopLevelOption String
+
+data EnabledBlockForging
+  = EnabledBlockForging
+  | DisabledBlockForging
+  | NotEffective
+    -- ^ one needs to send `SIGHUP` after consensus
+    -- initialised itself (especially after replying all
+    -- blocks).
+  deriving stock
+    (Eq, Show)
+
+data BasicInfoCommon = BasicInfoCommon {
+    biConfigPath    :: FilePath
+  , biNetworkMagic  :: NetworkMagic
+  , biProtocol      :: Text
+  , biVersion       :: Text
+  , biCommit        :: Text
+  , biNodeStartTime :: UTCTime
+  }
+
+-- Fields of this type are made strict to be sure no path from GC roots to genesis is retained
+data BasicInfoShelleyBased = BasicInfoShelleyBased {
+    bisEra               :: !Text
+  , bisSystemStartTime   :: !UTCTime
+  , bisSlotLength        :: !NominalDiffTime
+  , bisEpochLength       :: !Word64
+  , bisSlotsPerKESPeriod :: !Word64
+  }
+
+data BasicInfoByron = BasicInfoByron {
+    bibSystemStartTime :: UTCTime
+  , bibSlotLength      :: NominalDiffTime
+  , bibEpochLength     :: Word64
+  }
+
+data BasicInfoNetwork = BasicInfoNetwork {
+    niAddresses     :: [SocketOrSocketInfo]
+  , niDiffusionMode :: DiffusionMode
+  }

cardano-node/src/Cardano/Tracing/OrphanInstances/Common.hs → cardano-node/cardano-configuration/src/Cardano/Tracing/OrphanInstances/Common.hs

@@ -45,7 +45,6 @@ import           Cardano.BM.Stats
 import           Cardano.BM.Tracing (HasPrivacyAnnotation (..), HasSeverityAnnotation (..),
                    Severity (..), ToObject (..), Tracer (..), TracingVerbosity (..),
                    Transformable (..))
-import           Cardano.Node.Handlers.Shutdown ()
 
 import           Data.Aeson hiding (Value)
 import           Data.Scientific (coefficient)

cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs → cardano-node/cardano-configuration/src/Cardano/Tracing/OrphanInstances/Network.hs

@@ -27,7 +27,7 @@ import           Cardano.Network.OrphanInstances ()
 import qualified Cardano.Network.PeerSelection.ExtraRootPeers as Cardano.PublicRootPeers
 import qualified Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano
 import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano
-import           Cardano.Node.Queries (ConvertTxId)
+import           Cardano.Node.Protocol.Traits (ConvertTxId)
 import           Cardano.Tracing.OrphanInstances.Common
 import           Cardano.Tracing.Render
 import           Ouroboros.Consensus.Block (ConvertRawHash (..), Header, getHeader)