Merge #1927

1927: Remove redundant arg from Ouroboros.Consensus.Node.run r=dcoutts a=dcoutts

The IsProducer argument to run node is completely redundant and just makes more work for the node top level.

The Node.run uses the IsProducer to decide if we should run the block production thread or not.

Whether or not a node can be a producer is a function of the protocol's ConsensusConfig. So we extend ConsensusProtocol with checkIfCanBeLeader. This is much like the existing checkIsLeader but it only checks if we can ever be a slot leader, based on just the ConsensusConfig.

This works out well since checkIsLeader already does much the same thing for each protocol. The only slightly dicy one is the LeaderSchedule overlay but there we can use a conservative approximation.

Co-authored-by: Duncan Coutts <[email protected]>

Author: iohk-bors[bot]

ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Protocol.hs

@@ -319,6 +319,11 @@ instance TPraosCrypto c => ConsensusProtocol (TPraos c) where
 
   protocolSecurityParam = tpraosSecurityParam . tpraosParams
 
+  checkIfCanBeLeader TPraosConfig{tpraosIsCoreNodeOrNot} =
+    case tpraosIsCoreNodeOrNot of
+      TPraosIsACoreNode{}  -> True
+      TPraosIsNotACoreNode -> False
+
   checkIsLeader cfg@TPraosConfig{..} slot lv cs =
     case tpraosIsCoreNodeOrNot of
       TPraosIsNotACoreNode          -> return Nothing

ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Protocol/Praos.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleInstances         #-}
 {-# LANGUAGE KindSignatures            #-}
 {-# LANGUAGE LambdaCase                #-}
+{-# LANGUAGE NamedFieldPuns            #-}
 {-# LANGUAGE RecordWildCards           #-}
 {-# LANGUAGE ScopedTypeVariables       #-}
 {-# LANGUAGE StandaloneDeriving        #-}
@@ -259,6 +260,11 @@ instance PraosCrypto c => ConsensusProtocol (Praos c) where
   type ValidateView   (Praos c) = PraosValidateView    c
   type ConsensusState (Praos c) = [BlockInfo c]
 
+  checkIfCanBeLeader PraosConfig{praosNodeId} =
+    case praosNodeId of
+        CoreId{}  -> True
+        RelayId{} -> False  -- Relays are never leaders
+
   checkIsLeader cfg@PraosConfig{..} slot _u cs =
     case praosNodeId of
         RelayId _  -> return Nothing

ouroboros-consensus/src/Ouroboros/Consensus/Node.hs

@@ -11,7 +11,6 @@ module Ouroboros.Consensus.Node
   ( DiffusionTracers (..)
   , DiffusionArguments (..)
   , run
-  , IsProducer (..)
     -- * Exposed by 'run'
   , RunNode (..)
   , Tracers
@@ -65,6 +64,7 @@ import           Ouroboros.Consensus.Node.State
 import           Ouroboros.Consensus.Node.Tracers
 import           Ouroboros.Consensus.NodeKernel
 import           Ouroboros.Consensus.NodeNetwork
+import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Util.IOLike
 import           Ouroboros.Consensus.Util.Orphans ()
 import           Ouroboros.Consensus.Util.Random
@@ -83,12 +83,6 @@ import           Ouroboros.Consensus.Storage.LedgerDB.InMemory
 import           Ouroboros.Consensus.Storage.VolatileDB
                      (BlockValidationPolicy (..), mkBlocksPerFile)
 
--- | Whether the node produces blocks or not.
-data IsProducer
-  = IsProducer
-  | IsNotProducer
-  deriving (Eq, Show)
-
 -- | Start a node.
 --
 -- This opens the 'ChainDB', sets up the 'NodeKernel' and initialises the
@@ -107,7 +101,6 @@ run
   -> NetworkMagic
   -> FilePath                             -- ^ Database path
   -> ProtocolInfo blk
-  -> IsProducer
   -> (ChainDbArgs IO blk -> ChainDbArgs IO blk)
       -- ^ Customise the 'ChainDbArgs'
   -> (NodeArgs IO RemoteConnectionId blk -> NodeArgs IO RemoteConnectionId blk)
@@ -117,7 +110,7 @@ run
      -- layer is initialised.
   -> IO ()
 run tracers protocolTracers chainDbTracer diffusionTracers diffusionArguments
-    networkMagic dbPath pInfo isProducer customiseChainDbArgs
+    networkMagic dbPath pInfo customiseChainDbArgs
     customiseNodeArgs onNodeKernel = do
     either throwM return =<< checkDbMarker
       hasFS
@@ -172,7 +165,6 @@ run tracers protocolTracers chainDbTracer diffusionTracers diffusionArguments
                 tracers
                 btime
                 chainDB
-                isProducer
         nodeKernel <- initNodeKernel nodeArgs
         onNodeKernel registry nodeKernel
 
@@ -328,9 +320,8 @@ mkNodeArgs
   -> Tracers IO RemoteConnectionId blk
   -> BlockchainTime IO
   -> ChainDB IO blk
-  -> IsProducer
   -> NodeArgs IO RemoteConnectionId blk
-mkNodeArgs registry cfg initState tracers btime chainDB isProducer = NodeArgs
+mkNodeArgs registry cfg initState tracers btime chainDB = NodeArgs
     { tracers
     , registry
     , maxClockSkew           = ClockSkew 1
@@ -347,9 +338,12 @@ mkNodeArgs registry cfg initState tracers btime chainDB isProducer = NodeArgs
     , miniProtocolParameters = defaultMiniProtocolParameters
     }
   where
-    blockProduction = case isProducer of
-      IsNotProducer -> Nothing
-      IsProducer    -> Just BlockProduction
-                         { produceBlock       = \_lift' -> nodeForgeBlock cfg
-                         , runMonadRandomDict = runMonadRandomIO
-                         }
+    blockProduction
+      | checkIfCanBeLeader (configConsensus cfg)
+      = Just BlockProduction
+               { produceBlock       = \_lift' -> nodeForgeBlock cfg
+               , runMonadRandomDict = runMonadRandomIO
+               }
+      | otherwise
+      = Nothing
+

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs

@@ -157,6 +157,9 @@ class ( Show (ConsensusState p)
                 -> ConsensusState  p
                 -> m (Maybe (IsLeader p))
 
+  -- | Check if a node is configured such that it can be a leader.
+  checkIfCanBeLeader :: ConsensusConfig p -> Bool
+
   -- | Apply a header
   updateConsensusState :: HasCallStack
                        => ConsensusConfig p

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/BFT.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE FlexibleInstances         #-}
 {-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE NamedFieldPuns            #-}
 {-# LANGUAGE RecordWildCards           #-}
 {-# LANGUAGE ScopedTypeVariables       #-}
 {-# LANGUAGE StandaloneDeriving        #-}
@@ -134,11 +135,14 @@ instance BftCrypto c => ConsensusProtocol (Bft c) where
 
   protocolSecurityParam = bftSecurityParam . bftParams
 
+  checkIfCanBeLeader BftConfig{bftNodeId} =
+      case bftNodeId of
+        CoreId{}  -> True
+        RelayId{} -> False  -- Relays are never leaders
+
   checkIsLeader BftConfig{..} (SlotNo n) _l _cs = do
       return $ case bftNodeId of
-                 RelayId _ ->
-                   -- Relays are never leaders
-                   Nothing
+                 RelayId _ -> Nothing
                  CoreId (CoreNodeId i) ->
                    if n `mod` numCoreNodes == i
                      then Just ()

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/LeaderSchedule.hs

@@ -63,6 +63,8 @@ instance ConsensusProtocol p => ConsensusProtocol (WithLeaderSchedule p) where
   compareCandidates     WLSConfig{..} = compareCandidates     wlsConfigP
   protocolSecurityParam WLSConfig{..} = protocolSecurityParam wlsConfigP
 
+  checkIfCanBeLeader _ = True -- Conservative approximation
+
   checkIsLeader WLSConfig{..} slot _ _ = return $
     case Map.lookup slot $ getLeaderSchedule wlsConfigSchedule of
         Nothing                           -> Nothing

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/ModChainSel.hs

@@ -56,6 +56,7 @@ instance (Typeable p, Typeable s, ChainSelection p s)
     type ValidateView   (ModChainSel p s) = ValidateView   p
     type SelectView     (ModChainSel p s) = SelectView'    p
 
+    checkIfCanBeLeader    (McsConsensusConfig cfg) = checkIfCanBeLeader    cfg
     checkIsLeader         (McsConsensusConfig cfg) = checkIsLeader         cfg
     updateConsensusState  (McsConsensusConfig cfg) = updateConsensusState  cfg
     rewindConsensusState  (McsConsensusConfig cfg) = rewindConsensusState  cfg

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs

@@ -259,6 +259,11 @@ instance PBftCrypto c => ConsensusProtocol (PBft c) where
 
   protocolSecurityParam = pbftSecurityParam . pbftParams
 
+  checkIfCanBeLeader PBftConfig{pbftIsLeader} =
+      case pbftIsLeader of
+        PBftIsALeader{}  -> True
+        PBftIsNotALeader -> False
+
   checkIsLeader PBftConfig{pbftIsLeader, pbftParams} (SlotNo n) _l _cs =
       case pbftIsLeader of
         PBftIsNotALeader                           -> return Nothing