consensus: rename NodeArgs to NodeKernelArgs

IntersectMBO · Nov 10, 2020 · 5ce77c8 · 5ce77c8
1 parent 7daaf62
commit 5ce77c8
Show file tree

Hide file tree

Showing 5 changed files with 81 additions and 68 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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)
@@ -167,8 +167,9 @@ data LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk = L
         -> 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
@@ -287,23 +288,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
 
@@ -319,28 +321,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
@@ -475,7 +477,7 @@ mkChainDbArgsIdentity
   where
     k = configSecurityParam cfg
 
-mkNodeArgs
+mkNodeKernelArgs
   :: forall m addrNTN addrNTC blk. (RunNode blk, IOLike m)
   => ResourceRegistry m
   -> Int
@@ -485,10 +487,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
@@ -513,14 +524,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.
@@ -535,6 +546,8 @@ nodeArgsEnforceInvariants nodeArgs@NodeArgs{..} = nodeArgs
                 (blockFetchPipeliningMax miniProtocolParameters)
         }
     }
+  where
+    NodeKernelArgs{..} = nodeKernelArgs
 
 {-------------------------------------------------------------------------------
   Arguments for use in the real node
@@ -634,7 +647,7 @@ stdLowLevelRunNodeArgsIO StdRunNodeArgs{..} = do
       , rnChainDbArgsDefaults                 =
           updateDbDefaults $ ChainDB.defaultArgs mkHasFS
       , rnCustomiseChainDbArgs                = id
-      , rnCustomiseNodeArgs
+      , rnCustomiseNodeKernelArgs
       , rnRunDataDiffusion                    =
           \_reg apps ->
             stdRunDataDiffusion srnDiffusionTracers srnDiffusionArguments apps
@@ -661,10 +674,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})
@@ -679,12 +692,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
@@ -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)