From f6d52f82bc6e7edd48e89d55971f434aafbbf485 Mon Sep 17 00:00:00 2001
From: Thomas Winant <thomas@well-typed.com>
Date: Thu, 12 Nov 2020 12:42:45 +0100
Subject: [PATCH] Adapt to the reorganised Node.run arguments in consensus

In https://github.com/input-output-hk/ouroboros-network/pull/2720 we reorganised
the arguments to `Node.run` so that the consensus ThreadNet tests can use the
same `Node.run` function as the real node while using a custom network layer.

In this commit we propagate that change.

For people that want to override some arguments that now seem to have
disappeared: they have been moved to the `LowLevelRunNodeArgs` record in
consensus. See the `stdLowLevelRunNodeArgsIO` and `Node.runWith` functions for
constructing and running with custom `LowLevelRunNodeArgs`.
---
 cabal.project                        |  4 +-
 cardano-node/src/Cardano/Node/Run.hs | 80 ++++++++--------------------
 2 files changed, 25 insertions(+), 59 deletions(-)

diff --git a/cabal.project b/cabal.project
index b18220a17db..7de211cc437 100644
--- a/cabal.project
+++ b/cabal.project
@@ -159,8 +159,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: da2130c6b19d38cb9ec519ed4fb2d644b35e55cb
-  --sha256: 1jkic85qzp7lh2lab3iw6g1h71qar1ahvx0kinmh8hwjdrmyg6fl
+  tag: e8c011cd9f1c6c04d6a8ca27791fa9f5440b0bf4
+  --sha256: 1j3z7ybcxf74slg79wpjyj1yyd1v2xzqw11xnp874x8mka2kavbf
   subdir:
     io-sim
     io-sim-classes
diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
index c7b9f6d0607..6cad3d7136d 100644
--- a/cardano-node/src/Cardano/Node/Run.hs
+++ b/cardano-node/src/Cardano/Node/Run.hs
@@ -56,23 +56,16 @@ import           Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
 import           Ouroboros.Consensus.Block (BlockProtocol)
 import qualified Ouroboros.Consensus.Cardano as Consensus
 import qualified Ouroboros.Consensus.Config as Consensus
-import           Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
-import           Ouroboros.Consensus.Fragment.InFuture (defaultClockSkew)
+import           Ouroboros.Consensus.Config.SupportsNode (getNetworkMagic)
 import           Ouroboros.Consensus.Node (DiffusionArguments (..), DiffusionTracers (..),
-                     DnsSubscriptionTarget (..), IPSubscriptionTarget (..), NodeArgs (..), RunNode,
-                     RunNodeArgs (..))
+                     DnsSubscriptionTarget (..), IPSubscriptionTarget (..), RunNode,
+                     RunNodeArgs (..), StdRunNodeArgs (..))
 import qualified Ouroboros.Consensus.Node as Node (getChainDB, run)
-import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Util.Orphans ()
-import           Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..))
 import           Ouroboros.Network.Magic (NetworkMagic (..))
 import           Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), DiffusionMode)
 
-import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
-import           Ouroboros.Consensus.Storage.ImmutableDB (ValidationPolicy (..))
-import           Ouroboros.Consensus.Storage.VolatileDB (BlockValidationPolicy (..))
-
 import           Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..),
                      gatherConfiguredSockets, getSocketOrSocketInfoAddr)
 import           Cardano.Node.Configuration.Topology
@@ -194,7 +187,7 @@ handleSimpleNode
   -> IO ()
 handleSimpleNode p trace nodeTracers nc onKernel = do
 
-  let pInfo@ProtocolInfo{ pInfoConfig = cfg } = Consensus.protocolInfo p
+  let pInfo = Consensus.protocolInfo p
       tracer = toLogObject trace
 
   createTracers nc trace tracer
@@ -249,53 +242,26 @@ handleSimpleNode p trace nodeTracers nc onKernel = do
 
   withShutdownHandling nc trace $ \sfds ->
    Node.run
