[#526] Add BlockValidationMode data type

cardano-ledger/cardano-ledger.cabal

@@ -53,6 +53,7 @@ library
                        Cardano.Chain.Block.Header
                        Cardano.Chain.Block.Proof
                        Cardano.Chain.Block.Validation
+                       Cardano.Chain.Block.ValidationMode
 
                        Cardano.Chain.Common.AddrAttributes
                        Cardano.Chain.Common.AddrSpendingData

cardano-ledger/src/Cardano/Chain/Block/ValidationMode.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Cardano.Chain.Block.ValidationMode
+  ( BlockValidationMode (..)
+  , orThrowErrorBVM
+  , toTxValidationMode
+  , whenBlockValidation
+  ) where
+
+import Cardano.Prelude
+
+import Cardano.Chain.UTxO.ValidationMode (TxValidationMode (..))
+
+--------------------------------------------------------------------------------
+-- BlockValidationMode
+--------------------------------------------------------------------------------
+
+-- | Indicates what sort of block validation should be performed.
+data BlockValidationMode
+  = BlockValidation
+  -- ^ Perform all block validations.
+  | NoBlockValidation
+  -- ^ Perform no block validations.
+  deriving (Eq, Show)
+
+-- | Perform an action only when in the 'BlockValidation' mode. Otherwise, do
+-- nothing.
+whenBlockValidation
+  :: MonadError err m
+  => BlockValidationMode
+  -> m ()
+  -> m ()
+whenBlockValidation BlockValidation action = action
+whenBlockValidation _ _ = pure ()
+
+orThrowErrorBVM
+  :: (MonadError e m, MonadReader BlockValidationMode m)
+  => Bool
+  -> e
+  -> m ()
+orThrowErrorBVM condition err = do
+  bvm <- ask
+  unless (bvm == NoBlockValidation || condition) (throwError err)
+
+infix 1 `orThrowErrorBVM`
+
+-- | Translate a 'BlockValidationMode' to an appropriate 'TxValidationMode'.
+toTxValidationMode :: BlockValidationMode -> TxValidationMode
+toTxValidationMode BlockValidation   = TxValidation
+toTxValidationMode NoBlockValidation = NoTxValidation