diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index bdeca016221..a9d2045ec52 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -22,6 +22,7 @@ library Cardano.Api.Protocol.Shelley Cardano.Api.Shelley.Address Cardano.Api.Shelley.ColdKeys + Cardano.Api.Shelley.Genesis Cardano.Api.Shelley.OCert Cardano.Api.Shelley.KES Cardano.Api.Shelley.VRF @@ -81,6 +82,7 @@ library , shelley-spec-ledger , stm , text + , time , transformers , transformers-except , typed-protocols @@ -115,17 +117,24 @@ test-suite cardano-api-test , cardano-crypto-wrapper , cardano-ledger-test , cardano-prelude + , cardano-prelude-test + , cardano-slotting , containers , cryptonite , hedgehog + , ouroboros-consensus , ouroboros-consensus-shelley , ouroboros-network , shelley-spec-ledger + , shelley-spec-ledger-test + , time other-modules: Test.Cardano.Api Test.Cardano.Api.CBOR Test.Cardano.Api.Convert + Test.Cardano.Api.Examples Test.Cardano.Api.Gen + Test.Cardano.Api.Ledger Test.Cardano.Api.Orphans Test.Cardano.Api.View Test.Cardano.Api.Typed.CBOR diff --git a/cardano-api/src/Cardano/Api/Protocol.hs b/cardano-api/src/Cardano/Api/Protocol.hs index 029fc39de42..3eaa6c4e6f7 100644 --- a/cardano-api/src/Cardano/Api/Protocol.hs +++ b/cardano-api/src/Cardano/Api/Protocol.hs @@ -1,15 +1,20 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} + module Cardano.Api.Protocol ( -- * The enumeration of supported protocols Protocol(..) + , MockProtocol(..) -- * Node client support -- | Support for the context needed to run a client of a node that is using @@ -20,7 +25,9 @@ module Cardano.Api.Protocol import Cardano.Prelude -import Cardano.Config.Types (Protocol(..)) +import Control.Monad.Fail (fail) +import Data.Aeson + import Cardano.Chain.Slotting (EpochSlots(..)) import Cardano.Api.Protocol.Types @@ -30,6 +37,45 @@ import Cardano.Api.Protocol.Shelley import qualified Ouroboros.Consensus.Cardano as Consensus +data Protocol = MockProtocol !MockProtocol + | ByronProtocol + | ShelleyProtocol + | CardanoProtocol + deriving (Eq, Show, Generic) + +instance FromJSON Protocol where + parseJSON = + withText "Protocol" $ \str -> case str of + + -- The new names + "MockBFT" -> pure (MockProtocol MockBFT) + "MockPBFT" -> pure (MockProtocol MockPBFT) + "MockPraos" -> pure (MockProtocol MockPraos) + "Byron" -> pure ByronProtocol + "Shelley" -> pure ShelleyProtocol + "Cardano" -> pure CardanoProtocol + + -- The old names + "BFT" -> pure (MockProtocol MockBFT) + --"MockPBFT" -- same as new name + "Praos" -> pure (MockProtocol MockPraos) + "RealPBFT" -> pure ByronProtocol + "TPraos" -> pure ShelleyProtocol + + _ -> fail $ "Parsing of Protocol failed. " + <> show str <> " is not a valid protocol" + + +deriving instance NFData Protocol +deriving instance NoUnexpectedThunks Protocol + +data MockProtocol = MockBFT + | MockPBFT + | MockPraos + deriving (Eq, Show, Generic) + +deriving instance NFData MockProtocol +deriving instance NoUnexpectedThunks MockProtocol mkNodeClientProtocol :: Protocol -> SomeNodeClientProtocol mkNodeClientProtocol protocol = @@ -71,4 +117,3 @@ mkNodeClientProtocol protocol = -- client case. (EpochSlots 21600) (Consensus.SecurityParam 2160) - diff --git a/cardano-config/src/Cardano/Config/Shelley/Genesis.hs b/cardano-api/src/Cardano/Api/Shelley/Genesis.hs similarity index 98% rename from cardano-config/src/Cardano/Config/Shelley/Genesis.hs rename to cardano-api/src/Cardano/Api/Shelley/Genesis.hs index 05597a2593e..522dc0f306a 100644 --- a/cardano-config/src/Cardano/Config/Shelley/Genesis.hs +++ b/cardano-api/src/Cardano/Api/Shelley/Genesis.hs @@ -3,7 +3,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} -module Cardano.Config.Shelley.Genesis +module Cardano.Api.Shelley.Genesis ( ShelleyGenesis(..) , ShelleyGenesisError(..) , renderShelleyGenesisError @@ -19,7 +19,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Time as Time import Data.Aeson (Value, ToJSON(..), toJSON, FromJSON(..)) -import Data.Aeson.Types (Parser) +import Data.Aeson.Types (Parser) import Cardano.Config.Shelley.Orphans () import Cardano.Crypto.ProtocolMagic (ProtocolMagicId(..)) diff --git a/cardano-config/test/Golden/ShelleyGenesis b/cardano-api/test/Golden/ShelleyGenesis similarity index 100% rename from cardano-config/test/Golden/ShelleyGenesis rename to cardano-api/test/Golden/ShelleyGenesis diff --git a/cardano-config/test/Test/Cardano/Config/Examples.hs b/cardano-api/test/Test/Cardano/Api/Examples.hs similarity index 97% rename from cardano-config/test/Test/Cardano/Config/Examples.hs rename to cardano-api/test/Test/Cardano/Api/Examples.hs index d283a80cad1..f70e250ca0d 100644 --- a/cardano-config/test/Test/Cardano/Config/Examples.hs +++ b/cardano-api/test/Test/Cardano/Api/Examples.hs @@ -3,7 +3,7 @@ {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -module Test.Cardano.Config.Examples +module Test.Cardano.Api.Examples ( exampleShelleyGenesis ) where @@ -28,7 +28,7 @@ import Shelley.Spec.Ledger.Keys (KeyHash(..), KeyRole(..), Hash, VerKeyVRF, GenDelegPair(..)) import Shelley.Spec.Ledger.PParams (PParams' (..), emptyPParams) -import Cardano.Config.Shelley.Genesis +import Cardano.Api.Shelley.Genesis exampleShelleyGenesis :: ShelleyGenesis TPraosStandardCrypto diff --git a/cardano-config/test/Test/Cardano/Config/Types.hs b/cardano-api/test/Test/Cardano/Api/Ledger.hs similarity index 96% rename from cardano-config/test/Test/Cardano/Config/Types.hs rename to cardano-api/test/Test/Cardano/Api/Ledger.hs index f93d85f0442..15d8a9dbed0 100644 --- a/cardano-config/test/Test/Cardano/Config/Types.hs +++ b/cardano-api/test/Test/Cardano/Api/Ledger.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} -module Test.Cardano.Config.Types +module Test.Cardano.Api.Ledger ( tests ) where @@ -22,7 +22,7 @@ import Ouroboros.Consensus.Shelley.Protocol (TPraosStandardCrypto) import qualified Test.Shelley.Spec.Ledger.Genesis.Properties as Ledger import Test.Shelley.Spec.Ledger.Generator.Genesis -import Test.Cardano.Config.Examples +import Test.Cardano.Api.Examples import Test.Cardano.Prelude diff --git a/cardano-api/test/cardano-api-test.hs b/cardano-api/test/cardano-api-test.hs index 248d5dca132..9b3ad6baa69 100644 --- a/cardano-api/test/cardano-api-test.hs +++ b/cardano-api/test/cardano-api-test.hs @@ -6,6 +6,7 @@ import Hedgehog.Main (defaultMain) import qualified Test.Cardano.Api import qualified Test.Cardano.Api.CBOR import qualified Test.Cardano.Api.Convert +import qualified Test.Cardano.Api.Ledger import qualified Test.Cardano.Api.View import qualified Test.Cardano.Api.Typed.CBOR import qualified Test.Cardano.Api.Typed.RawBytes @@ -16,6 +17,7 @@ main = defaultMain [ Test.Cardano.Api.CBOR.tests , Test.Cardano.Api.Convert.tests + , Test.Cardano.Api.Ledger.tests , Test.Cardano.Api.View.tests , Test.Cardano.Api.tests , Test.Cardano.Api.Typed.CBOR.tests diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs index 93036ad0502..7261120a111 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs @@ -52,7 +52,7 @@ import qualified Shelley.Spec.Ledger.TxData as Shelley import Cardano.Api.Shelley.Address (ShelleyAddress) import Cardano.Api.Shelley.ColdKeys (KeyRole (..), OperatorKeyRole (..), readVerKey) -import Cardano.Config.Shelley.Genesis +import Cardano.Api.Shelley.Genesis import Cardano.Api.Shelley.ColdKeys import Cardano.Api.Shelley.OCert import Cardano.Api.Shelley.VRF diff --git a/cardano-config/cardano-config.cabal b/cardano-config/cardano-config.cabal index d42b44f955b..7b3e6ff8cd2 100644 --- a/cardano-config/cardano-config.cabal +++ b/cardano-config/cardano-config.cabal @@ -26,15 +26,11 @@ library Cardano.Config.GitRev Cardano.Config.GitRevFromGit Cardano.Config.LedgerQueries - Cardano.Config.Logging Cardano.Config.Orphanage Cardano.Config.Parsers - Cardano.Config.Shelley.Genesis Cardano.Config.Shelley.Orphans Cardano.Config.Shelley.Parsers - Cardano.Config.Topology Cardano.Config.TopHandler - Cardano.Config.TraceConfig Cardano.Config.Types Cardano.TracingOrphanInstances.Byron Cardano.TracingOrphanInstances.Common @@ -107,47 +103,3 @@ library -Wredundant-constraints -Wpartial-fields -Wcompat - -test-suite cardano-config-test - hs-source-dirs: test - main-is: cardano-config-test.hs - type: exitcode-stdio-1.0 - - build-depends: - base >= 4.12 && < 5 - , aeson - , bytestring - , cardano-config - , cardano-crypto-class - , cardano-crypto-test - , cardano-crypto-wrapper - , cardano-prelude - , cardano-prelude-test - , cardano-slotting - , containers - , cryptonite - , iproute - , ouroboros-consensus - , ouroboros-consensus-shelley - , ouroboros-network - , shelley-spec-ledger - , shelley-spec-ledger-test - , time - , hedgehog - , hedgehog-corpus - - other-modules: Test.Cardano.Config.Examples - Test.Cardano.Config.Gen - Test.Cardano.Config.Json - Test.Cardano.Config.Types - - default-language: Haskell2010 - default-extensions: NoImplicitPrelude - - ghc-options: -Wall - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints - -Wpartial-fields - -Wcompat - -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T diff --git a/cardano-config/src/Cardano/Config/Parsers.hs b/cardano-config/src/Cardano/Config/Parsers.hs index fb0e48a6a8d..a0b80488ee4 100644 --- a/cardano-config/src/Cardano/Config/Parsers.hs +++ b/cardano-config/src/Cardano/Config/Parsers.hs @@ -5,7 +5,6 @@ module Cardano.Config.Parsers ( command' - , nodeCLIParser , parseConfigFile , parseCoreNodeId , parseDbPath @@ -32,9 +31,7 @@ import Prelude (String) import Cardano.Prelude hiding (option) import Cardano.Chain.Common (Lovelace, mkLovelace) -import Cardano.Config.Byron.Parsers as Byron -import Cardano.Config.Shelley.Parsers as Shelley -import Cardano.Config.Topology +--import Cardano.Node.Topology import Cardano.Config.Types @@ -42,7 +39,6 @@ import Network.Socket (PortNumber) import Options.Applicative import Ouroboros.Consensus.NodeId (NodeId(..), CoreNodeId(..)) -import Ouroboros.Network.Block (MaxSlotNo(..), SlotNo(..)) -- Common command line parsers @@ -52,108 +48,6 @@ command' c descr p = command c $ info (p <**> helper) $ mconcat [ progDesc descr ] -nodeCLIParser :: Parser NodeCLI -nodeCLIParser = nodeRealProtocolModeParser <|> nodeMockProtocolModeParser - -nodeMockProtocolModeParser :: Parser NodeCLI -nodeMockProtocolModeParser = subparser - ( commandGroup "Execute node with a mock protocol." - <> metavar "run-mock" - <> command "run-mock" - (info (nodeMockParser <**> helper) - (progDesc "Execute node with a mock protocol.")) - ) -nodeRealProtocolModeParser :: Parser NodeCLI -nodeRealProtocolModeParser = subparser - ( commandGroup "Execute node with a real protocol." - <> metavar "run" - <> command "run" - (info (nodeRealParser <**> helper) - (progDesc "Execute node with a real protocol." )) - ) - --- | The mock protocol parser. -nodeMockParser :: Parser NodeCLI -nodeMockParser = do - -- Filepaths - topFp <- parseTopologyFile - dbFp <- parseDbPath - socketFp <- optional $ parseSocketPath "Path to a cardano-node socket" - - -- NodeConfiguration filepath - nodeConfigFp <- parseConfigFile - - -- Node Address - nAddress <- optional parseNodeAddress - - validate <- parseValidateDB - shutdownIPC <- parseShutdownIPC - shutdownOnSlotSynced <- parseShutdownOnSlotSynced - - pure $ NodeCLI - { nodeMode = MockProtocolMode - , nodeAddr = nAddress - , configFile = ConfigYamlFilePath nodeConfigFp - , topologyFile = TopologyFile topFp - , databaseFile = DbFile dbFp - , socketFile = socketFp - , protocolFiles = ProtocolFilepaths - { byronCertFile = Nothing - , byronKeyFile = Nothing - , shelleyKESFile = Nothing - , shelleyVRFFile = Nothing - , shelleyCertFile = Nothing - } - , validateDB = validate - , shutdownIPC - , shutdownOnSlotSynced - } - --- | The real protocol parser. -nodeRealParser :: Parser NodeCLI -nodeRealParser = do - -- Filepaths - topFp <- parseTopologyFile - dbFp <- parseDbPath - socketFp <- optional $ parseSocketPath "Path to a cardano-node socket" - - -- Protocol files - byronCertFile <- optional Byron.parseDelegationCert - byronKeyFile <- optional Byron.parseSigningKey - shelleyKESFile <- optional Shelley.parseKesKeyFilePath - shelleyVRFFile <- optional Shelley.parseVrfKeyFilePath - shelleyCertFile <- optional Shelley.parseOperationalCertFilePath - - -- Node Address - nAddress <- optional parseNodeAddress - - -- NodeConfiguration filepath - nodeConfigFp <- parseConfigFile - - validate <- parseValidateDB - shutdownIPC <- parseShutdownIPC - - shutdownOnSlotSynced <- parseShutdownOnSlotSynced - - pure NodeCLI - { nodeMode = RealProtocolMode - , nodeAddr = nAddress - , configFile = ConfigYamlFilePath nodeConfigFp - , topologyFile = TopologyFile topFp - , databaseFile = DbFile dbFp - , socketFile = socketFp - , protocolFiles = ProtocolFilepaths - { byronCertFile - , byronKeyFile - , shelleyKESFile - , shelleyVRFFile - , shelleyCertFile - } - , validateDB = validate - , shutdownIPC - , shutdownOnSlotSynced - } - parseConfigFile :: Parser FilePath parseConfigFile = strOption @@ -250,32 +144,6 @@ parsePort = <> value 0 -- Use an ephemeral port ) -parseValidateDB :: Parser Bool -parseValidateDB = - switch ( - long "validate-db" - <> help "Validate all on-disk database files" - ) - -parseShutdownIPC :: Parser (Maybe Fd) -parseShutdownIPC = - optional $ option (Fd <$> auto) ( - long "shutdown-ipc" - <> metavar "FD" - <> help "Shut down the process when this inherited FD reaches EOF" - <> hidden - ) - -parseShutdownOnSlotSynced :: Parser MaxSlotNo -parseShutdownOnSlotSynced = - fmap (fromMaybe NoMaxSlotNo) $ - optional $ option (MaxSlotNo . SlotNo <$> auto) ( - long "shutdown-on-slot-synced" - <> metavar "SLOT" - <> help "Shut down the process after ChainDB is synced up to the specified slot" - <> hidden - ) - parseSigningKeyFile :: String -> String -> Parser SigningKeyFile parseSigningKeyFile opt desc = SigningKeyFile <$> parseFilePath opt desc @@ -288,14 +156,6 @@ parseSocketPath helpMessage = <> metavar "FILEPATH" ) -parseTopologyFile :: Parser FilePath -parseTopologyFile = - strOption ( - long "topology" - <> metavar "FILEPATH" - <> help "The path to a file describing the topology." - ) - parseLogOutputFile :: Parser FilePath parseLogOutputFile = strOption diff --git a/cardano-config/src/Cardano/Config/Types.hs b/cardano-config/src/Cardano/Config/Types.hs index 5033137ef5f..06a34fcdbd3 100644 --- a/cardano-config/src/Cardano/Config/Types.hs +++ b/cardano-config/src/Cardano/Config/Types.hs @@ -15,7 +15,6 @@ module Cardano.Config.Types , CBORObject (..) , PoolMetaDataFile (..) , CertificateFile (..) - , ConfigYamlFilePath (..) , ConfigError (..) , DbFile (..) , GenesisFile (..) @@ -25,18 +24,7 @@ module Cardano.Config.Types , OperationalCertStartKESPeriod (..) , HasKESMetricsData (..) , NodeAddress (..) - , NodeConfiguration (..) - , NodeProtocolConfiguration (..) - , NodeMockProtocolConfiguration (..) - , NodeByronProtocolConfiguration (..) - , NodeShelleyProtocolConfiguration (..) - , NodeHardForkProtocolConfiguration (..) , NodeHostAddress (..) - , Protocol (..) - , MockProtocol (..) - , ncProtocol - , protocolName - , NodeCLI (..) , NodeProtocolMode (..) , SigningKeyFile (..) , ProtocolFilepaths (..) @@ -45,9 +33,6 @@ module Cardano.Config.Types , SocketPath (..) , UpdateProposalFile (..) , ViewMode (..) - , Fd (..) - , parseNodeConfiguration - , parseNodeConfigurationFP , parseNodeHostAddress ) where @@ -58,21 +43,12 @@ import Data.Aeson import Data.IP (IP) import Data.String (String) import qualified Data.Text as Text -import Data.Yaml (decodeFileThrow) -import Control.Monad.Fail import Network.Socket (PortNumber) -import System.FilePath ((), takeDirectory) -import System.Posix.Types (Fd(Fd)) import Cardano.BM.Tracing (ToObject) -import Cardano.Slotting.Slot (EpochNo) - -import qualified Cardano.Chain.Update as Byron -import qualified Cardano.Chain.Slotting as Byron (EpochSlots) - +import qualified Cardano.Chain.Slotting as Byron import Cardano.Crypto.KES.Class (Period) -import Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic) import Ouroboros.Consensus.Block (Header, BlockProtocol, ForgeState(..)) import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock) @@ -81,19 +57,16 @@ import Ouroboros.Consensus.Ledger.Abstract (LedgerError) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId, HasTxId, HasTxs(..), LedgerSupportsMempool(..)) import Ouroboros.Consensus.Mock.Ledger.Block (SimpleBlock) -import Ouroboros.Consensus.NodeId (CoreNodeId(..)) import Ouroboros.Consensus.Protocol.Abstract (CannotLead, ValidationErr) import Ouroboros.Consensus.Util.Condense (Condense (..)) import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock) import Ouroboros.Consensus.Shelley.Ledger.Mempool (GenTx, TxId) import Ouroboros.Consensus.Shelley.Protocol.Crypto.HotKey (HotKey (..)) -import Ouroboros.Network.Block (HeaderHash, MaxSlotNo(..)) +import Ouroboros.Network.Block (HeaderHash) import Cardano.Config.LedgerQueries import Cardano.Config.Orphanage () -import Cardano.Config.TraceConfig -import Cardano.Crypto (RequiresNetworkMagic(..)) import Shelley.Spec.Ledger.OCert (KESPeriod (..)) @@ -128,22 +101,6 @@ data CardanoEnvironment = NoEnvironment -- Cardano Configuration Data Structures -------------------------------------------------------------------------------- -data NodeCLI = NodeCLI - { nodeMode :: !NodeProtocolMode - , nodeAddr :: !(Maybe NodeAddress) - -- | Filepath of the configuration yaml file. This file determines - -- all the configuration settings required for the cardano node - -- (logging, tracing, protocol, slot length etc) - , configFile :: !ConfigYamlFilePath - , topologyFile :: !TopologyFile - , databaseFile :: !DbFile - , socketFile :: !(Maybe SocketPath) - , protocolFiles :: !ProtocolFilepaths - , validateDB :: !Bool - , shutdownIPC :: !(Maybe Fd) - , shutdownOnSlotSynced :: !MaxSlotNo - } - -- | Mock protocols requires different parameters to real protocols. -- Therefore we distinguish this at the top level on the command line. data NodeProtocolMode = MockProtocolMode @@ -158,16 +115,6 @@ data ProtocolFilepaths = , shelleyCertFile :: !(Maybe FilePath) } ---TODO: things will probably be clearer if we don't use these newtype wrappers and instead --- use records with named fields in the CLI code. - --- | Filepath of the configuration yaml file. This file determines --- all the configuration settings required for the cardano node --- (logging, tracing, protocol, slot length etc) -newtype ConfigYamlFilePath = ConfigYamlFilePath - { unConfigPath :: FilePath } - deriving newtype (Eq, Show) - newtype TopologyFile = TopologyFile { unTopology :: FilePath } deriving newtype Show @@ -214,349 +161,6 @@ newtype SigningKeyFile = SigningKeyFile deriving stock (Eq, Ord) deriving newtype (IsString, Show) -data NodeConfiguration = - NodeConfiguration { - -- Protocol-specific parameters: - ncProtocolConfig :: NodeProtocolConfiguration - - -- Node parameters, not protocol-specific: - , ncSocketPath :: Maybe SocketPath - - -- Logging parameters: - , ncViewMode :: ViewMode - , ncLoggingSwitch :: Bool - , ncLogMetrics :: Bool - , ncTraceConfig :: TraceOptions - } - deriving Show - -data NodeProtocolConfiguration = - NodeProtocolConfigurationMock NodeMockProtocolConfiguration - | NodeProtocolConfigurationByron NodeByronProtocolConfiguration - | NodeProtocolConfigurationShelley NodeShelleyProtocolConfiguration - | NodeProtocolConfigurationCardano NodeByronProtocolConfiguration - NodeShelleyProtocolConfiguration - NodeHardForkProtocolConfiguration - deriving Show - -data NodeMockProtocolConfiguration = - NodeMockProtocolConfiguration { - npcMockProtocol :: MockProtocol - , npcMockNodeId :: CoreNodeId - , npcMockNumCoreNodes :: Word64 - } - deriving Show - -data NodeByronProtocolConfiguration = - NodeByronProtocolConfiguration { - npcByronGenesisFile :: !GenesisFile - , npcByronReqNetworkMagic :: !RequiresNetworkMagic - , npcByronPbftSignatureThresh :: !(Maybe Double) - - -- | Update application name. - , npcByronApplicationName :: !Byron.ApplicationName - - -- | Application (ie software) version. - , npcByronApplicationVersion :: !Byron.NumSoftwareVersion - - -- | These declare the version of the protocol that the node is prepared - -- to run. This is usually the version of the protocol in use on the - -- chain now, but during protocol updates this version will be the one - -- that we declare that we are ready to move to. This is the endorsement - -- mechanism for determining when enough block producers are ready to - -- move to the next version. - -- - , npcByronSupportedProtocolVersionMajor :: !Word16 - , npcByronSupportedProtocolVersionMinor :: !Word16 - , npcByronSupportedProtocolVersionAlt :: !Word8 - } - deriving Show - -data NodeShelleyProtocolConfiguration = - NodeShelleyProtocolConfiguration { - npcShelleyGenesisFile :: !GenesisFile - - -- | These declare the version of the protocol that the node is prepared - -- to run. This is usually the version of the protocol in use on the - -- chain now, but during protocol updates this version will be the one - -- that we declare that we are ready to move to. This is the endorsement - -- mechanism for determining when enough block producers are ready to - -- move to the next version. - -- - , npcShelleySupportedProtocolVersionMajor :: !Natural - , npcShelleySupportedProtocolVersionMinor :: !Natural - - -- | The maximum major version of the protocol this node supports. - -- If the actual version ever goes higher than this then the node - -- will stop with an appropriate error message. - , npcShelleyMaxSupportedProtocolVersion :: !Natural - } - deriving Show - --- | Configuration relating to a hard forks themselves, not the specific eras. --- -data NodeHardForkProtocolConfiguration = - NodeHardForkProtocolConfiguration { - - -- | For testing purposes we support specifying that the hard fork - -- happens at an exact epoch number (ie the first epoch of the new era). - -- - -- Obviously if this is used, all the nodes in the test cluster must be - -- configured the same, or they will disagree. - -- - npcTestShelleyHardForkAtEpoch :: Maybe EpochNo - - -- | For testing purposes we support specifying that the hard fork - -- happens at a given major protocol version. For example this can be - -- used to cause the Shelley hard fork to occur at the transition from - -- protocol version 0 to version 1 (rather than the default of from 1 to - -- 2) which can make the test setup simpler. - -- - -- Obviously if this is used, all the nodes in the test cluster must be - -- configured the same, or they will disagree. - -- - , npcTestShelleyHardForkAtVersion :: Maybe Word - } - deriving Show - -instance FromJSON NodeConfiguration where - parseJSON = - withObject "NodeConfiguration" $ \v -> do - - -- Node parameters, not protocol-specific - ncSocketPath <- v .:? "SocketPath" - - -- Logging parameters - ncViewMode <- v .:? "ViewMode" .!= SimpleView - ncLoggingSwitch <- v .:? "TurnOnLogging" .!= True - ncLogMetrics <- v .:? "TurnOnLogMetrics" .!= True - ncTraceConfig <- if ncLoggingSwitch - then traceConfigParser v - else return TracingOff - - -- Protocol parameters - protocol <- v .: "Protocol" .!= ByronProtocol - ncProtocolConfig <- - case protocol of - MockProtocol ptcl -> - NodeProtocolConfigurationMock <$> parseMockProtocol ptcl v - - ByronProtocol -> - NodeProtocolConfigurationByron <$> parseByronProtocol v - - ShelleyProtocol -> - NodeProtocolConfigurationShelley <$> parseShelleyProtocol v - - CardanoProtocol -> - NodeProtocolConfigurationCardano <$> parseByronProtocol v - <*> parseShelleyProtocol v - <*> parseHardForkProtocol v - pure NodeConfiguration { - ncProtocolConfig - , ncSocketPath - , ncViewMode - , ncLoggingSwitch - , ncLogMetrics - , ncTraceConfig - } - where - parseMockProtocol npcMockProtocol v = do - npcMockNodeId <- v .: "NodeId" - npcMockNumCoreNodes <- v .: "NumCoreNodes" - pure NodeMockProtocolConfiguration { - npcMockProtocol - , npcMockNodeId - , npcMockNumCoreNodes - } - - parseByronProtocol v = do - primary <- v .:? "ByronGenesisFile" - secondary <- v .:? "GenesisFile" - npcByronGenesisFile <- - case (primary, secondary) of - (Just g, Nothing) -> return g - (Nothing, Just g) -> return g - (Nothing, Nothing) -> fail $ "Missing required field, either " - ++ "ByronGenesisFile or GenesisFile" - (Just _, Just _) -> fail $ "Specify either ByronGenesisFile" - ++ "or GenesisFile, but not both" - - npcByronReqNetworkMagic <- v .:? "RequiresNetworkMagic" - .!= RequiresNoMagic - npcByronPbftSignatureThresh <- v .:? "PBftSignatureThreshold" - npcByronApplicationName <- v .:? "ApplicationName" - .!= Byron.ApplicationName "cardano-sl" - npcByronApplicationVersion <- v .:? "ApplicationVersion" .!= 1 - protVerMajor <- v .: "LastKnownBlockVersion-Major" - protVerMinor <- v .: "LastKnownBlockVersion-Minor" - protVerAlt <- v .: "LastKnownBlockVersion-Alt" .!= 0 - - pure NodeByronProtocolConfiguration { - npcByronGenesisFile - , npcByronReqNetworkMagic - , npcByronPbftSignatureThresh - , npcByronApplicationName - , npcByronApplicationVersion - , npcByronSupportedProtocolVersionMajor = protVerMajor - , npcByronSupportedProtocolVersionMinor = protVerMinor - , npcByronSupportedProtocolVersionAlt = protVerAlt - } - - parseShelleyProtocol v = do - primary <- v .:? "ShelleyGenesisFile" - secondary <- v .:? "GenesisFile" - npcShelleyGenesisFile <- - case (primary, secondary) of - (Just g, Nothing) -> return g - (Nothing, Just g) -> return g - (Nothing, Nothing) -> fail $ "Missing required field, either " - ++ "ShelleyGenesisFile or GenesisFile" - (Just _, Just _) -> fail $ "Specify either ShelleyGenesisFile" - ++ "or GenesisFile, but not both" - - --TODO: these are silly names, allow better aliases: - protVerMajor <- v .: "LastKnownBlockVersion-Major" - protVerMinor <- v .: "LastKnownBlockVersion-Minor" - protVerMajroMax <- v .:? "MaxKnownMajorProtocolVersion" .!= 1 - - pure NodeShelleyProtocolConfiguration { - npcShelleyGenesisFile - , npcShelleySupportedProtocolVersionMajor = protVerMajor - , npcShelleySupportedProtocolVersionMinor = protVerMinor - , npcShelleyMaxSupportedProtocolVersion = protVerMajroMax - } - - parseHardForkProtocol v = do - npcTestShelleyHardForkAtEpoch <- v .:? "TestShelleyHardForkAtEpoch" - npcTestShelleyHardForkAtVersion <- v .:? "TestShelleyHardForkAtVersion" - pure NodeHardForkProtocolConfiguration { - npcTestShelleyHardForkAtEpoch, - npcTestShelleyHardForkAtVersion - } - - -parseNodeConfigurationFP :: ConfigYamlFilePath -> IO NodeConfiguration -parseNodeConfigurationFP (ConfigYamlFilePath fp) = do - nc <- decodeFileThrow fp - -- Make all the files be relative to the location of the config file. - pure $ adjustFilePaths (takeDirectory fp ) nc - -class AdjustFilePaths a where - adjustFilePaths :: (FilePath -> FilePath) -> a -> a - - -instance AdjustFilePaths NodeConfiguration where - adjustFilePaths f x@NodeConfiguration { - ncProtocolConfig, - ncSocketPath - } = - x { - ncProtocolConfig = adjustFilePaths f ncProtocolConfig, - ncSocketPath = adjustFilePaths f ncSocketPath - } - -instance AdjustFilePaths NodeProtocolConfiguration where - - adjustFilePaths f (NodeProtocolConfigurationMock pc) = - NodeProtocolConfigurationMock (adjustFilePaths f pc) - - adjustFilePaths f (NodeProtocolConfigurationByron pc) = - NodeProtocolConfigurationByron (adjustFilePaths f pc) - - adjustFilePaths f (NodeProtocolConfigurationShelley pc) = - NodeProtocolConfigurationShelley (adjustFilePaths f pc) - - adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pch) = - NodeProtocolConfigurationCardano (adjustFilePaths f pcb) - (adjustFilePaths f pcs) - pch - -instance AdjustFilePaths NodeMockProtocolConfiguration where - adjustFilePaths _f x = x -- Contains no file paths - -instance AdjustFilePaths NodeByronProtocolConfiguration where - adjustFilePaths f x@NodeByronProtocolConfiguration { - npcByronGenesisFile - } = - x { npcByronGenesisFile = adjustFilePaths f npcByronGenesisFile } - -instance AdjustFilePaths NodeShelleyProtocolConfiguration where - adjustFilePaths f x@NodeShelleyProtocolConfiguration { - npcShelleyGenesisFile - } = - x { npcShelleyGenesisFile = adjustFilePaths f npcShelleyGenesisFile } - -instance AdjustFilePaths SocketPath where - adjustFilePaths f (SocketPath p) = SocketPath (f p) - -instance AdjustFilePaths GenesisFile where - adjustFilePaths f (GenesisFile p) = GenesisFile (f p) - -instance AdjustFilePaths a => AdjustFilePaths (Maybe a) where - adjustFilePaths f = fmap (adjustFilePaths f) - - -parseNodeConfiguration :: NodeCLI -> IO NodeConfiguration -parseNodeConfiguration NodeCLI{configFile} = parseNodeConfigurationFP configFile - -data Protocol = MockProtocol !MockProtocol - | ByronProtocol - | ShelleyProtocol - | CardanoProtocol - deriving (Eq, Show, Generic) - -deriving instance NFData Protocol -deriving instance NoUnexpectedThunks Protocol - -data MockProtocol = MockBFT - | MockPBFT - | MockPraos - deriving (Eq, Show, Generic) - -deriving instance NFData MockProtocol -deriving instance NoUnexpectedThunks MockProtocol - -instance FromJSON Protocol where - parseJSON = - withText "Protocol" $ \str -> case str of - - -- The new names - "MockBFT" -> pure (MockProtocol MockBFT) - "MockPBFT" -> pure (MockProtocol MockPBFT) - "MockPraos" -> pure (MockProtocol MockPraos) - "Byron" -> pure ByronProtocol - "Shelley" -> pure ShelleyProtocol - "Cardano" -> pure CardanoProtocol - - -- The old names - "BFT" -> pure (MockProtocol MockBFT) - --"MockPBFT" -- same as new name - "Praos" -> pure (MockProtocol MockPraos) - "RealPBFT" -> pure ByronProtocol - "TPraos" -> pure ShelleyProtocol - - _ -> fail $ "Parsing of Protocol failed. " - <> show str <> " is not a valid protocol" - --- | A human readable name for the protocol --- -protocolName :: Protocol -> String -protocolName (MockProtocol MockBFT) = "Mock BFT" -protocolName (MockProtocol MockPBFT) = "Mock PBFT" -protocolName (MockProtocol MockPraos) = "Mock Praos" -protocolName ByronProtocol = "Byron" -protocolName ShelleyProtocol = "Shelley" -protocolName CardanoProtocol = "Byron; Shelley" - -ncProtocol :: NodeConfiguration -> Protocol -ncProtocol nc = - case ncProtocolConfig nc of - NodeProtocolConfigurationMock npc -> MockProtocol (npcMockProtocol npc) - NodeProtocolConfigurationByron{} -> ByronProtocol - NodeProtocolConfigurationShelley{} -> ShelleyProtocol - NodeProtocolConfigurationCardano{} -> CardanoProtocol - - -- Node can be run in two modes. data ViewMode = LiveView -- Live mode with TUI | SimpleView -- Simple mode, just output text. diff --git a/cardano-config/test/Test/Cardano/Config/Gen.hs b/cardano-config/test/Test/Cardano/Config/Gen.hs index f204dcd6bf2..c54aa94b5b3 100644 --- a/cardano-config/test/Test/Cardano/Config/Gen.hs +++ b/cardano-config/test/Test/Cardano/Config/Gen.hs @@ -20,7 +20,6 @@ module Test.Cardano.Config.Gen import Cardano.Prelude -import Cardano.Config.Topology import Cardano.Config.Types import Cardano.Crypto.DSIGN.Class diff --git a/cardano-config/test/cardano-config-test.hs b/cardano-config/test/cardano-config-test.hs deleted file mode 100644 index 8ba9856325b..00000000000 --- a/cardano-config/test/cardano-config-test.hs +++ /dev/null @@ -1,14 +0,0 @@ - -import Cardano.Prelude - -import Hedgehog.Main (defaultMain) - -import qualified Test.Cardano.Config.Json -import qualified Test.Cardano.Config.Types - -main :: IO () -main = - defaultMain - [ Test.Cardano.Config.Json.tests - , Test.Cardano.Config.Types.tests - ] diff --git a/cardano-node/app/cardano-node.hs b/cardano-node/app/cardano-node.hs index e54cab467fd..9e3c21ab330 100644 --- a/cardano-node/app/cardano-node.hs +++ b/cardano-node/app/cardano-node.hs @@ -22,8 +22,10 @@ import Cardano.Shell.Types (CardanoApplication (..), import Cardano.Common.Help import Cardano.Config.TopHandler import Cardano.Config.Parsers -import Cardano.Config.Logging (createLoggingFeature) -import Cardano.Config.Types +import Cardano.Config.Types (CardanoEnvironment(..)) +import Cardano.Node.Logging (createLoggingFeature) +import Cardano.Node.Parsers (nodeCLIParser) +import Cardano.Node.Types (NodeCLI(..)) import Cardano.Node.Features.Node main :: IO () diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 639f8f20d2a..dc96965e26e 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -28,20 +28,26 @@ library if os(linux) && flag(systemd) cpp-options: -DSYSTEMD - build-depends: systemd + build-depends: lobemo-scribe-systemd + , systemd hs-source-dirs: src exposed-modules: Cardano.Common.Help Cardano.Node.Features.Node + Cardano.Node.Logging Cardano.Node.Protocol Cardano.Node.Protocol.Byron Cardano.Node.Protocol.Cardano Cardano.Node.Protocol.Mock Cardano.Node.Protocol.Shelley Cardano.Node.Protocol.Types + Cardano.Node.Parsers Cardano.Node.Run Cardano.Node.Shutdown + Cardano.Node.Topology + Cardano.Node.TraceConfig + Cardano.Node.Types Cardano.Tracing.Kernel Cardano.Tracing.Peer Cardano.Tracing.Tracers @@ -68,10 +74,16 @@ library , directory , filepath , hostname + , iproute , io-sim-classes , iohk-monitoring + , lobemo-backend-aggregation + , lobemo-backend-ekg + , lobemo-backend-monitoring + , lobemo-backend-trace-forwarder , network , network-mux + , node-config , optparse-applicative , ouroboros-consensus , ouroboros-consensus-byron @@ -81,6 +93,7 @@ library , ouroboros-network , ouroboros-network-framework , process + , safe-exceptions , shelley-spec-ledger , strict-concurrency , text @@ -89,6 +102,7 @@ library , transformers , transformers-except , unordered-containers + , yaml default-language: Haskell2010 @@ -113,6 +127,39 @@ library , Cardano.Node.TUI.Run +library node-config + + hs-source-dirs: src + + exposed-modules: Cardano.Node.Types + Cardano.Node.TraceConfig + + build-depends: aeson + , base >=4.12 && <5 + , cardano-api + , cardano-crypto-wrapper + , cardano-ledger + , cardano-config + , cardano-prelude + , filepath + , iohk-monitoring + , ouroboros-consensus + , ouroboros-network + , text + , yaml + + + default-language: Haskell2010 + default-extensions: NoImplicitPrelude + OverloadedStrings + + ghc-options: -Wall + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + -Wpartial-fields + -Wcompat + executable cardano-node hs-source-dirs: app main-is: cardano-node.hs @@ -163,6 +210,7 @@ executable chairman , cardano-prelude , io-sim-classes , network-mux + , node-config , optparse-applicative , ouroboros-consensus , ouroboros-consensus-cardano @@ -178,3 +226,46 @@ executable chairman build-depends: Win32 else build-depends: unix + +test-suite cardano-node-test + hs-source-dirs: test + main-is: cardano-node-test.hs + type: exitcode-stdio-1.0 + + build-depends: + base >= 4.12 && < 5 + , aeson + , bytestring + , cardano-node + , cardano-config + , cardano-crypto-class + , cardano-crypto-test + , cardano-crypto-wrapper + , cardano-prelude + , cardano-prelude-test + , cardano-slotting + , containers + , cryptonite + , iproute + , ouroboros-consensus + , ouroboros-consensus-shelley + , ouroboros-network + , shelley-spec-ledger + , shelley-spec-ledger-test + , time + , hedgehog + , hedgehog-corpus + + other-modules: Test.Cardano.Node.Gen + Test.Cardano.Node.Json + + default-language: Haskell2010 + default-extensions: NoImplicitPrelude + + ghc-options: -Wall + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + -Wpartial-fields + -Wcompat + -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T diff --git a/cardano-node/chairman/chairman.hs b/cardano-node/chairman/chairman.hs index e86da2d7b52..f8c859dd298 100644 --- a/cardano-node/chairman/chairman.hs +++ b/cardano-node/chairman/chairman.hs @@ -18,7 +18,8 @@ import Ouroboros.Network.Block (BlockNo) import Cardano.Api (NetworkMagic(..)) import Cardano.Api.Protocol (mkNodeClientProtocol) -import Cardano.Config.Types (ConfigYamlFilePath(..), SocketPath(..), +import Cardano.Config.Types (SocketPath(..)) +import Cardano.Node.Types (ConfigYamlFilePath(..), ncProtocol, parseNodeConfigurationFP) import Cardano.Config.Parsers import Cardano.Chairman (chairmanTest) diff --git a/cardano-node/src/Cardano/Node/Features/Node.hs b/cardano-node/src/Cardano/Node/Features/Node.hs index a8618f1f739..86a36183c41 100644 --- a/cardano-node/src/Cardano/Node/Features/Node.hs +++ b/cardano-node/src/Cardano/Node/Features/Node.hs @@ -8,8 +8,9 @@ module Cardano.Node.Features.Node import Cardano.Prelude -import Cardano.Config.Types (CardanoEnvironment, NodeCLI) -import Cardano.Config.Logging (LoggingLayer (..),) +import Cardano.Config.Types (CardanoEnvironment) +import Cardano.Node.Types (NodeCLI) +import Cardano.Node.Logging (LoggingLayer (..),) import Cardano.Node.Run import Cardano.Shell.Types (CardanoFeature (..)) diff --git a/cardano-config/src/Cardano/Config/Logging.hs b/cardano-node/src/Cardano/Node/Logging.hs similarity index 97% rename from cardano-config/src/Cardano/Config/Logging.hs rename to cardano-node/src/Cardano/Node/Logging.hs index 8ebe3faade2..6a7690d7ba8 100644 --- a/cardano-config/src/Cardano/Config/Logging.hs +++ b/cardano-node/src/Cardano/Node/Logging.hs @@ -9,7 +9,7 @@ #define UNIX #endif -module Cardano.Config.Logging +module Cardano.Node.Logging ( LoggingLayer (..) , createLoggingFeature -- re-exports @@ -64,9 +64,9 @@ import qualified Cardano.BM.Trace as Trace import Cardano.Shell.Types (CardanoFeature (..)) import Cardano.Config.GitRev (gitRev) -import Cardano.Config.Types (ConfigYamlFilePath (..), ConfigError (..), CardanoEnvironment, - NodeConfiguration (..), NodeCLI (..), ViewMode (..), - parseNodeConfiguration) +import Cardano.Config.Types (ConfigError (..), CardanoEnvironment, ViewMode (..)) +import Cardano.Node.Types (ConfigYamlFilePath (..), NodeConfiguration (..), + NodeCLI (..), parseNodeConfiguration) -------------------------------- -- Layer diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs new file mode 100644 index 00000000000..85dae21c110 --- /dev/null +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Cardano.Node.Parsers + ( nodeCLIParser + ) where + +import Cardano.Prelude hiding (option) + +import Options.Applicative +import System.Posix.Types (Fd(..)) + +import Cardano.Config.Byron.Parsers as Byron +import Cardano.Config.Shelley.Parsers as Shelley +import Ouroboros.Network.Block (MaxSlotNo(..), SlotNo(..)) + +import Cardano.Node.Types +import Cardano.Config.Types (DbFile(..), ProtocolFilepaths(..), + NodeProtocolMode(..), TopologyFile(..)) +import Cardano.Config.Parsers + +nodeCLIParser :: Parser NodeCLI +nodeCLIParser = nodeRealProtocolModeParser <|> nodeMockProtocolModeParser + +nodeMockProtocolModeParser :: Parser NodeCLI +nodeMockProtocolModeParser = subparser + ( commandGroup "Execute node with a mock protocol." + <> metavar "run-mock" + <> command "run-mock" + (info (nodeMockParser <**> helper) + (progDesc "Execute node with a mock protocol.")) + ) +nodeRealProtocolModeParser :: Parser NodeCLI +nodeRealProtocolModeParser = subparser + ( commandGroup "Execute node with a real protocol." + <> metavar "run" + <> command "run" + (info (nodeRealParser <**> helper) + (progDesc "Execute node with a real protocol." )) + ) + +-- | The mock protocol parser. +nodeMockParser :: Parser NodeCLI +nodeMockParser = do + -- Filepaths + topFp <- parseTopologyFile + dbFp <- parseDbPath + socketFp <- optional $ parseSocketPath "Path to a cardano-node socket" + + -- NodeConfiguration filepath + nodeConfigFp <- parseConfigFile + + -- Node Address + nAddress <- optional parseNodeAddress + + validate <- parseValidateDB + shutdownIPC <- parseShutdownIPC + shutdownOnSlotSynced <- parseShutdownOnSlotSynced + + pure $ NodeCLI + { nodeMode = MockProtocolMode + , nodeAddr = nAddress + , configFile = ConfigYamlFilePath nodeConfigFp + , topologyFile = TopologyFile topFp + , databaseFile = DbFile dbFp + , socketFile = socketFp + , protocolFiles = ProtocolFilepaths + { byronCertFile = Nothing + , byronKeyFile = Nothing + , shelleyKESFile = Nothing + , shelleyVRFFile = Nothing + , shelleyCertFile = Nothing + } + , validateDB = validate + , shutdownIPC + , shutdownOnSlotSynced + } + +-- | The real protocol parser. +nodeRealParser :: Parser NodeCLI +nodeRealParser = do + -- Filepaths + topFp <- parseTopologyFile + dbFp <- parseDbPath + socketFp <- optional $ parseSocketPath "Path to a cardano-node socket" + + -- Protocol files + byronCertFile <- optional Byron.parseDelegationCert + byronKeyFile <- optional Byron.parseSigningKey + shelleyKESFile <- optional Shelley.parseKesKeyFilePath + shelleyVRFFile <- optional Shelley.parseVrfKeyFilePath + shelleyCertFile <- optional Shelley.parseOperationalCertFilePath + + -- Node Address + nAddress <- optional parseNodeAddress + + -- NodeConfiguration filepath + nodeConfigFp <- parseConfigFile + + validate <- parseValidateDB + shutdownIPC <- parseShutdownIPC + + shutdownOnSlotSynced <- parseShutdownOnSlotSynced + + pure NodeCLI + { nodeMode = RealProtocolMode + , nodeAddr = nAddress + , configFile = ConfigYamlFilePath nodeConfigFp + , topologyFile = TopologyFile topFp + , databaseFile = DbFile dbFp + , socketFile = socketFp + , protocolFiles = ProtocolFilepaths + { byronCertFile + , byronKeyFile + , shelleyKESFile + , shelleyVRFFile + , shelleyCertFile + } + , validateDB = validate + , shutdownIPC + , shutdownOnSlotSynced + } + +parseValidateDB :: Parser Bool +parseValidateDB = + switch ( + long "validate-db" + <> help "Validate all on-disk database files" + ) + +parseShutdownIPC :: Parser (Maybe Fd) +parseShutdownIPC = + optional $ option (Fd <$> auto) ( + long "shutdown-ipc" + <> metavar "FD" + <> help "Shut down the process when this inherited FD reaches EOF" + <> hidden + ) + +parseShutdownOnSlotSynced :: Parser MaxSlotNo +parseShutdownOnSlotSynced = + fmap (fromMaybe NoMaxSlotNo) $ + optional $ option (MaxSlotNo . SlotNo <$> auto) ( + long "shutdown-on-slot-synced" + <> metavar "SLOT" + <> help "Shut down the process after ChainDB is synced up to the specified slot" + <> hidden + ) + +parseTopologyFile :: Parser FilePath +parseTopologyFile = + strOption ( + long "topology" + <> metavar "FILEPATH" + <> help "The path to a file describing the topology." + ) diff --git a/cardano-node/src/Cardano/Node/Protocol.hs b/cardano-node/src/Cardano/Node/Protocol.hs index 692c8dd6c4e..018a6ce5428 100644 --- a/cardano-node/src/Cardano/Node/Protocol.hs +++ b/cardano-node/src/Cardano/Node/Protocol.hs @@ -12,10 +12,10 @@ import Cardano.Prelude import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT) -import Cardano.Config.Types - (NodeConfiguration(..), NodeProtocolConfiguration(..), - NodeMockProtocolConfiguration(..), ProtocolFilepaths(..), - MockProtocol(..)) +import Cardano.Api.Protocol (MockProtocol(..)) +import Cardano.Node.Types (NodeConfiguration(..), NodeProtocolConfiguration(..), + NodeMockProtocolConfiguration(..)) +import Cardano.Config.Types (ProtocolFilepaths(..)) import Cardano.Node.Protocol.Types (SomeConsensusProtocol(..)) import Cardano.Node.Protocol.Mock diff --git a/cardano-node/src/Cardano/Node/Protocol/Byron.hs b/cardano-node/src/Cardano/Node/Protocol/Byron.hs index f6bc0065d8b..7e5c2a91057 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Byron.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Byron.hs @@ -39,9 +39,9 @@ import qualified Ouroboros.Consensus.Cardano as Consensus import Ouroboros.Consensus.Byron.Ledger (ByronBlock) +import Cardano.Node.Types (NodeByronProtocolConfiguration (..)) import Cardano.Config.Types - (NodeByronProtocolConfiguration (..), - ProtocolFilepaths(..), GenesisFile (..)) + (ProtocolFilepaths(..), GenesisFile (..)) import Cardano.TracingOrphanInstances.Byron () import Cardano.Node.Protocol.Types diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index 80c92c2c789..b22897dc430 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -37,12 +37,13 @@ import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.Shelley.Protocol (TPraosStandardCrypto) import qualified Shelley.Spec.Ledger.PParams as Shelley -import Cardano.Config.Types +import Cardano.Node.Types (NodeByronProtocolConfiguration(..), NodeShelleyProtocolConfiguration(..), - NodeHardForkProtocolConfiguration(..), - ProtocolFilepaths(..), - HasKESMetricsData(..), KESMetricsData(..)) + NodeHardForkProtocolConfiguration(..)) +import Cardano.Config.Types + (ProtocolFilepaths(..), HasKESMetricsData(..), + KESMetricsData(..)) import Cardano.TracingOrphanInstances.Byron () import Cardano.TracingOrphanInstances.Shelley () diff --git a/cardano-node/src/Cardano/Node/Protocol/Mock.hs b/cardano-node/src/Cardano/Node/Protocol/Mock.hs index 37e8bb6413a..dc08bfdcb9c 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Mock.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Mock.hs @@ -32,7 +32,7 @@ import Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..)) import Ouroboros.Consensus.Protocol.Abstract (SecurityParam (..)) -import Cardano.Config.Types (NodeMockProtocolConfiguration(..)) +import Cardano.Node.Types (NodeMockProtocolConfiguration(..)) import Cardano.TracingOrphanInstances.Mock () import Cardano.Node.Protocol.Types @@ -126,4 +126,3 @@ mockSecurityParam = SecurityParam 5 mockSlotLength :: SlotLength mockSlotLength = slotLengthFromSec 20 - diff --git a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs index 57be1c18f22..903e8bc9ebf 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs @@ -42,9 +42,9 @@ import Shelley.Spec.Ledger.PParams (ProtVer(..)) import Cardano.Api.Shelley.OCert import Cardano.Api.Shelley.VRF import Cardano.Api.Shelley.KES +import Cardano.Node.Types (NodeShelleyProtocolConfiguration(..)) import Cardano.Config.Types - (NodeShelleyProtocolConfiguration(..), - ProtocolFilepaths(..), GenesisFile (..)) + (ProtocolFilepaths(..), GenesisFile (..)) import Cardano.TracingOrphanInstances.Shelley () import Cardano.Node.Protocol.Types diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 1d39b98f74f..6bd4d6dffd7 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -49,12 +49,15 @@ import Cardano.BM.Data.Transformers (setHostname) import Cardano.BM.Trace import Cardano.Config.GitRev (gitRev) -import Cardano.Config.Logging (LoggingLayer (..), Severity (..)) +import Cardano.Node.Logging (LoggingLayer (..), Severity (..)) #ifdef UNIX -import Cardano.Config.TraceConfig (traceBlockFetchDecisions) +import Cardano.Node.TraceConfig (traceBlockFetchDecisions) #endif -import Cardano.Config.TraceConfig (TraceOptions(..), TraceSelection(..)) -import Cardano.Config.Types (NodeConfiguration (..), ViewMode (..)) +import Cardano.Node.TraceConfig (TraceOptions(..), TraceSelection(..)) +import Cardano.Node.Types (NodeConfiguration (..), NodeCLI(..), + NodeMockProtocolConfiguration(..), NodeProtocolConfiguration(..), + ncProtocol, parseNodeConfiguration) +import Cardano.Config.Types (ViewMode (..)) import Ouroboros.Network.Magic (NetworkMagic (..)) import Ouroboros.Network.NodeToClient (LocalConnectionId) @@ -79,7 +82,7 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import Ouroboros.Consensus.Storage.ImmutableDB (ValidationPolicy (..)) import Ouroboros.Consensus.Storage.VolatileDB (BlockValidationPolicy (..)) -import Cardano.Config.Topology +import Cardano.Node.Topology import Cardano.Config.Types import Cardano.Node.Protocol (mkConsensusProtocol, diff --git a/cardano-node/src/Cardano/Node/Shutdown.hs b/cardano-node/src/Cardano/Node/Shutdown.hs index 1622e20f394..bb9b521132e 100644 --- a/cardano-node/src/Cardano/Node/Shutdown.hs +++ b/cardano-node/src/Cardano/Node/Shutdown.hs @@ -8,7 +8,7 @@ module Cardano.Node.Shutdown ShutdownFDs , withShutdownHandling - -- * Requesting shutdown + -- * Requesting shutdown , ShutdownDoorbell , getShutdownDoorbell , triggerShutdown @@ -28,6 +28,7 @@ import qualified GHC.IO.Handle.FD as IO (fdToHandle) import qualified System.Process as IO (createPipeFd) import qualified System.IO as IO import qualified System.IO.Error as IO +import System.Posix.Types (Fd(Fd)) import Cardano.BM.Trace import Cardano.BM.Data.Tracer ( @@ -39,11 +40,11 @@ import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry) import Ouroboros.Consensus.Util.STM (onEachChange) import Ouroboros.Network.Block (MaxSlotNo(..), SlotNo, pointSlot) -import Cardano.Config.Types +import Cardano.Node.Types -- | 'ShutdownFDs' mediate the graceful shutdown requests, -- either external or internal to the process. --- +-- -- In the external mediation case, the parent process passes us the file descriptor -- number of the read end of a pipe, via the CLI with @--shutdown-ipc FD@. -- In the internal mediation case, we create our own pipe. @@ -153,7 +154,7 @@ withShutdownHandling cli trace action = do -- | If configuration in 'NodeCLI' and 'ShutdownFDs' agree, -- spawn a thread that would cause node to shutdown upon ChainDB reaching the --- configuration-defined slot. +-- configuration-defined slot. maybeSpawnOnSlotSyncedShutdownHandler :: NodeCLI -> ShutdownFDs diff --git a/cardano-node/src/Cardano/Node/Socket.hs b/cardano-node/src/Cardano/Node/Socket.hs index 76a32f05d47..95ae3237c9d 100644 --- a/cardano-node/src/Cardano/Node/Socket.hs +++ b/cardano-node/src/Cardano/Node/Socket.hs @@ -18,7 +18,9 @@ import Control.Monad.Trans.Except.Extra (handleIOExceptT) import Network.Socket (Socket, AddrInfo (..), AddrInfoFlag (..), SocketType (..), defaultHints, getAddrInfo) -import Cardano.Config.Types +import Cardano.Config.Types (NodeAddress(..), NodeHostAddress(..), + SocketPath(..)) +import Cardano.Node.Types #if defined(mingw32_HOST_OS) #else diff --git a/cardano-node/src/Cardano/Node/TUI/Drawing.hs b/cardano-node/src/Cardano/Node/TUI/Drawing.hs index a14a2c5528d..199872aff92 100644 --- a/cardano-node/src/Cardano/Node/TUI/Drawing.hs +++ b/cardano-node/src/Cardano/Node/TUI/Drawing.hs @@ -41,7 +41,7 @@ import qualified Graphics.Vty as Vty import Numeric (showFFloat) import Text.Printf (printf) -import Cardano.Config.Types (Protocol(..)) +import Cardano.Api.Protocol(Protocol(..)) import Cardano.Tracing.Peer (Peer(..), ppPeer) data ColorTheme diff --git a/cardano-node/src/Cardano/Node/TUI/EventHandler.hs b/cardano-node/src/Cardano/Node/TUI/EventHandler.hs index 3a22a767765..c6c80cd42b5 100644 --- a/cardano-node/src/Cardano/Node/TUI/EventHandler.hs +++ b/cardano-node/src/Cardano/Node/TUI/EventHandler.hs @@ -24,12 +24,12 @@ import Data.Time.Clock (diffUTCTime, getCurrentTime) import Data.Version (showVersion) import qualified Graphics.Vty as Vty +import Cardano.Api.Protocol (Protocol(..), MockProtocol(..)) import Cardano.BM.Data.Aggregated (Measurable(..)) import Cardano.BM.Data.Backend (BackendKind(..), IsBackend(..), IsEffectuator(..)) import Cardano.BM.Data.Counter (Platform(..)) import Cardano.BM.Data.LogItem (LogObject(..), LOContent(..), LOMeta(..), utc2ns) import Cardano.Config.GitRev (gitRev) -import Cardano.Config.Types (Protocol(..), MockProtocol(..)) import Cardano.Node.TUI.Drawing (ColorTheme(..), LiveViewState(..), LiveViewThread(..), Screen(..), darkTheme, drawUI, lightTheme) diff --git a/cardano-node/src/Cardano/Node/TUI/Run.hs b/cardano-node/src/Cardano/Node/TUI/Run.hs index 72be54c1423..f46a7907d2b 100644 --- a/cardano-node/src/Cardano/Node/TUI/Run.hs +++ b/cardano-node/src/Cardano/Node/TUI/Run.hs @@ -35,7 +35,8 @@ import Cardano.Node.TUI.Drawing (LiveViewState(..), LiveViewThread(..) import Cardano.Node.TUI.EventHandler (LiveViewBackend(..)) import Cardano.Tracing.Peer (Peer (..)) -import Cardano.Config.Types +import Cardano.Config.Types (NodeAddress(..)) +import Cardano.Node.Types -- | Change a few fields in the LiveViewState after it has been initialized above. liveViewPostSetup :: NFData a => LiveViewBackend blk a -> NodeCLI -> NodeConfiguration-> IO () diff --git a/cardano-config/src/Cardano/Config/Topology.hs b/cardano-node/src/Cardano/Node/Topology.hs similarity index 96% rename from cardano-config/src/Cardano/Config/Topology.hs rename to cardano-node/src/Cardano/Node/Topology.hs index ee6de78e0c1..511f45329ff 100644 --- a/cardano-config/src/Cardano/Config/Topology.hs +++ b/cardano-node/src/Cardano/Node/Topology.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Cardano.Config.Topology +module Cardano.Node.Topology ( TopologyError(..) , NetworkTopology(..) , NodeHostAddress(..) @@ -24,7 +24,9 @@ import qualified Data.Text as T import Text.Read (readMaybe) import Network.Socket (PortNumber, SockAddr (..)) -import Cardano.Config.Types +import Cardano.Node.Types +import Cardano.Config.Types (NodeAddress(..), NodeHostAddress(..), + TopologyFile(..)) import Ouroboros.Consensus.Util.Condense (Condense (..)) diff --git a/cardano-config/src/Cardano/Config/TraceConfig.hs b/cardano-node/src/Cardano/Node/TraceConfig.hs similarity index 98% rename from cardano-config/src/Cardano/Config/TraceConfig.hs rename to cardano-node/src/Cardano/Node/TraceConfig.hs index 73071fcd5f5..c7ac0534229 100644 --- a/cardano-config/src/Cardano/Config/TraceConfig.hs +++ b/cardano-node/src/Cardano/Node/TraceConfig.hs @@ -2,7 +2,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -module Cardano.Config.TraceConfig +module Cardano.Node.TraceConfig ( TraceOptions (..) , TraceSelection (..) , traceConfigParser diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs new file mode 100644 index 00000000000..f90da184b70 --- /dev/null +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -0,0 +1,363 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Cardano.Node.Types + ( ConfigYamlFilePath(..) + , NodeCLI(..) + , NodeConfiguration(..) + , NodeByronProtocolConfiguration(..) + , NodeHardForkProtocolConfiguration(..) + , NodeProtocolConfiguration(..) + , NodeShelleyProtocolConfiguration(..) + , NodeMockProtocolConfiguration(..) + , TraceOptions(..) + , ncProtocol + , parseNodeConfiguration + , parseNodeConfigurationFP + , protocolName + ) where + +import Cardano.Prelude +import Prelude (String) + +import Control.Monad.Fail (fail) +import Data.Aeson +import Data.Yaml (decodeFileThrow) +import System.FilePath ((), takeDirectory) +import System.Posix.Types (Fd) + +import Cardano.Api +import Cardano.Api.Protocol +import Cardano.Config.Types +import Cardano.Crypto (RequiresNetworkMagic(..)) +import qualified Cardano.Chain.Update as Byron +import Cardano.Node.TraceConfig (TraceOptions(..), traceConfigParser) +import Ouroboros.Network.Block (MaxSlotNo(..)) +import Ouroboros.Consensus.NodeId (CoreNodeId(..)) + +--TODO: things will probably be clearer if we don't use these newtype wrappers and instead +-- use records with named fields in the CLI code. + +-- | Filepath of the configuration yaml file. This file determines +-- all the configuration settings required for the cardano node +-- (logging, tracing, protocol, slot length etc) +newtype ConfigYamlFilePath = ConfigYamlFilePath + { unConfigPath :: FilePath } + deriving newtype (Eq, Show) + +data NodeCLI = NodeCLI + { nodeMode :: !NodeProtocolMode + , nodeAddr :: !(Maybe NodeAddress) + -- | Filepath of the configuration yaml file. This file determines + -- all the configuration settings required for the cardano node + -- (logging, tracing, protocol, slot length etc) + , configFile :: !ConfigYamlFilePath + , topologyFile :: !TopologyFile + , databaseFile :: !DbFile + , socketFile :: !(Maybe SocketPath) + , protocolFiles :: !ProtocolFilepaths + , validateDB :: !Bool + , shutdownIPC :: !(Maybe Fd) + , shutdownOnSlotSynced :: !MaxSlotNo + } + +data NodeConfiguration + = NodeConfiguration + { -- Protocol-specific parameters: + ncProtocolConfig :: NodeProtocolConfiguration + + -- Node parameters, not protocol-specific: + , ncSocketPath :: Maybe SocketPath + + -- Logging parameters: + , ncViewMode :: ViewMode + , ncLoggingSwitch :: Bool + , ncLogMetrics :: Bool + , ncTraceConfig :: TraceOptions + } deriving Show + +class AdjustFilePaths a where + adjustFilePaths :: (FilePath -> FilePath) -> a -> a + +instance AdjustFilePaths NodeConfiguration where + adjustFilePaths f x@NodeConfiguration { + ncProtocolConfig, + ncSocketPath + } = + x { + ncProtocolConfig = adjustFilePaths f ncProtocolConfig, + ncSocketPath = adjustFilePaths f ncSocketPath + } + +instance FromJSON NodeConfiguration where + parseJSON = + withObject "NodeConfiguration" $ \v -> do + + -- Node parameters, not protocol-specific + ncSocketPath <- v .:? "SocketPath" + + -- Logging parameters + ncViewMode <- v .:? "ViewMode" .!= SimpleView + ncLoggingSwitch <- v .:? "TurnOnLogging" .!= True + ncLogMetrics <- v .:? "TurnOnLogMetrics" .!= True + ncTraceConfig <- if ncLoggingSwitch + then traceConfigParser v + else return TracingOff + + -- Protocol parameters + protocol <- v .: "Protocol" .!= ByronProtocol + ncProtocolConfig <- + case protocol of + MockProtocol ptcl -> + NodeProtocolConfigurationMock <$> parseMockProtocol ptcl v + + ByronProtocol -> + NodeProtocolConfigurationByron <$> parseByronProtocol v + + ShelleyProtocol -> + NodeProtocolConfigurationShelley <$> parseShelleyProtocol v + + CardanoProtocol -> + NodeProtocolConfigurationCardano <$> parseByronProtocol v + <*> parseShelleyProtocol v + <*> parseHardForkProtocol v + pure NodeConfiguration { + ncProtocolConfig + , ncSocketPath + , ncViewMode + , ncLoggingSwitch + , ncLogMetrics + , ncTraceConfig + } + where + parseMockProtocol npcMockProtocol v = do + npcMockNodeId <- v .: "NodeId" + npcMockNumCoreNodes <- v .: "NumCoreNodes" + pure NodeMockProtocolConfiguration { + npcMockProtocol + , npcMockNodeId + , npcMockNumCoreNodes + } + + parseByronProtocol v = do + primary <- v .:? "ByronGenesisFile" + secondary <- v .:? "GenesisFile" + npcByronGenesisFile <- + case (primary, secondary) of + (Just g, Nothing) -> return g + (Nothing, Just g) -> return g + (Nothing, Nothing) -> fail $ "Missing required field, either " + ++ "ByronGenesisFile or GenesisFile" + (Just _, Just _) -> fail $ "Specify either ByronGenesisFile" + ++ "or GenesisFile, but not both" + + npcByronReqNetworkMagic <- v .:? "RequiresNetworkMagic" + .!= RequiresNoMagic + npcByronPbftSignatureThresh <- v .:? "PBftSignatureThreshold" + npcByronApplicationName <- v .:? "ApplicationName" + .!= Byron.ApplicationName "cardano-sl" + npcByronApplicationVersion <- v .:? "ApplicationVersion" .!= 1 + protVerMajor <- v .: "LastKnownBlockVersion-Major" + protVerMinor <- v .: "LastKnownBlockVersion-Minor" + protVerAlt <- v .: "LastKnownBlockVersion-Alt" .!= 0 + + pure NodeByronProtocolConfiguration { + npcByronGenesisFile + , npcByronReqNetworkMagic + , npcByronPbftSignatureThresh + , npcByronApplicationName + , npcByronApplicationVersion + , npcByronSupportedProtocolVersionMajor = protVerMajor + , npcByronSupportedProtocolVersionMinor = protVerMinor + , npcByronSupportedProtocolVersionAlt = protVerAlt + } + + parseShelleyProtocol v = do + primary <- v .:? "ShelleyGenesisFile" + secondary <- v .:? "GenesisFile" + npcShelleyGenesisFile <- + case (primary, secondary) of + (Just g, Nothing) -> return g + (Nothing, Just g) -> return g + (Nothing, Nothing) -> fail $ "Missing required field, either " + ++ "ShelleyGenesisFile or GenesisFile" + (Just _, Just _) -> fail $ "Specify either ShelleyGenesisFile" + ++ "or GenesisFile, but not both" + + --TODO: these are silly names, allow better aliases: + protVerMajor <- v .: "LastKnownBlockVersion-Major" + protVerMinor <- v .: "LastKnownBlockVersion-Minor" + protVerMajroMax <- v .:? "MaxKnownMajorProtocolVersion" .!= 1 + + pure NodeShelleyProtocolConfiguration { + npcShelleyGenesisFile + , npcShelleySupportedProtocolVersionMajor = protVerMajor + , npcShelleySupportedProtocolVersionMinor = protVerMinor + , npcShelleyMaxSupportedProtocolVersion = protVerMajroMax + } + + parseHardForkProtocol v = do + npcTestShelleyHardForkAtEpoch <- v .:? "TestShelleyHardForkAtEpoch" + npcTestShelleyHardForkAtVersion <- v .:? "TestShelleyHardForkAtVersion" + pure NodeHardForkProtocolConfiguration { + npcTestShelleyHardForkAtEpoch, + npcTestShelleyHardForkAtVersion + } + +data NodeProtocolConfiguration = + NodeProtocolConfigurationMock NodeMockProtocolConfiguration + | NodeProtocolConfigurationByron NodeByronProtocolConfiguration + | NodeProtocolConfigurationShelley NodeShelleyProtocolConfiguration + | NodeProtocolConfigurationCardano NodeByronProtocolConfiguration + NodeShelleyProtocolConfiguration + NodeHardForkProtocolConfiguration + deriving Show + +data NodeShelleyProtocolConfiguration = + NodeShelleyProtocolConfiguration { + npcShelleyGenesisFile :: !GenesisFile + + -- | These declare the version of the protocol that the node is prepared + -- to run. This is usually the version of the protocol in use on the + -- chain now, but during protocol updates this version will be the one + -- that we declare that we are ready to move to. This is the endorsement + -- mechanism for determining when enough block producers are ready to + -- move to the next version. + -- + , npcShelleySupportedProtocolVersionMajor :: !Natural + , npcShelleySupportedProtocolVersionMinor :: !Natural + + -- | The maximum major version of the protocol this node supports. + -- If the actual version ever goes higher than this then the node + -- will stop with an appropriate error message. + , npcShelleyMaxSupportedProtocolVersion :: !Natural + } + deriving Show + +data NodeByronProtocolConfiguration = + NodeByronProtocolConfiguration { + npcByronGenesisFile :: !GenesisFile + , npcByronReqNetworkMagic :: !RequiresNetworkMagic + , npcByronPbftSignatureThresh :: !(Maybe Double) + + -- | Update application name. + , npcByronApplicationName :: !Byron.ApplicationName + + -- | Application (ie software) version. + , npcByronApplicationVersion :: !Byron.NumSoftwareVersion + + -- | These declare the version of the protocol that the node is prepared + -- to run. This is usually the version of the protocol in use on the + -- chain now, but during protocol updates this version will be the one + -- that we declare that we are ready to move to. This is the endorsement + -- mechanism for determining when enough block producers are ready to + -- move to the next version. + -- + , npcByronSupportedProtocolVersionMajor :: !Word16 + , npcByronSupportedProtocolVersionMinor :: !Word16 + , npcByronSupportedProtocolVersionAlt :: !Word8 + } + deriving Show + +data NodeMockProtocolConfiguration = + NodeMockProtocolConfiguration { + npcMockProtocol :: MockProtocol + , npcMockNodeId :: CoreNodeId + , npcMockNumCoreNodes :: Word64 + } + deriving Show + +-- | Configuration relating to a hard forks themselves, not the specific eras. +-- +data NodeHardForkProtocolConfiguration = + NodeHardForkProtocolConfiguration { + + -- | For testing purposes we support specifying that the hard fork + -- happens at an exact epoch number (ie the first epoch of the new era). + -- + -- Obviously if this is used, all the nodes in the test cluster must be + -- configured the same, or they will disagree. + -- + npcTestShelleyHardForkAtEpoch :: Maybe EpochNo + + -- | For testing purposes we support specifying that the hard fork + -- happens at a given major protocol version. For example this can be + -- used to cause the Shelley hard fork to occur at the transition from + -- protocol version 0 to version 1 (rather than the default of from 1 to + -- 2) which can make the test setup simpler. + -- + -- Obviously if this is used, all the nodes in the test cluster must be + -- configured the same, or they will disagree. + -- + , npcTestShelleyHardForkAtVersion :: Maybe Word + } + deriving Show + +instance AdjustFilePaths NodeProtocolConfiguration where + + adjustFilePaths f (NodeProtocolConfigurationMock pc) = + NodeProtocolConfigurationMock (adjustFilePaths f pc) + + adjustFilePaths f (NodeProtocolConfigurationByron pc) = + NodeProtocolConfigurationByron (adjustFilePaths f pc) + + adjustFilePaths f (NodeProtocolConfigurationShelley pc) = + NodeProtocolConfigurationShelley (adjustFilePaths f pc) + + adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pch) = + NodeProtocolConfigurationCardano (adjustFilePaths f pcb) + (adjustFilePaths f pcs) + pch + + +instance AdjustFilePaths NodeMockProtocolConfiguration where + adjustFilePaths _f x = x -- Contains no file paths + +instance AdjustFilePaths NodeByronProtocolConfiguration where + adjustFilePaths f x@NodeByronProtocolConfiguration { + npcByronGenesisFile + } = + x { npcByronGenesisFile = adjustFilePaths f npcByronGenesisFile } + +instance AdjustFilePaths NodeShelleyProtocolConfiguration where + adjustFilePaths f x@NodeShelleyProtocolConfiguration { + npcShelleyGenesisFile + } = + x { npcShelleyGenesisFile = adjustFilePaths f npcShelleyGenesisFile } + +instance AdjustFilePaths SocketPath where + adjustFilePaths f (SocketPath p) = SocketPath (f p) + +instance AdjustFilePaths GenesisFile where + adjustFilePaths f (GenesisFile p) = GenesisFile (f p) + +instance AdjustFilePaths a => AdjustFilePaths (Maybe a) where + adjustFilePaths f = fmap (adjustFilePaths f) + +ncProtocol :: NodeConfiguration -> Protocol +ncProtocol nc = + case ncProtocolConfig nc of + NodeProtocolConfigurationMock npc -> MockProtocol (npcMockProtocol npc) + NodeProtocolConfigurationByron{} -> ByronProtocol + NodeProtocolConfigurationShelley{} -> ShelleyProtocol + NodeProtocolConfigurationCardano{} -> CardanoProtocol + +parseNodeConfiguration :: NodeCLI -> IO NodeConfiguration +parseNodeConfiguration NodeCLI{configFile} = parseNodeConfigurationFP configFile + +parseNodeConfigurationFP :: ConfigYamlFilePath -> IO NodeConfiguration +parseNodeConfigurationFP (ConfigYamlFilePath fp) = do + nc <- decodeFileThrow fp + -- Make all the files be relative to the location of the config file. + pure $ adjustFilePaths (takeDirectory fp ) nc + +-- | A human readable name for the protocol +-- +protocolName :: Protocol -> String +protocolName (MockProtocol MockBFT) = "Mock BFT" +protocolName (MockProtocol MockPBFT) = "Mock PBFT" +protocolName (MockProtocol MockPraos) = "Mock Praos" +protocolName ByronProtocol = "Byron" +protocolName ShelleyProtocol = "Shelley" +protocolName CardanoProtocol = "Byron; Shelley" diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 94a7a4eac45..72d36657ff8 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -81,7 +81,7 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB import Cardano.Config.LedgerQueries -import Cardano.Config.TraceConfig +import Cardano.Node.TraceConfig import Cardano.Config.Types (TraceConstraints, HasKESMetricsData (..), KESMetricsData (..), MaxKESEvolutions (..), OperationalCertStartKESPeriod (..)) diff --git a/cardano-node/test/Test/Cardano/Node/Gen.hs b/cardano-node/test/Test/Cardano/Node/Gen.hs new file mode 100644 index 00000000000..4d9c6654f63 --- /dev/null +++ b/cardano-node/test/Test/Cardano/Node/Gen.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} + +module Test.Cardano.Node.Gen + ( genNetworkTopology + , genNodeAddress + , genNodeHostAddress + , genNodeSetup + ) where + +import Cardano.Prelude + +import Cardano.Config.Types (NodeAddress(..), NodeHostAddress(..)) +import Cardano.Node.Topology (NetworkTopology(..), NodeSetup(..), + RemoteAddress(..)) + +import qualified Data.IP as IP + +import Hedgehog (Gen) +import Hedgehog.Corpus (cooking) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Hedgehog.Internal.Gen () + +genNetworkTopology :: Gen NetworkTopology +genNetworkTopology = + Gen.choice + [ MockNodeTopology <$> Gen.list (Range.linear 0 10) genNodeSetup + , RealNodeTopology <$> Gen.list (Range.linear 0 10) genRemoteAddress + ] + +genNodeAddress :: Gen NodeAddress +genNodeAddress = + NodeAddress + <$> genNodeHostAddress + <*> fmap fromIntegral (Gen.word16 $ Range.linear 100 20000) + +genNodeHostAddress :: Gen NodeHostAddress +genNodeHostAddress = + NodeHostAddress + <$> Gen.choice + [ fmap (IP.IPv4 . IP.toIPv4w) <$> Gen.maybe Gen.enumBounded + , fmap (IP.IPv6 . IP.toIPv6w) <$> Gen.maybe genFourWord32 + ] + where + genFourWord32 :: Gen (Word32, Word32, Word32, Word32) + genFourWord32 = + (,,,) <$> Gen.enumBounded <*> Gen.enumBounded <*> Gen.enumBounded <*> Gen.enumBounded + +genNodeSetup :: Gen NodeSetup +genNodeSetup = + NodeSetup + <$> Gen.word64 (Range.linear 0 10000) + <*> genNodeAddress + <*> Gen.list (Range.linear 0 6) genRemoteAddress + +genRemoteAddress :: Gen RemoteAddress +genRemoteAddress = + RemoteAddress + <$> Gen.element cooking + <*> fmap fromIntegral (Gen.word16 $ Range.linear 100 20000) + <*> Gen.int (Range.linear 0 100) diff --git a/cardano-config/test/Test/Cardano/Config/Json.hs b/cardano-node/test/Test/Cardano/Node/Json.hs similarity index 91% rename from cardano-config/test/Test/Cardano/Config/Json.hs rename to cardano-node/test/Test/Cardano/Node/Json.hs index 0b96d6b50c7..d6ccc7ad891 100644 --- a/cardano-config/test/Test/Cardano/Config/Json.hs +++ b/cardano-node/test/Test/Cardano/Node/Json.hs @@ -1,18 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Test.Cardano.Config.Json +module Test.Cardano.Node.Json ( tests ) where import Cardano.Prelude -import Cardano.Config.Types import Data.Aeson (encode, fromJSON, decode, toJSON) +import Cardano.Config.Types (NodeAddress(..), NodeHostAddress(..)) + import Hedgehog (Property, discover) import qualified Hedgehog -import Test.Cardano.Config.Gen +import Test.Cardano.Node.Gen prop_roundtrip_NodeAddress_JSON :: Property prop_roundtrip_NodeAddress_JSON = diff --git a/cardano-node/test/cardano-node-test.hs b/cardano-node/test/cardano-node-test.hs new file mode 100644 index 00000000000..69ea027db38 --- /dev/null +++ b/cardano-node/test/cardano-node-test.hs @@ -0,0 +1,12 @@ + +import Cardano.Prelude + +import Hedgehog.Main (defaultMain) + +import qualified Test.Cardano.Node.Json + +main :: IO () +main = + defaultMain + [ Test.Cardano.Node.Json.tests + ]