-     RunNodeArgs {
-       rnTraceConsensus       = consensusTracers nodeTracers,
-       rnTraceNTN             = nodeToNodeTracers nodeTracers,
-       rnTraceNTC             = nodeToClientTracers nodeTracers,
-       rnTraceDB              = chainDBTracer nodeTracers,
-       rnTraceDiffusion       = diffusionTracers,
-       rnDiffusionArguments   = diffusionArguments,
-       rnNetworkMagic         = getNetworkMagic (Consensus.configBlock cfg),
-       rnDatabasePath         = dbPath,
-       rnProtocolInfo         = pInfo,
-       rnCustomiseChainDbArgs = customiseChainDbArgs $ ncValidateDB nc,
-       rnCustomiseNodeArgs    = customiseNodeArgs (ncMaxConcurrencyBulkSync nc)
-                                  (ncMaxConcurrencyDeadline nc),
-       rnNodeToNodeVersions   = supportedNodeToNodeVersions (Proxy @blk),
-       rnNodeToClientVersions = supportedNodeToClientVersions (Proxy @blk),
-       rnNodeKernelHook       = \registry nodeKernel -> do
-         maybeSpawnOnSlotSyncedShutdownHandler nc sfds trace registry
-           (Node.getChainDB nodeKernel)
-         onKernel nodeKernel,
-       rnMaxClockSkew         = defaultClockSkew
-    }
+     RunNodeArgs
+       { rnTraceConsensus = consensusTracers nodeTracers
+       , rnTraceNTN       = nodeToNodeTracers nodeTracers
+       , rnTraceNTC       = nodeToClientTracers nodeTracers
+       , rnProtocolInfo   = pInfo
+       , rnNodeKernelHook = \registry nodeKernel -> do
+           maybeSpawnOnSlotSyncedShutdownHandler nc sfds trace registry
+             (Node.getChainDB nodeKernel)
+           onKernel nodeKernel
+       }
+     StdRunNodeArgs
+       { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc
+       , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
+       , srcChainDbValidateOverride   = ncValidateDB nc
+       , srnDatabasePath              = dbPath
+       , srnDiffusionArguments        = diffusionArguments
+       , srnDiffusionTracers          = diffusionTracers
+       , srnTraceChainDB              = chainDBTracer nodeTracers
+       }
  where
-  customiseNodeArgs :: Maybe MaxConcurrencyBulkSync
-                    -> Maybe MaxConcurrencyDeadline
-                    -> NodeArgs IO RemoteConnectionId LocalConnectionId blk
-                    -> NodeArgs IO RemoteConnectionId LocalConnectionId blk
-  customiseNodeArgs bulk_m deadline_m args@NodeArgs{ blockFetchConfiguration } = args {
-      blockFetchConfiguration = blockFetchConfiguration {
-          bfcMaxConcurrencyBulkSync = maybe (bfcMaxConcurrencyBulkSync blockFetchConfiguration)
-            unMaxConcurrencyBulkSync bulk_m
-        , bfcMaxConcurrencyDeadline = maybe (bfcMaxConcurrencyDeadline blockFetchConfiguration)
-            unMaxConcurrencyDeadline deadline_m
-        }
-      }
-
-  customiseChainDbArgs :: Bool
-                       -> ChainDB.ChainDbArgs Identity IO blk
-                       -> ChainDB.ChainDbArgs Identity IO blk
-  customiseChainDbArgs runValid args
-    | runValid
-    = args
-      { ChainDB.cdbImmutableDbValidation = ValidateAllChunks
-      , ChainDB.cdbVolatileDbValidation = ValidateAll
-      }
-    | otherwise
-    = args
-
   createDiffusionTracers :: Tracers RemoteConnectionId LocalConnectionId blk
                          -> DiffusionTracers
   createDiffusionTracers nodeTracers' = DiffusionTracers