wip 3: rename checkSecurityParamConsistency to configAllSecurityParam…

…s but add a checkSecurityParamConsistency that actually checks security params are consistent

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node.hs

@@ -290,7 +290,7 @@ instance BlockSupportsMetrics ByronBlock where
   isSelfIssued = isSelfIssuedConstUnknown
 
 instance BlockSupportsSanityCheck ByronBlock where
-  checkSecurityParamConsistency =
+  configAllSecurityParams =
     pure . pbftSecurityParam . pbftParams . topLevelConfigProtocol
 
 instance RunNode ByronBlock

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs

@@ -108,7 +108,7 @@ instance ShelleyCompatible proto era => BlockSupportsMetrics (ShelleyBlock proto
 
 instance ProtocolConfigHasSecurityParam proto
   => BlockSupportsSanityCheck (ShelleyBlock proto era) where
-  checkSecurityParamConsistency = pure . protocolConfigSecurityParam . topLevelConfigProtocol
+  configAllSecurityParams = pure . protocolConfigSecurityParam . topLevelConfigProtocol
 
 instance
   ( ShelleyCompatible proto era

ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node.hs

@@ -251,6 +251,6 @@ instance BlockSupportsMetrics DualByronBlock where
   isSelfIssued = isSelfIssuedConstUnknown
 
 instance BlockSupportsSanityCheck DualByronBlock where
-  checkSecurityParamConsistency = pure . protocolConfigSecurityParam . topLevelConfigProtocol
+  configAllSecurityParams = pure . protocolConfigSecurityParam . topLevelConfigProtocol
 
 instance RunNode DualByronBlock

ouroboros-consensus-diffusion/changelog.d/20240207_130158_fraser.murray_startup_sanity_checks.md

@@ -0,0 +1,24 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+
+### Non-Breaking
+
+- Adds a Tracer for startup sanity check warnings in Ouroboros.Consensus.Node.Tracers (see BlockSupportsSanityCheck in ouroboros-consensus)
+
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->

ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal

@@ -58,7 +58,6 @@ library
     Ouroboros.Consensus.Node.ExitPolicy
     Ouroboros.Consensus.Node.Recovery
     Ouroboros.Consensus.Node.RethrowPolicy
-    Ouroboros.Consensus.Node.StartupWarning
     Ouroboros.Consensus.Node.Tracers
     Ouroboros.Consensus.NodeKernel
 

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

@@ -56,13 +56,13 @@ import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR
 import           Codec.Serialise (DeserialiseFailure)
 import           Control.DeepSeq (NFData)
+import           Control.Monad (forM_)
 import           Control.Monad.Class.MonadTime.SI (MonadTime)
 import           Control.Monad.Class.MonadTimer.SI (MonadTimer)
 import           Control.Tracer (Tracer, contramap, traceWith)
 import           Data.ByteString.Lazy (ByteString)
 import           Data.Functor.Contravariant (Predicate (..))
 import           Data.Hashable (Hashable)
-import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe, isNothing)
@@ -88,7 +88,6 @@ import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Recovery
 import           Ouroboros.Consensus.Node.RethrowPolicy
 import           Ouroboros.Consensus.Node.Run
-import           Ouroboros.Consensus.Node.StartupWarning
 import           Ouroboros.Consensus.Node.Tracers
 import           Ouroboros.Consensus.NodeKernel
 import           Ouroboros.Consensus.Storage.ChainDB (ChainDB, ChainDbArgs)
@@ -366,11 +365,8 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} =
                   , ChainDB.cdbVolatileDbValidation  = ValidateAll
                   }
 
-        case checkSecurityParamConsistency cfg of
-          _ :| [] -> pure ()
-          ks@(_ :| _) ->
-              traceWith (consensusSanityCheckTracer rnTraceConsensus) $
-              InconsistentSecurityParam ks
+        forM_ (sanityCheckConfig cfg) $ \issue ->
+          traceWith (consensusSanityCheckTracer rnTraceConsensus) issue
 
         chainDB <- openChainDB registry inFuture cfg initLedger
                   llrnChainDbArgsDefaults customiseChainDbArgs'

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

