{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Validation (
ValidateEnv (..)
, validateAndReopen
, ShouldBeFinalised (..)
, reconstructPrimaryIndex
) where
import Control.Exception (assert)
import Control.Monad (forM_, unless, when)
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.Trans.Class (lift)
import Control.Tracer (Tracer, contramap, traceWith)
import qualified Data.ByteString.Lazy as Lazy
import Data.Functor (($>))
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Set as Set
import GHC.Stack (HasCallStack)
import Ouroboros.Consensus.Block hiding (hashSize)
import Ouroboros.Consensus.Storage.ImmutableDB.API
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
(unChunkNo, unsafeEpochNoToChunkNo)
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index
(cachedIndex)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index as Index
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary
(PrimaryIndex)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary as Primary
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Secondary as Secondary
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Parser
(BlockSummary (..), parseChunkFile)
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.State
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util
import Ouroboros.Consensus.Storage.Serialisation (DecodeDisk (..),
HasBinaryBlockInfo (..))
import Ouroboros.Consensus.Util (lastMaybe, whenJust)
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.ResourceRegistry
import Streaming (Of (..))
import qualified Streaming.Prelude as S
import System.FS.API
data ValidateEnv m blk h = ValidateEnv {
forall (m :: * -> *) blk h. ValidateEnv m blk h -> HasFS m h
hasFS :: !(HasFS m h)
, forall (m :: * -> *) blk h. ValidateEnv m blk h -> ChunkInfo
chunkInfo :: !ChunkInfo
, forall (m :: * -> *) blk h.
ValidateEnv m blk h -> Tracer m (TraceEvent blk)
tracer :: !(Tracer m (TraceEvent blk))
, forall (m :: * -> *) blk h. ValidateEnv m blk h -> CacheConfig
cacheConfig :: !Index.CacheConfig
, forall (m :: * -> *) blk h. ValidateEnv m blk h -> CodecConfig blk
codecConfig :: !(CodecConfig blk)
, forall (m :: * -> *) blk h. ValidateEnv m blk h -> blk -> Bool
checkIntegrity :: !(blk -> Bool)
}
validateAndReopen ::
forall m blk h.
( IOLike m
, GetPrevHash blk
, HasBinaryBlockInfo blk
, DecodeDisk blk (Lazy.ByteString -> blk)
, ConvertRawHash blk
, Eq h
, HasCallStack
)
=> ValidateEnv m blk h
-> ResourceRegistry m
-> ValidationPolicy
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
validateAndReopen :: forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk, Eq h,
HasCallStack) =>
ValidateEnv m blk h
-> ResourceRegistry m
-> ValidationPolicy
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
validateAndReopen ValidateEnv m blk h
validateEnv ResourceRegistry m
registry ValidationPolicy
valPol = Proxy blk
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
forall blk (m :: * -> *) a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m a
wrapFsError (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h))
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
forall a b. (a -> b) -> a -> b
$ do
(ChunkNo
chunk, WithOrigin (Tip blk)
tip) <- m (ChunkNo, WithOrigin (Tip blk))
-> WithTempRegistry
(OpenState m blk h) m (ChunkNo, WithOrigin (Tip blk))
forall (m :: * -> *) a.
Monad m =>
m a -> WithTempRegistry (OpenState m blk h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ChunkNo, WithOrigin (Tip blk))
-> WithTempRegistry
(OpenState m blk h) m (ChunkNo, WithOrigin (Tip blk)))
-> m (ChunkNo, WithOrigin (Tip blk))
-> WithTempRegistry
(OpenState m blk h) m (ChunkNo, WithOrigin (Tip blk))
forall a b. (a -> b) -> a -> b
$ ValidateEnv m blk h
-> ValidationPolicy -> m (ChunkNo, WithOrigin (Tip blk))
forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> ValidationPolicy -> m (ChunkNo, WithOrigin (Tip blk))
validate ValidateEnv m blk h
validateEnv ValidationPolicy
valPol
Index m blk h
index <- m (Index m blk h)
-> WithTempRegistry (OpenState m blk h) m (Index m blk h)
forall (m :: * -> *) a.
Monad m =>
m a -> WithTempRegistry (OpenState m blk h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Index m blk h)
-> WithTempRegistry (OpenState m blk h) m (Index m blk h))
-> m (Index m blk h)
-> WithTempRegistry (OpenState m blk h) m (Index m blk h)
forall a b. (a -> b) -> a -> b
$ HasFS m h
-> ResourceRegistry m
-> Tracer m TraceCacheEvent
-> CacheConfig
-> ChunkInfo
-> ChunkNo
-> m (Index m blk h)
forall (m :: * -> *) blk h.
(IOLike m, ConvertRawHash blk, StandardHash blk, Typeable blk) =>
HasFS m h
-> ResourceRegistry m
-> Tracer m TraceCacheEvent
-> CacheConfig
-> ChunkInfo
-> ChunkNo
-> m (Index m blk h)
cachedIndex
HasFS m h
hasFS
ResourceRegistry m
registry
Tracer m TraceCacheEvent
cacheTracer
CacheConfig
cacheConfig
ChunkInfo
chunkInfo
ChunkNo
chunk
case WithOrigin (Tip blk)
tip of
WithOrigin (Tip blk)
Origin -> Bool
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
forall a. HasCallStack => Bool -> a -> a
assert (ChunkNo
chunk ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkNo
firstChunkNo) (WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h))
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
forall a b. (a -> b) -> a -> b
$ do
m () -> WithTempRegistry (OpenState m blk h) m ()
forall (m :: * -> *) a.
Monad m =>
m a -> WithTempRegistry (OpenState m blk h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithTempRegistry (OpenState m blk h) m ())
-> m () -> WithTempRegistry (OpenState m blk h) m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
tracer TraceEvent blk
forall blk. TraceEvent blk
NoValidLastLocation
HasFS m h
-> Index m blk h
-> ChunkNo
-> WithOrigin (Tip blk)
-> AllowExisting
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
forall (m :: * -> *) blk h.
(HasCallStack, IOLike m, Eq h) =>
HasFS m h
-> Index m blk h
-> ChunkNo
-> WithOrigin (Tip blk)
-> AllowExisting
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
mkOpenState HasFS m h
hasFS Index m blk h
index ChunkNo
chunk WithOrigin (Tip blk)
forall t. WithOrigin t
Origin AllowExisting
MustBeNew
NotOrigin Tip blk
tip' -> do
m () -> WithTempRegistry (OpenState m blk h) m ()
forall (m :: * -> *) a.
Monad m =>
m a -> WithTempRegistry (OpenState m blk h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WithTempRegistry (OpenState m blk h) m ())
-> m () -> WithTempRegistry (OpenState m blk h) m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
tracer (TraceEvent blk -> m ()) -> TraceEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> Tip blk -> TraceEvent blk
forall blk. ChunkNo -> Tip blk -> TraceEvent blk
ValidatedLastLocation ChunkNo
chunk Tip blk
tip'
HasFS m h
-> Index m blk h
-> ChunkNo
-> WithOrigin (Tip blk)
-> AllowExisting
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
forall (m :: * -> *) blk h.
(HasCallStack, IOLike m, Eq h) =>
HasFS m h
-> Index m blk h
-> ChunkNo
-> WithOrigin (Tip blk)
-> AllowExisting
-> WithTempRegistry (OpenState m blk h) m (OpenState m blk h)
mkOpenState HasFS m h
hasFS Index m blk h
index ChunkNo
chunk WithOrigin (Tip blk)
tip AllowExisting
AllowExisting
where
ValidateEnv { HasFS m h
hasFS :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, Tracer m (TraceEvent blk)
tracer :: forall (m :: * -> *) blk h.
ValidateEnv m blk h -> Tracer m (TraceEvent blk)
tracer :: Tracer m (TraceEvent blk)
tracer, CacheConfig
cacheConfig :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> CacheConfig
cacheConfig :: CacheConfig
cacheConfig, ChunkInfo
chunkInfo :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> ChunkInfo
chunkInfo :: ChunkInfo
chunkInfo } = ValidateEnv m blk h
validateEnv
cacheTracer :: Tracer m TraceCacheEvent
cacheTracer = (TraceCacheEvent -> TraceEvent blk)
-> Tracer m (TraceEvent blk) -> Tracer m TraceCacheEvent
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap TraceCacheEvent -> TraceEvent blk
forall blk. TraceCacheEvent -> TraceEvent blk
TraceCacheEvent Tracer m (TraceEvent blk)
tracer
validate ::
forall m blk h.
( IOLike m
, GetPrevHash blk
, HasBinaryBlockInfo blk
, DecodeDisk blk (Lazy.ByteString -> blk)
, ConvertRawHash blk
, HasCallStack
)
=> ValidateEnv m blk h
-> ValidationPolicy
-> m (ChunkNo, WithOrigin (Tip blk))
validate :: forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> ValidationPolicy -> m (ChunkNo, WithOrigin (Tip blk))
validate validateEnv :: ValidateEnv m blk h
validateEnv@ValidateEnv{ HasFS m h
hasFS :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, Tracer m (TraceEvent blk)
tracer :: forall (m :: * -> *) blk h.
ValidateEnv m blk h -> Tracer m (TraceEvent blk)
tracer :: Tracer m (TraceEvent blk)
tracer } ValidationPolicy
valPol = do
ValidateEnv m blk h -> m ()
forall (m :: * -> *) blk h.
(IOLike m, HasCallStack) =>
ValidateEnv m blk h -> m ()
migrate ValidateEnv m blk h
validateEnv
Set String
filesInDBFolder <- HasCallStack => FsPath -> m (Set String)
FsPath -> m (Set String)
listDirectory ([String] -> FsPath
mkFsPath [])
let (Set ChunkNo
chunkFiles, Set ChunkNo
_, Set ChunkNo
_) = Set String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
dbFilesOnDisk Set String
filesInDBFolder
case Set ChunkNo -> Maybe ChunkNo
forall a. Set a -> Maybe a
Set.lookupMax Set ChunkNo
chunkFiles of
Maybe ChunkNo
Nothing -> do
HasFS m h -> ChunkNo -> m ()
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> ChunkNo -> m ()
removeFilesStartingFrom HasFS m h
hasFS ChunkNo
firstChunkNo
(ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkNo
firstChunkNo, WithOrigin (Tip blk)
forall t. WithOrigin t
Origin)
Just ChunkNo
lastChunkOnDisk ->
let validateTracer :: Tracer m (TraceChunkValidation blk ())
validateTracer =
ChunkNo
-> Tracer m (TraceEvent blk)
-> Tracer m (TraceChunkValidation blk ())
decorateValidateTracer
ChunkNo
lastChunkOnDisk
Tracer m (TraceEvent blk)
tracer
in
case ValidationPolicy
valPol of
ValidationPolicy
ValidateAllChunks ->
ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
validateAllChunks ValidateEnv m blk h
validateEnv Tracer m (TraceChunkValidation blk ())
validateTracer ChunkNo
lastChunkOnDisk
ValidationPolicy
ValidateMostRecentChunk ->
ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
validateMostRecentChunk ValidateEnv m blk h
validateEnv Tracer m (TraceChunkValidation blk ())
validateTracer ChunkNo
lastChunkOnDisk
where
HasFS { HasCallStack => FsPath -> m (Set String)
listDirectory :: HasCallStack => FsPath -> m (Set String)
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
listDirectory } = HasFS m h
hasFS
decorateValidateTracer
:: ChunkNo
-> Tracer m (TraceEvent blk)
-> Tracer m (TraceChunkValidation blk ())
decorateValidateTracer :: ChunkNo
-> Tracer m (TraceEvent blk)
-> Tracer m (TraceChunkValidation blk ())
decorateValidateTracer ChunkNo
c' =
(TraceChunkValidation blk () -> TraceEvent blk)
-> Tracer m (TraceEvent blk)
-> Tracer m (TraceChunkValidation blk ())
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (TraceChunkValidation blk ChunkNo -> TraceEvent blk
forall blk. TraceChunkValidation blk ChunkNo -> TraceEvent blk
ChunkValidationEvent (TraceChunkValidation blk ChunkNo -> TraceEvent blk)
-> (TraceChunkValidation blk ()
-> TraceChunkValidation blk ChunkNo)
-> TraceChunkValidation blk ()
-> TraceEvent blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> ChunkNo)
-> TraceChunkValidation blk () -> TraceChunkValidation blk ChunkNo
forall a b.
(a -> b)
-> TraceChunkValidation blk a -> TraceChunkValidation blk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ChunkNo -> () -> ChunkNo
forall a b. a -> b -> a
const ChunkNo
c'))
validateAllChunks ::
forall m blk h.
( IOLike m
, GetPrevHash blk
, HasBinaryBlockInfo blk
, DecodeDisk blk (Lazy.ByteString -> blk)
, ConvertRawHash blk
, HasCallStack
)
=> ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
validateAllChunks :: forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
validateAllChunks validateEnv :: ValidateEnv m blk h
validateEnv@ValidateEnv { HasFS m h
hasFS :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, ChunkInfo
chunkInfo :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> ChunkInfo
chunkInfo :: ChunkInfo
chunkInfo } Tracer m (TraceChunkValidation blk ())
validateTracer ChunkNo
lastChunk =
(ChunkNo, WithOrigin (Tip blk))
-> ChunkNo -> ChainHash blk -> m (ChunkNo, WithOrigin (Tip blk))
go (ChunkNo
firstChunkNo, WithOrigin (Tip blk)
forall t. WithOrigin t
Origin) ChunkNo
firstChunkNo ChainHash blk
forall {k} (b :: k). ChainHash b
GenesisHash
where
go ::
(ChunkNo, WithOrigin (Tip blk))
-> ChunkNo
-> ChainHash blk
-> m (ChunkNo, WithOrigin (Tip blk))
go :: (ChunkNo, WithOrigin (Tip blk))
-> ChunkNo -> ChainHash blk -> m (ChunkNo, WithOrigin (Tip blk))
go (ChunkNo, WithOrigin (Tip blk))
lastValid ChunkNo
chunk ChainHash blk
prevHash = do
let shouldBeFinalised :: ShouldBeFinalised
shouldBeFinalised =
if ChunkNo
chunk ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkNo
lastChunk
then ShouldBeFinalised
ShouldNotBeFinalised
else ShouldBeFinalised
ShouldBeFinalised
ExceptT () m (Maybe (Tip blk)) -> m (Either () (Maybe (Tip blk)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ValidateEnv m blk h
-> ShouldBeFinalised
-> ChunkNo
-> Maybe (ChainHash blk)
-> Tracer m (TraceChunkValidation blk ())
-> ExceptT () m (Maybe (Tip blk))
forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> ShouldBeFinalised
-> ChunkNo
-> Maybe (ChainHash blk)
-> Tracer m (TraceChunkValidation blk ())
-> ExceptT () m (Maybe (Tip blk))
validateChunk ValidateEnv m blk h
validateEnv ShouldBeFinalised
shouldBeFinalised ChunkNo
chunk (ChainHash blk -> Maybe (ChainHash blk)
forall a. a -> Maybe a
Just ChainHash blk
prevHash) Tracer m (TraceChunkValidation blk ())
validateTracer) m (Either () (Maybe (Tip blk)))
-> (Either () (Maybe (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk)))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left () -> (ChunkNo, WithOrigin (Tip blk)) -> ChunkNo -> m ()
cleanup (ChunkNo, WithOrigin (Tip blk))
lastValid ChunkNo
chunk m ()
-> (ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (ChunkNo, WithOrigin (Tip blk))
lastValid
Right Maybe (Tip blk)
Nothing -> (ChunkNo, WithOrigin (Tip blk))
-> ChunkNo -> ChainHash blk -> m (ChunkNo, WithOrigin (Tip blk))
continueOrStop (ChunkNo, WithOrigin (Tip blk))
lastValid ChunkNo
chunk ChainHash blk
prevHash
Right (Just Tip blk
validBlk) -> (ChunkNo, WithOrigin (Tip blk))
-> ChunkNo -> ChainHash blk -> m (ChunkNo, WithOrigin (Tip blk))
continueOrStop (ChunkNo
chunk, Tip blk -> WithOrigin (Tip blk)
forall t. t -> WithOrigin t
NotOrigin Tip blk
validBlk) ChunkNo
chunk ChainHash blk
prevHash'
where
prevHash' :: ChainHash blk
prevHash' = HeaderHash blk -> ChainHash blk
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (Tip blk -> HeaderHash blk
forall blk. Tip blk -> HeaderHash blk
tipHash Tip blk
validBlk)
continueOrStop ::
(ChunkNo, WithOrigin (Tip blk))
-> ChunkNo
-> ChainHash blk
-> m (ChunkNo, WithOrigin (Tip blk))
continueOrStop :: (ChunkNo, WithOrigin (Tip blk))
-> ChunkNo -> ChainHash blk -> m (ChunkNo, WithOrigin (Tip blk))
continueOrStop (ChunkNo, WithOrigin (Tip blk))
lastValid ChunkNo
chunk ChainHash blk
prevHash
| ChunkNo
chunk ChunkNo -> ChunkNo -> Bool
forall a. Ord a => a -> a -> Bool
< ChunkNo
lastChunk
= do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validateTracer (ChunkNo -> () -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> validateTo -> TraceChunkValidation blk validateTo
ValidatedChunk ChunkNo
chunk ())
(ChunkNo, WithOrigin (Tip blk))
-> ChunkNo -> ChainHash blk -> m (ChunkNo, WithOrigin (Tip blk))
go (ChunkNo, WithOrigin (Tip blk))
lastValid (ChunkNo -> ChunkNo
nextChunkNo ChunkNo
chunk) ChainHash blk
prevHash
| Bool
otherwise
= Bool
-> m (ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a. HasCallStack => Bool -> a -> a
assert (ChunkNo
chunk ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkNo
lastChunk) (m (ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk)))
-> m (ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a b. (a -> b) -> a -> b
$ do
(ChunkNo, WithOrigin (Tip blk)) -> ChunkNo -> m ()
cleanup (ChunkNo, WithOrigin (Tip blk))
lastValid ChunkNo
chunk
(ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkNo, WithOrigin (Tip blk))
lastValid
cleanup ::
(ChunkNo, WithOrigin (Tip blk))
-> ChunkNo
-> m ()
cleanup :: (ChunkNo, WithOrigin (Tip blk)) -> ChunkNo -> m ()
cleanup (ChunkNo
lastValidChunk, WithOrigin (Tip blk)
tip) ChunkNo
lastValidatedChunk = case WithOrigin (Tip blk)
tip of
WithOrigin (Tip blk)
Origin ->
HasFS m h -> ChunkNo -> m ()
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> ChunkNo -> m ()
removeFilesStartingFrom HasFS m h
hasFS ChunkNo
firstChunkNo
NotOrigin Tip blk
_ -> do
HasFS m h -> ChunkNo -> m ()
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> ChunkNo -> m ()
removeFilesStartingFrom HasFS m h
hasFS (ChunkNo -> ChunkNo
nextChunkNo ChunkNo
lastValidChunk)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChunkNo
lastValidChunk ChunkNo -> ChunkNo -> Bool
forall a. Ord a => a -> a -> Bool
< ChunkNo
lastValidatedChunk) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Proxy blk -> HasFS m h -> ChunkInfo -> ChunkNo -> m ()
forall (m :: * -> *) blk h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> HasFS m h -> ChunkInfo -> ChunkNo -> m ()
Primary.unfinalise (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
lastValidChunk
validateMostRecentChunk ::
forall m blk h.
( IOLike m
, GetPrevHash blk
, HasBinaryBlockInfo blk
, DecodeDisk blk (Lazy.ByteString -> blk)
, ConvertRawHash blk
, HasCallStack
)
=> ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
validateMostRecentChunk :: forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> Tracer m (TraceChunkValidation blk ())
-> ChunkNo
-> m (ChunkNo, WithOrigin (Tip blk))
validateMostRecentChunk validateEnv :: ValidateEnv m blk h
validateEnv@ValidateEnv { HasFS m h
hasFS :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS } Tracer m (TraceChunkValidation blk ())
validateTracer ChunkNo
c = do
(ChunkNo, WithOrigin (Tip blk))
res <- ChunkNo -> m (ChunkNo, WithOrigin (Tip blk))
go ChunkNo
c
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validateTracer (ChunkNo -> () -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> validateTo -> TraceChunkValidation blk validateTo
ValidatedChunk ChunkNo
c ())
(ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkNo, WithOrigin (Tip blk))
res
where
go :: ChunkNo -> m (ChunkNo, WithOrigin (Tip blk))
go :: ChunkNo -> m (ChunkNo, WithOrigin (Tip blk))
go ChunkNo
chunk = ExceptT () m (Maybe (Tip blk)) -> m (Either () (Maybe (Tip blk)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ValidateEnv m blk h
-> ShouldBeFinalised
-> ChunkNo
-> Maybe (ChainHash blk)
-> Tracer m (TraceChunkValidation blk ())
-> ExceptT () m (Maybe (Tip blk))
forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> ShouldBeFinalised
-> ChunkNo
-> Maybe (ChainHash blk)
-> Tracer m (TraceChunkValidation blk ())
-> ExceptT () m (Maybe (Tip blk))
validateChunk ValidateEnv m blk h
validateEnv ShouldBeFinalised
ShouldNotBeFinalised ChunkNo
chunk Maybe (ChainHash blk)
forall a. Maybe a
Nothing Tracer m (TraceChunkValidation blk ())
validateTracer) m (Either () (Maybe (Tip blk)))
-> (Either () (Maybe (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk)))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right (Just Tip blk
validBlk) -> do
HasFS m h -> ChunkNo -> m ()
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> ChunkNo -> m ()
removeFilesStartingFrom HasFS m h
hasFS (ChunkNo -> ChunkNo
nextChunkNo ChunkNo
chunk)
(ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkNo
chunk, Tip blk -> WithOrigin (Tip blk)
forall t. t -> WithOrigin t
NotOrigin Tip blk
validBlk)
Either () (Maybe (Tip blk))
_
| Just ChunkNo
chunk' <- ChunkNo -> Maybe ChunkNo
prevChunkNo ChunkNo
chunk -> ChunkNo -> m (ChunkNo, WithOrigin (Tip blk))
go ChunkNo
chunk'
| Bool
otherwise -> do
HasFS m h -> ChunkNo -> m ()
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> ChunkNo -> m ()
removeFilesStartingFrom HasFS m h
hasFS ChunkNo
firstChunkNo
(ChunkNo, WithOrigin (Tip blk))
-> m (ChunkNo, WithOrigin (Tip blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkNo
firstChunkNo, WithOrigin (Tip blk)
forall t. WithOrigin t
Origin)
data ShouldBeFinalised =
ShouldBeFinalised
| ShouldNotBeFinalised
deriving (Int -> ShouldBeFinalised -> ShowS
[ShouldBeFinalised] -> ShowS
ShouldBeFinalised -> String
(Int -> ShouldBeFinalised -> ShowS)
-> (ShouldBeFinalised -> String)
-> ([ShouldBeFinalised] -> ShowS)
-> Show ShouldBeFinalised
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShouldBeFinalised -> ShowS
showsPrec :: Int -> ShouldBeFinalised -> ShowS
$cshow :: ShouldBeFinalised -> String
show :: ShouldBeFinalised -> String
$cshowList :: [ShouldBeFinalised] -> ShowS
showList :: [ShouldBeFinalised] -> ShowS
Show)
validateChunk ::
forall m blk h.
( IOLike m
, GetPrevHash blk
, HasBinaryBlockInfo blk
, DecodeDisk blk (Lazy.ByteString -> blk)
, ConvertRawHash blk
, HasCallStack
)
=> ValidateEnv m blk h
-> ShouldBeFinalised
-> ChunkNo
-> Maybe (ChainHash blk)
-> Tracer m (TraceChunkValidation blk ())
-> ExceptT () m (Maybe (Tip blk))
validateChunk :: forall (m :: * -> *) blk h.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk), ConvertRawHash blk,
HasCallStack) =>
ValidateEnv m blk h
-> ShouldBeFinalised
-> ChunkNo
-> Maybe (ChainHash blk)
-> Tracer m (TraceChunkValidation blk ())
-> ExceptT () m (Maybe (Tip blk))
validateChunk ValidateEnv{Tracer m (TraceEvent blk)
HasFS m h
CodecConfig blk
ChunkInfo
CacheConfig
blk -> Bool
hasFS :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> HasFS m h
chunkInfo :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> ChunkInfo
tracer :: forall (m :: * -> *) blk h.
ValidateEnv m blk h -> Tracer m (TraceEvent blk)
cacheConfig :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> CacheConfig
codecConfig :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> CodecConfig blk
checkIntegrity :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> blk -> Bool
hasFS :: HasFS m h
chunkInfo :: ChunkInfo
tracer :: Tracer m (TraceEvent blk)
cacheConfig :: CacheConfig
codecConfig :: CodecConfig blk
checkIntegrity :: blk -> Bool
..} ShouldBeFinalised
shouldBeFinalised ChunkNo
chunk Maybe (ChainHash blk)
mbPrevHash Tracer m (TraceChunkValidation blk ())
validationTracer = do
m () -> ExceptT () m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT () m ()) -> m () -> ExceptT () m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> () -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> validateTo -> TraceChunkValidation blk validateTo
StartedValidatingChunk ChunkNo
chunk ()
Bool
chunkFileExists <- m Bool -> ExceptT () m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT () m Bool) -> m Bool -> ExceptT () m Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => FsPath -> m Bool
FsPath -> m Bool
doesFileExist FsPath
chunkFile
Bool -> ExceptT () m () -> ExceptT () m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
chunkFileExists (ExceptT () m () -> ExceptT () m ())
-> ExceptT () m () -> ExceptT () m ()
forall a b. (a -> b) -> a -> b
$ do
m () -> ExceptT () m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT () m ()) -> m () -> ExceptT () m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> TraceChunkValidation blk validateTo
MissingChunkFile ChunkNo
chunk
() -> ExceptT () m ()
forall a. () -> ExceptT () m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ()
Bool
secondaryIndexFileExists <- m Bool -> ExceptT () m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT () m Bool) -> m Bool -> ExceptT () m Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => FsPath -> m Bool
FsPath -> m Bool
doesFileExist FsPath
secondaryIndexFile
[Entry blk]
entriesFromSecondaryIndex <- m [Entry blk] -> ExceptT () m [Entry blk]
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Entry blk] -> ExceptT () m [Entry blk])
-> m [Entry blk] -> ExceptT () m [Entry blk]
forall a b. (a -> b) -> a -> b
$ if Bool
secondaryIndexFileExists
then (ImmutableDBError blk -> Maybe ())
-> m [WithBlockSize (Entry blk)]
-> m (Either () [WithBlockSize (Entry blk)])
forall e b a.
Exception e =>
(e -> Maybe b) -> m a -> m (Either b a)
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust ImmutableDBError blk -> Maybe ()
isInvalidFileError
(HasFS m h
-> SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, MonadThrow m, StandardHash blk,
Typeable blk) =>
HasFS m h
-> SecondaryOffset
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
Secondary.readAllEntries HasFS m h
hasFS SecondaryOffset
0 ChunkNo
chunk (Bool -> Entry blk -> Bool
forall a b. a -> b -> a
const Bool
False) Word64
forall a. Bounded a => a
maxBound IsEBB
IsEBB) m (Either () [WithBlockSize (Entry blk)])
-> (Either () [WithBlockSize (Entry blk)] -> m [Entry blk])
-> m [Entry blk]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left ()
_ -> do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> TraceChunkValidation blk validateTo
InvalidSecondaryIndex ChunkNo
chunk
[Entry blk] -> m [Entry blk]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right [WithBlockSize (Entry blk)]
entriesFromFile ->
[Entry blk] -> m [Entry blk]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Entry blk] -> m [Entry blk]) -> [Entry blk] -> m [Entry blk]
forall a b. (a -> b) -> a -> b
$ [Entry blk] -> [Entry blk]
forall hash. [Entry hash] -> [Entry hash]
fixupEBB ((WithBlockSize (Entry blk) -> Entry blk)
-> [WithBlockSize (Entry blk)] -> [Entry blk]
forall a b. (a -> b) -> [a] -> [b]
map WithBlockSize (Entry blk) -> Entry blk
forall a. WithBlockSize a -> a
withoutBlockSize [WithBlockSize (Entry blk)]
entriesFromFile)
else do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> TraceChunkValidation blk validateTo
MissingSecondaryIndex ChunkNo
chunk
[Entry blk] -> m [Entry blk]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
let expectedChecksums :: [CRC]
expectedChecksums = (Entry blk -> CRC) -> [Entry blk] -> [CRC]
forall a b. (a -> b) -> [a] -> [b]
map Entry blk -> CRC
forall blk. Entry blk -> CRC
Secondary.checksum [Entry blk]
entriesFromSecondaryIndex
([(BlockSummary blk, ChainHash blk)]
entriesWithPrevHashes, Maybe (ChunkFileError blk, Word64)
mbErr) <- m ([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64))
-> ExceptT
()
m
([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64))
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64))
-> ExceptT
()
m
([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64)))
-> m ([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64))
-> ExceptT
()
m
([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64))
forall a b. (a -> b) -> a -> b
$
CodecConfig blk
-> HasFS m h
-> (blk -> Bool)
-> FsPath
-> [CRC]
-> (Stream
(Of (BlockSummary blk, ChainHash blk))
m
(Maybe (ChunkFileError blk, Word64))
-> m ([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64)))
-> m ([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64))
forall (m :: * -> *) blk h r.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
DecodeDisk blk (ByteString -> blk)) =>
CodecConfig blk
-> HasFS m h
-> (blk -> Bool)
-> FsPath
-> [CRC]
-> (Stream
(Of (BlockSummary blk, ChainHash blk))
m
(Maybe (ChunkFileError blk, Word64))
-> m r)
-> m r
parseChunkFile
CodecConfig blk
codecConfig
HasFS m h
hasFS
blk -> Bool
checkIntegrity
FsPath
chunkFile
[CRC]
expectedChecksums
(\Stream
(Of (BlockSummary blk, ChainHash blk))
m
(Maybe (ChunkFileError blk, Word64))
entries -> (\([(BlockSummary blk, ChainHash blk)]
es :> Maybe (ChunkFileError blk, Word64)
mbErr) -> ([(BlockSummary blk, ChainHash blk)]
es, Maybe (ChunkFileError blk, Word64)
mbErr)) (Of
[(BlockSummary blk, ChainHash blk)]
(Maybe (ChunkFileError blk, Word64))
-> ([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64)))
-> m (Of
[(BlockSummary blk, ChainHash blk)]
(Maybe (ChunkFileError blk, Word64)))
-> m ([(BlockSummary blk, ChainHash blk)],
Maybe (ChunkFileError blk, Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream
(Of (BlockSummary blk, ChainHash blk))
m
(Maybe (ChunkFileError blk, Word64))
-> m (Of
[(BlockSummary blk, ChainHash blk)]
(Maybe (ChunkFileError blk, Word64)))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Of [a] r)
S.toList Stream
(Of (BlockSummary blk, ChainHash blk))
m
(Maybe (ChunkFileError blk, Word64))
entries)
case [(BlockSummary blk, ChainHash blk)]
entriesWithPrevHashes of
(BlockSummary blk
_, ChainHash blk
actualPrevHash) : [(BlockSummary blk, ChainHash blk)]
_
| Just ChainHash blk
expectedPrevHash <- Maybe (ChainHash blk)
mbPrevHash
, ChainHash blk
expectedPrevHash ChainHash blk -> ChainHash blk -> Bool
forall a. Eq a => a -> a -> Bool
/= ChainHash blk
actualPrevHash
-> do
m () -> ExceptT () m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT () m ()) -> m () -> ExceptT () m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
tracer (TraceEvent blk -> m ()) -> TraceEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$ ChainHash blk -> ChainHash blk -> TraceEvent blk
forall blk. ChainHash blk -> ChainHash blk -> TraceEvent blk
ChunkFileDoesntFit ChainHash blk
expectedPrevHash ChainHash blk
actualPrevHash
() -> ExceptT () m ()
forall a. () -> ExceptT () m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ()
[(BlockSummary blk, ChainHash blk)]
_ -> () -> ExceptT () m ()
forall a. a -> ExceptT () m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
m (Maybe (Tip blk)) -> ExceptT () m (Maybe (Tip blk))
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Tip blk)) -> ExceptT () m (Maybe (Tip blk)))
-> m (Maybe (Tip blk)) -> ExceptT () m (Maybe (Tip blk))
forall a b. (a -> b) -> a -> b
$ do
Maybe (ChunkFileError blk, Word64)
-> ((ChunkFileError blk, Word64) -> m ()) -> m ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe (ChunkFileError blk, Word64)
mbErr (((ChunkFileError blk, Word64) -> m ()) -> m ())
-> ((ChunkFileError blk, Word64) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(ChunkFileError blk
parseErr, Word64
endOfLastValidBlock) -> do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> ChunkFileError blk -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo
-> ChunkFileError blk -> TraceChunkValidation blk validateTo
InvalidChunkFile ChunkNo
chunk ChunkFileError blk
parseErr
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m ()) -> m ()
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
chunkFile (AllowExisting -> OpenMode
AppendMode AllowExisting
AllowExisting) ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
eHnd ->
HasCallStack => Handle h -> Word64 -> m ()
Handle h -> Word64 -> m ()
hTruncate Handle h
eHnd Word64
endOfLastValidBlock
let summary :: [BlockSummary blk]
summary = ((BlockSummary blk, ChainHash blk) -> BlockSummary blk)
-> [(BlockSummary blk, ChainHash blk)] -> [BlockSummary blk]
forall a b. (a -> b) -> [a] -> [b]
map (BlockSummary blk, ChainHash blk) -> BlockSummary blk
forall a b. (a, b) -> a
fst [(BlockSummary blk, ChainHash blk)]
entriesWithPrevHashes
entries :: [Entry blk]
entries = (BlockSummary blk -> Entry blk)
-> [BlockSummary blk] -> [Entry blk]
forall a b. (a -> b) -> [a] -> [b]
map BlockSummary blk -> Entry blk
forall blk. BlockSummary blk -> Entry blk
summaryEntry [BlockSummary blk]
summary
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Entry blk]
entriesFromSecondaryIndex [Entry blk] -> [Entry blk] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Entry blk]
entries Bool -> Bool -> Bool
||
Bool -> Bool
not Bool
secondaryIndexFileExists) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> TraceChunkValidation blk validateTo
RewriteSecondaryIndex ChunkNo
chunk
HasFS m h -> ChunkNo -> [Entry blk] -> m ()
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, MonadThrow m) =>
HasFS m h -> ChunkNo -> [Entry blk] -> m ()
Secondary.writeAllEntries HasFS m h
hasFS ChunkNo
chunk [Entry blk]
entries
let primaryIndex :: PrimaryIndex
primaryIndex = Proxy blk
-> ChunkInfo
-> ShouldBeFinalised
-> ChunkNo
-> [BlockOrEBB]
-> PrimaryIndex
forall blk.
(ConvertRawHash blk, HasCallStack) =>
Proxy blk
-> ChunkInfo
-> ShouldBeFinalised
-> ChunkNo
-> [BlockOrEBB]
-> PrimaryIndex
reconstructPrimaryIndex
(forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
ChunkInfo
chunkInfo
ShouldBeFinalised
shouldBeFinalised
ChunkNo
chunk
((Entry blk -> BlockOrEBB) -> [Entry blk] -> [BlockOrEBB]
forall a b. (a -> b) -> [a] -> [b]
map Entry blk -> BlockOrEBB
forall blk. Entry blk -> BlockOrEBB
Secondary.blockOrEBB [Entry blk]
entries)
Bool
primaryIndexFileExists <- HasCallStack => FsPath -> m Bool
FsPath -> m Bool
doesFileExist FsPath
primaryIndexFile
Bool
primaryIndexFileMatches <- if Bool
primaryIndexFileExists
then (ImmutableDBError blk -> Maybe ())
-> m PrimaryIndex -> m (Either () PrimaryIndex)
forall e b a.
Exception e =>
(e -> Maybe b) -> m a -> m (Either b a)
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust ImmutableDBError blk -> Maybe ()
isInvalidFileError (Proxy blk -> HasFS m h -> ChunkNo -> m PrimaryIndex
forall blk (m :: * -> *) h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> HasFS m h -> ChunkNo -> m PrimaryIndex
Primary.load (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) HasFS m h
hasFS ChunkNo
chunk) m (Either () PrimaryIndex)
-> (Either () PrimaryIndex -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left () -> do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> TraceChunkValidation blk validateTo
InvalidPrimaryIndex ChunkNo
chunk
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Right PrimaryIndex
primaryIndexFromFile ->
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ PrimaryIndex
primaryIndexFromFile PrimaryIndex -> PrimaryIndex -> Bool
forall a. Eq a => a -> a -> Bool
== PrimaryIndex
primaryIndex
else do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> TraceChunkValidation blk validateTo
MissingPrimaryIndex ChunkNo
chunk
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
primaryIndexFileMatches (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Tracer m (TraceChunkValidation blk ())
-> TraceChunkValidation blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChunkValidation blk ())
validationTracer (TraceChunkValidation blk () -> m ())
-> TraceChunkValidation blk () -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> TraceChunkValidation blk ()
forall blk validateTo.
ChunkNo -> TraceChunkValidation blk validateTo
RewritePrimaryIndex ChunkNo
chunk
HasFS m h -> ChunkNo -> PrimaryIndex -> m ()
forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h -> ChunkNo -> PrimaryIndex -> m ()
Primary.write HasFS m h
hasFS ChunkNo
chunk PrimaryIndex
primaryIndex
Maybe (Tip blk) -> m (Maybe (Tip blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Tip blk) -> m (Maybe (Tip blk)))
-> Maybe (Tip blk) -> m (Maybe (Tip blk))
forall a b. (a -> b) -> a -> b
$ BlockSummary blk -> Tip blk
summaryToTipInfo (BlockSummary blk -> Tip blk)
-> Maybe (BlockSummary blk) -> Maybe (Tip blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BlockSummary blk] -> Maybe (BlockSummary blk)
forall a. [a] -> Maybe a
lastMaybe [BlockSummary blk]
summary
where
chunkFile :: FsPath
chunkFile = ChunkNo -> FsPath
fsPathChunkFile ChunkNo
chunk
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
secondaryIndexFile :: FsPath
secondaryIndexFile = ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk
HasFS { HasCallStack => Handle h -> Word64 -> m ()
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hTruncate, HasCallStack => FsPath -> m Bool
doesFileExist :: HasCallStack => FsPath -> m Bool
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesFileExist } = HasFS m h
hasFS
summaryToTipInfo :: BlockSummary blk -> Tip blk
summaryToTipInfo :: BlockSummary blk -> Tip blk
summaryToTipInfo BlockSummary {BlockNo
SlotNo
Entry blk
summaryEntry :: forall blk. BlockSummary blk -> Entry blk
summaryEntry :: Entry blk
summaryBlockNo :: BlockNo
summarySlotNo :: SlotNo
summaryBlockNo :: forall blk. BlockSummary blk -> BlockNo
summarySlotNo :: forall blk. BlockSummary blk -> SlotNo
..} = Tip {
tipSlotNo :: SlotNo
tipSlotNo = SlotNo
summarySlotNo
, tipIsEBB :: IsEBB
tipIsEBB = BlockOrEBB -> IsEBB
isBlockOrEBB (BlockOrEBB -> IsEBB) -> BlockOrEBB -> IsEBB
forall a b. (a -> b) -> a -> b
$ Entry blk -> BlockOrEBB
forall blk. Entry blk -> BlockOrEBB
Secondary.blockOrEBB Entry blk
summaryEntry
, tipBlockNo :: BlockNo
tipBlockNo = BlockNo
summaryBlockNo
, tipHash :: HeaderHash blk
tipHash = Entry blk -> HeaderHash blk
forall blk. Entry blk -> HeaderHash blk
Secondary.headerHash Entry blk
summaryEntry
}
isInvalidFileError :: ImmutableDBError blk -> Maybe ()
isInvalidFileError :: ImmutableDBError blk -> Maybe ()
isInvalidFileError = \case
UnexpectedFailure (InvalidFileError {}) -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
ImmutableDBError blk
_ -> Maybe ()
forall a. Maybe a
Nothing
fixupEBB :: forall hash. [Secondary.Entry hash] -> [Secondary.Entry hash]
fixupEBB :: forall hash. [Entry hash] -> [Entry hash]
fixupEBB = \case
entry :: Entry hash
entry@Secondary.Entry { blockOrEBB :: forall blk. Entry blk -> BlockOrEBB
blockOrEBB = EBB EpochNo
epoch' }:[Entry hash]
rest
| let chunk' :: ChunkNo
chunk' = EpochNo -> ChunkNo
unsafeEpochNoToChunkNo EpochNo
epoch'
, ChunkNo
chunk' ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
/= ChunkNo
chunk
-> Entry hash
entry { Secondary.blockOrEBB = Block (SlotNo (unChunkNo chunk')) }Entry hash -> [Entry hash] -> [Entry hash]
forall a. a -> [a] -> [a]
:[Entry hash]
rest
[Entry hash]
entries -> [Entry hash]
entries
reconstructPrimaryIndex ::
forall blk. (ConvertRawHash blk, HasCallStack)
=> Proxy blk
-> ChunkInfo
-> ShouldBeFinalised
-> ChunkNo
-> [BlockOrEBB]
-> PrimaryIndex
reconstructPrimaryIndex :: forall blk.
(ConvertRawHash blk, HasCallStack) =>
Proxy blk
-> ChunkInfo
-> ShouldBeFinalised
-> ChunkNo
-> [BlockOrEBB]
-> PrimaryIndex
reconstructPrimaryIndex Proxy blk
pb ChunkInfo
chunkInfo ShouldBeFinalised
shouldBeFinalised ChunkNo
chunk [BlockOrEBB]
blockOrEBBs =
PrimaryIndex -> Maybe PrimaryIndex -> PrimaryIndex
forall a. a -> Maybe a -> a
fromMaybe (String -> PrimaryIndex
forall a. HasCallStack => String -> a
error String
nonIncreasing) (Maybe PrimaryIndex -> PrimaryIndex)
-> Maybe PrimaryIndex -> PrimaryIndex
forall a b. (a -> b) -> a -> b
$
ChunkNo -> [SecondaryOffset] -> Maybe PrimaryIndex
Primary.mk ChunkNo
chunk ([SecondaryOffset] -> Maybe PrimaryIndex)
-> ([SecondaryOffset] -> [SecondaryOffset])
-> [SecondaryOffset]
-> Maybe PrimaryIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SecondaryOffset
0SecondaryOffset -> [SecondaryOffset] -> [SecondaryOffset]
forall a. a -> [a] -> [a]
:) ([SecondaryOffset] -> Maybe PrimaryIndex)
-> [SecondaryOffset] -> Maybe PrimaryIndex
forall a b. (a -> b) -> a -> b
$
HasCallStack =>
NextRelativeSlot
-> SecondaryOffset -> [RelativeSlot] -> [SecondaryOffset]
NextRelativeSlot
-> SecondaryOffset -> [RelativeSlot] -> [SecondaryOffset]
go (RelativeSlot -> NextRelativeSlot
NextRelativeSlot (ChunkInfo -> ChunkNo -> RelativeSlot
firstBlockOrEBB ChunkInfo
chunkInfo ChunkNo
chunk)) SecondaryOffset
0 ([RelativeSlot] -> [SecondaryOffset])
-> [RelativeSlot] -> [SecondaryOffset]
forall a b. (a -> b) -> a -> b
$
(BlockOrEBB -> RelativeSlot) -> [BlockOrEBB] -> [RelativeSlot]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkSlot -> RelativeSlot
chunkRelative (ChunkSlot -> RelativeSlot)
-> (BlockOrEBB -> ChunkSlot) -> BlockOrEBB -> RelativeSlot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkInfo -> BlockOrEBB -> ChunkSlot
chunkSlotForBlockOrEBB ChunkInfo
chunkInfo) [BlockOrEBB]
blockOrEBBs
where
nonIncreasing :: String
nonIncreasing :: String
nonIncreasing = String
"blocks have non-increasing slot numbers"
go :: HasCallStack
=> NextRelativeSlot
-> SecondaryOffset
-> [RelativeSlot]
-> [SecondaryOffset]
go :: HasCallStack =>
NextRelativeSlot
-> SecondaryOffset -> [RelativeSlot] -> [SecondaryOffset]
go NextRelativeSlot
expected SecondaryOffset
lastSecondaryOffset [RelativeSlot]
relSlots =
case (NextRelativeSlot
expected, [RelativeSlot]
relSlots) of
(NextRelativeSlot
_, []) ->
case ShouldBeFinalised
shouldBeFinalised of
ShouldBeFinalised
ShouldNotBeFinalised -> []
ShouldBeFinalised
ShouldBeFinalised -> ChunkInfo
-> ChunkNo
-> NextRelativeSlot
-> SecondaryOffset
-> [SecondaryOffset]
Primary.backfillChunk
ChunkInfo
chunkInfo
ChunkNo
chunk
NextRelativeSlot
expected
SecondaryOffset
lastSecondaryOffset
(NextRelativeSlot
NoMoreRelativeSlots, [RelativeSlot]
_) ->
String -> [SecondaryOffset]
forall a. HasCallStack => String -> a
error String
"reconstructPrimaryIndex: too many entries"
(NextRelativeSlot RelativeSlot
nextExpectedRelSlot, RelativeSlot
relSlot:[RelativeSlot]
relSlots') ->
if HasCallStack => RelativeSlot -> RelativeSlot -> Ordering
RelativeSlot -> RelativeSlot -> Ordering
compareRelativeSlot RelativeSlot
relSlot RelativeSlot
nextExpectedRelSlot Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then
String -> [SecondaryOffset]
forall a. HasCallStack => String -> a
error String
nonIncreasing
else
let backfilled :: [SecondaryOffset]
backfilled = RelativeSlot
-> RelativeSlot -> SecondaryOffset -> [SecondaryOffset]
Primary.backfill
RelativeSlot
relSlot
RelativeSlot
nextExpectedRelSlot
SecondaryOffset
lastSecondaryOffset
secondaryOffset :: SecondaryOffset
secondaryOffset = SecondaryOffset
lastSecondaryOffset
SecondaryOffset -> SecondaryOffset -> SecondaryOffset
forall a. Num a => a -> a -> a
+ Proxy blk -> SecondaryOffset
forall blk. ConvertRawHash blk => Proxy blk -> SecondaryOffset
Secondary.entrySize Proxy blk
pb
in [SecondaryOffset]
backfilled [SecondaryOffset] -> [SecondaryOffset] -> [SecondaryOffset]
forall a. [a] -> [a] -> [a]
++ SecondaryOffset
secondaryOffset
SecondaryOffset -> [SecondaryOffset] -> [SecondaryOffset]
forall a. a -> [a] -> [a]
: HasCallStack =>
NextRelativeSlot
-> SecondaryOffset -> [RelativeSlot] -> [SecondaryOffset]
NextRelativeSlot
-> SecondaryOffset -> [RelativeSlot] -> [SecondaryOffset]
go (HasCallStack => RelativeSlot -> NextRelativeSlot
RelativeSlot -> NextRelativeSlot
nextRelativeSlot RelativeSlot
relSlot) SecondaryOffset
secondaryOffset [RelativeSlot]
relSlots'
migrate :: (IOLike m, HasCallStack) => ValidateEnv m blk h -> m ()
migrate :: forall (m :: * -> *) blk h.
(IOLike m, HasCallStack) =>
ValidateEnv m blk h -> m ()
migrate ValidateEnv { HasFS m h
hasFS :: forall (m :: * -> *) blk h. ValidateEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, Tracer m (TraceEvent blk)
tracer :: forall (m :: * -> *) blk h.
ValidateEnv m blk h -> Tracer m (TraceEvent blk)
tracer :: Tracer m (TraceEvent blk)
tracer } = do
Set String
filesInDBFolder <- HasCallStack => FsPath -> m (Set String)
FsPath -> m (Set String)
listDirectory ([String] -> FsPath
mkFsPath [])
let epochFileChunkNos :: [(FsPath, ChunkNo)]
epochFileChunkNos :: [(FsPath, ChunkNo)]
epochFileChunkNos =
(String -> Maybe (FsPath, ChunkNo))
-> [String] -> [(FsPath, ChunkNo)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\String
file -> ([String] -> FsPath
mkFsPath [String
file],) (ChunkNo -> (FsPath, ChunkNo))
-> Maybe ChunkNo -> Maybe (FsPath, ChunkNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe ChunkNo
isEpochFile String
file)
(Set String -> [String]
forall a. Set a -> [a]
Set.toAscList Set String
filesInDBFolder)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(FsPath, ChunkNo)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FsPath, ChunkNo)]
epochFileChunkNos) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
tracer (TraceEvent blk -> m ()) -> TraceEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> TraceEvent blk
forall blk. Text -> TraceEvent blk
Migrating Text
".epoch files to .chunk files"
[(FsPath, ChunkNo)] -> ((FsPath, ChunkNo) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(FsPath, ChunkNo)]
epochFileChunkNos (((FsPath, ChunkNo) -> m ()) -> m ())
-> ((FsPath, ChunkNo) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(FsPath
epochFile, ChunkNo
chunk) ->
HasCallStack => FsPath -> FsPath -> m ()
FsPath -> FsPath -> m ()
renameFile FsPath
epochFile (ChunkNo -> FsPath
fsPathChunkFile ChunkNo
chunk)
where
HasFS { HasCallStack => FsPath -> m (Set String)
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
listDirectory :: HasCallStack => FsPath -> m (Set String)
listDirectory, HasCallStack => FsPath -> FsPath -> m ()
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
renameFile } = HasFS m h
hasFS
isEpochFile :: String -> Maybe ChunkNo
isEpochFile :: String -> Maybe ChunkNo
isEpochFile String
s = case String -> Maybe (String, ChunkNo)
parseDBFile String
s of
Just (String
prefix, ChunkNo
chunk)
| String
prefix String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"epoch"
-> ChunkNo -> Maybe ChunkNo
forall a. a -> Maybe a
Just ChunkNo
chunk
Maybe (String, ChunkNo)
_ -> Maybe ChunkNo
forall a. Maybe a
Nothing