Remove the InvalidBlockReason data type

dnadales · dnadales · commit d7ce17784c54 · 2024-11-11T16:40:18.000+01:00
... since it was only wrapping up an `ExtValidationError` value.
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Tracers.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Tracers.hs
@@ -24,13 +24,14 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Forecast (OutsideForecastRange)
 import           Ouroboros.Consensus.Genesis.Governor (TraceGDDEvent)
+import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Mempool (MempoolSize, TraceEventMempool)
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                      (TraceBlockFetchServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
-                     (InvalidBlockReason, TraceChainSyncClientEvent)
+                     (TraceChainSyncClientEvent)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
                      (TraceChainSyncServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
@@ -343,7 +344,7 @@ data TraceForgeEvent blk
     -- | We forged a block that is invalid according to the ledger in the
     -- ChainDB. This means there is an inconsistency between the mempool
     -- validation and the ledger validation. This is a serious error!
-  | TraceForgedInvalidBlock SlotNo blk (InvalidBlockReason blk)
+  | TraceForgedInvalidBlock SlotNo blk (ExtValidationError blk)
 
     -- | We adopted the block we produced, we also trace the transactions
     -- that were adopted.
diff --git a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
@@ -159,7 +159,7 @@ oneBenchRun
 -- | No invalid blocks in this benchmark
 invalidBlock ::
     WithFingerprint
-        (HeaderHash blk -> Maybe (ChainDB.InvalidBlockReason blk))
+        (HeaderHash blk -> Maybe (Extended.ExtValidationError blk))
 invalidBlock =
     WithFingerprint isInvalidBlock fp
   where
diff --git a/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md b/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md
@@ -8,4 +8,4 @@
 - Remove `CheckInFuture m blk` argument from `initialChainSelection`.
 - Remove `cdbsCheckInFuture` from `ChainDbSpecificArgs`.
 - Delete module `Ouroboros.Consensus.Fragment.InFuture`. `ClockSkew` functions live now in `Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck`.
-* Remove `InFutureExceedsClockSkew` from `ValidationError`.
+* Remove ``InvalidBlockReason`, since it was now simply wrapping up `ExtValidationError`.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
@@ -60,7 +60,6 @@ module Ouroboros.Consensus.MiniProtocol.ChainSync.Client (
   , ChainSyncLoPBucketConfig (..)
   , ChainSyncLoPBucketEnabledConfig (..)
     -- * Trace events
-  , InvalidBlockReason
   , TraceChainSyncClientEvent (..)
     -- * State shared with other components
   , ChainSyncClientHandle (..)
@@ -114,8 +113,7 @@ import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
 import           Ouroboros.Consensus.Node.GsmState (GsmState (..))
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Protocol.Abstract
-import           Ouroboros.Consensus.Storage.ChainDB (ChainDB,
-                     InvalidBlockReason)
+import           Ouroboros.Consensus.Storage.ChainDB (ChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Consensus.Util
 import           Ouroboros.Consensus.Util.AnchoredFragment (cross)
@@ -158,7 +156,7 @@ data ChainDbView m blk = ChainDbView {
     getIsInvalidBlock ::
       STM m
           (WithFingerprint
-              (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+              (HeaderHash blk -> Maybe (ExtValidationError blk)))
   }
 
 -- | Configuration of the leaky bucket when it is enabled.
@@ -1984,12 +1982,12 @@ invalidBlockRejector ::
   => Tracer m (TraceChainSyncClientEvent blk)
   -> NodeToNodeVersion
   -> DiffusionPipeliningSupport
-  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
      -- ^ Get the invalid block checker
   -> STM m (AnchoredFragment (Header blk))
      -- ^ Get the candidate
   -> Watcher m
-         (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+         (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
          Fingerprint
 invalidBlockRejector tracer _version pipelining getIsInvalidBlock getCandidate =
     Watcher {
@@ -1999,7 +1997,7 @@ invalidBlockRejector tracer _version pipelining getIsInvalidBlock getCandidate =
       , wReader      = getIsInvalidBlock
       }
   where
-    checkInvalid :: (HeaderHash blk -> Maybe (InvalidBlockReason blk)) -> m ()
+    checkInvalid :: (HeaderHash blk -> Maybe (ExtValidationError blk)) -> m ()
     checkInvalid isInvalidBlock = do
         theirFrag <- atomically getCandidate
         -- The invalid block is likely to be a more recent block, so check from
@@ -2019,7 +2017,7 @@ invalidBlockRejector tracer _version pipelining getIsInvalidBlock getCandidate =
             )
           $ AF.toNewestFirst theirFrag
 
-    disconnect :: Header blk -> InvalidBlockReason blk -> m ()
+    disconnect :: Header blk -> ExtValidationError blk -> m ()
     disconnect invalidHeader reason = do
         let ex =
                 InvalidBlock
@@ -2157,7 +2155,7 @@ data ChainSyncClientException =
         (HeaderHash blk)
         -- ^ Invalid block. If pipelining was negotiated, this can be
         -- different from the previous argument.
-        (InvalidBlockReason blk)
+        (ExtValidationError blk)
     -- ^ The upstream node's chain contained a block that we know is invalid.
   |
     InFutureHeaderExceedsClockSkew !InFutureCheck.HeaderArrivalException
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
@@ -51,8 +51,6 @@ module Ouroboros.Consensus.Storage.ChainDB.API (
   , streamFrom
   , traverseIterator
   , validBounds
-    -- * Invalid block reason
-  , InvalidBlockReason (..)
     -- * Followers
   , ChainType (..)
   , Follower (..)
@@ -347,7 +345,7 @@ data ChainDB m blk = ChainDB {
       -- In particular, this affects the watcher in 'bracketChainSyncClient',
       -- which rechecks the blocks in all candidate chains whenever a new
       -- invalid block is detected. These blocks are likely to be valid.
-    , getIsInvalidBlock :: STM m (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+    , getIsInvalidBlock :: STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
 
     , closeDB            :: m ()
 
@@ -682,19 +680,6 @@ streamFrom from db registry blockComponent = do
           Right it -> return it
           Left  e  -> error $ "failed to stream from genesis to tip: " <> show e
 
-{-------------------------------------------------------------------------------
-  Invalid block reason
--------------------------------------------------------------------------------}
-
--- | The reason why a block is invalid.
-data InvalidBlockReason blk
-  = ValidationError !(ExtValidationError blk)
-    -- ^ The ledger found the block to be invalid.
-  deriving (Eq, Show, Generic)
-
-instance LedgerSupportsProtocol blk
-      => NoThunks (InvalidBlockReason blk)
-
 {-------------------------------------------------------------------------------
   Followers
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
@@ -56,7 +56,7 @@ import           Ouroboros.Consensus.Ledger.Inspect
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                      AddBlockResult (..), BlockComponent (..), ChainType (..),
-                     InvalidBlockReason (..), LoE (..))
+                     LoE (..))
 import           Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
                      (InvalidBlockPunishment, noPunishment)
 import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment as InvalidBlockPunishment
@@ -1219,7 +1219,7 @@ ledgerValidateCandidate chainSelEnv chainDiff@(ChainDiff rollback suffix) =
     addInvalidBlock e (RealPoint slot hash) = atomically $
       modifyTVar varInvalid $ \(WithFingerprint invalid fp) ->
         WithFingerprint
-          (Map.insert hash (InvalidBlockInfo (ValidationError e) slot) invalid)
+          (Map.insert hash (InvalidBlockInfo e slot) invalid)
           (succ fp)
 
 -- | Validate a candidate chain using 'ledgerValidateCandidate'.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs
@@ -36,7 +36,7 @@ import           Ouroboros.Consensus.Ledger.Abstract (IsLedger, LedgerState)
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB.API (BlockComponent (..),
-                     ChainDbFailure (..), InvalidBlockReason)
+                     ChainDbFailure (..))
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB as LgrDB
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.Types
 import           Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB)
@@ -177,7 +177,7 @@ getIsFetched CDB{..} = basedOnHash <$> VolatileDB.getIsMember cdbVolatileDB
 getIsInvalidBlock ::
      forall m blk. (IOLike m, HasHeader blk)
   => ChainDbEnv m blk
-  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
 getIsInvalidBlock CDB{..} =
   fmap (fmap (fmap invalidBlockReason) . flip Map.lookup) <$> readTVar cdbInvalid
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
@@ -83,8 +83,8 @@ import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                      AddBlockResult (..), ChainDbError (..),
-                     ChainSelectionPromise (..), ChainType, InvalidBlockReason,
-                     LoE, StreamFrom, StreamTo, UnknownRange)
+                     ChainSelectionPromise (..), ChainType, LoE, StreamFrom,
+                     StreamTo, UnknownRange)
 import           Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
                      (InvalidBlockPunishment)
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB (LgrDB,
@@ -400,7 +400,7 @@ type InvalidBlocks blk = Map (HeaderHash blk) (InvalidBlockInfo blk)
 -- VolatileDB for some slot @s@, the hashes older or equal to @s@ can be
 -- removed from this map.
 data InvalidBlockInfo blk = InvalidBlockInfo
-  { invalidBlockReason :: !(InvalidBlockReason blk)
+  { invalidBlockReason :: !(ExtValidationError blk)
   , invalidBlockSlotNo :: !SlotNo
   } deriving (Eq, Show, Generic, NoThunks)
 
@@ -617,7 +617,7 @@ data TraceAddBlockEvent blk =
   | IgnoreBlockAlreadyInVolatileDB (RealPoint blk)
 
     -- | A block that is know to be invalid was ignored.
-  | IgnoreInvalidBlock (RealPoint blk) (InvalidBlockReason blk)
+  | IgnoreInvalidBlock (RealPoint blk) (ExtValidationError blk)
 
     -- | The block was added to the queue and will be added to the ChainDB by
     -- the background thread. The size of the queue is included.
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs
@@ -18,7 +18,6 @@ import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Protocol.Abstract
-import           Ouroboros.Consensus.Storage.ChainDB (InvalidBlockReason)
 import           Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB
 import           Ouroboros.Consensus.Storage.ImmutableDB
@@ -113,7 +112,3 @@ deriving instance ( ToExpr blk
                   )
                  => ToExpr (ChainProducerState blk)
 deriving instance ToExpr a => ToExpr (WithFingerprint a)
-deriving instance ( ToExpr (HeaderHash blk)
-                  , ToExpr (ExtValidationError blk)
-                  )
-                 => ToExpr (InvalidBlockReason blk)
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs
@@ -99,8 +99,6 @@ import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.NodeId
 import           Ouroboros.Consensus.Protocol.BFT
-import           Ouroboros.Consensus.Storage.ChainDB.API
-                     (InvalidBlockReason (ValidationError))
 import           Ouroboros.Consensus.Util (lastMaybe, whenJust)
 import           Ouroboros.Consensus.Util.Condense
 import           Ouroboros.Consensus.Util.IOLike
@@ -384,7 +382,6 @@ runChainSync skew securityParam (ClientUpdates clientUpdates)
               let isInvalidBlock hash =
                     if hash `Set.member` knownInvalid
                     then Just
-                       . ValidationError
                        . ExtValidationErrorLedger
                        $ TestBlock.InvalidBlock
                     else Nothing
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
@@ -104,9 +104,9 @@ import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.MockChainSel
 import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                      AddBlockResult (..), BlockComponent (..),
-                     ChainDbError (..), InvalidBlockReason (..),
-                     IteratorResult (..), LoE (..), StreamFrom (..),
-                     StreamTo (..), UnknownRange (..), validBounds)
+                     ChainDbError (..), IteratorResult (..), LoE (..),
+                     StreamFrom (..), StreamTo (..), UnknownRange (..),
+                     validBounds)
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel (olderThanK)
 import           Ouroboros.Consensus.Storage.LedgerDB
 import           Ouroboros.Consensus.Util (repeatedly)
@@ -154,7 +154,6 @@ deriving instance ( ToExpr blk
                   , ToExpr (Chain blk)
                   , ToExpr (ChainProducerState blk)
                   , ToExpr (ExtLedgerState blk)
-                  , ToExpr (InvalidBlockReason blk)
                   )
                  => ToExpr (Model blk)
 
@@ -705,7 +704,7 @@ class ( HasHeader blk
   Internal auxiliary
 -------------------------------------------------------------------------------}
 
-type InvalidBlocks blk = Map (HeaderHash blk) (InvalidBlockReason blk, SlotNo)
+type InvalidBlocks blk = Map (HeaderHash blk) (ExtValidationError blk, SlotNo)
 
 -- | Result of 'validate', also used internally.
 data ValidatedChain blk =
@@ -727,7 +726,7 @@ validate :: forall blk. LedgerSupportsProtocol blk
 validate cfg Model { initLedger, invalid } chain =
     go initLedger Genesis (Chain.toOldestFirst chain)
   where
-    mkInvalid :: blk -> InvalidBlockReason blk -> InvalidBlocks blk
+    mkInvalid :: blk -> ExtValidationError blk -> InvalidBlocks blk
     mkInvalid b reason =
       Map.singleton (blockHash b) (reason, blockSlot b)
 
@@ -744,7 +743,7 @@ validate cfg Model { initLedger, invalid } chain =
           -> ValidatedChain
                validPrefix
                ledger
-               (invalid <> mkInvalid b (ValidationError e))
+               (invalid <> mkInvalid b e)
 
         -- Valid block according to the ledger
         Right ledger'
