From 2d2e1580d1d87256387360de9eb905b2a0bba60d Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Tue, 10 Nov 2020 09:46:03 -0800 Subject: [PATCH] consensus: rename NodeArgs to NodeKernelArgs --- .../src/Test/ThreadNet/Network.hs | 6 +- .../Consensus/Network/NodeToClient.hs | 8 +- .../Ouroboros/Consensus/Network/NodeToNode.hs | 8 +- .../src/Ouroboros/Consensus/Node.hs | 107 ++++++++++-------- .../src/Ouroboros/Consensus/NodeKernel.hs | 20 ++-- 5 files changed, 81 insertions(+), 68 deletions(-) diff --git a/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs b/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs index fd8be906caa..1fa72f03c24 100644 --- a/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs +++ b/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs @@ -965,7 +965,7 @@ runThreadNetwork systemTime ThreadNetworkArgs let kaRng = case seed of Seed s -> mkStdGen s - let nodeArgs = NodeArgs + let nodeKernelArgs = NodeKernelArgs { tracers , registry , cfg = pInfoConfig @@ -994,7 +994,7 @@ runThreadNetwork systemTime ThreadNetworkArgs } } - nodeKernel <- initNodeKernel nodeArgs + nodeKernel <- initNodeKernel nodeKernelArgs let mempool = getMempool nodeKernel let app = NTN.mkApps nodeKernel @@ -1007,7 +1007,7 @@ runThreadNetwork systemTime ThreadNetworkArgs { canAwaitTimeout = waitForever , mustReplyTimeout = waitForever }) - (NTN.mkHandlers nodeArgs nodeKernel) + (NTN.mkHandlers nodeKernelArgs nodeKernel) -- In practice, a robust wallet/user can persistently add a transaction -- until it appears on the chain. This thread adds robustness for the diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToClient.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToClient.hs index dd1e98207cd..6fe96171d2a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToClient.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToClient.hs @@ -99,10 +99,10 @@ data Handlers m peer blk = Handlers { mkHandlers :: forall m blk remotePeer localPeer. (IOLike m, LedgerSupportsMempool blk, QueryLedger blk) - => NodeArgs m remotePeer localPeer blk - -> NodeKernel m remotePeer localPeer blk - -> Handlers m localPeer blk -mkHandlers NodeArgs {cfg, tracers} NodeKernel {getChainDB, getMempool} = + => NodeKernelArgs m remotePeer localPeer blk + -> NodeKernel m remotePeer localPeer blk + -> Handlers m localPeer blk +mkHandlers NodeKernelArgs {cfg, tracers} NodeKernel {getChainDB, getMempool} = Handlers { hChainSyncServer = chainSyncBlocksServer diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs index fbfdebb9fa6..6675ac26e2c 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs @@ -158,11 +158,11 @@ mkHandlers , LedgerSupportsProtocol blk , Ord remotePeer ) - => NodeArgs m remotePeer localPeer blk - -> NodeKernel m remotePeer localPeer blk - -> Handlers m remotePeer blk + => NodeKernelArgs m remotePeer localPeer blk + -> NodeKernel m remotePeer localPeer blk + -> Handlers m remotePeer blk mkHandlers - NodeArgs {keepAliveRng, miniProtocolParameters} + NodeKernelArgs {keepAliveRng, miniProtocolParameters} NodeKernel {getChainDB, getMempool, getTopLevelConfig, getTracers = tracers} = Handlers { hChainSyncClient = diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs index 05b4e925f4d..cead543123a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs @@ -35,7 +35,7 @@ module Ouroboros.Consensus.Node , LastShutDownWasClean (..) , ChainDbArgs (..) , HardForkBlockchainTimeArgs (..) - , NodeArgs (..) + , NodeKernelArgs (..) , NodeKernel (..) , MaxTxCapacityOverride (..) , MempoolCapacityBytesOverride (..) @@ -46,8 +46,8 @@ module Ouroboros.Consensus.Node -- * Internal helpers , openChainDB , mkChainDbArgsIdentity - , mkNodeArgs - , nodeArgsEnforceInvariants + , mkNodeKernelArgs + , nodeKernelArgsEnforceInvariants ) where import Codec.Serialise (DeserialiseFailure) @@ -165,8 +165,9 @@ data LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk = L , rnCustomiseChainDbArgs :: ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk -- | Customise the 'NodeArgs' - , rnCustomiseNodeArgs :: NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk - -> NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + , rnCustomiseNodeKernelArgs :: + NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk -- | Ie 'bfcSalt' , rnBfcSalt :: Int @@ -284,23 +285,24 @@ runWith RunNodeArgs{..} LowLevelRunNodeArgs{..} = (blockchainTimeTracer rnTraceConsensus) } - nodeArgs <- nodeArgsEnforceInvariants . rnCustomiseNodeArgs <$> - mkNodeArgs - registry - rnBfcSalt - rnKeepAliveRng - cfg - blockForging - rnTraceConsensus - btime - chainDB - nodeKernel <- initNodeKernel nodeArgs + nodeKernelArgs <- + fmap (nodeKernelArgsEnforceInvariants . rnCustomiseNodeKernelArgs) $ + mkNodeKernelArgs + registry + rnBfcSalt + rnKeepAliveRng + cfg + blockForging + rnTraceConsensus + btime + chainDB + nodeKernel <- initNodeKernel nodeKernelArgs rnNodeKernelHook registry nodeKernel - let ntnApps = mkNodeToNodeApps nodeArgs nodeKernel - ntcApps = mkNodeToClientApps nodeArgs nodeKernel + let ntnApps = mkNodeToNodeApps nodeKernelArgs nodeKernel + ntcApps = mkNodeToClientApps nodeKernelArgs nodeKernel diffusionApplications = mkDiffusionApplications - (miniProtocolParameters nodeArgs) + (miniProtocolParameters nodeKernelArgs) ntnApps ntcApps @@ -316,28 +318,28 @@ runWith RunNodeArgs{..} LowLevelRunNodeArgs{..} = codecConfig = configCodec cfg mkNodeToNodeApps - :: NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk - -> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + -> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk -> BlockNodeToNodeVersion blk -> NTN.Apps m (ConnectionId addrNTN) ByteString ByteString ByteString ByteString () - mkNodeToNodeApps nodeArgs nodeKernel version = + mkNodeToNodeApps nodeKernelArgs nodeKernel version = NTN.mkApps nodeKernel rnTraceNTN (NTN.defaultCodecs codecConfig version) rnChainSyncTimeout - (NTN.mkHandlers nodeArgs nodeKernel) + (NTN.mkHandlers nodeKernelArgs nodeKernel) mkNodeToClientApps - :: NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk - -> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + -> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk -> BlockNodeToClientVersion blk -> NTC.Apps m (ConnectionId addrNTC) ByteString ByteString ByteString () - mkNodeToClientApps nodeArgs nodeKernel version = + mkNodeToClientApps nodeKernelArgs nodeKernel version = NTC.mkApps rnTraceNTC (NTC.defaultCodecs codecConfig version) - (NTC.mkHandlers nodeArgs nodeKernel) + (NTC.mkHandlers nodeKernelArgs nodeKernel) mkDiffusionApplications :: MiniProtocolParameters @@ -466,7 +468,7 @@ mkChainDbArgsIdentity registry inFuture cfg initLedger where k = configSecurityParam cfg -mkNodeArgs +mkNodeKernelArgs :: forall m addrNTN addrNTC blk. (RunNode blk, IOLike m) => ResourceRegistry m -> Int @@ -476,10 +478,19 @@ mkNodeArgs -> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk -> BlockchainTime m -> ChainDB m blk - -> m (NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk) -mkNodeArgs registry bfcSalt keepAliveRng cfg initBlockForging tracers btime chainDB = do + -> m (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk) +mkNodeKernelArgs + registry + bfcSalt + keepAliveRng + cfg + initBlockForging + tracers + btime + chainDB + = do blockForging <- sequence initBlockForging - return NodeArgs + return NodeKernelArgs { tracers , registry , cfg @@ -504,14 +515,14 @@ mkNodeArgs registry bfcSalt keepAliveRng cfg initBlockForging tracers btime chai , bfcSalt } --- | We allow the user running the node to customise the 'NodeArgs' through --- 'rnCustomiseNodeArgs', but there are some limits to some values. This --- function makes sure we don't exceed those limits and that the values are --- consistent. -nodeArgsEnforceInvariants - :: NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk - -> NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk -nodeArgsEnforceInvariants nodeArgs@NodeArgs{..} = nodeArgs +-- | We allow the user running the node to customise the 'NodeKernelArgs' +-- through 'rnCustomiseNodeKernelArgs', but there are some limits to some +-- values. This function makes sure we don't exceed those limits and that the +-- values are consistent. +nodeKernelArgsEnforceInvariants + :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk +nodeKernelArgsEnforceInvariants nodeKernelArgs = nodeKernelArgs { miniProtocolParameters = miniProtocolParameters -- If 'blockFetchPipeliningMax' exceeds the configured default, it -- would be a protocol violation. @@ -526,6 +537,8 @@ nodeArgsEnforceInvariants nodeArgs@NodeArgs{..} = nodeArgs (blockFetchPipeliningMax miniProtocolParameters) } } + where + NodeKernelArgs{..} = nodeKernelArgs {------------------------------------------------------------------------------- Arguments for use in the real node @@ -625,7 +638,7 @@ stdLowLevelRunNodeArgsIO StdRunNodeArgs{..} = do , rnChainDbArgsDefaults = updateDbDefaults $ ChainDB.defaultArgs mkHasFS , rnCustomiseChainDbArgs = id - , rnCustomiseNodeArgs + , rnCustomiseNodeKernelArgs , rnRunDataDiffusion = \_reg apps -> stdRunDataDiffusion srnDiffusionTracers srnDiffusionArguments apps @@ -652,10 +665,10 @@ stdLowLevelRunNodeArgsIO StdRunNodeArgs{..} = do , ChainDB.cdbVolatileDbValidation = ValidateAll }) - rnCustomiseNodeArgs :: - NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk - -> NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk - rnCustomiseNodeArgs = + rnCustomiseNodeKernelArgs :: + NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + rnCustomiseNodeKernelArgs = overBFC $ maybe id (\y x -> x {bfcMaxConcurrencyDeadline = y}) @@ -670,12 +683,12 @@ stdLowLevelRunNodeArgsIO StdRunNodeArgs{..} = do overBFC :: (BlockFetchConfiguration -> BlockFetchConfiguration) - -> NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk - -> NodeArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk + -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk overBFC f args = args { blockFetchConfiguration = f blockFetchConfiguration } where - NodeArgs + NodeKernelArgs { blockFetchConfiguration } = args diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs index 85c601540d2..808cddc43f9 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs @@ -15,7 +15,7 @@ module Ouroboros.Consensus.NodeKernel ( NodeKernel (..) , MaxTxCapacityOverride (..) , MempoolCapacityBytesOverride (..) - , NodeArgs (..) + , NodeKernelArgs (..) , TraceForgeEvent (..) , initNodeKernel , getMempoolReader @@ -114,7 +114,7 @@ data MaxTxCapacityOverride -- of a block. -- | Arguments required when initializing a node -data NodeArgs m remotePeer localPeer blk = NodeArgs { +data NodeKernelArgs m remotePeer localPeer blk = NodeKernelArgs { tracers :: Tracers m remotePeer localPeer blk , registry :: ResourceRegistry m , cfg :: TopLevelConfig blk @@ -138,11 +138,11 @@ initNodeKernel , Ord remotePeer , Hashable remotePeer ) - => NodeArgs m remotePeer localPeer blk + => NodeKernelArgs m remotePeer localPeer blk -> m (NodeKernel m remotePeer localPeer blk) -initNodeKernel args@NodeArgs { registry, cfg, tracers, maxTxCapacityOverride - , blockForging, chainDB, initChainDB - , blockFetchConfiguration } = do +initNodeKernel args@NodeKernelArgs { registry, cfg, tracers, maxTxCapacityOverride + , blockForging, chainDB, initChainDB + , blockFetchConfiguration } = do initChainDB (configStorage cfg) (InitChainDB.fromFull chainDB) @@ -196,11 +196,11 @@ initInternalState , NoThunks remotePeer , RunNode blk ) - => NodeArgs m remotePeer localPeer blk + => NodeKernelArgs m remotePeer localPeer blk -> m (InternalState m remotePeer localPeer blk) -initInternalState NodeArgs { tracers, chainDB, registry, cfg, - blockFetchSize, btime, - mempoolCapacityOverride } = do +initInternalState NodeKernelArgs { tracers, chainDB, registry, cfg, + blockFetchSize, btime, + mempoolCapacityOverride } = do varCandidates <- newTVarIO mempty mempool <- openMempool registry (chainDBLedgerInterface chainDB)