From 5794570a6115fe1b66f70c2c99af60a0fe431bd1 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 20 Nov 2019 12:22:06 -0400 Subject: [PATCH 1/9] Implement mock vs real protocol selection in `cardano-node.hs` --- cardano-config/src/Cardano/Config/Logging.hs | 34 +++--- cardano-config/src/Cardano/Config/Protocol.hs | 8 +- cardano-config/src/Cardano/Config/Types.hs | 19 +++- cardano-node/app/cardano-node.hs | 39 +++++-- cardano-node/app/chairman.hs | 4 +- cardano-node/src/Cardano/CLI/Ops.hs | 6 +- cardano-node/src/Cardano/Common/Parsers.hs | 107 ++++++++++++------ .../src/Cardano/Node/Features/Node.hs | 4 +- cardano-node/src/Cardano/Node/Run.hs | 34 +++--- cardano-node/src/Cardano/Wallet/Run.hs | 4 +- scripts/mainnet.sh | 2 +- 11 files changed, 164 insertions(+), 97 deletions(-) diff --git a/cardano-config/src/Cardano/Config/Logging.hs b/cardano-config/src/Cardano/Config/Logging.hs index a27aca4286c..ba93e5108b0 100644 --- a/cardano-config/src/Cardano/Config/Logging.hs +++ b/cardano-config/src/Cardano/Config/Logging.hs @@ -22,8 +22,6 @@ module Cardano.Config.Logging , mkLOMeta , LOMeta (..) , LOContent (..) - -- CLI argument parser - , LoggingCLIArguments (..) ) where import Cardano.Prelude hiding (trace) @@ -60,8 +58,9 @@ import qualified Cardano.BM.Trace as Trace import Cardano.Shell.Lib (GeneralException (..)) import Cardano.Shell.Types (CardanoFeature (..)) -import Cardano.Config.Types (ConfigYamlFilePath(..), CardanoEnvironment, - NodeCLI(..), NodeConfiguration(..), parseNodeConfiguration) +import Cardano.Config.Types (ConfigYamlFilePath (..), CardanoEnvironment, + NodeMockCLI (..), NodeProtocolMode (..), + NodeConfiguration (..), NodeCLI (..),parseNodeConfiguration) -------------------------------------------------------------------------------- @@ -114,11 +113,6 @@ data LoggingLayer = LoggingLayer -- Feature -------------------------------- --- | CLI specific data structure. -data LoggingCLIArguments = LoggingCLIArguments - { logConfigFile :: !(Maybe FilePath) - , captureMetrics :: !Bool - } data LoggingFlag = LoggingEnabled | LoggingDisabled deriving (Eq, Show) @@ -174,17 +168,13 @@ createLoggingFeatureCLI _ mLogConfig captureLogMetrics = do -- | Create logging feature for `cardano-node` createLoggingFeature - :: CardanoEnvironment -> NodeCLI -> IO (LoggingLayer, CardanoFeature) -createLoggingFeature _ nCli = do - -- we parse any additional configuration if there is any - -- We don't know where the user wants to fetch the additional - -- configuration from, it could be from - -- the filesystem, so we give him the most flexible/powerful context, @IO@. - -- - -- Currently we parse outside the features since we want to have a complete - -- parser for __every feature__. - nc <- parseNodeConfiguration . unConfigPath $ configFp nCli - let logConfigFp = if ncLoggingSwitch nc then Just . unConfigPath $ configFp nCli else Nothing + :: CardanoEnvironment -> NodeProtocolMode -> IO (LoggingLayer, CardanoFeature) +createLoggingFeature _ nodeProtocolMode = do + + configYamlFp <- pure $ getConfigYaml nodeProtocolMode + + nc <- parseNodeConfiguration $ unConfigPath configYamlFp + let logConfigFp = if ncLoggingSwitch nc then Just $ unConfigPath configYamlFp else Nothing (disabled', loggingConfiguration) <- loggingCLIConfiguration logConfigFp @@ -203,6 +193,10 @@ createLoggingFeature _ nCli = do -- we return both pure (loggingLayer, cardanoFeature) + where + getConfigYaml :: NodeProtocolMode -> ConfigYamlFilePath + getConfigYaml (RealProtocolMode (NodeCLI _ _ _ rConfigFp _ )) = rConfigFp + getConfigYaml (MockProtocolMode (NodeMockCLI _ _ _ mConfigFp _)) = mConfigFp -- | Initialize `LoggingCardanoFeature` loggingCardanoFeatureInit :: LoggingFlag -> LoggingConfiguration -> IO (LoggingLayer, LoggingLayer -> IO()) diff --git a/cardano-config/src/Cardano/Config/Protocol.hs b/cardano-config/src/Cardano/Config/Protocol.hs index 9f9ddb4e8aa..2b1cf2578c3 100644 --- a/cardano-config/src/Cardano/Config/Protocol.hs +++ b/cardano-config/src/Cardano/Config/Protocol.hs @@ -131,7 +131,7 @@ fromProtocol -> Maybe NodeId -> Maybe Word64 -- ^ Number of core nodes - -> GenesisFile + -> Maybe GenesisFile -> RequiresNetworkMagic -> Maybe Double -> Maybe DelegationCertFile @@ -161,9 +161,11 @@ fromProtocol _ nId mNumCoreNodes _ _ _ _ _ _ MockPBFT = , pbftSignatureThreshold = (1.0 / fromIntegral numNodes) + 0.1 , pbftSlotLength = mockSlotLength } - cid -fromProtocol gHash _ _ genFile nMagic sigThresh delCertFp sKeyFp update RealPBFT = do +fromProtocol gHash _ _ mGenFile nMagic sigThresh delCertFp sKeyFp update RealPBFT = do let genHash = either panic identity $ decodeHash gHash + genFile = fromMaybe (panic $ "Cardano.Config.Protocol.fromProtocol: " + <> "Genesis file not specified" + ) mGenFile gc <- firstExceptT LedgerConfigError $ Genesis.mkConfigFromFile nMagic diff --git a/cardano-config/src/Cardano/Config/Types.hs b/cardano-config/src/Cardano/Config/Types.hs index 9ff667bb329..6347d98f2cd 100644 --- a/cardano-config/src/Cardano/Config/Types.hs +++ b/cardano-config/src/Cardano/Config/Types.hs @@ -10,9 +10,11 @@ module Cardano.Config.Types , GenesisFile (..) , LastKnownBlockVersion (..) , MiscellaneousFilepaths (..) - , NodeCLI (..) , NodeConfiguration (..) , Protocol (..) + , NodeMockCLI (..) + , NodeCLI (..) + , NodeProtocolMode (..) , SigningKeyFile (..) , SocketFile (..) , TopologyFile (..) @@ -56,8 +58,21 @@ data NodeCLI = NodeCLI , nodeAddr :: !NodeAddress , configFp :: !ConfigYamlFilePath , validateDB :: !Bool + } + +data NodeMockCLI = NodeMockCLI + { mockMscFp :: !MiscellaneousFilepaths + , mockGenesisHash :: !Text + , mockNodeAddr :: !NodeAddress + , mockConfigFp :: !ConfigYamlFilePath + , mockValidateDB :: !Bool } deriving Show +-- | Mock protocols requires different parameters to real protocols. +-- Therefore we distinguish this at the top level on the command line. +data NodeProtocolMode = MockProtocolMode NodeMockCLI + | RealProtocolMode NodeCLI + -- | Filepath of the configuration yaml file. This file determines -- all the configuration settings required for the cardano node -- (logging, tracing, protocol, slot length etc) @@ -68,7 +83,7 @@ newtype ConfigYamlFilePath = ConfigYamlFilePath data MiscellaneousFilepaths = MiscellaneousFilepaths { topFile :: !TopologyFile , dBFile :: !DbFile - , genesisFile :: !GenesisFile + , genesisFile :: !(Maybe GenesisFile) , delegCertFile :: !(Maybe DelegationCertFile) , signKeyFile :: !(Maybe SigningKeyFile) , socketFile :: !SocketFile diff --git a/cardano-node/app/cardano-node.hs b/cardano-node/app/cardano-node.hs index 8ffb2303189..e037bd53137 100644 --- a/cardano-node/app/cardano-node.hs +++ b/cardano-node/app/cardano-node.hs @@ -25,24 +25,25 @@ import Cardano.Node.Features.Node main :: IO () main = toplevelExceptionHandler $ do - cli <- Opt.execParser opts + cli <- Opt.customExecParser p opts (features, nodeLayer) <- initializeAllFeatures cli env runCardanoApplicationWithFeatures features (cardanoApplication nodeLayer) where + p = Opt.prefs Opt.showHelpOnEmpty + env :: CardanoEnvironment env = NoEnvironment cardanoApplication :: NodeLayer -> CardanoApplication cardanoApplication = CardanoApplication . nlRunNode - opts :: Opt.ParserInfo NodeCLI + opts :: Opt.ParserInfo NodeProtocolMode opts = - Opt.info (nodeCliParser - <**> helperBrief "help" "Show this help text" nodeCliHelpMain - ) + Opt.info (nodeProtocolModeParser + <**> helperBrief "help" "Show this help text" nodeCliHelpMain) ( Opt.fullDesc <> Opt.progDesc "Start node of the Cardano blockchain." @@ -55,18 +56,34 @@ main = toplevelExceptionHandler $ do nodeCliHelpMain :: String nodeCliHelpMain = renderHelpDoc 80 $ - parserHelpHeader "cardano-node" nodeCliParser + parserHelpHeader "cardano-node" nodeProtocolModeParser <$$> "" - <$$> parserHelpOptions nodeCliParser + <$$> parserHelpOptions nodeProtocolModeParser initializeAllFeatures - :: NodeCLI + :: NodeProtocolMode -> CardanoEnvironment -> IO ([CardanoFeature], NodeLayer) -initializeAllFeatures nCli@NodeCLI { configFp = ncFp } +initializeAllFeatures nCli@(RealProtocolMode nC@NodeCLI { configFp = ncFp }) + cardanoEnvironment = do + (loggingLayer, loggingFeature) <- createLoggingFeature cardanoEnvironment nCli + + nodeConfig <- parseNodeConfiguration $ unConfigPath ncFp + (nodeLayer , nodeFeature) <- + createNodeFeature + loggingLayer + cardanoEnvironment + nodeConfig + nC + + pure ([ loggingFeature + , nodeFeature + ] :: [CardanoFeature] + , nodeLayer) + +initializeAllFeatures nCli@(MockProtocolMode nC@NodeMockCLI { mockConfigFp = ncFp }) cardanoEnvironment = do - (loggingLayer, loggingFeature) <- createLoggingFeature cardanoEnvironment nCli nodeConfig <- parseNodeConfiguration $ unConfigPath ncFp @@ -75,7 +92,7 @@ initializeAllFeatures nCli@NodeCLI { configFp = ncFp } loggingLayer cardanoEnvironment nodeConfig - nCli + nC pure ([ loggingFeature , nodeFeature diff --git a/cardano-node/app/chairman.hs b/cardano-node/app/chairman.hs index a18c68b01ff..193fcd2dfcc 100644 --- a/cardano-node/app/chairman.hs +++ b/cardano-node/app/chairman.hs @@ -46,8 +46,8 @@ main = do frmPtclRes <- runExceptT $ fromProtocol caGenesisHash (ncNodeId nc) - (fromIntegral <$> ncNumCoreNodes nc) - (caGenesisFile) + (ncNumCoreNodes nc) + (Just caGenesisFile) (ncReqNetworkMagic nc) (ncPbftSignatureThresh nc) (caDelegationCertFp) diff --git a/cardano-node/src/Cardano/CLI/Ops.hs b/cardano-node/src/Cardano/CLI/Ops.hs index 9d5f5ef7f14..643d090a077 100644 --- a/cardano-node/src/Cardano/CLI/Ops.hs +++ b/cardano-node/src/Cardano/CLI/Ops.hs @@ -209,9 +209,9 @@ withRealPBFT gHash genFile nMagic sigThresh delCertFp sKeyFp update ptcl action FromProtocolError $ fromProtocol gHash - Nothing - Nothing - genFile + nId + mNumNodes + (Just genFile) nMagic sigThresh delCertFp diff --git a/cardano-node/src/Cardano/Common/Parsers.hs b/cardano-node/src/Cardano/Common/Parsers.hs index 3b1d682774e..5ef6939b308 100644 --- a/cardano-node/src/Cardano/Common/Parsers.hs +++ b/cardano-node/src/Cardano/Common/Parsers.hs @@ -4,8 +4,8 @@ {-# OPTIONS_GHC -Wno-all-missed-specialisations #-} module Cardano.Common.Parsers - ( loggingParser - , nodeCliParser + ( nodeMockParser + , nodeProtocolModeParser , parseConfigFile , parseCoreNodeId , parseDbPath @@ -30,7 +30,6 @@ import Cardano.Prelude hiding (option) import Network.Socket (PortNumber) import Options.Applicative -import Cardano.Config.Logging (LoggingCLIArguments(..)) import Ouroboros.Consensus.NodeId (NodeId(..), CoreNodeId(..)) import Cardano.Config.CommonCLI @@ -40,16 +39,73 @@ import Cardano.Config.Types -- Common command line parsers --- | The product parser for all the CLI arguments. -nodeCliParser :: Parser NodeCLI -nodeCliParser = do +nodeProtocolModeParser :: Parser NodeProtocolMode +nodeProtocolModeParser = nodeRealProtocolModeParser <|> nodeMockProtocolModeParser + +nodeMockProtocolModeParser :: Parser NodeProtocolMode +nodeMockProtocolModeParser = subparser + ( commandGroup "Execute node with a mock protocol." + <> metavar "run-mock" + <> command "run-mock" + (MockProtocolMode + <$> info + (nodeMockParser <**> helper) + (progDesc "Execute node with a mock protocol.")) + ) +nodeRealProtocolModeParser :: Parser NodeProtocolMode +nodeRealProtocolModeParser = subparser + ( commandGroup "Execute node with a real protocol." + <> metavar "run" + <> command "run" + (RealProtocolMode + <$> info + (nodeRealParser <**> helper) + (progDesc "Execute node with a real protocol." )) + ) + +-- | The mock protocol parser. +nodeMockParser :: Parser NodeMockCLI +nodeMockParser = do -- Filepaths topFp <- parseTopologyFile dbFp <- parseDbPath - genFp <- parseGenesisPath + socketFp <- parseSocketDir -- <|> parseSocketPath + + genHash <- parseGenesisHash + + -- NodeConfiguration filepath + nodeConfigFp <- parseConfigFile + + -- Node Address + nAddress <- parseNodeAddress + + validate <- parseValidateDB + + pure $ NodeMockCLI + { mockMscFp = MiscellaneousFilepaths + { topFile = TopologyFile topFp + , dBFile = DbFile dbFp + , genesisFile = Nothing + , delegCertFile = Nothing + , signKeyFile = Nothing + , socketFile = SocketFile socketFp + } + , mockGenesisHash = genHash + , mockNodeAddr = nAddress + , mockConfigFp = ConfigYamlFilePath nodeConfigFp + , mockValidateDB = validate + } + +-- | The real protocol parser. +nodeRealParser :: Parser NodeCLI +nodeRealParser = do + -- Filepaths + topFp <- parseTopologyFile + dbFp <- parseDbPath + genFp <- optional parseGenesisPath delCertFp <- optional parseDelegationCert sKeyFp <- optional parseSigningKey - socketFp <- parseSocketDir + socketFp <- parseSocketDir -- TODO: Left off here. Get parseSocketPath from next commit parseSocketPath <|> genHash <- parseGenesisHash @@ -65,7 +121,7 @@ nodeCliParser = do { mscFp = MiscellaneousFilepaths { topFile = TopologyFile topFp , dBFile = DbFile dbFp - , genesisFile = GenesisFile genFp + , genesisFile = GenesisFile <$> genFp , delegCertFile = DelegationCertFile <$> delCertFp , signKeyFile = SigningKeyFile <$> sKeyFp , socketFile = SocketFile socketFp @@ -76,6 +132,8 @@ nodeCliParser = do , validateDB = validate } + + parseConfigFile :: Parser FilePath parseConfigFile = strOption @@ -208,28 +266,9 @@ parseLogOutputFile = <> completer (bashCompleter "file") ) --- | A parser disables logging if --log-config is not supplied. -loggingParser :: Parser LoggingCLIArguments -loggingParser = - fromMaybe muteLoggingCLIArguments - <$> optional parseLoggingCLIArgumentsInternal - where - parseLoggingCLIArgumentsInternal :: Parser LoggingCLIArguments - parseLoggingCLIArgumentsInternal = - LoggingCLIArguments - <$> (Just - <$> strOption - ( long "log-config" - <> metavar "LOGCONFIG" - <> help "Configuration file for logging" - <> completer (bashCompleter "file"))) - <*> switch - ( long "log-metrics" - <> help "Log a number of metrics about this node") - - -- This is the value returned by the parser, when --log-config is omitted. - muteLoggingCLIArguments :: LoggingCLIArguments - muteLoggingCLIArguments = - LoggingCLIArguments - Nothing - False +parseLogMetricsLast :: Parser (Last Bool) +parseLogMetricsLast = + Last . Just <$> switch + ( long "log-metrics" + <> help "Log a number of metrics about this node" + ) diff --git a/cardano-node/src/Cardano/Node/Features/Node.hs b/cardano-node/src/Cardano/Node/Features/Node.hs index 213a3b49e0c..667f9b9d572 100644 --- a/cardano-node/src/Cardano/Node/Features/Node.hs +++ b/cardano-node/src/Cardano/Node/Features/Node.hs @@ -8,7 +8,7 @@ module Cardano.Node.Features.Node import Cardano.Prelude -import Cardano.Config.Types (CardanoEnvironment, NodeConfiguration, CardanoEnvironment, NodeCLI(..)) +import Cardano.Config.Types (CardanoEnvironment, NodeConfiguration, CardanoEnvironment, NodeMockCLI(..)) import Cardano.Config.Logging (LoggingLayer (..),) import Cardano.Node.Run import Cardano.Shell.Types (CardanoFeature (..)) @@ -30,7 +30,7 @@ createNodeFeature :: LoggingLayer -> CardanoEnvironment -> NodeConfiguration - -> NodeCLI + -> NodeMockCLI -> IO (NodeLayer, CardanoFeature) createNodeFeature loggingLayer _ nc nCli = do -- we parse any additional configuration if there is any diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index b47681de975..c5d7ada6988 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -70,7 +70,7 @@ import Ouroboros.Storage.ImmutableDB (ValidationPolicy (..)) import Cardano.Common.LocalSocket import Cardano.Config.Protocol (SomeProtocol(..), fromProtocol) import Cardano.Config.Topology -import Cardano.Config.Types (DbFile(..), NodeCLI(..), +import Cardano.Config.Types (DbFile(..), NodeMockCLI(..), SocketFile(..), TopologyFile(..)) import Cardano.Tracing.Tracers #ifdef UNIX @@ -81,7 +81,7 @@ import Cardano.Node.TUI.LiveView runNode :: LoggingLayer -> NodeConfiguration - -> NodeCLI + -> NodeMockCLI -> IO () runNode loggingLayer nc nCli = do hn <- hostname @@ -95,14 +95,14 @@ runNode loggingLayer nc nCli = do MinimalVerbosity -> "minimal" MaximalVerbosity -> "maximal" eitherSomeProtocol <- runExceptT $ fromProtocol - (genesisHash nCli) + (mockGenesisHash nCli) (ncNodeId nc) - (fromIntegral <$> ncNumCoreNodes nc) - (genesisFile $ mscFp nCli) + (ncNumCoreNodes nc) + (genesisFile $ mockMscFp nCli) (ncReqNetworkMagic nc) (ncPbftSignatureThresh nc) - (delegCertFile $ mscFp nCli) - (signKeyFile $ mscFp nCli) + (delegCertFile $ mockMscFp nCli) + (signKeyFile $ mockMscFp nCli) (ncUpdate nc) (ncProtocol nc) @@ -151,7 +151,7 @@ handleSimpleNode => Consensus.Protocol blk -> Tracer IO (LogObject Text) -> Tracers ConnectionId blk - -> NodeCLI + -> NodeMockCLI -> NodeConfiguration -> (NodeKernel IO ConnectionId blk -> IO ()) -- ^ Called on the 'NodeKernel' after creating it, but before the network @@ -160,7 +160,7 @@ handleSimpleNode -> IO () handleSimpleNode p trace nodeTracers nCli nc onKernel = do NetworkTopology nodeSetups <- - either error id <$> readTopologyFile (unTopology . topFile $ mscFp nCli) + either error id <$> readTopologyFile (unTopology . topFile $ mockMscFp nCli) let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p @@ -172,14 +172,14 @@ handleSimpleNode p trace nodeTracers nCli nc onKernel = do map (\ns -> (nodeId ns, producers ns)) nodeSetups of Just ps -> ps Nothing -> error $ "handleSimpleNode: own address " - <> show (nodeAddr nCli) + <> show (mockNodeAddr nCli) <> ", Node Id " <> show nid <> " not found in topology" traceWith tracer $ unlines [ "**************************************" - , "I am Node " <> show (nodeAddr nCli) <> " Id: " <> show nid + , "I am Node " <> show (mockNodeAddr nCli) <> " Id: " <> show nid , "My producers are " <> show producers' , "**************************************" ] @@ -187,10 +187,10 @@ handleSimpleNode p trace nodeTracers nCli nc onKernel = do -- Socket directory myLocalAddr <- localSocketAddrInfo (ncNodeId nc) - (unSocket . socketFile $ mscFp nCli) + (unSocket . socketFile $ mockMscFp nCli) MkdirIfMissing - addrs <- nodeAddressInfo $ nodeAddr nCli + addrs <- nodeAddressInfo $ mockNodeAddr nCli let ipProducerAddrs :: [NodeAddress] dnsProducerAddrs :: [RemoteAddress] (ipProducerAddrs, dnsProducerAddrs) = partitionEithers @@ -236,13 +236,13 @@ handleSimpleNode p trace nodeTracers nCli nc onKernel = do , daDnsProducers = dnsProducers } - removeStaleLocalSocket (ncNodeId nc) (unSocket . socketFile $ mscFp nCli) + removeStaleLocalSocket (ncNodeId nc) (unSocket . socketFile $ mockMscFp nCli) - dbPath <- canonicalizePath =<< makeAbsolute (unDB . dBFile $ mscFp nCli) + dbPath <- canonicalizePath =<< makeAbsolute (unDB . dBFile $ mockMscFp nCli) varTip <- atomically $ newTVar GenesisPoint - when (validateDB nCli) $ + when (mockValidateDB nCli) $ traceWith tracer "Performing DB validation" Node.run @@ -274,7 +274,7 @@ handleSimpleNode p trace nodeTracers nCli nc onKernel = do customiseChainDbArgs :: ChainDB.ChainDbArgs IO blk -> ChainDB.ChainDbArgs IO blk customiseChainDbArgs args = args - { ChainDB.cdbValidation = if validateDB nCli + { ChainDB.cdbValidation = if mockValidateDB nCli then ValidateAllEpochs else ValidateMostRecentEpoch } diff --git a/cardano-node/src/Cardano/Wallet/Run.hs b/cardano-node/src/Cardano/Wallet/Run.hs index dd20afc7b51..0a9d4b50c35 100644 --- a/cardano-node/src/Cardano/Wallet/Run.hs +++ b/cardano-node/src/Cardano/Wallet/Run.hs @@ -36,8 +36,8 @@ runClient (WalletCLI config delegCertFile gHash gFile sKeyFile socketFp) tracer eSomeProtocol <- runExceptT $ fromProtocol gHash (ncNodeId nc) - (fromIntegral <$> ncNumCoreNodes nc) - gFile + (ncNumCoreNodes nc) + (Just gFile) (ncReqNetworkMagic nc) (ncPbftSignatureThresh nc) delegCertFile diff --git a/scripts/mainnet.sh b/scripts/mainnet.sh index dd458a5fcd8..8b84e2de4f5 100755 --- a/scripts/mainnet.sh +++ b/scripts/mainnet.sh @@ -7,7 +7,7 @@ NODE="$(executable_runner cardano-node)" TOPOLOGY=${TOPOLOGY:-"${configuration}/mainnet-topology.json"} -ARGS=( +ARGS=( run --database-path "${root}/db/" --genesis-file "${configuration}/mainnet-genesis.json" --genesis-hash "5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb" From 59f66cca26c33a96270371f98da4df69c208d322 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 21 Nov 2019 15:33:24 -0400 Subject: [PATCH 2/9] Propagate `NodeProtocolMode` --- cardano-config/src/Cardano/Config/Protocol.hs | 1 + cardano-config/src/Cardano/Config/Types.hs | 2 +- cardano-node/app/cardano-node.hs | 41 +- cardano-node/src/Cardano/CLI/Ops.hs | 4 +- cardano-node/src/Cardano/Common/Parsers.hs | 9 +- .../src/Cardano/Node/Features/Node.hs | 11 +- cardano-node/src/Cardano/Node/Run.hs | 396 +++++++++++------- 7 files changed, 269 insertions(+), 195 deletions(-) diff --git a/cardano-config/src/Cardano/Config/Protocol.hs b/cardano-config/src/Cardano/Config/Protocol.hs index 2b1cf2578c3..6f091c97312 100644 --- a/cardano-config/src/Cardano/Config/Protocol.hs +++ b/cardano-config/src/Cardano/Config/Protocol.hs @@ -161,6 +161,7 @@ fromProtocol _ nId mNumCoreNodes _ _ _ _ _ _ MockPBFT = , pbftSignatureThreshold = (1.0 / fromIntegral numNodes) + 0.1 , pbftSlotLength = mockSlotLength } + cid fromProtocol gHash _ _ mGenFile nMagic sigThresh delCertFp sKeyFp update RealPBFT = do let genHash = either panic identity $ decodeHash gHash genFile = fromMaybe (panic $ "Cardano.Config.Protocol.fromProtocol: " diff --git a/cardano-config/src/Cardano/Config/Types.hs b/cardano-config/src/Cardano/Config/Types.hs index 6347d98f2cd..69b952f925e 100644 --- a/cardano-config/src/Cardano/Config/Types.hs +++ b/cardano-config/src/Cardano/Config/Types.hs @@ -117,7 +117,7 @@ data NodeConfiguration = NodeConfiguration { ncProtocol :: Protocol , ncNodeId :: Maybe NodeId - , ncNumCoreNodes :: Maybe Int + , ncNumCoreNodes :: Maybe Word64 , ncReqNetworkMagic :: RequiresNetworkMagic , ncPbftSignatureThresh :: Maybe Double , ncLoggingSwitch :: Bool diff --git a/cardano-node/app/cardano-node.hs b/cardano-node/app/cardano-node.hs index e037bd53137..d61028e996a 100644 --- a/cardano-node/app/cardano-node.hs +++ b/cardano-node/app/cardano-node.hs @@ -65,36 +65,11 @@ initializeAllFeatures :: NodeProtocolMode -> CardanoEnvironment -> IO ([CardanoFeature], NodeLayer) -initializeAllFeatures nCli@(RealProtocolMode nC@NodeCLI { configFp = ncFp }) - cardanoEnvironment = do - (loggingLayer, loggingFeature) <- createLoggingFeature cardanoEnvironment nCli - - nodeConfig <- parseNodeConfiguration $ unConfigPath ncFp - (nodeLayer , nodeFeature) <- - createNodeFeature - loggingLayer - cardanoEnvironment - nodeConfig - nC - - pure ([ loggingFeature - , nodeFeature - ] :: [CardanoFeature] - , nodeLayer) - -initializeAllFeatures nCli@(MockProtocolMode nC@NodeMockCLI { mockConfigFp = ncFp }) - cardanoEnvironment = do - (loggingLayer, loggingFeature) <- createLoggingFeature cardanoEnvironment nCli - - nodeConfig <- parseNodeConfiguration $ unConfigPath ncFp - (nodeLayer , nodeFeature) <- - createNodeFeature - loggingLayer - cardanoEnvironment - nodeConfig - nC - - pure ([ loggingFeature - , nodeFeature - ] :: [CardanoFeature] - , nodeLayer) +initializeAllFeatures npm cardanoEnvironment = do + (loggingLayer, loggingFeature) <- createLoggingFeature cardanoEnvironment npm + (nodeLayer , nodeFeature) <- createNodeFeature + loggingLayer + cardanoEnvironment + npm + + pure ([loggingFeature, nodeFeature] :: [CardanoFeature], nodeLayer) diff --git a/cardano-node/src/Cardano/CLI/Ops.hs b/cardano-node/src/Cardano/CLI/Ops.hs index 643d090a077..774f05f6f9e 100644 --- a/cardano-node/src/Cardano/CLI/Ops.hs +++ b/cardano-node/src/Cardano/CLI/Ops.hs @@ -209,8 +209,8 @@ withRealPBFT gHash genFile nMagic sigThresh delCertFp sKeyFp update ptcl action FromProtocolError $ fromProtocol gHash - nId - mNumNodes + Nothing + Nothing (Just genFile) nMagic sigThresh diff --git a/cardano-node/src/Cardano/Common/Parsers.hs b/cardano-node/src/Cardano/Common/Parsers.hs index 5ef6939b308..f33008eaf6e 100644 --- a/cardano-node/src/Cardano/Common/Parsers.hs +++ b/cardano-node/src/Cardano/Common/Parsers.hs @@ -5,7 +5,9 @@ module Cardano.Common.Parsers ( nodeMockParser + , nodeMockProtocolModeParser , nodeProtocolModeParser + , nodeRealParser , parseConfigFile , parseCoreNodeId , parseDbPath @@ -265,10 +267,3 @@ parseLogOutputFile = <> help "Logging output file" <> completer (bashCompleter "file") ) - -parseLogMetricsLast :: Parser (Last Bool) -parseLogMetricsLast = - Last . Just <$> switch - ( long "log-metrics" - <> help "Log a number of metrics about this node" - ) diff --git a/cardano-node/src/Cardano/Node/Features/Node.hs b/cardano-node/src/Cardano/Node/Features/Node.hs index 667f9b9d572..5d3e57d3549 100644 --- a/cardano-node/src/Cardano/Node/Features/Node.hs +++ b/cardano-node/src/Cardano/Node/Features/Node.hs @@ -8,7 +8,9 @@ module Cardano.Node.Features.Node import Cardano.Prelude -import Cardano.Config.Types (CardanoEnvironment, NodeConfiguration, CardanoEnvironment, NodeMockCLI(..)) +import Cardano.Config.Types (CardanoEnvironment, + CardanoEnvironment, + NodeProtocolMode (..)) import Cardano.Config.Logging (LoggingLayer (..),) import Cardano.Node.Run import Cardano.Shell.Types (CardanoFeature (..)) @@ -29,10 +31,9 @@ data NodeLayer = NodeLayer createNodeFeature :: LoggingLayer -> CardanoEnvironment - -> NodeConfiguration - -> NodeMockCLI + -> NodeProtocolMode -> IO (NodeLayer, CardanoFeature) -createNodeFeature loggingLayer _ nc nCli = do +createNodeFeature loggingLayer _ npm = do -- we parse any additional configuration if there is any -- We don't know where the user wants to fetch the additional -- configuration from, it could be from the filesystem, so @@ -40,7 +41,7 @@ createNodeFeature loggingLayer _ nc nCli = do -- Construct the node layer let nodeLayer = NodeLayer { - nlRunNode = liftIO $ runNode loggingLayer nc nCli + nlRunNode = liftIO $ runNode loggingLayer npm } -- Construct the cardano feature diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index c5d7ada6988..3c8fac00aac 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -70,8 +70,10 @@ import Ouroboros.Storage.ImmutableDB (ValidationPolicy (..)) import Cardano.Common.LocalSocket import Cardano.Config.Protocol (SomeProtocol(..), fromProtocol) import Cardano.Config.Topology -import Cardano.Config.Types (DbFile(..), NodeMockCLI(..), - SocketFile(..), TopologyFile(..)) +import Cardano.Config.Types (ConfigYamlFilePath(..), DbFile(..), NodeMockCLI(..), + NodeProtocolMode (..), NodeCLI(..), + SocketFile(..), TopologyFile(..), + parseNodeConfiguration) import Cardano.Tracing.Tracers #ifdef UNIX import Cardano.Node.TUI.LiveView @@ -80,29 +82,36 @@ import Cardano.Node.TUI.LiveView runNode :: LoggingLayer - -> NodeConfiguration - -> NodeMockCLI + -> NodeProtocolMode -> IO () -runNode loggingLayer nc nCli = do +runNode loggingLayer npm = do hn <- hostname let !trace = setHostname hn $ llAppendName loggingLayer "node" (llBasicTrace loggingLayer) let tracer = contramap pack $ toLogObject trace + (mscFp', configFp', genHash') <- + case npm of + MockProtocolMode (NodeMockCLI mMscFp genHash _ configYaml _) -> + pure (mMscFp, configYaml, genHash) + RealProtocolMode (NodeCLI rMscFp genHash _ configYaml _) -> + pure (rMscFp, configYaml, genHash) + + nc <- parseNodeConfiguration $ unConfigPath configFp' traceWith tracer $ "tracing verbosity = " ++ case traceVerbosity $ ncTraceOptions nc of NormalVerbosity -> "normal" MinimalVerbosity -> "minimal" MaximalVerbosity -> "maximal" eitherSomeProtocol <- runExceptT $ fromProtocol - (mockGenesisHash nCli) + genHash' (ncNodeId nc) (ncNumCoreNodes nc) - (genesisFile $ mockMscFp nCli) + (genesisFile mscFp') (ncReqNetworkMagic nc) (ncPbftSignatureThresh nc) - (delegCertFile $ mockMscFp nCli) - (signKeyFile $ mockMscFp nCli) + (delegCertFile mscFp') + (signKeyFile mscFp') (ncUpdate nc) (ncProtocol nc) @@ -114,7 +123,7 @@ runNode loggingLayer nc nCli = do tracers <- mkTracers (ncTraceOptions nc) trace case ncViewMode nc of - SimpleView -> handleSimpleNode p trace tracers nCli nc (const $ pure ()) + SimpleView -> handleSimpleNode p trace tracers npm (const $ pure ()) LiveView -> do #ifdef UNIX let c = llConfiguration loggingLayer @@ -130,13 +139,13 @@ runNode loggingLayer nc nCli = do captureCounters be trace -- User will see a terminal graphics and will be able to interact with it. - nodeThread <- Async.async $ handleSimpleNode p trace tracers nCli nc + nodeThread <- Async.async $ handleSimpleNode p trace tracers npm (setNodeKernel be) setNodeThread be nodeThread void $ Async.waitAny [nodeThread] #else - handleSimpleNode p trace tracers nCli nc (const $ pure ()) + handleSimpleNode p trace tracers npm (const $ pure ()) #endif where hostname = do @@ -146,149 +155,242 @@ runNode loggingLayer nc nCli = do -- | Sets up a simple node, which will run the chain sync protocol and block -- fetch protocol, and, if core, will also look at the mempool when trying to -- create a new block. + handleSimpleNode :: forall blk. RunNode blk => Consensus.Protocol blk -> Tracer IO (LogObject Text) -> Tracers ConnectionId blk - -> NodeMockCLI - -> NodeConfiguration + -> NodeProtocolMode -> (NodeKernel IO ConnectionId blk -> IO ()) -- ^ Called on the 'NodeKernel' after creating it, but before the network -- layer is initialised. This implies this function must not block, -- otherwise the node won't actually start. -> IO () -handleSimpleNode p trace nodeTracers nCli nc onKernel = do - NetworkTopology nodeSetups <- - either error id <$> readTopologyFile (unTopology . topFile $ mockMscFp nCli) - - let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p - - let tracer = contramap pack $ toLogObject trace - traceWith tracer $ - "System started at " <> show (nodeStartTime (Proxy @blk) cfg) - - let producers' = case List.lookup nid $ - map (\ns -> (nodeId ns, producers ns)) nodeSetups of - Just ps -> ps - Nothing -> error $ "handleSimpleNode: own address " - <> show (mockNodeAddr nCli) - <> ", Node Id " - <> show nid - <> " not found in topology" - - traceWith tracer $ unlines - [ "**************************************" - , "I am Node " <> show (mockNodeAddr nCli) <> " Id: " <> show nid - , "My producers are " <> show producers' - , "**************************************" - ] - - -- Socket directory - myLocalAddr <- localSocketAddrInfo - (ncNodeId nc) - (unSocket . socketFile $ mockMscFp nCli) - MkdirIfMissing - - addrs <- nodeAddressInfo $ mockNodeAddr nCli - let ipProducerAddrs :: [NodeAddress] - dnsProducerAddrs :: [RemoteAddress] - (ipProducerAddrs, dnsProducerAddrs) = partitionEithers - [ maybe (Right ra) Left $ remoteAddressToNodeAddress ra - | ra <- producers' ] - - ipProducers :: IPSubscriptionTarget - ipProducers = - let ips = nodeAddressToSockAddr <$> ipProducerAddrs - in IPSubscriptionTarget { - ispIps = ips, - ispValency = length ips - } - - dnsProducers :: [DnsSubscriptionTarget] - dnsProducers = producerSubscription <$> dnsProducerAddrs - - producerSubscription :: RemoteAddress -> DnsSubscriptionTarget - producerSubscription ra = - DnsSubscriptionTarget - { dstDomain = BSC.pack (raAddress ra) - , dstPort = raPort ra - , dstValency = raValency ra - } - - diffusionTracers :: DiffusionTracers - diffusionTracers = DiffusionTracers - { dtIpSubscriptionTracer = ipSubscriptionTracer nodeTracers - , dtDnsSubscriptionTracer = dnsSubscriptionTracer nodeTracers - , dtDnsResolverTracer = dnsResolverTracer nodeTracers - , dtErrorPolicyTracer = errorPolicyTracer nodeTracers - , dtMuxTracer = muxTracer nodeTracers - , dtMuxLocalTracer = nullTracer - , dtHandshakeTracer = nullTracer - , dtHandshakeLocalTracer = nullTracer - } - - diffusionArguments :: DiffusionArguments - diffusionArguments = DiffusionArguments - { daAddresses = addrs - , daLocalAddress = myLocalAddr - , daIpProducers = ipProducers - , daDnsProducers = dnsProducers - } - - removeStaleLocalSocket (ncNodeId nc) (unSocket . socketFile $ mockMscFp nCli) - - dbPath <- canonicalizePath =<< makeAbsolute (unDB . dBFile $ mockMscFp nCli) - - varTip <- atomically $ newTVar GenesisPoint - - when (mockValidateDB nCli) $ - traceWith tracer "Performing DB validation" - - Node.run - (consensusTracers nodeTracers) - (withTip varTip $ chainDBTracer nodeTracers) - diffusionTracers - diffusionArguments - (nodeNetworkMagic (Proxy @blk) cfg) - (dbPath <> "-" <> show nid) - pInfo - isProducer - customiseChainDbArgs - id -- No NodeParams customisation - $ \registry nodeKernel -> do - -- Watch the tip of the chain and store it in @varTip@ so we can include - -- it in trace messages. - let chainDB = getChainDB nodeKernel - void $ onEachChange registry id Nothing - (ChainDB.getTipPoint chainDB) $ \tip -> - atomically $ writeTVar varTip tip - onKernel nodeKernel +handleSimpleNode p trace nodeTracers npm onKernel = do + case npm of + -- Run a node using a real protocol + RealProtocolMode (NodeCLI rMscFp _ rNodeAddr config runDBValidation) -> do + nc <- parseNodeConfiguration $ unConfigPath config + let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p + + hn <- getHostName + -- Tracing + let tracer = contramap pack $ toLogObject trace + + traceWith tracer $ + "System started at " <> show (nodeStartTime (Proxy @blk) cfg) + + traceWith tracer $ unlines + [ "**************************************" + , "Hostname: " <> hn + , "My producers are " + , "**************************************" + ] + + + -- Socket directory + myLocalAddr <- localSocketAddrInfo + Nothing + (unSocket $ socketFile rMscFp) + MkdirIfMissing + + addrs <- nodeAddressInfo rNodeAddr + + let ipProducerAddrs :: [NodeAddress] + dnsProducerAddrs :: [RemoteAddress] + (ipProducerAddrs, dnsProducerAddrs) = partitionEithers + [ maybe (Right ra) Left $ remoteAddressToNodeAddress ra + | ra <- [RemoteAddress "18.185.45.45" 3001 1] ] + ipProducers :: IPSubscriptionTarget + ipProducers = + let ips = nodeAddressToSockAddr <$> ipProducerAddrs + in IPSubscriptionTarget { + ispIps = ips, + ispValency = length ips + } + + dnsProducers :: [DnsSubscriptionTarget] + dnsProducers = producerSubscription <$> dnsProducerAddrs + + + producerSubscription :: RemoteAddress -> DnsSubscriptionTarget + producerSubscription ra = + DnsSubscriptionTarget + { dstDomain = BSC.pack (raAddress ra) + , dstPort = raPort ra + , dstValency = raValency ra + } + diffusionTracers :: DiffusionTracers + diffusionTracers = DiffusionTracers + { dtIpSubscriptionTracer = ipSubscriptionTracer nodeTracers + , dtDnsSubscriptionTracer = dnsSubscriptionTracer nodeTracers + , dtDnsResolverTracer = dnsResolverTracer nodeTracers + , dtErrorPolicyTracer = errorPolicyTracer nodeTracers + , dtMuxTracer = muxTracer nodeTracers + , dtMuxLocalTracer = nullTracer + , dtHandshakeTracer = nullTracer + , dtHandshakeLocalTracer = nullTracer + } + + diffusionArguments :: DiffusionArguments + diffusionArguments = DiffusionArguments + { daAddresses = addrs + , daLocalAddress = myLocalAddr + , daIpProducers = ipProducers + , daDnsProducers = dnsProducers + } + + removeStaleLocalSocket Nothing (unSocket $ socketFile rMscFp) + dbPath <- canonicalizePath =<< makeAbsolute (unDB $ dBFile rMscFp) + varTip <- atomically $ newTVar GenesisPoint + + when runDBValidation $ + traceWith tracer "Performing DB validation" + + Node.run + (consensusTracers nodeTracers) + (withTip varTip $ chainDBTracer nodeTracers) + diffusionTracers + diffusionArguments + (nodeNetworkMagic (Proxy @blk) cfg) + dbPath + pInfo + (isProducer nc) + (customiseChainDbArgs runDBValidation) + id -- No NodeParams customisation + $ \registry nodeKernel -> do + -- Watch the tip of the chain and store it in @varTip@ so we can include + -- it in trace messages. + let chainDB = getChainDB nodeKernel + void $ onEachChange registry id Nothing + (ChainDB.getTipPoint chainDB) $ \tip -> + atomically $ writeTVar varTip tip + onKernel nodeKernel + MockProtocolMode (NodeMockCLI mMscFp _ mockNodeAddress cfgYaml runDBValidation) -> do + nc <- parseNodeConfiguration $ unConfigPath cfgYaml + NetworkTopology nodeSetups <- either error id <$> readTopologyFile (unTopology $ topFile mMscFp) + + let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p + + -- Tracing + let tracer = contramap pack $ toLogObject trace + traceWith tracer $ "System started at " <> show (nodeStartTime (Proxy @blk) cfg) + + let producersList = map (\ns -> (nodeId ns, producers ns)) nodeSetups + + let producers' = case (List.lookup (nid nc) producersList) of + Just ps -> ps + Nothing -> error $ "handleSimpleNode: own address " + <> show mockNodeAddress + <> ", Node Id " + <> show (nid nc) + <> " not found in topology" + + ---------------------------------------------- + + traceWith tracer $ unlines + [ "**************************************" + , "I am Node " <> show mockNodeAddress <> " Id: " <> show (nid nc) + , "My producers are " <> show producers' + , "**************************************" + ] + + -- Socket directory + myLocalAddr <- localSocketAddrInfo + (ncNodeId nc) + (unSocket $ socketFile mMscFp) + MkdirIfMissing + + addrs <- nodeAddressInfo mockNodeAddress + let ipProducerAddrs :: [NodeAddress] + dnsProducerAddrs :: [RemoteAddress] + (ipProducerAddrs, dnsProducerAddrs) = partitionEithers + [ maybe (Right ra) Left $ remoteAddressToNodeAddress ra + | ra <- producers' ] + ipProducers :: IPSubscriptionTarget + ipProducers = + let ips = nodeAddressToSockAddr <$> ipProducerAddrs + in IPSubscriptionTarget { + ispIps = ips, + ispValency = length ips + } + dnsProducers :: [DnsSubscriptionTarget] + dnsProducers = producerSubscription <$> dnsProducerAddrs + + producerSubscription :: RemoteAddress -> DnsSubscriptionTarget + producerSubscription ra = + DnsSubscriptionTarget + { dstDomain = BSC.pack (raAddress ra) + , dstPort = raPort ra + , dstValency = raValency ra + } + diffusionTracers :: DiffusionTracers + diffusionTracers = DiffusionTracers + { dtIpSubscriptionTracer = ipSubscriptionTracer nodeTracers + , dtDnsSubscriptionTracer = dnsSubscriptionTracer nodeTracers + , dtDnsResolverTracer = dnsResolverTracer nodeTracers + , dtErrorPolicyTracer = errorPolicyTracer nodeTracers + , dtMuxTracer = muxTracer nodeTracers + , dtMuxLocalTracer = nullTracer + , dtHandshakeTracer = nullTracer + , dtHandshakeLocalTracer = nullTracer + } + + diffusionArguments :: DiffusionArguments + diffusionArguments = DiffusionArguments + { daAddresses = addrs + , daLocalAddress = myLocalAddr + , daIpProducers = ipProducers + , daDnsProducers = dnsProducers + } + + removeStaleLocalSocket (ncNodeId nc) (unSocket $ socketFile mMscFp) + dbPath <- canonicalizePath =<< makeAbsolute (unDB $ dBFile mMscFp) + + varTip <- atomically $ newTVar GenesisPoint + Node.run + (consensusTracers nodeTracers) + (withTip varTip $ chainDBTracer nodeTracers) + diffusionTracers + diffusionArguments + (nodeNetworkMagic (Proxy @blk) cfg) + (dbPath <> "-" <> show (nid nc)) + pInfo + (isProducer nc) + (customiseChainDbArgs runDBValidation) + id -- No NodeParams customisation + $ \registry nodeKernel -> do + -- Watch the tip of the chain and store it in @varTip@ so we can include + -- it in trace messages. + let chainDB = getChainDB nodeKernel + void $ onEachChange registry id Nothing + (ChainDB.getTipPoint chainDB) $ \tip -> + atomically $ writeTVar varTip tip + onKernel nodeKernel where - nid :: Word64 - nid = case ncNodeId nc of - Just (CoreId (CoreNodeId n)) -> n - Just (RelayId _) -> error "Non-core nodes currently not supported" - Nothing -> 999 - - customiseChainDbArgs :: ChainDB.ChainDbArgs IO blk - -> ChainDB.ChainDbArgs IO blk - customiseChainDbArgs args = args - { ChainDB.cdbValidation = if mockValidateDB nCli - then ValidateAllEpochs - else ValidateMostRecentEpoch - } - - isProducer :: IsProducer - isProducer = case p of - -- For the real protocol, look at the leader credentials - Consensus.ProtocolRealPBFT _ _ _ _ mbLeaderCredentials - | Just _ <- mbLeaderCredentials - -> IsProducer - | otherwise - -> IsNotProducer - - -- For mock protocols, look at the NodeId - _ -> case ncNodeId nc of - Just (CoreId _) -> IsProducer - _ -> IsNotProducer + nid :: NodeConfiguration -> Word64 + nid nc = case ncNodeId nc of + Just (CoreId (CoreNodeId n)) -> n + Just (RelayId _) -> panic $ "Cardano.Node.Run.nid: " + <> "Non-core nodes currently not supported" + Nothing -> panic $ "Cardano.Node.Run.nid: " + <> "Please specify a NodeId in your configuration .yaml file" + + customiseChainDbArgs :: Bool + -> ChainDB.ChainDbArgs IO blk + -> ChainDB.ChainDbArgs IO blk + customiseChainDbArgs runValid args = args + { ChainDB.cdbValidation = if runValid + then ValidateAllEpochs + else ValidateMostRecentEpoch + } + isProducer :: NodeConfiguration -> IsProducer + isProducer nc = case p of + -- For the real protocol, look at the leader credentials + Consensus.ProtocolRealPBFT _ _ _ _ (Just _) -> IsProducer + Consensus.ProtocolRealPBFT _ _ _ _ Nothing -> IsNotProducer + -- For mock protocols, look at the NodeId + _ -> case ncNodeId nc of + Just (CoreId _) -> IsProducer + _ -> IsNotProducer From b4bdd7f2e6d770abd633c776f124a9a601024b08 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 28 Nov 2019 18:08:09 -0400 Subject: [PATCH 3/9] Implement `SocketPath` --- .../benchmark-chain-sync-mainnet.sh | 2 +- .../cluster3nodes/run-3node-cluster.sh | 4 +- .../cluster3nodes/run_tx_generator.sh | 2 +- cardano-config/src/Cardano/Config/Types.hs | 6 +-- cardano-node/README.md | 4 +- cardano-node/app/chairman.hs | 8 ++-- cardano-node/app/wallet-client.hs | 8 ++-- cardano-node/src/Cardano/CLI/Parsers.hs | 7 ++- cardano-node/src/Cardano/CLI/Run.hs | 10 ++-- cardano-node/src/Cardano/CLI/Tx.hs | 4 +- cardano-node/src/Cardano/CLI/Tx/Generation.hs | 10 ++-- cardano-node/src/Cardano/CLI/Tx/Submission.hs | 8 ++-- cardano-node/src/Cardano/Chairman.hs | 9 ++-- .../src/Cardano/Common/LocalSocket.hs | 47 ++++--------------- cardano-node/src/Cardano/Common/Parsers.hs | 28 +++++------ cardano-node/src/Cardano/Node/Run.hs | 25 ++++------ cardano-node/src/Cardano/Wallet/Client.hs | 7 +-- cardano-node/src/Cardano/Wallet/Logging.hs | 4 +- cardano-node/src/Cardano/Wallet/Run.hs | 5 +- nix/nixos/cardano-node-service.nix | 2 +- nix/nixos/chairman-as-a-service.nix | 2 +- scripts/SCRIPTS.md | 2 +- scripts/lib-node.sh | 2 +- scripts/mainnet.sh | 2 +- 24 files changed, 86 insertions(+), 122 deletions(-) diff --git a/benchmarking/chain-sync/benchmark-chain-sync-mainnet.sh b/benchmarking/chain-sync/benchmark-chain-sync-mainnet.sh index 3e1da9326b3..b2be0b2e99d 100755 --- a/benchmarking/chain-sync/benchmark-chain-sync-mainnet.sh +++ b/benchmarking/chain-sync/benchmark-chain-sync-mainnet.sh @@ -39,7 +39,7 @@ exec ${NODE} \ --genesis-hash "5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb" \ --config ${BASEDIR}/configuration/log-configuration.yaml \ --database-path .//db-mainnet \ - --socket-dir /tmp/socket-bm-chain-sync \ + --socket-path /tmp/socket-bm-chain-sync \ --topology ${BASEDIR}/configuration/topology-local.yaml \ --host-addr 127.0.0.1 \ --port 7778 \ diff --git a/benchmarking/cluster3nodes/run-3node-cluster.sh b/benchmarking/cluster3nodes/run-3node-cluster.sh index a63369fe726..1079b81e974 100755 --- a/benchmarking/cluster3nodes/run-3node-cluster.sh +++ b/benchmarking/cluster3nodes/run-3node-cluster.sh @@ -44,8 +44,8 @@ function commonargs() { printf -- "--topology configuration/simple-topology.json " printf -- "--database-path ./db/ " printf -- "--genesis-file ${genesis_file} " - printf -- "--genesis-hash ${genesis_hash} " - printf -- "--socket-dir /tmp/cluster3nodes-socket/ " + printf -- "--genesis-hash ${genesis_hash}" + printf -- "--socket-path /tmp/cluster3nodes-socket/ " } function nodeargs () { diff --git a/benchmarking/cluster3nodes/run_tx_generator.sh b/benchmarking/cluster3nodes/run_tx_generator.sh index dc299d72c37..5abb28c785b 100755 --- a/benchmarking/cluster3nodes/run_tx_generator.sh +++ b/benchmarking/cluster3nodes/run_tx_generator.sh @@ -25,7 +25,7 @@ exec ${GENERATOR} \ --delegation-certificate ${CONFIGDIR}/latest-genesis/delegation-cert.000.json \ --genesis-file ${GENESISJSON} \ --genesis-hash ${GENESISHASH} \ - --socket-dir /tmp/cluster3nodes-socket \ + --socket-path /tmp/cluster3nodes-socket \ --real-pbft \ --num-of-txs $numtx \ --add-tx-size $addsizetx \ diff --git a/cardano-config/src/Cardano/Config/Types.hs b/cardano-config/src/Cardano/Config/Types.hs index 69b952f925e..714c8ffa8a0 100644 --- a/cardano-config/src/Cardano/Config/Types.hs +++ b/cardano-config/src/Cardano/Config/Types.hs @@ -16,9 +16,9 @@ module Cardano.Config.Types , NodeCLI (..) , NodeProtocolMode (..) , SigningKeyFile (..) - , SocketFile (..) , TopologyFile (..) , TraceOptions (..) + , SocketPath (..) , Update (..) , ViewMode (..) , parseNodeConfiguration @@ -86,7 +86,7 @@ data MiscellaneousFilepaths = MiscellaneousFilepaths , genesisFile :: !(Maybe GenesisFile) , delegCertFile :: !(Maybe DelegationCertFile) , signKeyFile :: !(Maybe SigningKeyFile) - , socketFile :: !SocketFile + , socketFile :: !SocketPath } deriving Show newtype TopologyFile = TopologyFile @@ -105,7 +105,7 @@ newtype DelegationCertFile = DelegationCertFile { unDelegationCert :: FilePath } deriving Show -newtype SocketFile = SocketFile +data SocketPath = SocketFile { unSocket :: FilePath } deriving Show diff --git a/cardano-node/README.md b/cardano-node/README.md index efe4e4722b2..c15c5ffd80a 100644 --- a/cardano-node/README.md +++ b/cardano-node/README.md @@ -47,7 +47,7 @@ The general synopsis is as follows: Usage: cardano-node --topology FILEPATH --database-path FILEPATH --genesis-file FILEPATH [--delegation-certificate FILEPATH] - [--signing-key FILEPATH] --socket-dir FILEPATH + [--signing-key FILEPATH] --socket-path FILEPATH [--host-addr HOST-NAME] --port PORT --config NODE-CONFIGURATION [--help] [--help-tracing] [--help-advanced] @@ -63,7 +63,7 @@ Usage: cardano-node --topology FILEPATH --database-path FILEPATH `--signing-key` - Optional path to the signing key. -`--socket-dir` - Path to the socket directory. +`--socket-path` - Path to the socket directory. `--host-addr` - Optionally specify your node's IPv4 or IPv6 address. diff --git a/cardano-node/app/chairman.hs b/cardano-node/app/chairman.hs index 193fcd2dfcc..1359ddd44b4 100644 --- a/cardano-node/app/chairman.hs +++ b/cardano-node/app/chairman.hs @@ -23,7 +23,7 @@ import Cardano.Config.Protocol ( ProtocolInstantiationError , SomeProtocol(..), fromProtocol) import Cardano.Config.Types (ConfigYamlFilePath(..), DelegationCertFile(..), GenesisFile (..), NodeConfiguration(..), - SigningKeyFile(..), SocketFile(..), parseNodeConfiguration) + SigningKeyFile(..), SocketPath(..), parseNodeConfiguration) import Cardano.Common.Parsers import Cardano.Chairman (runChairman) @@ -63,7 +63,7 @@ main = do let run = runChairman p caCoreNodeIds caSecurityParam caMaxBlockNo - (unSocket caSocketDir) + caSocketDir stdoutTracer case caTimeout of @@ -102,7 +102,7 @@ data ChairmanArgs = ChairmanArgs { , caTimeoutType :: !TimeoutType , caGenesisFile :: !GenesisFile , caGenesisHash :: !Text - , caSocketDir :: !SocketFile + , caSocketDir :: !SocketPath , caConfigYaml :: !ConfigYamlFilePath , caSigningKeyFp :: !(Maybe SigningKeyFile) , caDelegationCertFp :: !(Maybe DelegationCertFile) @@ -146,7 +146,7 @@ parseChairmanArgs = "timeout-is-success" "Exit successfully on timeout." <*> (GenesisFile <$> parseGenesisPath) <*> parseGenesisHash - <*> (SocketFile <$> parseSocketDir) + <*> parseSocketPath "Path to a cardano-node socket" <*> (ConfigYamlFilePath <$> parseConfigFile) <*> (optional $ SigningKeyFile <$> parseSigningKey) <*> (optional $ DelegationCertFile <$> parseDelegationCert) diff --git a/cardano-node/app/wallet-client.hs b/cardano-node/app/wallet-client.hs index ef5bf19a130..3cef1990103 100644 --- a/cardano-node/app/wallet-client.hs +++ b/cardano-node/app/wallet-client.hs @@ -13,12 +13,10 @@ import Cardano.Shell.Lib (runCardanoApplicationWithFeatures) import Cardano.Shell.Types (CardanoApplication (..), CardanoFeature (..)) -import Cardano.Common.Parsers ( parseConfigFile, parseGenesisFile - , parseSocketDir) +import Cardano.Common.Parsers (parseConfigFile, parseGenesisFile, parseSocketPath) import Cardano.Config.CommonCLI import Cardano.Config.Types ( CardanoEnvironment (..), ConfigYamlFilePath (..) - , DelegationCertFile(..), SigningKeyFile (..) - , SocketFile (..)) + , DelegationCertFile(..), SigningKeyFile (..)) import Cardano.Config.Logging (LoggingLayer (..)) import Cardano.Wallet.Logging (WalletCLI(..), createLoggingFeatureWallet) import Cardano.Wallet.Run @@ -53,7 +51,7 @@ parseWalletCLI = WalletCLI <*> parseGenesisHash <*> parseGenesisFile "genesis-json" <*> optional (SigningKeyFile <$> parseSigningKey) - <*> (SocketFile <$> parseSocketDir) + <*> parseSocketPath "Path to a cardano-node socket." initializeAllFeatures :: WalletCLI -> CardanoEnvironment -> IO ([CardanoFeature], NodeLayer) initializeAllFeatures wCli cardanoEnvironment = do diff --git a/cardano-node/src/Cardano/CLI/Parsers.hs b/cardano-node/src/Cardano/CLI/Parsers.hs index bede08b50c8..2dc2dd0e307 100644 --- a/cardano-node/src/Cardano/CLI/Parsers.hs +++ b/cardano-node/src/Cardano/CLI/Parsers.hs @@ -37,8 +37,7 @@ import Cardano.Chain.Slotting (EpochNumber(..)) import Cardano.Chain.UTxO (TxId, TxIn(..), TxOut(..)) import Cardano.Config.CommonCLI import Cardano.Config.Topology (NodeAddress(..), NodeHostAddress(..)) -import Cardano.Config.Types ( DelegationCertFile(..), GenesisFile(..), SigningKeyFile(..) - , SocketFile(..)) +import Cardano.Config.Types ( DelegationCertFile(..), GenesisFile(..), SigningKeyFile(..)) import Cardano.Crypto (RequiresNetworkMagic(..), decodeHash) import Cardano.Crypto.ProtocolMagic ( AProtocolMagic(..), ProtocolMagic , ProtocolMagicId(..)) @@ -400,7 +399,7 @@ parseTxRelatedValues = <*> parseProtocol <*> (GenesisFile <$> parseGenesisPath) <*> parseGenesisHash - <*> (SocketFile <$> parseSocketDir) + <*> parseSocketPath "Path to a cardano-node socket" , command' "issue-genesis-utxo-expenditure" "Write a file with a signed transaction, spending genesis UTxO." @@ -439,7 +438,7 @@ parseTxRelatedValues = <*> (DelegationCertFile <$> parseDelegationCert) <*> (GenesisFile <$> parseGenesisPath) <*> parseGenesisHash - <*> (SocketFile <$> parseSocketDir) + <*> parseSocketPath "Path to a cardano-node socket" <*> parseProtocol <*> (NE.fromList <$> some ( parseTargetNodeAddress diff --git a/cardano-node/src/Cardano/CLI/Run.hs b/cardano-node/src/Cardano/CLI/Run.hs index 0bc1b029f30..9d5ff52384c 100644 --- a/cardano-node/src/Cardano/CLI/Run.hs +++ b/cardano-node/src/Cardano/CLI/Run.hs @@ -65,8 +65,12 @@ import Cardano.CLI.Tx.Generation (NumberOfTxs (..), genesisBenchmarkRunner) import Cardano.Common.Orphans () import Cardano.Config.Protocol -import Cardano.Config.Types import Cardano.Config.Logging (createLoggingFeatureCLI) +import Cardano.Config.Types ( CardanoEnvironment(..), DelegationCertFile(..) + , GenesisFile(..), LastKnownBlockVersion(..) + , NodeConfiguration(..), SigningKeyFile(..) + , SocketPath(..), Update(..) + , parseNodeConfiguration) import Cardano.Config.Topology (NodeAddress(..), TopologyInfo(..)) -- | Sub-commands of 'cardano-cli'. @@ -138,7 +142,7 @@ data ClientCommand Protocol GenesisFile Text - SocketFile + SocketPath | SpendGenesisUTxO Protocol GenesisFile @@ -174,7 +178,7 @@ data ClientCommand GenesisFile Text -- ^ Genesis hash - SocketFile + SocketPath Protocol (NonEmpty NodeAddress) NumberOfTxs diff --git a/cardano-node/src/Cardano/CLI/Tx.hs b/cardano-node/src/Cardano/CLI/Tx.hs index 47b95c45af3..ee4e4512b6d 100644 --- a/cardano-node/src/Cardano/CLI/Tx.hs +++ b/cardano-node/src/Cardano/CLI/Tx.hs @@ -59,7 +59,7 @@ import Cardano.CLI.Ops import Cardano.CLI.Tx.Submission import Cardano.Config.Protocol import Cardano.Config.Types (DelegationCertFile, GenesisFile, - SigningKeyFile, SocketFile, Update) + SigningKeyFile, SocketPath, Update) import Cardano.Config.Topology import Cardano.Common.Orphans () @@ -255,7 +255,7 @@ nodeSubmitTx -> Maybe Double -> Maybe DelegationCertFile -> Maybe SigningKeyFile - -> SocketFile + -> SocketPath -> Update -> Protocol -> GenTx ByronBlock diff --git a/cardano-node/src/Cardano/CLI/Tx/Generation.hs b/cardano-node/src/Cardano/CLI/Tx/Generation.hs index fa2e83bc4fd..d8566f175ed 100644 --- a/cardano-node/src/Cardano/CLI/Tx/Generation.hs +++ b/cardano-node/src/Cardano/CLI/Tx/Generation.hs @@ -61,7 +61,7 @@ import qualified Cardano.Chain.Genesis as CC.Genesis import qualified Cardano.Chain.MempoolPayload as CC.Mempool import qualified Cardano.Chain.UTxO as CC.UTxO import Cardano.Config.Logging (LoggingLayer (..), Trace) -import Cardano.Config.Types (SocketFile) +import Cardano.Config.Types (SocketPath) import qualified Cardano.Crypto as Crypto import Cardano.Config.Topology (NodeAddress (..), NodeHostAddress(..)) @@ -134,7 +134,7 @@ newtype TxAdditionalSize = ----------------------------------------------------------------------------------------- genesisBenchmarkRunner :: LoggingLayer - -> SocketFile + -> SocketPath -> Consensus.Protocol ByronBlock -> NonEmpty NodeAddress -> NumberOfTxs @@ -382,7 +382,7 @@ extractGenesisFunds genesisConfig signingKeys = -- (latter corresponds to 'targetAddress' here) and "remember" it in 'availableFunds'. prepareInitialFunds :: Tracer IO String - -> SocketFile + -> SocketPath -> CC.Genesis.Config -> NodeConfig ByronConsensusProtocol -> Map Int ((CC.UTxO.TxIn, CC.UTxO.TxOut), Crypto.SigningKey) @@ -605,7 +605,7 @@ runBenchmark -> Tracer IO SendRecvConnect -> Tracer IO (SendRecvTxSubmission ByronBlock) -> Tracer IO String - -> SocketFile + -> SocketPath -> NodeConfig ByronConsensusProtocol -> Crypto.SigningKey -> CC.Common.Address @@ -738,7 +738,7 @@ runBenchmark benchTracer -- Technically all splitting transactions will send money back to 'sourceAddress'. createMoreFundCoins :: Tracer IO String - -> SocketFile + -> SocketPath -> NodeConfig ByronConsensusProtocol -> Crypto.SigningKey -> FeePerTx diff --git a/cardano-node/src/Cardano/CLI/Tx/Submission.hs b/cardano-node/src/Cardano/CLI/Tx/Submission.hs index b8b4975c40e..eb836cbbbba 100644 --- a/cardano-node/src/Cardano/CLI/Tx/Submission.hs +++ b/cardano-node/src/Cardano/CLI/Tx/Submission.hs @@ -45,7 +45,7 @@ import Ouroboros.Network.NodeToClient (NetworkConnectTracers (..)) import qualified Ouroboros.Network.NodeToClient as NodeToClient import Cardano.Common.LocalSocket -import Cardano.Config.Types (SocketFile(..)) +import Cardano.Config.Types (SocketPath(..)) @@ -57,14 +57,14 @@ import Cardano.Config.Types (SocketFile(..)) submitTx :: ( RunNode blk , Show (ApplyTxErr blk) ) - => SocketFile + => SocketPath -> NodeConfig (BlockProtocol blk) -> NodeId -> GenTx blk -> Tracer IO String -> IO () -submitTx socketFp protoInfoConfig nId tx tracer = do - socketPath <- localSocketAddrInfo (Just nId) (unSocket $ socketFp) NoMkdirIfMissing +submitTx socketFp protoInfoConfig _ tx tracer = do + socketPath <- localSocketAddrInfo socketFp NodeToClient.connectTo NetworkConnectTracers { nctMuxTracer = nullTracer, diff --git a/cardano-node/src/Cardano/Chairman.hs b/cardano-node/src/Cardano/Chairman.hs index 2ce24c359b3..a2d3b301b5c 100644 --- a/cardano-node/src/Cardano/Chairman.hs +++ b/cardano-node/src/Cardano/Chairman.hs @@ -62,6 +62,7 @@ import Ouroboros.Network.Protocol.Handshake.Version import Ouroboros.Network.NodeToClient import Cardano.Common.LocalSocket +import Cardano.Config.Types (SocketPath) import Cardano.Tracing.Tracers (TraceConstraints) -- | Run chairman: connect with all the core nodes. Chairman will store the @@ -81,7 +82,7 @@ runChairman :: forall blk. -- will throw an exception. -> Maybe BlockNo -- ^ finish after that many blocks, if 'Nothing' run continuously. - -> FilePath + -> SocketPath -- ^ local socket dir -> Tracer IO String -> IO () @@ -127,7 +128,7 @@ createConnection -> Maybe BlockNo -> Tracer IO String -> NodeConfig (BlockProtocol blk) - -> FilePath + -> SocketPath -> IO () createConnection coreNodeId @@ -136,8 +137,8 @@ createConnection maxBlockNo tracer pInfoConfig - socketDir = do - addr <- localSocketAddrInfo (Just $ fromCoreNodeId coreNodeId) socketDir NoMkdirIfMissing + socketFp = do + addr <- localSocketAddrInfo socketFp connectTo NetworkConnectTracers { nctMuxTracer = nullTracer, diff --git a/cardano-node/src/Cardano/Common/LocalSocket.hs b/cardano-node/src/Cardano/Common/LocalSocket.hs index 5357c5f1f4a..4fcd691af65 100644 --- a/cardano-node/src/Cardano/Common/LocalSocket.hs +++ b/cardano-node/src/Cardano/Common/LocalSocket.hs @@ -1,66 +1,37 @@ module Cardano.Common.LocalSocket - ( MkdirIfMissing(..) - , localSocketAddrInfo + ( localSocketAddrInfo , removeStaleLocalSocket ) where import Cardano.Prelude -import System.Directory ( canonicalizePath, createDirectoryIfMissing - , makeAbsolute, removeFile) -import System.FilePath (()) +import System.Directory (removeFile) import System.IO.Error (isDoesNotExistError) import Network.Socket as Socket -import Ouroboros.Consensus.NodeId (NodeId(..), CoreNodeId(..)) +import Cardano.Config.Types (SocketPath(..)) -data MkdirIfMissing - = MkdirIfMissing - | NoMkdirIfMissing - deriving (Eq, Show) - -localSocketFilePath :: NodeId -> FilePath -localSocketFilePath (CoreId (CoreNodeId n)) = "node-core-" ++ show (n :: Word64) ++ ".socket" -localSocketFilePath (RelayId n) = "node-relay-" ++ show (n :: Word64) ++ ".socket" -- | Provide an AF_UNIX address for a socket situated in 'socketDir', with its name -- derived from the node ID. When 'mkdir' is 'MkdirIfMissing', the directory is created. -localSocketAddrInfo :: Maybe NodeId -> FilePath -> MkdirIfMissing -> IO Socket.AddrInfo -localSocketAddrInfo Nothing socketPath _ = do - pure $ - Socket.AddrInfo - [] - Socket.AF_UNIX - Socket.Stream - Socket.defaultProtocol - (Socket.SockAddrUnix socketPath) - Nothing -localSocketAddrInfo (Just nodeId) socketDir mkdir = do - dir <- canonicalizePath =<< makeAbsolute socketDir - when (mkdir == MkdirIfMissing) - $ createDirectoryIfMissing True dir +localSocketAddrInfo :: SocketPath -> IO Socket.AddrInfo +localSocketAddrInfo (SocketFile fp) = do pure $ Socket.AddrInfo [] Socket.AF_UNIX Socket.Stream Socket.defaultProtocol - (Socket.SockAddrUnix $ dir localSocketFilePath nodeId) + (Socket.SockAddrUnix fp) Nothing +-- TODO: Convert to ExceptT -- | Remove the socket established with 'localSocketAddrInfo'. -removeStaleLocalSocket :: Maybe NodeId -> FilePath -> IO () -removeStaleLocalSocket Nothing socketFp = do +removeStaleLocalSocket :: SocketPath -> IO () +removeStaleLocalSocket (SocketFile socketFp) = do removeFile socketFp `catch` \e -> if isDoesNotExistError e then return () else throwIO e -removeStaleLocalSocket (Just nodeId) socketDir = do - dir <- canonicalizePath =<< makeAbsolute socketDir - removeFile (dir localSocketFilePath nodeId) - `catch` \e -> - if isDoesNotExistError e - then return () - else throwIO e diff --git a/cardano-node/src/Cardano/Common/Parsers.hs b/cardano-node/src/Cardano/Common/Parsers.hs index f33008eaf6e..7f586340837 100644 --- a/cardano-node/src/Cardano/Common/Parsers.hs +++ b/cardano-node/src/Cardano/Common/Parsers.hs @@ -20,7 +20,7 @@ module Cardano.Common.Parsers , parseLogOutputFile , parseNodeId , parseProtocol - , parseSocketDir + , parseSocketPath , parseTopologyInfo ) where @@ -71,7 +71,7 @@ nodeMockParser = do -- Filepaths topFp <- parseTopologyFile dbFp <- parseDbPath - socketFp <- parseSocketDir -- <|> parseSocketPath + socketFp <- parseSocketPath "Path to a cardano-node socket" genHash <- parseGenesisHash @@ -90,7 +90,7 @@ nodeMockParser = do , genesisFile = Nothing , delegCertFile = Nothing , signKeyFile = Nothing - , socketFile = SocketFile socketFp + , socketFile = socketFp } , mockGenesisHash = genHash , mockNodeAddr = nAddress @@ -107,7 +107,7 @@ nodeRealParser = do genFp <- optional parseGenesisPath delCertFp <- optional parseDelegationCert sKeyFp <- optional parseSigningKey - socketFp <- parseSocketDir -- TODO: Left off here. Get parseSocketPath from next commit parseSocketPath <|> + socketFp <- parseSocketPath "Path to a cardano-node socket" genHash <- parseGenesisHash @@ -126,7 +126,7 @@ nodeRealParser = do , genesisFile = GenesisFile <$> genFp , delegCertFile = DelegationCertFile <$> delCertFp , signKeyFile = SigningKeyFile <$> sKeyFp - , socketFile = SocketFile socketFp + , socketFile = socketFp } , genesisHash = genHash , nodeAddr = nAddress @@ -215,15 +215,6 @@ parsePort = <> help "The port number" ) -parseSocketDir :: Parser FilePath -parseSocketDir = - strOption - ( long "socket-dir" - <> metavar "FILEPATH" - <> help "Directory with local sockets:\ - \ ${dir}/node-{core,relay}-${node-id}.socket" - ) - parseValidateDB :: Parser Bool parseValidateDB = switch ( @@ -249,6 +240,15 @@ parseProtocol = asum "Permissive BFT consensus with a real ledger" ] +parseSocketPath :: Text -> Parser SocketPath +parseSocketPath helpMessage = + SocketFile <$> strOption + ( long "socket-path" + <> (help $ toS helpMessage) + <> completer (bashCompleter "file") + <> metavar "FILEPATH" + ) + parseTopologyInfo :: String -> Parser TopologyInfo parseTopologyInfo desc = TopologyInfo <$> parseNodeId desc <*> parseTopologyFile diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 3c8fac00aac..e6346f520d3 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -71,8 +71,7 @@ import Cardano.Common.LocalSocket import Cardano.Config.Protocol (SomeProtocol(..), fromProtocol) import Cardano.Config.Topology import Cardano.Config.Types (ConfigYamlFilePath(..), DbFile(..), NodeMockCLI(..), - NodeProtocolMode (..), NodeCLI(..), - SocketFile(..), TopologyFile(..), + NodeProtocolMode (..), NodeCLI(..),TopologyFile(..), parseNodeConfiguration) import Cardano.Tracing.Tracers #ifdef UNIX @@ -174,7 +173,6 @@ handleSimpleNode p trace nodeTracers npm onKernel = do nc <- parseNodeConfiguration $ unConfigPath config let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p - hn <- getHostName -- Tracing let tracer = contramap pack $ toLogObject trace @@ -183,17 +181,13 @@ handleSimpleNode p trace nodeTracers npm onKernel = do traceWith tracer $ unlines [ "**************************************" - , "Hostname: " <> hn + , "Node IP: " <> (show $ naHostAddress rNodeAddr) , "My producers are " , "**************************************" ] - -- Socket directory - myLocalAddr <- localSocketAddrInfo - Nothing - (unSocket $ socketFile rMscFp) - MkdirIfMissing + myLocalAddr <- localSocketAddrInfo $ socketFile rMscFp addrs <- nodeAddressInfo rNodeAddr @@ -241,7 +235,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do , daDnsProducers = dnsProducers } - removeStaleLocalSocket Nothing (unSocket $ socketFile rMscFp) + removeStaleLocalSocket $ socketFile rMscFp dbPath <- canonicalizePath =<< makeAbsolute (unDB $ dBFile rMscFp) varTip <- atomically $ newTVar GenesisPoint @@ -273,7 +267,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p - -- Tracing + -- Tracing let tracer = contramap pack $ toLogObject trace traceWith tracer $ "System started at " <> show (nodeStartTime (Proxy @blk) cfg) @@ -287,7 +281,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do <> show (nid nc) <> " not found in topology" - ---------------------------------------------- + ---------------------------------------------- traceWith tracer $ unlines [ "**************************************" @@ -297,10 +291,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do ] -- Socket directory - myLocalAddr <- localSocketAddrInfo - (ncNodeId nc) - (unSocket $ socketFile mMscFp) - MkdirIfMissing + myLocalAddr <- localSocketAddrInfo $ socketFile mMscFp addrs <- nodeAddressInfo mockNodeAddress let ipProducerAddrs :: [NodeAddress] @@ -345,7 +336,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do , daDnsProducers = dnsProducers } - removeStaleLocalSocket (ncNodeId nc) (unSocket $ socketFile mMscFp) + removeStaleLocalSocket $ socketFile mMscFp dbPath <- canonicalizePath =<< makeAbsolute (unDB $ dBFile mMscFp) varTip <- atomically $ newTVar GenesisPoint diff --git a/cardano-node/src/Cardano/Wallet/Client.hs b/cardano-node/src/Cardano/Wallet/Client.hs index 35ab408e648..73e0c11ab43 100644 --- a/cardano-node/src/Cardano/Wallet/Client.hs +++ b/cardano-node/src/Cardano/Wallet/Client.hs @@ -49,6 +49,7 @@ import Ouroboros.Network.Protocol.Handshake.Version import Ouroboros.Network.NodeToClient import Cardano.Common.LocalSocket +import Cardano.Config.Types (SocketPath) import Cardano.Tracing.Tracers (TraceConstraints) runWalletClient :: forall blk. @@ -56,13 +57,13 @@ runWalletClient :: forall blk. , TraceConstraints blk ) => Protocol blk - -> FilePath + -> SocketPath -> CoreNodeId -> Tracer IO String -> IO () -runWalletClient ptcl sockDir nid tracer = do +runWalletClient ptcl sockFp (CoreNodeId _) tracer = do - addr <- localSocketAddrInfo (Just (CoreId nid)) sockDir NoMkdirIfMissing + addr <- localSocketAddrInfo sockFp let ProtocolInfo{pInfoConfig} = protocolInfo ptcl diff --git a/cardano-node/src/Cardano/Wallet/Logging.hs b/cardano-node/src/Cardano/Wallet/Logging.hs index 69f1566ec09..787fcac0116 100644 --- a/cardano-node/src/Cardano/Wallet/Logging.hs +++ b/cardano-node/src/Cardano/Wallet/Logging.hs @@ -9,7 +9,7 @@ import Cardano.Shell.Types (CardanoFeature (..)) import Cardano.Config.Types ( CardanoEnvironment, ConfigYamlFilePath(..) , DelegationCertFile , GenesisFile, NodeConfiguration(..) - , SigningKeyFile, SocketFile, parseNodeConfiguration) + , SigningKeyFile, SocketPath, parseNodeConfiguration) import Cardano.Config.Logging ( LoggingLayer (..), loggingCardanoFeatureInit , loggingCLIConfiguration) @@ -50,7 +50,7 @@ data WalletCLI = WalletCLI , waGenesisHash :: !Text , waGenesisFile :: !GenesisFile , waSignKeyFile :: !(Maybe SigningKeyFile) - , waSocketFile :: !SocketFile + , waSocketFile :: !SocketPath -- Socket Directory. Will be changed in -- an upcoming PR to an actual socket filepath. } diff --git a/cardano-node/src/Cardano/Wallet/Run.hs b/cardano-node/src/Cardano/Wallet/Run.hs index 0a9d4b50c35..fc64d99ec24 100644 --- a/cardano-node/src/Cardano/Wallet/Run.hs +++ b/cardano-node/src/Cardano/Wallet/Run.hs @@ -18,7 +18,7 @@ import Ouroboros.Consensus.NodeId (NodeId (..)) import Cardano.Config.Protocol (ProtocolInstantiationError) import Cardano.Config.Types ( ConfigYamlFilePath(..), NodeConfiguration(..) - , SocketFile(..), parseNodeConfiguration) + , parseNodeConfiguration) import Cardano.Wallet.Client import Cardano.Wallet.Logging (WalletCLI (..)) @@ -49,8 +49,7 @@ runClient (WalletCLI config delegCertFile gHash gFile sKeyFile socketFp) tracer Left err -> (putTextLn $ renderError err) >> exitFailure Right (SomeProtocol p) -> pure $ SomeProtocol p - let socketDir = unSocket socketFp - runWalletClient p socketDir coreNodeId tracer' + runWalletClient p socketFp coreNodeId tracer' renderError :: ProtocolInstantiationError -> Text renderError = pack . show diff --git a/nix/nixos/cardano-node-service.nix b/nix/nixos/cardano-node-service.nix index 22c43c16ef7..cc76a4afb6a 100644 --- a/nix/nixos/cardano-node-service.nix +++ b/nix/nixos/cardano-node-service.nix @@ -17,7 +17,7 @@ let "--genesis-hash ${cfg.genesisHash}" "--config ${cfg.nodeConfigFile}" "--database-path ${cfg.databasePath}" - "--socket-dir ${if (cfg.runtimeDir == null) then "${cfg.stateDir}/socket" else "/run/${cfg.runtimeDir}"}" + "--socket-path ${if (cfg.runtimeDir == null) then "${cfg.stateDir}/socket" else "/run/${cfg.runtimeDir}"}" "--topology ${cfg.topology}" "--host-addr ${cfg.hostAddr}" "--port ${toString cfg.port}" diff --git a/nix/nixos/chairman-as-a-service.nix b/nix/nixos/chairman-as-a-service.nix index f878c9d95a5..56f05bc73c5 100644 --- a/nix/nixos/chairman-as-a-service.nix +++ b/nix/nixos/chairman-as-a-service.nix @@ -27,7 +27,7 @@ let "--security-param ${toString cfg.k}" "--genesis-file ${cfg.genesisFile}" "--genesis-hash ${cfg.genesisHash}" - "--socket-dir ${if (ncfg.runtimeDir == null) then "${ncfg.stateDir}/socket" else "/run/${ncfg.runtimeDir}"}" + "--socket-path ${if (ncfg.runtimeDir == null) then "${ncfg.stateDir}/socket" else "/run/${ncfg.runtimeDir}"}" "--config ${cfg.nodeConfigFile}" "${optionalString cfg.timeoutIsSuccess "--timeout-is-success"}" ]; diff --git a/scripts/SCRIPTS.md b/scripts/SCRIPTS.md index 361d3da2566..f870ca3535f 100644 --- a/scripts/SCRIPTS.md +++ b/scripts/SCRIPTS.md @@ -26,7 +26,7 @@ - issue-utxo-expenditure.sh
Write a file with a transaction spending a normal UTxO entry, given a key owning it - mainnet.sh
Run a node against Cardano Mainnet -- shelley-testnet2.sh
Start a dev cluster with 3 nodes, +- shelley-testnet-live.sh
Start a dev cluster with 3 nodes, with neat curses-based UI (run from tmux) - shelley-testnet-dns.sh
Start a dev cluster with 3 nodes (run from tmux) - shelley-testnet.sh
Start a dev cluster with 3 nodes, with diff --git a/scripts/lib-node.sh b/scripts/lib-node.sh index e9bb2719b44..2fc4aa20bdc 100644 --- a/scripts/lib-node.sh +++ b/scripts/lib-node.sh @@ -29,7 +29,7 @@ function commonargs() { printf -- "--database-path ${root}/db/ " printf -- "--genesis-file ${genesis_file} " printf -- "--genesis-hash ${genesis_hash} " - printf -- "--socket-dir ${root}/socket/$1 " + printf -- "--socket-path ${root}/socket/$1 " } function nodeargs () { diff --git a/scripts/mainnet.sh b/scripts/mainnet.sh index 8b84e2de4f5..c4453abbadc 100755 --- a/scripts/mainnet.sh +++ b/scripts/mainnet.sh @@ -12,7 +12,7 @@ ARGS=( run --genesis-file "${configuration}/mainnet-genesis.json" --genesis-hash "5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb" --topology "${TOPOLOGY}" - --socket-dir "${root}/socket/" + --socket-dir "${root}/socket/mainnet-socket" --config "${configuration}/configuration-mainnet.yaml" --port 7776 ) From e888b57db207398858b1c2dd79e5cc8610d3c61e Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 22 Nov 2019 13:54:41 -0400 Subject: [PATCH 4/9] Implement `RealNodeTopology` While running a real protocol, the node determines the peers it will connect to from a JSON configuration file. --- cardano-config/src/Cardano/Config/Topology.hs | 8 +++ cardano-node/src/Cardano/Node/Run.hs | 50 +++++++++++++++---- 2 files changed, 48 insertions(+), 10 deletions(-) diff --git a/cardano-config/src/Cardano/Config/Topology.hs b/cardano-config/src/Cardano/Config/Topology.hs index cb1b619e844..f9602f5c2c8 100644 --- a/cardano-config/src/Cardano/Config/Topology.hs +++ b/cardano-config/src/Cardano/Config/Topology.hs @@ -12,6 +12,7 @@ module Cardano.Config.Topology , NodeAddress(..) , NodeHostAddress(..) , NodeSetup(..) + , RealNodeTopology(..) , RemoteAddress(..) , createNodeAddress , nodeAddressInfo @@ -135,6 +136,13 @@ data NodeSetup = NodeSetup , producers :: ![RemoteAddress] } deriving Show +data RealNodeTopology = RealNodeTopology { rProducers :: ![RemoteAddress] } + +instance FromJSON RealNodeTopology where + parseJSON = withObject "RealNodeTopology" $ \v -> + RealNodeTopology + <$> v .: "rProducers" + instance FromJSON NodeId where parseJSON v = CoreId . CoreNodeId <$> parseJSON v diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index e6346f520d3..bb2ea22b10c 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -26,8 +26,12 @@ import Prelude (error, id, unlines) #ifdef UNIX import qualified Control.Concurrent.Async as Async #endif +import Control.Exception (IOException) +import qualified Control.Exception as Exception import Control.Tracer +import Data.Aeson (eitherDecode) import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Lazy as LB import Data.Either (partitionEithers) import Data.Functor.Contravariant (contramap) import qualified Data.List as List @@ -89,12 +93,7 @@ runNode loggingLayer npm = do llAppendName loggingLayer "node" (llBasicTrace loggingLayer) let tracer = contramap pack $ toLogObject trace - (mscFp', configFp', genHash') <- - case npm of - MockProtocolMode (NodeMockCLI mMscFp genHash _ configYaml _) -> - pure (mMscFp, configYaml, genHash) - RealProtocolMode (NodeCLI rMscFp genHash _ configYaml _) -> - pure (rMscFp, configYaml, genHash) + (mscFp', configFp', genHash') <- return $ extractFilePathsAndGenHash npm nc <- parseNodeConfiguration $ unConfigPath configFp' traceWith tracer $ "tracing verbosity = " ++ @@ -173,6 +172,14 @@ handleSimpleNode p trace nodeTracers npm onKernel = do nc <- parseNodeConfiguration $ unConfigPath config let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p + -- Topology + eitherTopology <- readRealNodeTopology . unTopology $ topFile rMscFp + topology <- case eitherTopology of + --TODO: Convert handleSimpleNode to return `ExceptT` + Left err -> panic $ "Cardano.Node.Run.readRealNodeTopology: " + <> err + Right top -> pure top + -- Tracing let tracer = contramap pack $ toLogObject trace @@ -180,9 +187,10 @@ handleSimpleNode p trace nodeTracers npm onKernel = do "System started at " <> show (nodeStartTime (Proxy @blk) cfg) traceWith tracer $ unlines - [ "**************************************" - , "Node IP: " <> (show $ naHostAddress rNodeAddr) - , "My producers are " + [ "" + , "**************************************" + , "Host node address: " <> show rNodeAddr + , "My producers are " <> (show $ rProducers topology) , "**************************************" ] @@ -195,7 +203,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do dnsProducerAddrs :: [RemoteAddress] (ipProducerAddrs, dnsProducerAddrs) = partitionEithers [ maybe (Right ra) Left $ remoteAddressToNodeAddress ra - | ra <- [RemoteAddress "18.185.45.45" 3001 1] ] + | ra <- rProducers topology ] ipProducers :: IPSubscriptionTarget ipProducers = let ips = nodeAddressToSockAddr <$> ipProducerAddrs @@ -385,3 +393,25 @@ handleSimpleNode p trace nodeTracers npm onKernel = do _ -> case ncNodeId nc of Just (CoreId _) -> IsProducer _ -> IsNotProducer + +-- | Read the `RealNodeTopology` configuration from the specified file. +-- While running a real protocol, this gives your node its own address and +-- other remote peers it will attempt to connect to. +readRealNodeTopology :: FilePath -> IO (Either Text RealNodeTopology) +readRealNodeTopology fp = do + ebs <- Exception.try $ BSC.readFile fp :: IO (Either IOException BSC.ByteString) + case ebs of + Left e -> pure $ handler e + Right bs -> pure . first toS . eitherDecode $ LB.fromStrict bs + where + handler :: IOException -> Either Text RealNodeTopology + handler e = Left . pack $ show e + +extractFilePathsAndGenHash + :: NodeProtocolMode -> (MiscellaneousFilepaths ,ConfigYamlFilePath, Text) +extractFilePathsAndGenHash npm = + case npm of + MockProtocolMode (NodeMockCLI mMscFp genHash _ configYaml _) -> + (mMscFp, configYaml, genHash) + RealProtocolMode (NodeCLI rMscFp genHash _ configYaml _) -> + (rMscFp, configYaml, genHash) From d47c90f38a055282afdc4e1b451df479c4af799e Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 24 Jan 2020 15:40:22 -0400 Subject: [PATCH 5/9] Remove `NodeId` value from all config files using the `RealPBFT` protocol --- benchmarking/chain-sync/configuration/log-config-ci.yaml | 2 +- benchmarking/chain-sync/configuration/log-configuration.yaml | 2 +- benchmarking/cluster3nodes/configuration/log-config-0.yaml | 2 +- benchmarking/cluster3nodes/configuration/log-config-1.yaml | 2 +- benchmarking/cluster3nodes/configuration/log-config-2.yaml | 2 +- .../cluster3nodes/configuration/log-config-generator.yaml | 2 +- .../cluster3nodes/configuration/log-config-genesis.yaml | 2 +- cardano-node/README.md | 2 +- configuration/configuration-mainnet.yaml | 2 +- configuration/configuration-silent.yaml | 2 +- configuration/log-config-0.liveview.yaml | 2 +- configuration/log-config-0.yaml | 2 +- configuration/log-config-1.liveview.yaml | 2 +- configuration/log-config-1.yaml | 2 +- configuration/log-config-2.liveview.yaml | 2 +- configuration/log-config-2.yaml | 2 +- configuration/log-configuration.yaml | 2 +- 17 files changed, 17 insertions(+), 17 deletions(-) diff --git a/benchmarking/chain-sync/configuration/log-config-ci.yaml b/benchmarking/chain-sync/configuration/log-config-ci.yaml index 020f32d584b..76841acde04 100644 --- a/benchmarking/chain-sync/configuration/log-config-ci.yaml +++ b/benchmarking/chain-sync/configuration/log-config-ci.yaml @@ -77,7 +77,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresNoMagic diff --git a/benchmarking/chain-sync/configuration/log-configuration.yaml b/benchmarking/chain-sync/configuration/log-configuration.yaml index 5785d04969d..dab5ec052e1 100644 --- a/benchmarking/chain-sync/configuration/log-configuration.yaml +++ b/benchmarking/chain-sync/configuration/log-configuration.yaml @@ -85,7 +85,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresNoMagic diff --git a/benchmarking/cluster3nodes/configuration/log-config-0.yaml b/benchmarking/cluster3nodes/configuration/log-config-0.yaml index c172a938fd3..480c78ca80a 100644 --- a/benchmarking/cluster3nodes/configuration/log-config-0.yaml +++ b/benchmarking/cluster3nodes/configuration/log-config-0.yaml @@ -75,7 +75,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/benchmarking/cluster3nodes/configuration/log-config-1.yaml b/benchmarking/cluster3nodes/configuration/log-config-1.yaml index ad179fd1f93..5853eae0780 100644 --- a/benchmarking/cluster3nodes/configuration/log-config-1.yaml +++ b/benchmarking/cluster3nodes/configuration/log-config-1.yaml @@ -77,7 +77,7 @@ options: ########################################################## -NodeId: 1 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/benchmarking/cluster3nodes/configuration/log-config-2.yaml b/benchmarking/cluster3nodes/configuration/log-config-2.yaml index 22e9fa986d8..9ae5885144f 100644 --- a/benchmarking/cluster3nodes/configuration/log-config-2.yaml +++ b/benchmarking/cluster3nodes/configuration/log-config-2.yaml @@ -81,7 +81,7 @@ options: ########################################################## -NodeId: 2 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/benchmarking/cluster3nodes/configuration/log-config-generator.yaml b/benchmarking/cluster3nodes/configuration/log-config-generator.yaml index 0835efd298b..961b34056c1 100644 --- a/benchmarking/cluster3nodes/configuration/log-config-generator.yaml +++ b/benchmarking/cluster3nodes/configuration/log-config-generator.yaml @@ -81,7 +81,7 @@ options: ########################################################## -NodeId: 99 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/benchmarking/cluster3nodes/configuration/log-config-genesis.yaml b/benchmarking/cluster3nodes/configuration/log-config-genesis.yaml index f128ec9666e..d1b7b9d89fb 100644 --- a/benchmarking/cluster3nodes/configuration/log-config-genesis.yaml +++ b/benchmarking/cluster3nodes/configuration/log-config-genesis.yaml @@ -49,7 +49,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/cardano-node/README.md b/cardano-node/README.md index c15c5ffd80a..f2df7129af7 100644 --- a/cardano-node/README.md +++ b/cardano-node/README.md @@ -77,7 +77,7 @@ Usage: cardano-node --topology FILEPATH --database-path FILEPATH The `--config` flag points to a `.yaml` file that is responsible to configuring the logging & other important settings for the node. Some of the more important settings are as follows: -`NodeId: 0` -- Soon to be removed from config file. Used to identify nodes in local clusters. +`NodeId: 0` -- Used in mock protocols only to differentiate nodes. `Protocol: RealPBFT` -- Protocol the node will execute diff --git a/configuration/configuration-mainnet.yaml b/configuration/configuration-mainnet.yaml index 6f3f7ab81c6..283b385e4c2 100644 --- a/configuration/configuration-mainnet.yaml +++ b/configuration/configuration-mainnet.yaml @@ -81,7 +81,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresNoMagic diff --git a/configuration/configuration-silent.yaml b/configuration/configuration-silent.yaml index 7d2aaaed979..0c0cc4d4e6a 100644 --- a/configuration/configuration-silent.yaml +++ b/configuration/configuration-silent.yaml @@ -59,7 +59,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresNoMagic diff --git a/configuration/log-config-0.liveview.yaml b/configuration/log-config-0.liveview.yaml index 3dadbafd392..dc640edbd2a 100644 --- a/configuration/log-config-0.liveview.yaml +++ b/configuration/log-config-0.liveview.yaml @@ -86,7 +86,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/configuration/log-config-0.yaml b/configuration/log-config-0.yaml index 0eb336b5cb2..f13cfee7f50 100644 --- a/configuration/log-config-0.yaml +++ b/configuration/log-config-0.yaml @@ -92,7 +92,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/configuration/log-config-1.liveview.yaml b/configuration/log-config-1.liveview.yaml index 6a940fd1739..00a6f0ccf0d 100644 --- a/configuration/log-config-1.liveview.yaml +++ b/configuration/log-config-1.liveview.yaml @@ -85,7 +85,7 @@ options: ############### Cardano Node Configuration ############### ########################################################## -NodeId: 1 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/configuration/log-config-1.yaml b/configuration/log-config-1.yaml index bdfdd49f629..7957ff7fd29 100644 --- a/configuration/log-config-1.yaml +++ b/configuration/log-config-1.yaml @@ -91,7 +91,7 @@ options: ############### Cardano Node Configuration ############### ########################################################## -NodeId: 1 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/configuration/log-config-2.liveview.yaml b/configuration/log-config-2.liveview.yaml index c11f457d1f3..106d7ad1823 100644 --- a/configuration/log-config-2.liveview.yaml +++ b/configuration/log-config-2.liveview.yaml @@ -91,7 +91,7 @@ options: ########################################################## -NodeId: 2 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/configuration/log-config-2.yaml b/configuration/log-config-2.yaml index cefedf79881..a9eac33f6b4 100644 --- a/configuration/log-config-2.yaml +++ b/configuration/log-config-2.yaml @@ -97,7 +97,7 @@ options: ########################################################## -NodeId: 2 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresMagic diff --git a/configuration/log-configuration.yaml b/configuration/log-configuration.yaml index a0cf4e3d4cc..6966cc3f364 100644 --- a/configuration/log-configuration.yaml +++ b/configuration/log-configuration.yaml @@ -87,7 +87,7 @@ options: ########################################################## -NodeId: 0 +NodeId: Protocol: RealPBFT NumCoreNodes: 1 RequiresNetworkMagic: RequiresNoMagic From f4cc305a573abbd47c0d18bbc7c0d692b23caa77 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 28 Nov 2019 18:38:29 -0400 Subject: [PATCH 6/9] Update Scripts Fix `localSocketAddrInfo` --- .../configuration/topology-local.yaml | 10 +++- .../simple-topology-real-pbft-node-0.json | 15 ++++++ .../simple-topology-real-pbft-node-1.json | 14 +++++ .../simple-topology-real-pbft-node-2.json | 14 +++++ .../cluster3nodes/run-3node-cluster.sh | 16 +++--- .../cluster3nodes/run_tx_generator.sh | 3 +- cardano-config/src/Cardano/Config/Topology.hs | 2 +- cardano-node/README.md | 2 +- cardano-node/src/Cardano/CLI/Parsers.hs | 1 - cardano-node/src/Cardano/CLI/Run.hs | 9 ++-- configuration/mainnet-topology.json | 53 ++++++++----------- .../simple-topology-real-pbft-node-0.json | 15 ++++++ .../simple-topology-real-pbft-node-1.json | 14 +++++ .../simple-topology-real-pbft-node-2.json | 14 +++++ scripts/chairman.sh | 6 ++- scripts/generator.sh | 2 +- scripts/lib-node.sh | 6 +-- scripts/mainnet.sh | 2 +- scripts/shelley-testnet-live.sh | 6 +-- scripts/shelley-testnet.sh | 6 +-- scripts/start-wallet.sh | 2 +- scripts/submit-tx.sh | 1 - 22 files changed, 149 insertions(+), 64 deletions(-) create mode 100644 benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-0.json create mode 100644 benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-1.json create mode 100644 benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-2.json create mode 100644 configuration/realPBFT/simple-topology-real-pbft-node-0.json create mode 100644 configuration/realPBFT/simple-topology-real-pbft-node-1.json create mode 100644 configuration/realPBFT/simple-topology-real-pbft-node-2.json diff --git a/benchmarking/chain-sync/configuration/topology-local.yaml b/benchmarking/chain-sync/configuration/topology-local.yaml index 269a98176f4..0b7d4d45f49 100644 --- a/benchmarking/chain-sync/configuration/topology-local.yaml +++ b/benchmarking/chain-sync/configuration/topology-local.yaml @@ -1 +1,9 @@ -[{"nodeAddress":{"addr":"127.0.0.1","port":3001},"nodeId":0,"producers":[{"addr":"127.0.0.1","port":7777,"valency":1}]}] +{ + "Producers":[ + { + "addr":"127.0.0.1", + "port":7777, + "valency":1 + } + ] +} diff --git a/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-0.json b/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-0.json new file mode 100644 index 00000000000..95902077560 --- /dev/null +++ b/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-0.json @@ -0,0 +1,15 @@ + + { + "Producers":[ + { + "addr":"127.0.0.1", + "port":3001, + "valency":1 + }, + { + "addr":"127.0.0.1", + "port":3002, + "valency":1 + } + ] + } diff --git a/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-1.json b/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-1.json new file mode 100644 index 00000000000..a64ebe10a66 --- /dev/null +++ b/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-1.json @@ -0,0 +1,14 @@ +{ + "Producers":[ + { + "addr":"127.0.0.1", + "port":3000, + "valency":1 + }, + { + "addr":"127.0.0.1", + "port":3002, + "valency":1 + } + ] +} diff --git a/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-2.json b/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-2.json new file mode 100644 index 00000000000..a762a3e8f19 --- /dev/null +++ b/benchmarking/cluster3nodes/configuration/simple-topology-real-pbft-node-2.json @@ -0,0 +1,14 @@ +{ + "Producers":[ + { + "addr":"127.0.0.1", + "port":3000, + "valency":1 + }, + { + "addr":"127.0.0.1", + "port":3001, + "valency":1 + } + ] +} diff --git a/benchmarking/cluster3nodes/run-3node-cluster.sh b/benchmarking/cluster3nodes/run-3node-cluster.sh index 1079b81e974..8f70215f50a 100755 --- a/benchmarking/cluster3nodes/run-3node-cluster.sh +++ b/benchmarking/cluster3nodes/run-3node-cluster.sh @@ -41,16 +41,16 @@ function dlgcert () { printf -- "--delegation-certificate ${genesis_root}/delegation-cert.%03d.json " "$1" } function commonargs() { - printf -- "--topology configuration/simple-topology.json " - printf -- "--database-path ./db/ " + printf -- "--topology configuration/simple-topology-real-pbft-node-$1.json " + printf -- "--database-path ./db-$1/ " printf -- "--genesis-file ${genesis_file} " - printf -- "--genesis-hash ${genesis_hash}" - printf -- "--socket-path /tmp/cluster3nodes-socket/ " + printf -- "--genesis-hash ${genesis_hash} " + printf -- "--socket-path /tmp/cluster3nodes-socket/$1 " } function nodeargs () { local extra="$2" - commonargs + commonargs $1 nodecfg $1 dlgkey $1 dlgcert $1 @@ -65,8 +65,8 @@ tmux select-pane -t 0 # start nodes tmux select-pane -t 0 -tmux send-keys "cd '${BASEPATH}'; ${CMD} exe:cardano-node $(nodeargs 0 "$(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${BASEPATH}'; ${CMD} exe:cardano-node run $(nodeargs 0 "$(echo -n ${EXTRA})") " C-m tmux select-pane -t 1 -tmux send-keys "cd '${BASEPATH}'; ${CMD} exe:cardano-node $(nodeargs 1 "$(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${BASEPATH}'; ${CMD} exe:cardano-node run $(nodeargs 1 "$(echo -n ${EXTRA})") " C-m tmux select-pane -t 2 -tmux send-keys "cd '${BASEPATH}'; ${CMD} exe:cardano-node $(nodeargs 2 "$(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${BASEPATH}'; ${CMD} exe:cardano-node run $(nodeargs 2 "$(echo -n ${EXTRA})") " C-m diff --git a/benchmarking/cluster3nodes/run_tx_generator.sh b/benchmarking/cluster3nodes/run_tx_generator.sh index 5abb28c785b..662afebb0c6 100755 --- a/benchmarking/cluster3nodes/run_tx_generator.sh +++ b/benchmarking/cluster3nodes/run_tx_generator.sh @@ -25,7 +25,7 @@ exec ${GENERATOR} \ --delegation-certificate ${CONFIGDIR}/latest-genesis/delegation-cert.000.json \ --genesis-file ${GENESISJSON} \ --genesis-hash ${GENESISHASH} \ - --socket-path /tmp/cluster3nodes-socket \ + --socket-path /tmp/cluster3nodes-socket/0 \ --real-pbft \ --num-of-txs $numtx \ --add-tx-size $addsizetx \ @@ -36,5 +36,4 @@ exec ${GENERATOR} \ --sig-key ${CONFIGDIR}/latest-genesis/delegate-keys.000.key \ --sig-key ${CONFIGDIR}/latest-genesis/delegate-keys.001.key \ --sig-key ${CONFIGDIR}/latest-genesis/delegate-keys.002.key \ - --node-id 0 \ ${TARGETNODES} diff --git a/cardano-config/src/Cardano/Config/Topology.hs b/cardano-config/src/Cardano/Config/Topology.hs index f9602f5c2c8..9fa315fbc21 100644 --- a/cardano-config/src/Cardano/Config/Topology.hs +++ b/cardano-config/src/Cardano/Config/Topology.hs @@ -141,7 +141,7 @@ data RealNodeTopology = RealNodeTopology { rProducers :: ![RemoteAddress] } instance FromJSON RealNodeTopology where parseJSON = withObject "RealNodeTopology" $ \v -> RealNodeTopology - <$> v .: "rProducers" + <$> v .: "Producers" instance FromJSON NodeId where parseJSON v = CoreId . CoreNodeId <$> parseJSON v diff --git a/cardano-node/README.md b/cardano-node/README.md index f2df7129af7..2902973018e 100644 --- a/cardano-node/README.md +++ b/cardano-node/README.md @@ -63,7 +63,7 @@ Usage: cardano-node --topology FILEPATH --database-path FILEPATH `--signing-key` - Optional path to the signing key. -`--socket-path` - Path to the socket directory. +`--socket-path` - Path to the socket file. `--host-addr` - Optionally specify your node's IPv4 or IPv6 address. diff --git a/cardano-node/src/Cardano/CLI/Parsers.hs b/cardano-node/src/Cardano/CLI/Parsers.hs index 2dc2dd0e307..4a411f89918 100644 --- a/cardano-node/src/Cardano/CLI/Parsers.hs +++ b/cardano-node/src/Cardano/CLI/Parsers.hs @@ -469,7 +469,6 @@ parseTxRelatedValues = <*> parseSigningKeysFiles "sig-key" "Path to signing key file, for genesis UTxO using by generator." - <*> parseNodeId "Node Id of target node" ] diff --git a/cardano-node/src/Cardano/CLI/Run.hs b/cardano-node/src/Cardano/CLI/Run.hs index 9d5ff52384c..66a3f9a3a85 100644 --- a/cardano-node/src/Cardano/CLI/Run.hs +++ b/cardano-node/src/Cardano/CLI/Run.hs @@ -49,7 +49,6 @@ import Cardano.Crypto (ProtocolMagicId, RequiresNetworkMagic(..)) import qualified Cardano.Crypto.Hashing as Crypto import qualified Cardano.Crypto.Signing as Crypto -import Ouroboros.Consensus.NodeId import qualified Ouroboros.Consensus.Protocol as Consensus import Cardano.CLI.Delegation @@ -188,7 +187,6 @@ data ClientCommand TPSRate (Maybe TxAdditionalSize) [SigningKeyFile] - NodeId deriving Show runCommand :: ClientCommand -> ExceptT CliError IO () runCommand (Genesis outDir params ptcl) = do @@ -303,7 +301,7 @@ runCommand (GenerateTxs delegCert genFile genHash - socketDir + socketFp ptcl targetNodeAddresses numOfTxs @@ -312,8 +310,7 @@ runCommand (GenerateTxs feePerTx tps txAdditionalSize - sigKeysFiles - _nodeId) = do + sigKeysFiles) = do -- Default update value let update = Update (ApplicationName "cardano-sl") 1 $ LastKnownBlockVersion 0 2 0 @@ -338,7 +335,7 @@ runCommand (GenerateTxs firstExceptT GenesisBenchmarkRunnerError $ genesisBenchmarkRunner loggingLayer - socketDir + socketFp protocol targetNodeAddresses numOfTxs diff --git a/configuration/mainnet-topology.json b/configuration/mainnet-topology.json index cd846c3fa33..31efdf2ff88 100644 --- a/configuration/mainnet-topology.json +++ b/configuration/mainnet-topology.json @@ -1,31 +1,24 @@ -[ - { - "nodeId":0, - "nodeAddress":{ - "addr":"127.0.0.1", - "port":7776 +{ + "Producers": [ + { + "addr": "3.125.75.199", + "port": 3001, + "valency": 1 }, - "producers":[ - { - "addr":"3.125.75.199", - "port":3001, - "valency":1 - }, - { - "addr":"18.177.103.105", - "port":3001, - "valency":1 - }, - { - "addr":"18.141.0.112", - "port":3001, - "valency":1 - }, - { - "addr":"52.14.58.121", - "port":3001, - "valency":1 - } - ] - } -] + { + "addr": "18.177.103.105", + "port": 3001, + "valency": 1 + }, + { + "addr": "18.141.0.112", + "port": 3001, + "valency": 1 + }, + { + "addr": "52.14.58.121", + "port": 3001, + "valency": 1 + } + ] + } diff --git a/configuration/realPBFT/simple-topology-real-pbft-node-0.json b/configuration/realPBFT/simple-topology-real-pbft-node-0.json new file mode 100644 index 00000000000..95902077560 --- /dev/null +++ b/configuration/realPBFT/simple-topology-real-pbft-node-0.json @@ -0,0 +1,15 @@ + + { + "Producers":[ + { + "addr":"127.0.0.1", + "port":3001, + "valency":1 + }, + { + "addr":"127.0.0.1", + "port":3002, + "valency":1 + } + ] + } diff --git a/configuration/realPBFT/simple-topology-real-pbft-node-1.json b/configuration/realPBFT/simple-topology-real-pbft-node-1.json new file mode 100644 index 00000000000..a64ebe10a66 --- /dev/null +++ b/configuration/realPBFT/simple-topology-real-pbft-node-1.json @@ -0,0 +1,14 @@ +{ + "Producers":[ + { + "addr":"127.0.0.1", + "port":3000, + "valency":1 + }, + { + "addr":"127.0.0.1", + "port":3002, + "valency":1 + } + ] +} diff --git a/configuration/realPBFT/simple-topology-real-pbft-node-2.json b/configuration/realPBFT/simple-topology-real-pbft-node-2.json new file mode 100644 index 00000000000..a762a3e8f19 --- /dev/null +++ b/configuration/realPBFT/simple-topology-real-pbft-node-2.json @@ -0,0 +1,14 @@ +{ + "Producers":[ + { + "addr":"127.0.0.1", + "port":3000, + "valency":1 + }, + { + "addr":"127.0.0.1", + "port":3001, + "valency":1 + } + ] +} diff --git a/scripts/chairman.sh b/scripts/chairman.sh index 86a7712b6de..69a14fc3e45 100755 --- a/scripts/chairman.sh +++ b/scripts/chairman.sh @@ -1,5 +1,9 @@ #!/usr/bin/env bash +[ $# -ne 1 ] && echo "Usage: $(basename $0) TargetSocketFilePath" 1>&2 && exit 1 + +SOCKET=$1 + set -e . $(dirname $0)/lib-node.sh @@ -12,5 +16,5 @@ ${CHAIRMAN} \ -t 1000 \ --genesis-file "${genesis_file}" \ --genesis-hash "${genesis_hash}" \ - --socket-dir "${root}/socket/" \ + --socket-path "${1}" \ --config "${configuration}/log-config-0.yaml" diff --git a/scripts/generator.sh b/scripts/generator.sh index da6e1cab6e3..ce7a88ba4aa 100755 --- a/scripts/generator.sh +++ b/scripts/generator.sh @@ -9,7 +9,7 @@ NETARGS=( --config "configuration/log-configuration.yaml" --genesis-file "${genesis_file}" --genesis-hash "${genesis_hash}" - --socket-dir "./socket/" + --socket-path "./socket/0" ) TX_GEN_ARGS=( diff --git a/scripts/lib-node.sh b/scripts/lib-node.sh index 2fc4aa20bdc..c03fbf40745 100644 --- a/scripts/lib-node.sh +++ b/scripts/lib-node.sh @@ -25,8 +25,8 @@ function dlgcert () { printf -- "--delegation-certificate ${genesis_root}/delegation-cert.%03d.json " "$1" } function commonargs() { - printf -- "--topology ${configuration}/simple-topology.json " - printf -- "--database-path ${root}/db/ " + printf -- "--topology ${configuration}/realPBFT/simple-topology-real-pbft-node-$1.json " + printf -- "--database-path ${root}/db/db-$1 " printf -- "--genesis-file ${genesis_file} " printf -- "--genesis-hash ${genesis_hash} " printf -- "--socket-path ${root}/socket/$1 " @@ -36,7 +36,7 @@ function nodeargs () { local id="$1" local flavor="$2" local extra="$3" - commonargs + commonargs $id nodecfg $id $flavor dlgkey $id dlgcert $id diff --git a/scripts/mainnet.sh b/scripts/mainnet.sh index c4453abbadc..20fa2710fcc 100755 --- a/scripts/mainnet.sh +++ b/scripts/mainnet.sh @@ -12,7 +12,7 @@ ARGS=( run --genesis-file "${configuration}/mainnet-genesis.json" --genesis-hash "5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb" --topology "${TOPOLOGY}" - --socket-dir "${root}/socket/mainnet-socket" + --socket-path "${root}/socket/mainnet-socket" --config "${configuration}/configuration-mainnet.yaml" --port 7776 ) diff --git a/scripts/shelley-testnet-live.sh b/scripts/shelley-testnet-live.sh index 948793db0e8..0e020dd6530 100755 --- a/scripts/shelley-testnet-live.sh +++ b/scripts/shelley-testnet-live.sh @@ -26,8 +26,8 @@ tmux select-pane -t 0 tmux split-window -v tmux select-pane -t 1 -tmux send-keys "cd '${PWD}'; ${NODE} $(nodeargs 0 '.liveview' "${ALGO} $(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${PWD}'; ${NODE} run $(nodeargs 0 '.liveview' "${ALGO} $(echo -n ${EXTRA})") " C-m tmux select-pane -t 2 -tmux send-keys "cd '${PWD}'; ${NODE} $(nodeargs 1 '.liveview' "${ALGO} $(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${PWD}'; ${NODE} run $(nodeargs 1 '.liveview' "${ALGO} $(echo -n ${EXTRA})") " C-m tmux select-pane -t 3 -tmux send-keys "cd '${PWD}'; ${NODE} $(nodeargs 2 '.liveview' "${ALGO} $(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${PWD}'; ${NODE} run $(nodeargs 2 '.liveview' "${ALGO} $(echo -n ${EXTRA})") " C-m diff --git a/scripts/shelley-testnet.sh b/scripts/shelley-testnet.sh index fa26ac69bed..2bde7db2425 100755 --- a/scripts/shelley-testnet.sh +++ b/scripts/shelley-testnet.sh @@ -35,8 +35,8 @@ tmux select-pane -t 0 tmux split-window -v tmux select-pane -t 1 -tmux send-keys "cd '${PWD}'; ${NODE} $(nodeargs 0 '' "${ALGO} $(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${PWD}'; ${NODE} run $(nodeargs 0 '' "${ALGO} $(echo -n ${EXTRA})") " C-m tmux select-pane -t 2 -tmux send-keys "cd '${PWD}'; ${NODE} $(nodeargs 1 '' "${ALGO} $(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${PWD}'; ${NODE} run $(nodeargs 1 '' "${ALGO} $(echo -n ${EXTRA})") " C-m tmux select-pane -t 3 -tmux send-keys "cd '${PWD}'; ${NODE} $(nodeargs 2 '' "${ALGO} $(echo -n ${EXTRA})") " C-m +tmux send-keys "cd '${PWD}'; ${NODE} run $(nodeargs 2 '' "${ALGO} $(echo -n ${EXTRA})") " C-m diff --git a/scripts/start-wallet.sh b/scripts/start-wallet.sh index f907e477fdd..c6fff47855e 100755 --- a/scripts/start-wallet.sh +++ b/scripts/start-wallet.sh @@ -11,7 +11,7 @@ genesis_file="${genesis_root}/genesis.json" ${WALLET} \ --config ${configuration}/log-config-0.yaml \ - --socket-dir ${root}/socket/ \ + --socket-path ./socket/wallet-socket \ --genesis-json ${genesis_file} \ --genesis-hash ${genesis_hash} \ $@ diff --git a/scripts/submit-tx.sh b/scripts/submit-tx.sh index 15f76861f0a..a0994b23c67 100755 --- a/scripts/submit-tx.sh +++ b/scripts/submit-tx.sh @@ -17,7 +17,6 @@ NOW=`date "+%Y-%m-%d 00:00:00"` NETARGS=( submit-tx --tx "$TX" - --node-id "0" --${ALGO} --genesis-file "${genesis_file}" --genesis-hash "${genesis_hash}" From 98cbd46fc1b2227b0d136722312bfb6287e067c6 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 3 Dec 2019 11:37:24 -0400 Subject: [PATCH 7/9] Update `SubmitTx` to only require a socket path and tx file --- cardano-node/src/Cardano/CLI/Parsers.hs | 3 +-- cardano-node/src/Cardano/CLI/Run.hs | 10 +++++----- cardano-node/src/Cardano/CLI/Tx.hs | 15 +++++++-------- cardano-node/src/Cardano/CLI/Tx/Generation.hs | 5 ++--- cardano-node/src/Cardano/CLI/Tx/Submission.hs | 9 +++++---- cardano-node/src/Cardano/Wallet/Client.hs | 4 +--- cardano-node/src/Cardano/Wallet/Run.hs | 2 +- scripts/submit-tx.sh | 2 -- 8 files changed, 22 insertions(+), 28 deletions(-) diff --git a/cardano-node/src/Cardano/CLI/Parsers.hs b/cardano-node/src/Cardano/CLI/Parsers.hs index 4a411f89918..df61c32b631 100644 --- a/cardano-node/src/Cardano/CLI/Parsers.hs +++ b/cardano-node/src/Cardano/CLI/Parsers.hs @@ -395,11 +395,10 @@ parseTxRelatedValues = "Submit a raw, signed transaction, in its on-wire representation." $ SubmitTx <$> parseTxFile "tx" - <*> parseTopologyInfo "Target node that will receive the transaction" <*> parseProtocol <*> (GenesisFile <$> parseGenesisPath) <*> parseGenesisHash - <*> parseSocketPath "Path to a cardano-node socket" + <*> parseSocketPath "Socket of target node" , command' "issue-genesis-utxo-expenditure" "Write a file with a signed transaction, spending genesis UTxO." diff --git a/cardano-node/src/Cardano/CLI/Run.hs b/cardano-node/src/Cardano/CLI/Run.hs index 66a3f9a3a85..5453a01668b 100644 --- a/cardano-node/src/Cardano/CLI/Run.hs +++ b/cardano-node/src/Cardano/CLI/Run.hs @@ -70,7 +70,7 @@ import Cardano.Config.Types ( CardanoEnvironment(..), DelegationCertFi , NodeConfiguration(..), SigningKeyFile(..) , SocketPath(..), Update(..) , parseNodeConfiguration) -import Cardano.Config.Topology (NodeAddress(..), TopologyInfo(..)) +import Cardano.Config.Topology (NodeAddress(..)) -- | Sub-commands of 'cardano-cli'. data ClientCommand @@ -137,11 +137,11 @@ data ClientCommand | SubmitTx TxFile -- ^ Filepath of transaction to submit. - TopologyInfo Protocol GenesisFile Text SocketPath + -- ^ Socket path of target node. | SpendGenesisUTxO Protocol GenesisFile @@ -238,21 +238,21 @@ runCommand (CheckDelegation magic cert issuerVF delegateVF) = do delegateVK <- readVerificationKey delegateVF liftIO $ checkByronGenesisDelegation cert magic issuerVK delegateVK -runCommand (SubmitTx fp topology ptcl genFile genHash socketDir) = do +runCommand (SubmitTx fp ptcl genFile genHash socketPath) = do -- Default update value let update = Update (ApplicationName "cardano-sl") 1 $ LastKnownBlockVersion 0 2 0 tx <- liftIO $ readByronTx fp firstExceptT NodeSubmitTxError $ nodeSubmitTx - topology genHash + Nothing genFile RequiresNoMagic Nothing Nothing Nothing - socketDir + socketPath update ptcl tx diff --git a/cardano-node/src/Cardano/CLI/Tx.hs b/cardano-node/src/Cardano/CLI/Tx.hs index ee4e4512b6d..a4083564fd8 100644 --- a/cardano-node/src/Cardano/CLI/Tx.hs +++ b/cardano-node/src/Cardano/CLI/Tx.hs @@ -60,7 +60,6 @@ import Cardano.CLI.Tx.Submission import Cardano.Config.Protocol import Cardano.Config.Types (DelegationCertFile, GenesisFile, SigningKeyFile, SocketPath, Update) -import Cardano.Config.Topology import Cardano.Common.Orphans () @@ -248,8 +247,10 @@ issueUTxOExpenditure -- | Submit a transaction to a node specified by topology info. nodeSubmitTx - :: TopologyInfo - -> Text + :: Text + -- ^ Genesis hash. + -> Maybe Int + -- ^ Number of core nodes. -> GenesisFile -> RequiresNetworkMagic -> Maybe Double @@ -261,14 +262,14 @@ nodeSubmitTx -> GenTx ByronBlock -> ExceptT RealPBFTError IO () nodeSubmitTx - topology gHash + _mNumCoreNodes genFile nMagic sigThresh delCertFp sKeyFp - socketFp + targetSocketFp update ptcl gentx = @@ -276,9 +277,8 @@ nodeSubmitTx \p@Consensus.ProtocolRealPBFT{} -> liftIO $ do -- TODO: Update submitGenTx to use `ExceptT` traceWith stdoutTracer ("TxId: " ++ condense (Consensus.txId gentx)) - submitTx socketFp + submitTx targetSocketFp (pInfoConfig (protocolInfo p)) - (node topology) gentx stdoutTracer @@ -294,4 +294,3 @@ fromCborTxAux lbs = toCborTxAux :: UTxO.ATxAux ByteString -> LB.ByteString toCborTxAux = LB.fromStrict . UTxO.aTaAnnotation -- The ByteString anotation is the CBOR encoded version. - diff --git a/cardano-node/src/Cardano/CLI/Tx/Generation.hs b/cardano-node/src/Cardano/CLI/Tx/Generation.hs index d8566f175ed..2da9c824953 100644 --- a/cardano-node/src/Cardano/CLI/Tx/Generation.hs +++ b/cardano-node/src/Cardano/CLI/Tx/Generation.hs @@ -89,7 +89,6 @@ import Ouroboros.Consensus.Ledger.Byron (ByronBlock (..), GenTx (..), ByronConsensusProtocol) import qualified Ouroboros.Consensus.Ledger.Byron as Byron -import Ouroboros.Consensus.NodeId (NodeId (..), CoreNodeId(..)) import Ouroboros.Consensus.Protocol.Abstract (NodeConfig) import Ouroboros.Consensus.Protocol.ExtConfig (extNodeConfig) @@ -413,7 +412,7 @@ prepareInitialFunds llTracer genesisAddress (NE.fromList [outForBig]) - submitTx socketFp pInfoConfig (CoreId (CoreNodeId 0)) genesisTx llTracer + submitTx socketFp pInfoConfig genesisTx llTracer -- Done, the first transaction 'initGenTx' is submitted, now 'sourceAddress' has a lot of money. let txIn = CC.UTxO.TxInUtxo (getTxIdFromGenTx genesisTx) 0 @@ -789,7 +788,7 @@ createMoreFundCoins llTracer [] -- Submit all splitting transactions sequentially. liftIO $ forM_ splittingTxs $ \(tx, _) -> - submitTx socketFp pInfoConfig (CoreId (CoreNodeId 0)) tx llTracer + submitTx socketFp pInfoConfig tx llTracer -- Re-create availableFunds with information about all splitting transactions -- (it will be used for main transactions). diff --git a/cardano-node/src/Cardano/CLI/Tx/Submission.hs b/cardano-node/src/Cardano/CLI/Tx/Submission.hs index eb836cbbbba..e60263aca0e 100644 --- a/cardano-node/src/Cardano/CLI/Tx/Submission.hs +++ b/cardano-node/src/Cardano/CLI/Tx/Submission.hs @@ -27,6 +27,8 @@ import Ouroboros.Consensus.Node.Run (RunNode) import qualified Ouroboros.Consensus.Node.Run as Node import Ouroboros.Consensus.NodeId (NodeId(..)) import Ouroboros.Consensus.Protocol (NodeConfig) +import qualified Ouroboros.Consensus.Protocol as Consensus +import Ouroboros.Consensus.Protocol hiding (Protocol) import Network.TypedProtocol.Driver (runPeer) import Network.TypedProtocol.Codec.Cbor (Codec, DeserialiseFailure) @@ -59,12 +61,11 @@ submitTx :: ( RunNode blk ) => SocketPath -> NodeConfig (BlockProtocol blk) - -> NodeId -> GenTx blk -> Tracer IO String -> IO () -submitTx socketFp protoInfoConfig _ tx tracer = do - socketPath <- localSocketAddrInfo socketFp +submitTx targetSocketFp protoInfoConfig tx tracer = do + targetSocketFp' <- localSocketAddrInfo targetSocketFp NodeToClient.connectTo NetworkConnectTracers { nctMuxTracer = nullTracer, @@ -72,7 +73,7 @@ submitTx socketFp protoInfoConfig _ tx tracer = do } (localInitiatorNetworkApplication tracer protoInfoConfig tx) Nothing - socketPath + targetSocketFp' localInitiatorNetworkApplication :: forall blk m peer. diff --git a/cardano-node/src/Cardano/Wallet/Client.hs b/cardano-node/src/Cardano/Wallet/Client.hs index 73e0c11ab43..124729decfe 100644 --- a/cardano-node/src/Cardano/Wallet/Client.hs +++ b/cardano-node/src/Cardano/Wallet/Client.hs @@ -30,7 +30,6 @@ import Ouroboros.Consensus.Block (BlockProtocol) import Ouroboros.Consensus.Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Node.Run -import Ouroboros.Consensus.NodeId import Ouroboros.Consensus.Protocol import Network.TypedProtocol.Codec @@ -58,10 +57,9 @@ runWalletClient :: forall blk. ) => Protocol blk -> SocketPath - -> CoreNodeId -> Tracer IO String -> IO () -runWalletClient ptcl sockFp (CoreNodeId _) tracer = do +runWalletClient ptcl sockFp tracer = do addr <- localSocketAddrInfo sockFp diff --git a/cardano-node/src/Cardano/Wallet/Run.hs b/cardano-node/src/Cardano/Wallet/Run.hs index fc64d99ec24..d07ff566fcb 100644 --- a/cardano-node/src/Cardano/Wallet/Run.hs +++ b/cardano-node/src/Cardano/Wallet/Run.hs @@ -49,7 +49,7 @@ runClient (WalletCLI config delegCertFile gHash gFile sKeyFile socketFp) tracer Left err -> (putTextLn $ renderError err) >> exitFailure Right (SomeProtocol p) -> pure $ SomeProtocol p - runWalletClient p socketFp coreNodeId tracer' + runWalletClient p socketFp tracer' renderError :: ProtocolInstantiationError -> Text renderError = pack . show diff --git a/scripts/submit-tx.sh b/scripts/submit-tx.sh index a0994b23c67..68aef455989 100755 --- a/scripts/submit-tx.sh +++ b/scripts/submit-tx.sh @@ -20,8 +20,6 @@ NETARGS=( --${ALGO} --genesis-file "${genesis_file}" --genesis-hash "${genesis_hash}" - --socket-dir "./socket/" - --topology "${configuration}/simple-topology.json" ) From 4f2a9865e7151151f495ddc3910f8bba29d0c352 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 27 Jan 2020 10:08:27 -0400 Subject: [PATCH 8/9] Update `setTopology` --- cardano-node/src/Cardano/Node/Run.hs | 3 +-- cardano-node/src/Cardano/Node/TUI/LiveView.hs | 23 ++++++++++++------- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index bb2ea22b10c..b34ea17f31b 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -132,8 +132,7 @@ runNode loggingLayer npm = do be :: LiveViewBackend blk Text <- realize c let lvbe = MkBackend { bEffectuate = effectuate be, bUnrealize = unrealize be } llAddBackend loggingLayer lvbe (UserDefinedBK "LiveViewBackend") - let nId = fromMaybe (panic "LiveView not possible for real protocols as yet") (ncNodeId nc) - setTopology be nId + setTopology be npm captureCounters be trace -- User will see a terminal graphics and will be able to interact with it. diff --git a/cardano-node/src/Cardano/Node/TUI/LiveView.hs b/cardano-node/src/Cardano/Node/TUI/LiveView.hs index 3b9b7002200..e1057e6c19c 100644 --- a/cardano-node/src/Cardano/Node/TUI/LiveView.hs +++ b/cardano-node/src/Cardano/Node/TUI/LiveView.hs @@ -76,6 +76,8 @@ import Cardano.BM.Data.Severity import Cardano.BM.Data.SubTrace import Cardano.BM.Trace +import Cardano.Config.Topology +import Cardano.Config.Types import Cardano.Node.TUI.GitRev (gitRev) import Cardano.Slotting.Slot (unSlotNo) import qualified Ouroboros.Network.AnchoredFragment as Net @@ -542,14 +544,19 @@ initLiveViewState = do , lvsColorTheme = DarkTheme } -setTopology :: NFData a => LiveViewBackend blk a -> NodeId -> IO () -setTopology lvbe nodeid = - modifyMVar_ (getbe lvbe) $ \lvs -> - return $ lvs { lvsNodeId = namenum } - where - namenum = case nodeid of - CoreId num -> "C" <> pack (show num) - RelayId num -> "R" <> pack (show num) +setTopology :: NFData a => LiveViewBackend blk a -> NodeProtocolMode -> IO () +setTopology lvbe (RealProtocolMode (NodeCLI _ _ nAddress _ _)) = + modifyMVar_ (getbe lvbe) $ \lvs -> + return $ lvs { lvsNodeId = pack $ "Port: " <> (show $ naPort nAddress) } +setTopology lvbe (MockProtocolMode (NodeMockCLI _ _ _ cfgYaml _)) = do + nc <- parseNodeConfiguration $ unConfigPath cfgYaml + modifyMVar_ (getbe lvbe) $ \lvs -> + return $ lvs { lvsNodeId = namenum (ncNodeId nc) } + where + namenum (Just (CoreId num)) = "C" <> pack (show num) + namenum (Just (RelayId num)) = "R" <> pack (show num) + namenum Nothing = panic $ "Cardano.Node.TUI.LiveView.namenum: " + <> "Mock protocols require a NodeId value in the configuration .yaml file" setNodeThread :: NFData a => LiveViewBackend blk a -> Async.Async () -> IO () setNodeThread lvbe nodeThr = From caf342fb22441eead2bd9240b4ee30e0ac2a352d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 22 Jan 2020 15:39:02 -0400 Subject: [PATCH 9/9] Update iohk-nix Update `nix/cardano-node-service.nix` Update `nix/scripts.nix` Update `nix/svclib.nix` --- cardano-node/src/Cardano/CLI/Tx/Submission.hs | 3 --- cardano-node/src/Cardano/Node/Run.hs | 4 ++-- nix/nixos/cardano-node-service.nix | 6 +++--- nix/scripts.nix | 2 +- nix/sources.json | 8 ++++---- nix/svclib.nix | 15 +++++---------- 6 files changed, 15 insertions(+), 23 deletions(-) diff --git a/cardano-node/src/Cardano/CLI/Tx/Submission.hs b/cardano-node/src/Cardano/CLI/Tx/Submission.hs index e60263aca0e..2af84945987 100644 --- a/cardano-node/src/Cardano/CLI/Tx/Submission.hs +++ b/cardano-node/src/Cardano/CLI/Tx/Submission.hs @@ -25,10 +25,7 @@ import Ouroboros.Consensus.Block (BlockProtocol) import Ouroboros.Consensus.Mempool (ApplyTxErr, GenTx) import Ouroboros.Consensus.Node.Run (RunNode) import qualified Ouroboros.Consensus.Node.Run as Node -import Ouroboros.Consensus.NodeId (NodeId(..)) import Ouroboros.Consensus.Protocol (NodeConfig) -import qualified Ouroboros.Consensus.Protocol as Consensus -import Ouroboros.Consensus.Protocol hiding (Protocol) import Network.TypedProtocol.Driver (runPeer) import Network.TypedProtocol.Codec.Cbor (Codec, DeserialiseFailure) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index b34ea17f31b..39f89927d6e 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -193,7 +193,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do , "**************************************" ] - -- Socket directory + -- Socket path myLocalAddr <- localSocketAddrInfo $ socketFile rMscFp addrs <- nodeAddressInfo rNodeAddr @@ -297,7 +297,7 @@ handleSimpleNode p trace nodeTracers npm onKernel = do , "**************************************" ] - -- Socket directory + -- Socket path myLocalAddr <- localSocketAddrInfo $ socketFile mMscFp addrs <- nodeAddressInfo mockNodeAddress diff --git a/nix/nixos/cardano-node-service.nix b/nix/nixos/cardano-node-service.nix index cc76a4afb6a..b455cf9b8a3 100644 --- a/nix/nixos/cardano-node-service.nix +++ b/nix/nixos/cardano-node-service.nix @@ -10,7 +10,7 @@ let inherit (commonLib) svcLib; envConfig = cfg.environments.${cfg.environment}; systemdServiceName = "cardano-node${optionalString cfg.instanced "@"}"; mkScript = cfg: - let exec = "cardano-node"; + let exec = "cardano-node run"; cmd = builtins.filter (x: x != "") [ "${cfg.package}/bin/${exec}" "--genesis-file ${cfg.genesisFile}" @@ -183,8 +183,8 @@ in { topology = mkOption { type = types.path; - default = commonLib.mkEdgeTopology { - inherit (cfg) nodeId port; + default = localLib.mkEdgeTopology { + inherit (cfg) port; inherit (envConfig) edgeNodes; }; description = '' diff --git a/nix/scripts.nix b/nix/scripts.nix index 107da481433..0c5f0cf6e9b 100644 --- a/nix/scripts.nix +++ b/nix/scripts.nix @@ -42,7 +42,7 @@ let edgeHost = if config.useProxy then config.proxyHost else config.edgeHost; edgeNodes = if config.useProxy then [] else config.edgeNodes; in config.topologyFile or commonLib.mkEdgeTopology { - inherit (config) hostAddr port nodeId; + inherit (config) hostAddr port; inherit edgeNodes edgeHost edgePort; }; serviceConfig = { diff --git a/nix/sources.json b/nix/sources.json index ccfc46dceae..92aaee53210 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -60,15 +60,15 @@ "url_template": "https://github.com///archive/.tar.gz" }, "iohk-nix": { - "branch": "haskell-overhaul", + "branch": "master", "description": "nix scripts shared across projects", "homepage": null, "owner": "input-output-hk", "repo": "iohk-nix", - "rev": "df6b4c782594aed5956b59e12de342a026170b8a", - "sha256": "0v53b8pksi99rjj5xdvv5v8dbryy2y7l7bbvzy64qq03v648kdhf", + "rev": "40fc58f0f1cb0f9de24d8df3144a8cd8f2e3a775", + "sha256": "1h3d1gmjfxbwrdszj1ciqlbn646fy687w940fs4gx2bc12j39acb", "type": "tarball", - "url": "https://github.com/input-output-hk/iohk-nix/archive/df6b4c782594aed5956b59e12de342a026170b8a.tar.gz", + "url": "https://github.com/input-output-hk/iohk-nix/archive/40fc58f0f1cb0f9de24d8df3144a8cd8f2e3a775.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "niv": { diff --git a/nix/svclib.nix b/nix/svclib.nix index ac55b5075ca..642169320e2 100644 --- a/nix/svclib.nix +++ b/nix/svclib.nix @@ -26,10 +26,8 @@ let addr = host-addr; ports = map (x: port-base + x) (range 0 (node-count - 1)); mkPeer = port: { inherit addr port valency; }; - mkNodeTopo = nodeId: port: { - inherit nodeId; - nodeAddress = { inherit addr port; }; - producers = map mkPeer (remove port ports); + mkNodeTopo = port : { + Producers = map mkPeer (remove port ports); }; in toFile "topology.json" (toJSON (imap0 mkNodeTopo ports)); @@ -68,13 +66,10 @@ let ## we choose not to spread ports for this topology shelley-ids = range node-id-base (node-id-base + node-count - 1); mkPeer = id: { inherit valency; port = port-base + id; addr = addr-fn id; }; - mkShelleyNode = id: { - nodeId = id; - nodeAddress = { port = port-base + id; addr = addr-fn id; }; - producers = map (mkPeer) (remove id shelley-ids) ++ - [ { inherit valency; port = proxy-port; addr = proxy-addr; } ]; + mkShelleyNode = { + Producers = map (mkPeer) (remove id shelley-ids); }; - topology = map mkShelleyNode shelley-ids; + topology = mkShelleyNode; in toFile "topology.yaml" (toJSON topology); # Note how some values are literal strings, and some integral.