Gate noThunksInvariant behind expensive-invariants build flag (#1651)

This PR closes #1649 by:

* Defining the `expensive-invariants` build flag (disabled by default)
* Gating the use of `unsafeNoThunks` (the expensive check to avoid)
behind the `ENABLE_EXPENSIVE_INVARIANTS` CPP flag (implied by
`expensive-invariants`)
* Breaking `noThunkInvariants` into its own module to reduce the amount
of CPP needed to compile without warnings
* Tweaking the cabal overrides used in CI to:
+ Run with `+checktvarinvariants` and `+checkmvarinvariants` by default
(via `asserts.cabal`)
+ Run `no-thunks` CI with `+expensive-invariants` in addition to the
default flags

Author: geo2a

.github/workflows/cabal.project.no-thunks.local

@@ -1,4 +1,4 @@
 import: .github/workflows/cabal.project.default.local
 
-package strict-checked-vars
-  flags: +checktvarinvariants +checkmvarinvariants
+package ouroboros-consensus
+  flags: +expensive-invariants

asserts.cabal

@@ -56,3 +56,7 @@ package strict-stm
 
 package text-short
   flags: +asserts
+
+package strict-checked-vars
+  flags: +checktvarinvariants +checkmvarinvariants
+

ouroboros-consensus/changelog.d/20250829_100724_agustin.mista_expensive_invariants_flag.md

@@ -0,0 +1,6 @@
+### Non-Breaking
+
+- Gate `NoThunks` invariant checks behind the `expensive-invariants` build to allow for:
+  + No invariant checking in production
+  + Cheap (domain-specific) invariant checking in regular CI
+  + Cheap and expensive invariant checking in nightly CI

ouroboros-consensus/ouroboros-consensus.cabal

@@ -28,6 +28,11 @@ flag asserts
   manual: False
   default: False
 
+flag expensive-invariants
+  description: Enable checks for expensive invariants
+  manual: True
+  default: False
+
 common common-lib
   default-language: Haskell2010
   ghc-options:
@@ -46,6 +51,9 @@ common common-lib
     ghc-options: -fno-ignore-asserts
     cpp-options: -DENABLE_ASSERTIONS
 
+  if flag(expensive-invariants)
+    cpp-options: -DENABLE_EXPENSIVE_INVARIANTS
+
 common common-test
   import: common-lib
   ghc-options:
@@ -284,6 +292,7 @@ library
     Ouroboros.Consensus.Util.LeakyBucket
     Ouroboros.Consensus.Util.MonadSTM.NormalForm
     Ouroboros.Consensus.Util.MonadSTM.StrictSVar
+    Ouroboros.Consensus.Util.NormalForm.Invariant
     Ouroboros.Consensus.Util.NormalForm.StrictMVar
     Ouroboros.Consensus.Util.NormalForm.StrictTVar
     Ouroboros.Consensus.Util.Orphans

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs

@@ -96,7 +96,6 @@ import Data.Word (Word64)
 import GHC.Generics (Generic)
 import GHC.Stack (HasCallStack)
 import Network.TypedProtocol.Core
-import NoThunks.Class (unsafeNoThunks)
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.BlockchainTime (RelativeTime)
 import Ouroboros.Consensus.Config
@@ -2190,7 +2189,7 @@ continueWithState ::
   Stateful m blk s st ->
   m (Consensus st blk m)
 continueWithState !s (Stateful f) =
-  checkInvariant (show <$> unsafeNoThunks s) $ f s
+  checkInvariant (noThunksInvariant s) $ f s
 
 {-------------------------------------------------------------------------------
   Return value

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/NormalForm/Invariant.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+
+-- | 'NoThunks' invariant.
+--
+-- Due to its expensive nature, this invariant is gated behind the
+-- @expensive-invariants@ flag from the @ouroboros-consensus@ package.
+module Ouroboros.Consensus.Util.NormalForm.Invariant
+  ( -- * Invariant
+    noThunksInvariant
+  ) where
+
+import NoThunks.Class (NoThunks (..), unsafeNoThunks)
+
+{-------------------------------------------------------------------------------
+  Invariant
+-------------------------------------------------------------------------------}
+
+noThunksInvariant :: NoThunks a => a -> Maybe String
+#ifdef ENABLE_EXPENSIVE_INVARIANTS
+noThunksInvariant = fmap show . unsafeNoThunks
+#else
+noThunksInvariant = const Nothing
+#endif

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/NormalForm/StrictMVar.hs

@@ -9,8 +9,12 @@
 -- 'NoThunks' invariant. See 'newMVarWithInvariant' and
 -- 'newEmptyMVarWithInvariant'.
 --
--- Use the @checkmvarinvariants@ cabal flag from the @strict-checked-vars@
--- package to enable or disable invariant checks at compile time.
+-- Due to their expensive nature, checks for the 'NoThunks' invariant are
+-- disabled by default and can be enabled at compile-time via the
+-- @expensive-invariants@ flag from the @ouroboros-consensus@ package. To
+-- disable invariant checks entirely (i.e., both 'NoThunks' and custom ones),
+-- use the @checkmvarinvariants@ cabal flag from the @strict-checked-vars@
+-- package.
 --
 -- The exports of this module (should) mirror the exports of the
 -- "Control.Concurrent.Class.MonadMVar.Strict.Checked" module from the
@@ -42,7 +46,8 @@ import Control.Concurrent.Class.MonadMVar.Strict.Checked hiding
   )
 import qualified Control.Concurrent.Class.MonadMVar.Strict.Checked as Checked
 import GHC.Stack (HasCallStack)
-import NoThunks.Class (NoThunks (..), unsafeNoThunks)
+import NoThunks.Class (NoThunks (..))
+import Ouroboros.Consensus.Util.NormalForm.Invariant (noThunksInvariant)
 
 {-------------------------------------------------------------------------------
   StrictMVar
@@ -80,13 +85,6 @@ newEmptyMVarWithInvariant ::
 newEmptyMVarWithInvariant inv =
   Checked.newEmptyMVarWithInvariant (\x -> inv x <> noThunksInvariant x)
 
-{-------------------------------------------------------------------------------
-  Invariant
--------------------------------------------------------------------------------}
-
-noThunksInvariant :: NoThunks a => a -> Maybe String
-noThunksInvariant = fmap show . unsafeNoThunks
-
 {-------------------------------------------------------------------------------
   NoThunks instance
 -------------------------------------------------------------------------------}

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/NormalForm/StrictTVar.hs

@@ -9,8 +9,12 @@
 -- 'NoThunks' invariant. See 'newTVarWithInvariant' and
 -- 'newTVarWithInvariantIO'.
 --
--- Use the @checktvarinvariants@ cabal flag from the @strict-checked-vars@
--- package to enable or disable invariant checks at compile time.
+-- Due to their expensive nature, checks for the 'NoThunks' invariant are
+-- disabled by default and can be enabled at compile-time via the
+-- @expensive-invariants@ flag from the @ouroboros-consensus@ package. To
+-- disable invariant checks entirely (i.e., both 'NoThunks' and custom ones),
+-- use the @checktvarinvariants@ cabal flag from the @strict-checked-vars@
+-- package.
 --
 -- The exports of this module (should) mirror the exports of the
 -- "Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked" module from the
@@ -43,9 +47,7 @@ import Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked hiding
 import qualified Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked as Checked
 import GHC.Stack
 import NoThunks.Class (NoThunks (..))
-import Ouroboros.Consensus.Util.NormalForm.StrictMVar
-  ( noThunksInvariant
-  )
+import Ouroboros.Consensus.Util.NormalForm.Invariant (noThunksInvariant)
 
 {-------------------------------------------------------------------------------
   StrictTVar