{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.Chain.Epoch.Validation (
EpochError (..),
validateEpochFile,
validateEpochFiles,
)
where
import Cardano.Chain.Block (
ABlockOrBoundary (..),
ChainValidationError,
ChainValidationState (..),
blockSlot,
updateChainBlockOrBoundary,
)
import Cardano.Chain.Epoch.File (
ParseError,
mainnetEpochSlots,
parseEpochFileWithBoundary,
parseEpochFilesWithBoundary,
)
import qualified Cardano.Chain.Genesis as Genesis
import Cardano.Chain.Slotting (
EpochAndSlotCount,
fromSlotNumber,
)
import Cardano.Chain.ValidationMode (ValidationMode)
import Cardano.Prelude hiding (trace)
import Control.Monad.Trans.Resource (ResIO, runResourceT)
import Control.Tracer
import Streaming (Of (..), Stream, hoist)
import qualified Streaming.Prelude as S
data EpochError
= EpochParseError ParseError
| EpochChainValidationError (Maybe EpochAndSlotCount) ChainValidationError
| Initial
deriving (EpochError -> EpochError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpochError -> EpochError -> Bool
$c/= :: EpochError -> EpochError -> Bool
== :: EpochError -> EpochError -> Bool
$c== :: EpochError -> EpochError -> Bool
Eq, Int -> EpochError -> ShowS
[EpochError] -> ShowS
EpochError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpochError] -> ShowS
$cshowList :: [EpochError] -> ShowS
show :: EpochError -> String
$cshow :: EpochError -> String
showsPrec :: Int -> EpochError -> ShowS
$cshowsPrec :: Int -> EpochError -> ShowS
Show)
validateEpochFile ::
forall m.
MonadIO m =>
Tracer m EpochError ->
ValidationMode ->
Genesis.Config ->
ChainValidationState ->
FilePath ->
m ChainValidationState
validateEpochFile :: forall (m :: * -> *).
MonadIO m =>
Tracer m EpochError
-> ValidationMode
-> Config
-> ChainValidationState
-> String
-> m ChainValidationState
validateEpochFile Tracer m EpochError
tr ValidationMode
vMode Config
config ChainValidationState
cvs String
fp = do
Either EpochError ChainValidationState
res <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
forall a b. (a -> b) -> a -> b
$ (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` ValidationMode
vMode)
forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
forall a b. (a -> b) -> a -> b
$ Config
-> ChainValidationState
-> Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
-> ExceptT
EpochError (ReaderT ValidationMode ResIO) ChainValidationState
foldChainValidationState Config
config ChainValidationState
cvs Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
stream
case Either EpochError ChainValidationState
res of
Left EpochError
e -> forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer m EpochError
tr EpochError
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainValidationState
cvs
Right ChainValidationState
cvs' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainValidationState
cvs'
where
stream :: Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
stream = EpochSlots
-> String
-> Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
parseEpochFileWithBoundary EpochSlots
mainnetEpochSlots String
fp
validateEpochFiles ::
ValidationMode ->
Genesis.Config ->
ChainValidationState ->
[FilePath] ->
IO (Either EpochError ChainValidationState)
validateEpochFiles :: ValidationMode
-> Config
-> ChainValidationState
-> [String]
-> IO (Either EpochError ChainValidationState)
validateEpochFiles ValidationMode
vMode Config
config ChainValidationState
cvs [String]
fps =
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
forall a b. (a -> b) -> a -> b
$ (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` ValidationMode
vMode)
forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(Config
-> ChainValidationState
-> Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
-> ExceptT
EpochError (ReaderT ValidationMode ResIO) ChainValidationState
foldChainValidationState Config
config ChainValidationState
cvs Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
stream)
where
stream :: Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
stream = EpochSlots
-> [String]
-> Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
parseEpochFilesWithBoundary EpochSlots
mainnetEpochSlots [String]
fps
foldChainValidationState ::
Genesis.Config ->
ChainValidationState ->
Stream (Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) () ->
ExceptT EpochError (ReaderT ValidationMode ResIO) ChainValidationState
foldChainValidationState :: Config
-> ChainValidationState
-> Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
-> ExceptT
EpochError (ReaderT ValidationMode ResIO) ChainValidationState
foldChainValidationState Config
config ChainValidationState
chainValState Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
blocks =
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m r -> m b
S.foldM_
( \ChainValidationState
cvs ABlockOrBoundary ByteString
block ->
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (Maybe EpochAndSlotCount -> ChainValidationError -> EpochError
EpochChainValidationError (forall a. ABlockOrBoundary a -> Maybe EpochAndSlotCount
blockOrBoundarySlot ABlockOrBoundary ByteString
block))
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadError ChainValidationError m,
MonadReader ValidationMode m) =>
Config
-> ChainValidationState
-> ABlockOrBoundary ByteString
-> m ChainValidationState
updateChainBlockOrBoundary Config
config ChainValidationState
cvs ABlockOrBoundary ByteString
block
)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainValidationState
chainValState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist (forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ParseError -> EpochError
EpochParseError) Stream
(Of (ABlockOrBoundary ByteString)) (ExceptT ParseError ResIO) ()
blocks))
where
blockOrBoundarySlot :: ABlockOrBoundary a -> Maybe EpochAndSlotCount
blockOrBoundarySlot :: forall a. ABlockOrBoundary a -> Maybe EpochAndSlotCount
blockOrBoundarySlot = \case
ABOBBoundary ABoundaryBlock a
_ -> forall a. Maybe a
Nothing
ABOBBlock ABlock a
block -> forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
mainnetEpochSlots forall a b. (a -> b) -> a -> b
$ forall a. ABlock a -> SlotNumber
blockSlot ABlock a
block