Sanity checking for node configuration on startup

ouroboros-consensus-cardano/changelog.d/20240214_182440_fraser.murray_startup_sanity_checks.md

@@ -0,0 +1,27 @@
+<!--
+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
+
+- A bullet item for the Non-Breaking category
+
+-->
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -422,6 +422,7 @@ test-suite cardano-test
     Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.Server
     Test.Consensus.Cardano.Serialisation
     Test.Consensus.Cardano.SupportedNetworkProtocolVersion
+    Test.Consensus.Cardano.SupportsSanityCheck
     Test.ThreadNet.AllegraMary
     Test.ThreadNet.Cardano
     Test.ThreadNet.MaryAlonzo

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

@@ -288,6 +288,10 @@ instance NodeInitStorage ByronBlock where
 instance BlockSupportsMetrics ByronBlock where
   isSelfIssued = isSelfIssuedConstUnknown
 
+instance BlockSupportsSanityCheck ByronBlock where
+  configAllSecurityParams =
+    pure . pbftSecurityParam . pbftParams . topLevelConfigProtocol
+
 deriving via SelectViewDiffusionPipelining ByronBlock
   instance BlockSupportsDiffusionPipelining ByronBlock
 

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

@@ -32,10 +32,12 @@ import qualified Cardano.Ledger.Shelley.API as SL
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol)
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Run
+import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.TPraos
 import           Ouroboros.Consensus.Shelley.Eras (EraCrypto)
 import           Ouroboros.Consensus.Shelley.Ledger