@@ -41,8 +41,6 @@ import           Ouroboros.Network.TxSubmission.Inbound
                      (TraceTxSubmissionInbound)
 import           Ouroboros.Network.TxSubmission.Outbound
                      (TraceTxSubmissionOutbound)
-import           Ouroboros.Consensus.Node.StartupWarning
-                     (StartupWarning)
 
 {-------------------------------------------------------------------------------
   All tracers of a node bundled together
@@ -63,7 +61,7 @@ data Tracers' remotePeer localPeer blk f = Tracers
   , blockchainTimeTracer          :: f (TraceBlockchainTimeEvent UTCTime)
   , forgeStateInfoTracer          :: f (TraceLabelCreds (ForgeStateInfo blk))
   , keepAliveClientTracer         :: f (TraceKeepAliveClient remotePeer)
-  , consensusSanityCheckTracer    :: f StartupWarning
+  , consensusSanityCheckTracer    :: f SanityCheckIssue
   , consensusErrorTracer          :: f SomeException
   }
 

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs

@@ -68,6 +68,7 @@ import           Test.ThreadNet.Util.NodeToNodeVersion
 import           Test.ThreadNet.Util.NodeTopology
 import           Test.ThreadNet.Util.Seed
 import           Test.Util.HardFork.Future
+import           Test.Util.SanityCheck (prop_sanityChecks)
 import           Test.Util.Slots (NumSlots (..))
 import           Test.Util.Time (dawnOfTime)
 
@@ -138,6 +139,7 @@ prop_simple_hfc_convergence testSetup@TestSetup{..} =
     counterexample ("eraSizeA: " <> show eraSizeA) $
     tabulate "epochs in era A" [labelEraSizeA] $
     prop_general args testOutput .&&.
+    prop_sanityChecks (topLevelConfig (CoreNodeId 0))  .&&.
     prop_allExpectedBlocks
   where
     k :: SecurityParam

ouroboros-consensus/changelog.d/20240207_130158_fraser.murray_startup_sanity_checks.md

@@ -0,0 +1,22 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+### Non-Breaking
+
+- Add BlockSupportsSanityCheck to check for common configuration issues which may manifest themselves in unusual but not necessarily immediately obvious ways
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsSanityCheck.hs

@@ -1,17 +1,48 @@
 module Ouroboros.Consensus.Block.SupportsSanityCheck
-  ( BlockSupportsSanityCheck(..)
+  ( SanityCheckIssue(..)
+  , BlockSupportsSanityCheck(..)
+  , checkSecurityParamConsistency
+  , sanityCheckConfig
   , ProtocolConfigHasSecurityParam(..)
   ) where
 
+import Control.Exception
+import Data.Maybe (catMaybes)
 import Ouroboros.Consensus.Config (TopLevelConfig)
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty(..))
 import Ouroboros.Consensus.Config.SecurityParam
 import Ouroboros.Consensus.Protocol.Abstract
 
+data SanityCheckIssue
+  = InconsistentSecurityParam (NonEmpty SecurityParam)
+  deriving (Show, Eq)
+
+instance Exception SanityCheckIssue
+
 class BlockSupportsSanityCheck blk where
-  checkSecurityParamConsistency
+  configAllSecurityParams
     :: TopLevelConfig blk
     -> NonEmpty SecurityParam
 
