Skip to content

Commit

Permalink
consensus: rename NodeArgs to NodeKernelArgs
Browse files Browse the repository at this point in the history
  • Loading branch information
nfrisby committed Nov 10, 2020
1 parent e1ff991 commit 2d2e158
Show file tree
Hide file tree
Showing 5 changed files with 81 additions and 68 deletions.
6 changes: 3 additions & 3 deletions ouroboros-consensus-test/src/Test/ThreadNet/Network.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -994,7 +994,7 @@ runThreadNetwork systemTime ThreadNetworkArgs
}
}

nodeKernel <- initNodeKernel nodeArgs
nodeKernel <- initNodeKernel nodeKernelArgs
let mempool = getMempool nodeKernel
let app = NTN.mkApps
nodeKernel
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
107 changes: 60 additions & 47 deletions ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ module Ouroboros.Consensus.Node
, LastShutDownWasClean (..)
, ChainDbArgs (..)
, HardForkBlockchainTimeArgs (..)
, NodeArgs (..)
, NodeKernelArgs (..)
, NodeKernel (..)
, MaxTxCapacityOverride (..)
, MempoolCapacityBytesOverride (..)
Expand All @@ -46,8 +46,8 @@ module Ouroboros.Consensus.Node
-- * Internal helpers
, openChainDB
, mkChainDbArgsIdentity
, mkNodeArgs
, nodeArgsEnforceInvariants
, mkNodeKernelArgs
, nodeKernelArgsEnforceInvariants
) where

import Codec.Serialise (DeserialiseFailure)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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.
Expand All @@ -526,6 +537,8 @@ nodeArgsEnforceInvariants nodeArgs@NodeArgs{..} = nodeArgs
(blockFetchPipeliningMax miniProtocolParameters)
}
}
where
NodeKernelArgs{..} = nodeKernelArgs

{-------------------------------------------------------------------------------
Arguments for use in the real node
Expand Down Expand Up @@ -625,7 +638,7 @@ stdLowLevelRunNodeArgsIO StdRunNodeArgs{..} = do
, rnChainDbArgsDefaults =
updateDbDefaults $ ChainDB.defaultArgs mkHasFS
, rnCustomiseChainDbArgs = id
, rnCustomiseNodeArgs
, rnCustomiseNodeKernelArgs
, rnRunDataDiffusion =
\_reg apps ->
stdRunDataDiffusion srnDiffusionTracers srnDiffusionArguments apps
Expand All @@ -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})
Expand All @@ -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
20 changes: 10 additions & 10 deletions ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ module Ouroboros.Consensus.NodeKernel (
NodeKernel (..)
, MaxTxCapacityOverride (..)
, MempoolCapacityBytesOverride (..)
, NodeArgs (..)
, NodeKernelArgs (..)
, TraceForgeEvent (..)
, initNodeKernel
, getMempoolReader
Expand Down Expand Up @@ -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
Expand All @@ -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)

Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit 2d2e158

Please sign in to comment.