{-# LANGUAGE FlexibleContexts #-}
module Cardano.Chain.ValidationMode
( ValidationMode (..)
, fromBlockValidationMode
, orThrowErrorInBlockValidationMode
, askBlockValidationMode
, askTxValidationMode
, whenBlockValidation
, whenTxValidation
, unlessNoTxValidation
, wrapErrorWithValidationMode
) where
import Cardano.Prelude
import Cardano.Chain.Block.ValidationMode
(BlockValidationMode (..), toTxValidationMode)
import Cardano.Chain.UTxO.ValidationMode (TxValidationMode (..))
data ValidationMode = ValidationMode
{ ValidationMode -> BlockValidationMode
blockValidationMode :: !BlockValidationMode
, ValidationMode -> TxValidationMode
txValidationMode :: !TxValidationMode
} deriving (Int -> ValidationMode -> ShowS
[ValidationMode] -> ShowS
ValidationMode -> String
(Int -> ValidationMode -> ShowS)
-> (ValidationMode -> String)
-> ([ValidationMode] -> ShowS)
-> Show ValidationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationMode] -> ShowS
$cshowList :: [ValidationMode] -> ShowS
show :: ValidationMode -> String
$cshow :: ValidationMode -> String
showsPrec :: Int -> ValidationMode -> ShowS
$cshowsPrec :: Int -> ValidationMode -> ShowS
Show)
fromBlockValidationMode :: BlockValidationMode -> ValidationMode
fromBlockValidationMode :: BlockValidationMode -> ValidationMode
fromBlockValidationMode BlockValidationMode
bvm = ValidationMode :: BlockValidationMode -> TxValidationMode -> ValidationMode
ValidationMode
{ blockValidationMode :: BlockValidationMode
blockValidationMode = BlockValidationMode
bvm
, txValidationMode :: TxValidationMode
txValidationMode = BlockValidationMode -> TxValidationMode
toTxValidationMode BlockValidationMode
bvm
}
orThrowErrorInBlockValidationMode
:: (MonadError e m, MonadReader ValidationMode m)
=> Bool
-> e
-> m ()
orThrowErrorInBlockValidationMode :: Bool -> e -> m ()
orThrowErrorInBlockValidationMode Bool
condition e
err = do
BlockValidationMode
bvm <- m BlockValidationMode
forall (m :: * -> *).
MonadReader ValidationMode m =>
m BlockValidationMode
askBlockValidationMode
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BlockValidationMode
bvm BlockValidationMode -> BlockValidationMode -> Bool
forall a. Eq a => a -> a -> Bool
== BlockValidationMode
NoBlockValidation Bool -> Bool -> Bool
|| Bool
condition) (e -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
err)
infix 1 `orThrowErrorInBlockValidationMode`
askBlockValidationMode
:: MonadReader ValidationMode m
=> m BlockValidationMode
askBlockValidationMode :: m BlockValidationMode
askBlockValidationMode = ValidationMode -> BlockValidationMode
blockValidationMode (ValidationMode -> BlockValidationMode)
-> m ValidationMode -> m BlockValidationMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ValidationMode
forall r (m :: * -> *). MonadReader r m => m r
ask
askTxValidationMode
:: MonadReader ValidationMode m
=> m TxValidationMode
askTxValidationMode :: m TxValidationMode
askTxValidationMode = ValidationMode -> TxValidationMode
txValidationMode (ValidationMode -> TxValidationMode)
-> m ValidationMode -> m TxValidationMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ValidationMode
forall r (m :: * -> *). MonadReader r m => m r
ask
whenBlockValidation
:: (MonadError err m, MonadReader ValidationMode m)
=> m ()
-> m ()
whenBlockValidation :: m () -> m ()
whenBlockValidation m ()
action = do
BlockValidationMode
bvmode <- m BlockValidationMode
forall (m :: * -> *).
MonadReader ValidationMode m =>
m BlockValidationMode
askBlockValidationMode
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BlockValidationMode
bvmode BlockValidationMode -> BlockValidationMode -> Bool
forall a. Eq a => a -> a -> Bool
== BlockValidationMode
BlockValidation) m ()
action
whenTxValidation
:: (MonadError err m, MonadReader ValidationMode m)
=> m ()
-> m ()
whenTxValidation :: m () -> m ()
whenTxValidation m ()
action = do
TxValidationMode
tvmode <- m TxValidationMode
forall (m :: * -> *).
MonadReader ValidationMode m =>
m TxValidationMode
askTxValidationMode
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TxValidationMode
tvmode TxValidationMode -> TxValidationMode -> Bool
forall a. Eq a => a -> a -> Bool
== TxValidationMode
TxValidation) m ()
action
unlessNoTxValidation
:: (MonadError err m, MonadReader ValidationMode m)
=> m ()
-> m ()
unlessNoTxValidation :: m () -> m ()
unlessNoTxValidation m ()
action = do
TxValidationMode
tvmode <- m TxValidationMode
forall (m :: * -> *).
MonadReader ValidationMode m =>
m TxValidationMode
askTxValidationMode
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TxValidationMode
tvmode TxValidationMode -> TxValidationMode -> Bool
forall a. Eq a => a -> a -> Bool
== TxValidationMode
NoTxValidation) m ()
action
wrapErrorWithValidationMode
:: (MonadError e' m, MonadReader ValidationMode m)
=> ReaderT ValidationMode (Either e) a
-> (e -> e')
-> m a
wrapErrorWithValidationMode :: ReaderT ValidationMode (Either e) a -> (e -> e') -> m a
wrapErrorWithValidationMode ReaderT ValidationMode (Either e) a
rt e -> e'
wrapper = do
ValidationMode
vMode <- m ValidationMode
forall r (m :: * -> *). MonadReader r m => m r
ask
case ReaderT ValidationMode (Either e) a -> ValidationMode -> Either e a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ValidationMode (Either e) a
rt ValidationMode
vMode of
Left e
err -> e' -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e' -> m a) -> e' -> m a
forall a b. (a -> b) -> a -> b
$ e -> e'
wrapper e
err
Right a
x -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
infix 1 `wrapErrorWithValidationMode`