+checkSecurityParamConsistency
+  :: BlockSupportsSanityCheck blk
+  => TopLevelConfig blk
+  -> Maybe SanityCheckIssue
+checkSecurityParamConsistency cfg = do
+  let allParams = configAllSecurityParams cfg
+  if allSame allParams
+    then Nothing
+    else Just (InconsistentSecurityParam allParams)
+
+allSame :: Eq a => NonEmpty a -> Bool
+allSame (x :| xs) = all (x ==) xs
+
+sanityCheckConfig
+  :: BlockSupportsSanityCheck blk
+  => TopLevelConfig blk
+  -> [SanityCheckIssue]
+sanityCheckConfig cfg =
+  catMaybes [checkSecurityParamConsistency cfg]
+
 class ProtocolConfigHasSecurityParam p where
   protocolConfigSecurityParam :: ConsensusConfig p -> SecurityParam

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Node/SanityCheck.hs

@@ -21,13 +21,14 @@ import           Data.SOP.Strict
 import           Ouroboros.Consensus.HardFork.History.EpochInfo
 
 instance CanHardFork xs => BlockSupportsSanityCheck (HardForkBlock xs) where
-  checkSecurityParamConsistency tlc = do
+  configAllSecurityParams tlc = do
     let configProtocol = topLevelConfigProtocol tlc
     hardForkConsensusConfigK configProtocol :|
       perEraConsensusConfigSecurityParams (hardForkConsensusConfigPerEra configProtocol)
 
-perEraConsensusConfigSecurityParams :: All SingleEraBlock xs
-                                    => PerEraConsensusConfig xs -> [SecurityParam]
+perEraConsensusConfigSecurityParams
+  :: All SingleEraBlock xs
+  => PerEraConsensusConfig xs -> [SecurityParam]
 perEraConsensusConfigSecurityParams (PerEraConsensusConfig xs) =
   unK $ hctraverse_ (Proxy @SingleEraBlock) go xs
     where

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs

@@ -12,7 +12,6 @@
 {-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
-{-# LANGUAGE UndecidableInstances       #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 

ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/SanityCheck.hs

@@ -10,17 +10,16 @@ import Ouroboros.Consensus.Block.SupportsSanityCheck
 import Ouroboros.Consensus.Config
 import Test.Util.Orphans.Arbitrary ()
 import Test.Tasty.QuickCheck
-import Data.List.NonEmpty (nub)
 
 prop_sanityChecks
   :: BlockSupportsSanityCheck blk
   => TopLevelConfig blk -> Property
 prop_sanityChecks cfg =
-  prop_securityParamConsistent cfg
+  sanityCheckConfig cfg === []
 
 prop_securityParamConsistent
   :: BlockSupportsSanityCheck blk
   => TopLevelConfig blk -> Property
 prop_securityParamConsistent cfg =
-  length (nub (checkSecurityParamConsistency cfg)) === 1
+  checkSecurityParamConsistency cfg === Nothing
 

ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node.hs

@@ -20,16 +20,12 @@ import           Codec.Serialise (Serialise)
 import qualified Data.Map.Strict as Map
 import           Data.Void (Void)
 import           Ouroboros.Consensus.Block
-import           Ouroboros.Consensus.Block.SupportsSanityCheck
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Ledger.SupportsMempool (txForgetValidated)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Mock.Ledger
-import           Ouroboros.Consensus.Mock.Ledger.Block.BFT
-import           Ouroboros.Consensus.Mock.Ledger.Block.PBFT
 import           Ouroboros.Consensus.Mock.Node.Abstract
 import           Ouroboros.Consensus.Mock.Node.Serialisation ()
-import           Ouroboros.Consensus.Mock.Protocol.Praos
 import           Ouroboros.Consensus.Node.InitStorage
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.Run
@@ -61,7 +57,7 @@ instance BlockSupportsMetrics (SimpleBlock c ext) where
 
 instance ProtocolConfigHasSecurityParam (BlockProtocol (SimpleBlock c ext))
   => BlockSupportsSanityCheck (SimpleBlock c ext) where
-  checkSecurityParamConsistency =
+  configAllSecurityParams =
     pure . protocolConfigSecurityParam . topLevelConfigProtocol
 
 instance ( LedgerSupportsProtocol      (SimpleBlock SimpleMockCrypto ext)