@@ -104,6 +106,11 @@ instance ShelleyCompatible proto era => BlockSupportsMetrics (ShelleyBlock proto
                          (SL.VKey 'SL.BlockIssuer (EraCrypto era))
       issuerVKeys = shelleyBlockIssuerVKeys cfg
 
+instance ConsensusProtocol proto => BlockSupportsSanityCheck (ShelleyBlock proto era) where
+  configAllSecurityParams = pure . protocolSecurityParam . topLevelConfigProtocol
 
-instance (ShelleyCompatible proto era, LedgerSupportsProtocol (ShelleyBlock proto era))
-  => RunNode (ShelleyBlock proto era)
+instance
+  ( ShelleyCompatible proto era
+  , LedgerSupportsProtocol (ShelleyBlock proto era)
+  , BlockSupportsSanityCheck (ShelleyBlock proto era)
+  ) => RunNode (ShelleyBlock proto era)

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

@@ -162,8 +162,8 @@ shelleyTransition ShelleyPartialLedgerConfig{..}
          return newPParamsEpochNo
 
 instance
-  ( ShelleyCompatible proto era,
-    LedgerSupportsProtocol (ShelleyBlock proto era)
+  ( ShelleyCompatible proto era
+  , LedgerSupportsProtocol (ShelleyBlock proto era)
   ) => SingleEraBlock (ShelleyBlock proto era) where
   singleEraTransition pcfg _eraParams _eraStart ledgerState =
       -- TODO: We might be evaluating 'singleEraTransition' more than once when

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

@@ -249,6 +249,9 @@ instance NodeInitStorage DualByronBlock where
 instance BlockSupportsMetrics DualByronBlock where
   isSelfIssued = isSelfIssuedConstUnknown
 
+instance BlockSupportsSanityCheck DualByronBlock where
+  configAllSecurityParams = pure . configSecurityParam
+
 deriving via SelectViewDiffusionPipelining DualByronBlock
   instance BlockSupportsDiffusionPipelining DualByronBlock
 

ouroboros-consensus-cardano/test/cardano-test/Main.hs

@@ -7,6 +7,7 @@ import qualified Test.Consensus.Cardano.Golden
 import qualified Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.Server
 import qualified Test.Consensus.Cardano.Serialisation
 import qualified Test.Consensus.Cardano.SupportedNetworkProtocolVersion
+import qualified Test.Consensus.Cardano.SupportsSanityCheck
 import           Test.Tasty
 import qualified Test.ThreadNet.AllegraMary
 import qualified Test.ThreadNet.Cardano
@@ -28,6 +29,7 @@ tests =
   , Test.Consensus.Cardano.Golden.tests
   , Test.Consensus.Cardano.Serialisation.tests
   , Test.Consensus.Cardano.SupportedNetworkProtocolVersion.tests
+  , Test.Consensus.Cardano.SupportsSanityCheck.tests
   , Test.ThreadNet.AllegraMary.tests
   , Test.ThreadNet.Cardano.tests
   , Test.ThreadNet.MaryAlonzo.tests

ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/SupportsSanityCheck.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE NamedFieldPuns #-}
+module Test.Consensus.Cardano.SupportsSanityCheck (tests) where
+
+import           Ouroboros.Consensus.Cardano.Block
+import           Ouroboros.Consensus.Config
+import           Ouroboros.Consensus.HardFork.Combinator.Basics
+import           Ouroboros.Consensus.Node.ProtocolInfo
+import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
+import           Test.Consensus.Cardano.ProtocolInfo
+import qualified Test.QuickCheck as QC
+import qualified Test.QuickCheck.Gen as Gen
+import           Test.Tasty
+import           Test.Tasty.QuickCheck
+import qualified Test.ThreadNet.Infra.Shelley as Shelley
+import           Test.Util.SanityCheck
+
+tests :: TestTree
+tests = testGroup "SupportsSanityCheck"
+  [ testProperty "cardano block top level config passes a sanity check" prop_cardanoBlockSanityChecks
+  , testProperty "intentionally-misconfigured top level config fails a sanity check" prop_intentionallyBrokenConfigDoesNotSanityCheck
+  ]
+
+prop_cardanoBlockSanityChecks :: QC.Property
+prop_cardanoBlockSanityChecks =
+  forAllBlind genSimpleTestProtocolInfo (prop_sanityChecks . pInfoConfig)
+
+prop_intentionallyBrokenConfigDoesNotSanityCheck :: QC.Property
+prop_intentionallyBrokenConfigDoesNotSanityCheck =
+  forAllBlind genSimpleTestProtocolInfo $ \pinfo ->
+    let saneTopLevelConfig =
+          pInfoConfig pinfo
+        brokenConfig = breakTopLevelConfig saneTopLevelConfig
+    in expectFailure $ prop_sanityChecks brokenConfig
+
+breakTopLevelConfig :: TopLevelConfig (CardanoBlock StandardCrypto) -> TopLevelConfig (CardanoBlock StandardCrypto)
+breakTopLevelConfig tlc =
+  let TopLevelConfig{topLevelConfigProtocol} = tlc
+      HardForkConsensusConfig{hardForkConsensusConfigK} = topLevelConfigProtocol
+      SecurityParam k = hardForkConsensusConfigK
+  in tlc
+    { topLevelConfigProtocol = topLevelConfigProtocol
+      { hardForkConsensusConfigK = SecurityParam (succ k)
+      }
+    }
+
+genSimpleTestProtocolInfo :: Gen (ProtocolInfo (CardanoBlock StandardCrypto))
+genSimpleTestProtocolInfo = do
+  setup <- arbitrary
+  pure $
+    mkSimpleTestProtocolInfo
+      (decentralizationParam setup)
+      (securityParam setup)
+      (byronSlotLength setup)
+      (shelleySlotLength setup)
+      (hardForkSpec setup)
+
+data SimpleTestProtocolInfoSetup = SimpleTestProtocolInfoSetup
+  { decentralizationParam :: Shelley.DecentralizationParam
+  , securityParam         :: SecurityParam
+  , byronSlotLength       :: ByronSlotLengthInSeconds
+  , shelleySlotLength     :: ShelleySlotLengthInSeconds
+  , hardForkSpec          :: HardForkSpec
+  }
+
+instance Arbitrary SimpleTestProtocolInfoSetup where
+  arbitrary = do
+    SimpleTestProtocolInfoSetup
+      <$> arbitrary
+      <*> genSecurityParam
+      <*> genByronSlotLength
+      <*> genShelleySlotLength
+      <*> genHardForkSpec
+    where
+      genSecurityParam =
+        SecurityParam <$> Gen.choose (8, 12)
+      genByronSlotLength =
+        ByronSlotLengthInSeconds <$> Gen.choose (1, 4)
+      genShelleySlotLength =
+        ShelleySlotLengthInSeconds <$> Gen.choose (1, 4)
+      genHardForkSpec =
+        hardForkInto <$> Gen.chooseEnum (Byron, Conway)

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/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs

@@ -60,7 +60,7 @@ import qualified Codec.CBOR.Encoding as CBOR
 import           Codec.Serialise (DeserialiseFailure)
 import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM
 import           Control.DeepSeq (NFData)
-import           Control.Monad (when)
+import           Control.Monad (forM_, when)
 import           Control.Monad.Class.MonadTime.SI (MonadTime)
 import           Control.Monad.Class.MonadTimer.SI (MonadTimer)
 import           Control.Tracer (Tracer, contramap, traceWith)
@@ -422,6 +422,9 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} =
                 -- ChainDB to detect and recover from any disk corruption.
               = ChainDB.ensureValidateAll
 
+        forM_ (sanityCheckConfig cfg) $ \issue ->
+          traceWith (consensusSanityCheckTracer rnTraceConsensus) issue
+
         (chainDB, finalArgs) <- openChainDB
                      registry
                      inFuture

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

@@ -64,6 +64,7 @@ data Tracers' remotePeer localPeer blk f = Tracers
   , blockchainTimeTracer          :: f (TraceBlockchainTimeEvent UTCTime)
   , forgeStateInfoTracer          :: f (TraceLabelCreds (ForgeStateInfo blk))
   , keepAliveClientTracer         :: f (TraceKeepAliveClient remotePeer)
+  , consensusSanityCheckTracer    :: f SanityCheckIssue
   , consensusErrorTracer          :: f SomeException
   , gsmTracer                     :: f (TraceGsmEvent (Tip blk))
   , gddTracer                     :: f (TraceGDDEvent remotePeer blk)
@@ -86,6 +87,7 @@ instance (forall a. Semigroup (f a))
       , blockchainTimeTracer          = f blockchainTimeTracer
       , forgeStateInfoTracer          = f forgeStateInfoTracer
       , keepAliveClientTracer         = f keepAliveClientTracer
+      , consensusSanityCheckTracer    = f consensusSanityCheckTracer
       , consensusErrorTracer          = f consensusErrorTracer
       , gsmTracer                     = f gsmTracer
       , gddTracer                     = f gddTracer
@@ -116,6 +118,7 @@ nullTracers = Tracers
     , blockchainTimeTracer          = nullTracer
     , forgeStateInfoTracer          = nullTracer
     , keepAliveClientTracer         = nullTracer
+    , consensusSanityCheckTracer    = nullTracer
     , consensusErrorTracer          = nullTracer
     , gsmTracer                     = nullTracer
     , gddTracer                     = nullTracer
@@ -149,6 +152,7 @@ showTracers tr = Tracers
     , blockchainTimeTracer          = showTracing tr
     , forgeStateInfoTracer          = showTracing tr
     , keepAliveClientTracer         = showTracing tr
+    , consensusSanityCheckTracer    = showTracing tr
     , consensusErrorTracer          = showTracing tr
     , gsmTracer                     = showTracing tr
     , gddTracer                     = showTracing tr

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

@@ -62,6 +62,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)
 
@@ -132,6 +133,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-protocol/changelog.d/20240207_130614_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
+
+- ProtocolConfigHasSecurityParam instances for Praos and TPraos
+
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->

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. For now it only checks that `k` is the same across all eras.
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->

ouroboros-consensus/ouroboros-consensus.cabal

@@ -77,6 +77,7 @@ library
     Ouroboros.Consensus.Block.SupportsDiffusionPipelining
     Ouroboros.Consensus.Block.SupportsMetrics
     Ouroboros.Consensus.Block.SupportsProtocol
+    Ouroboros.Consensus.Block.SupportsSanityCheck
     Ouroboros.Consensus.BlockchainTime
     Ouroboros.Consensus.BlockchainTime.API
     Ouroboros.Consensus.BlockchainTime.WallClock.Default
@@ -121,6 +122,7 @@ library
     Ouroboros.Consensus.HardFork.Combinator.Node.DiffusionPipelining
     Ouroboros.Consensus.HardFork.Combinator.Node.InitStorage
     Ouroboros.Consensus.HardFork.Combinator.Node.Metrics
+    Ouroboros.Consensus.HardFork.Combinator.Node.SanityCheck
     Ouroboros.Consensus.HardFork.Combinator.PartialConfig
     Ouroboros.Consensus.HardFork.Combinator.Protocol
     Ouroboros.Consensus.HardFork.Combinator.Protocol.ChainSel
@@ -359,6 +361,7 @@ library unstable-consensus-testlib
     Test.Util.Range
     Test.Util.RefEnv
     Test.Util.SOP
+    Test.Util.SanityCheck
     Test.Util.Schedule
     Test.Util.Serialisation.Examples
     Test.Util.Serialisation.Golden

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

@@ -9,3 +9,4 @@ import           Ouroboros.Consensus.Block.RealPoint as X
 import           Ouroboros.Consensus.Block.SupportsDiffusionPipelining as X
 import           Ouroboros.Consensus.Block.SupportsMetrics as X
 import           Ouroboros.Consensus.Block.SupportsProtocol as X
+import           Ouroboros.Consensus.Block.SupportsSanityCheck as X