{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary (
SecondaryOffset
, PrimaryIndex (..)
, appendOffsets
, backfill
, backfillChunk
, containsSlot
, currentVersionNumber
, filledSlots
, firstFilledSlot
, getLastSlot
, isFilledSlot
, lastFilledSlot
, lastOffset
, load
, nextFilledSlot
, offsetOfSlot
, open
, readFirstFilledSlot
, readOffset
, readOffsets
, secondaryOffsetSize
, sizeOfSlot
, slots
, truncateToSlot
, truncateToSlotFS
, unfinalise
, write
, mk
, toSecondaryOffsets
) where
import Control.Exception (assert)
import Control.Monad
import Data.Binary (Get, Put)
import qualified Data.Binary.Get as Get
import qualified Data.Binary.Put as Put
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import Data.Functor.Identity (Identity (..))
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import Data.Vector.Unboxed (Vector)
import qualified Data.Vector.Unboxed as V
import Data.Word
import Foreign.Storable (sizeOf)
import GHC.Generics (Generic)
import Ouroboros.Consensus.Block (StandardHash)
import Ouroboros.Consensus.Storage.ImmutableDB.API
(ImmutableDBError (..), SecondaryOffset,
UnexpectedFailure (..))
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util
(fsPathPrimaryIndexFile, runGet)
import Ouroboros.Consensus.Util.CallStack
import Ouroboros.Consensus.Util.IOLike
import System.FS.API.Lazy hiding (allowExisting)
getSecondaryOffset :: Get SecondaryOffset
getSecondaryOffset :: Get SecondaryOffset
getSecondaryOffset = Get SecondaryOffset
Get.getWord32be
putSecondaryOffset :: SecondaryOffset -> Put
putSecondaryOffset :: SecondaryOffset -> Put
putSecondaryOffset = SecondaryOffset -> Put
Put.putWord32be
secondaryOffsetSize :: Word64
secondaryOffsetSize :: Word64
secondaryOffsetSize = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ SecondaryOffset -> Int
forall a. Storable a => a -> Int
sizeOf ([Char] -> SecondaryOffset
forall a. HasCallStack => [Char] -> a
error [Char]
"sizeOf" :: SecondaryOffset)
{-# INLINE secondaryOffsetSize #-}
data PrimaryIndex = MkPrimaryIndex {
PrimaryIndex -> ChunkNo
primaryIndexChunkNo :: !ChunkNo
, PrimaryIndex -> Vector SecondaryOffset
primaryIndexOffsets :: !(Vector SecondaryOffset)
}
deriving stock (PrimaryIndex -> PrimaryIndex -> Bool
(PrimaryIndex -> PrimaryIndex -> Bool)
-> (PrimaryIndex -> PrimaryIndex -> Bool) -> Eq PrimaryIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimaryIndex -> PrimaryIndex -> Bool
== :: PrimaryIndex -> PrimaryIndex -> Bool
$c/= :: PrimaryIndex -> PrimaryIndex -> Bool
/= :: PrimaryIndex -> PrimaryIndex -> Bool
Eq, Int -> PrimaryIndex -> ShowS
[PrimaryIndex] -> ShowS
PrimaryIndex -> [Char]
(Int -> PrimaryIndex -> ShowS)
-> (PrimaryIndex -> [Char])
-> ([PrimaryIndex] -> ShowS)
-> Show PrimaryIndex
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimaryIndex -> ShowS
showsPrec :: Int -> PrimaryIndex -> ShowS
$cshow :: PrimaryIndex -> [Char]
show :: PrimaryIndex -> [Char]
$cshowList :: [PrimaryIndex] -> ShowS
showList :: [PrimaryIndex] -> ShowS
Show, (forall x. PrimaryIndex -> Rep PrimaryIndex x)
-> (forall x. Rep PrimaryIndex x -> PrimaryIndex)
-> Generic PrimaryIndex
forall x. Rep PrimaryIndex x -> PrimaryIndex
forall x. PrimaryIndex -> Rep PrimaryIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrimaryIndex -> Rep PrimaryIndex x
from :: forall x. PrimaryIndex -> Rep PrimaryIndex x
$cto :: forall x. Rep PrimaryIndex x -> PrimaryIndex
to :: forall x. Rep PrimaryIndex x -> PrimaryIndex
Generic)
deriving anyclass (Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
Proxy PrimaryIndex -> [Char]
(Context -> PrimaryIndex -> IO (Maybe ThunkInfo))
-> (Context -> PrimaryIndex -> IO (Maybe ThunkInfo))
-> (Proxy PrimaryIndex -> [Char])
-> NoThunks PrimaryIndex
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
$cnoThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
noThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PrimaryIndex -> [Char]
showTypeOf :: Proxy PrimaryIndex -> [Char]
NoThunks)
assertInPrimaryIndex :: HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex :: HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex = HasCallStack => ChunkNo -> RelativeSlot -> Word64
ChunkNo -> RelativeSlot -> Word64
assertRelativeSlotInChunk (ChunkNo -> RelativeSlot -> Word64)
-> (PrimaryIndex -> ChunkNo)
-> PrimaryIndex
-> RelativeSlot
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimaryIndex -> ChunkNo
primaryIndexChunkNo
mk :: ChunkNo -> [SecondaryOffset] -> Maybe PrimaryIndex
mk :: ChunkNo -> [SecondaryOffset] -> Maybe PrimaryIndex
mk ChunkNo
chunk offsets :: [SecondaryOffset]
offsets@(SecondaryOffset
0:[SecondaryOffset]
_)
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (SecondaryOffset -> SecondaryOffset -> Bool)
-> [SecondaryOffset] -> [SecondaryOffset] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith SecondaryOffset -> SecondaryOffset -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [SecondaryOffset]
offsets (Int -> [SecondaryOffset] -> [SecondaryOffset]
forall a. Int -> [a] -> [a]
drop Int
1 [SecondaryOffset]
offsets)
= PrimaryIndex -> Maybe PrimaryIndex
forall a. a -> Maybe a
Just (PrimaryIndex -> Maybe PrimaryIndex)
-> PrimaryIndex -> Maybe PrimaryIndex
forall a b. (a -> b) -> a -> b
$ ChunkNo -> Vector SecondaryOffset -> PrimaryIndex
MkPrimaryIndex ChunkNo
chunk (Vector SecondaryOffset -> PrimaryIndex)
-> Vector SecondaryOffset -> PrimaryIndex
forall a b. (a -> b) -> a -> b
$ [SecondaryOffset] -> Vector SecondaryOffset
forall a. Unbox a => [a] -> Vector a
V.fromList [SecondaryOffset]
offsets
mk ChunkNo
_ [SecondaryOffset]
_ = Maybe PrimaryIndex
forall a. Maybe a
Nothing
toSecondaryOffsets :: PrimaryIndex -> [SecondaryOffset]
toSecondaryOffsets :: PrimaryIndex -> [SecondaryOffset]
toSecondaryOffsets = Vector SecondaryOffset -> [SecondaryOffset]
forall a. Unbox a => Vector a -> [a]
V.toList (Vector SecondaryOffset -> [SecondaryOffset])
-> (PrimaryIndex -> Vector SecondaryOffset)
-> PrimaryIndex
-> [SecondaryOffset]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimaryIndex -> Vector SecondaryOffset
primaryIndexOffsets
currentVersionNumber :: Word8
currentVersionNumber :: Word8
currentVersionNumber = Word8
1
slots :: PrimaryIndex -> Word64
slots :: PrimaryIndex -> Word64
slots (MkPrimaryIndex ChunkNo
_ Vector SecondaryOffset
offsets) = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
readOffset ::
forall blk m h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
=> Proxy blk
-> HasFS m h
-> ChunkNo
-> RelativeSlot
-> m (Maybe SecondaryOffset)
readOffset :: forall blk (m :: * -> *) h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk
-> HasFS m h
-> ChunkNo
-> RelativeSlot
-> m (Maybe SecondaryOffset)
readOffset Proxy blk
pb HasFS m h
hasFS ChunkNo
chunk RelativeSlot
slot = Identity (Maybe SecondaryOffset) -> Maybe SecondaryOffset
forall a. Identity a -> a
runIdentity (Identity (Maybe SecondaryOffset) -> Maybe SecondaryOffset)
-> m (Identity (Maybe SecondaryOffset))
-> m (Maybe SecondaryOffset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Proxy blk
-> HasFS m h
-> ChunkNo
-> Identity RelativeSlot
-> m (Identity (Maybe SecondaryOffset))
forall blk (m :: * -> *) h (t :: * -> *).
(HasCallStack, MonadThrow m, Traversable t, StandardHash blk,
Typeable blk) =>
Proxy blk
-> HasFS m h
-> ChunkNo
-> t RelativeSlot
-> m (t (Maybe SecondaryOffset))
readOffsets Proxy blk
pb HasFS m h
hasFS ChunkNo
chunk (RelativeSlot -> Identity RelativeSlot
forall a. a -> Identity a
Identity RelativeSlot
slot)
readOffsets ::
forall blk m h t.
( HasCallStack
, MonadThrow m
, Traversable t
, StandardHash blk
, Typeable blk
)
=> Proxy blk
-> HasFS m h
-> ChunkNo
-> t RelativeSlot
-> m (t (Maybe SecondaryOffset))
readOffsets :: forall blk (m :: * -> *) h (t :: * -> *).
(HasCallStack, MonadThrow m, Traversable t, StandardHash blk,
Typeable blk) =>
Proxy blk
-> HasFS m h
-> ChunkNo
-> t RelativeSlot
-> m (t (Maybe SecondaryOffset))
readOffsets Proxy blk
pb hasFS :: HasFS m h
hasFS@HasFS { HasCallStack => Handle h -> m Word64
hGetSize :: HasCallStack => Handle h -> m Word64
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hGetSize } ChunkNo
chunk t RelativeSlot
toRead =
HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m (t (Maybe SecondaryOffset)))
-> m (t (Maybe SecondaryOffset))
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
primaryIndexFile OpenMode
ReadMode ((Handle h -> m (t (Maybe SecondaryOffset)))
-> m (t (Maybe SecondaryOffset)))
-> (Handle h -> m (t (Maybe SecondaryOffset)))
-> m (t (Maybe SecondaryOffset))
forall a b. (a -> b) -> a -> b
$ \Handle h
pHnd -> do
Word64
size <- HasCallStack => Handle h -> m Word64
Handle h -> m Word64
hGetSize Handle h
pHnd
t RelativeSlot
-> (RelativeSlot -> m (Maybe SecondaryOffset))
-> m (t (Maybe SecondaryOffset))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t RelativeSlot
toRead ((RelativeSlot -> m (Maybe SecondaryOffset))
-> m (t (Maybe SecondaryOffset)))
-> (RelativeSlot -> m (Maybe SecondaryOffset))
-> m (t (Maybe SecondaryOffset))
forall a b. (a -> b) -> a -> b
$ \RelativeSlot
relSlot -> do
let slot :: Word64
slot = HasCallStack => ChunkNo -> RelativeSlot -> Word64
ChunkNo -> RelativeSlot -> Word64
assertRelativeSlotInChunk ChunkNo
chunk RelativeSlot
relSlot
let offset :: AbsOffset
offset = Word64 -> AbsOffset
AbsOffset (Word64 -> AbsOffset) -> Word64 -> AbsOffset
forall a b. (a -> b) -> a -> b
$
Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int
forall a. Storable a => a -> Int
sizeOf Word8
currentVersionNumber) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+
Word64
slot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
secondaryOffsetSize
if AbsOffset -> Word64
unAbsOffset AbsOffset
offset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
nbBytes Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
size then
Maybe SecondaryOffset -> m (Maybe SecondaryOffset)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SecondaryOffset
forall a. Maybe a
Nothing
else do
(SecondaryOffset
secondaryOffset, SecondaryOffset
nextSecondaryOffset) <-
Proxy blk
-> FsPath
-> Get (SecondaryOffset, SecondaryOffset)
-> ByteString
-> m (SecondaryOffset, SecondaryOffset)
forall blk a (m :: * -> *).
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m a
runGet Proxy blk
pb FsPath
primaryIndexFile Get (SecondaryOffset, SecondaryOffset)
get (ByteString -> m (SecondaryOffset, SecondaryOffset))
-> m ByteString -> m (SecondaryOffset, SecondaryOffset)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
hGetExactlyAt HasFS m h
hasFS Handle h
pHnd Word64
nbBytes AbsOffset
offset
Maybe SecondaryOffset -> m (Maybe SecondaryOffset)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SecondaryOffset -> m (Maybe SecondaryOffset))
-> Maybe SecondaryOffset -> m (Maybe SecondaryOffset)
forall a b. (a -> b) -> a -> b
$ if SecondaryOffset
nextSecondaryOffset SecondaryOffset -> SecondaryOffset -> SecondaryOffset
forall a. Num a => a -> a -> a
- SecondaryOffset
secondaryOffset SecondaryOffset -> SecondaryOffset -> Bool
forall a. Ord a => a -> a -> Bool
> SecondaryOffset
0
then SecondaryOffset -> Maybe SecondaryOffset
forall a. a -> Maybe a
Just SecondaryOffset
secondaryOffset
else Maybe SecondaryOffset
forall a. Maybe a
Nothing
where
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
nbBytes :: Word64
nbBytes = Word64
secondaryOffsetSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
2
get :: Get (SecondaryOffset, SecondaryOffset)
get :: Get (SecondaryOffset, SecondaryOffset)
get = (,) (SecondaryOffset
-> SecondaryOffset -> (SecondaryOffset, SecondaryOffset))
-> Get SecondaryOffset
-> Get (SecondaryOffset -> (SecondaryOffset, SecondaryOffset))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SecondaryOffset
getSecondaryOffset Get (SecondaryOffset -> (SecondaryOffset, SecondaryOffset))
-> Get SecondaryOffset -> Get (SecondaryOffset, SecondaryOffset)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SecondaryOffset
getSecondaryOffset
readFirstFilledSlot ::
forall blk m h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
=> Proxy blk
-> HasFS m h
-> ChunkInfo
-> ChunkNo
-> m (Maybe RelativeSlot)
readFirstFilledSlot :: forall blk (m :: * -> *) h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (Maybe RelativeSlot)
readFirstFilledSlot Proxy blk
pb hasFS :: HasFS m h
hasFS@HasFS { HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hSeek, HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome } ChunkInfo
chunkInfo ChunkNo
chunk =
HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m (Maybe RelativeSlot))
-> m (Maybe RelativeSlot)
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
primaryIndexFile OpenMode
ReadMode ((Handle h -> m (Maybe RelativeSlot)) -> m (Maybe RelativeSlot))
-> (Handle h -> m (Maybe RelativeSlot)) -> m (Maybe RelativeSlot)
forall a b. (a -> b) -> a -> b
$ \Handle h
pHnd -> do
HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
Handle h -> SeekMode -> Int64 -> m ()
hSeek Handle h
pHnd SeekMode
AbsoluteSeek Int64
skip
HasCallStack =>
Handle h -> NextRelativeSlot -> m (Maybe RelativeSlot)
Handle h -> NextRelativeSlot -> m (Maybe RelativeSlot)
go Handle h
pHnd (NextRelativeSlot -> m (Maybe RelativeSlot))
-> NextRelativeSlot -> m (Maybe RelativeSlot)
forall a b. (a -> b) -> a -> b
$ RelativeSlot -> NextRelativeSlot
NextRelativeSlot (ChunkInfo -> ChunkNo -> RelativeSlot
firstBlockOrEBB ChunkInfo
chunkInfo ChunkNo
chunk)
where
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
skip :: Int64
skip = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int
forall a. Storable a => a -> Int
sizeOf Word8
currentVersionNumber)
Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
secondaryOffsetSize
go :: HasCallStack => Handle h -> NextRelativeSlot -> m (Maybe RelativeSlot)
go :: HasCallStack =>
Handle h -> NextRelativeSlot -> m (Maybe RelativeSlot)
go Handle h
pHnd NextRelativeSlot
nextRelative = Handle h -> m (Maybe SecondaryOffset)
getNextOffset Handle h
pHnd m (Maybe SecondaryOffset)
-> (Maybe SecondaryOffset -> m (Maybe RelativeSlot))
-> m (Maybe RelativeSlot)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe SecondaryOffset
mOffset ->
case (NextRelativeSlot
nextRelative, Maybe SecondaryOffset
mOffset) of
(NextRelativeSlot
_, Maybe SecondaryOffset
Nothing) ->
Maybe RelativeSlot -> m (Maybe RelativeSlot)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RelativeSlot
forall a. Maybe a
Nothing
(NextRelativeSlot
NoMoreRelativeSlots, Just SecondaryOffset
_) ->
ImmutableDBError blk -> m (Maybe RelativeSlot)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ImmutableDBError blk -> m (Maybe RelativeSlot))
-> ImmutableDBError blk -> m (Maybe RelativeSlot)
forall a b. (a -> b) -> a -> b
$ UnexpectedFailure blk -> ImmutableDBError blk
forall blk. UnexpectedFailure blk -> ImmutableDBError blk
UnexpectedFailure (UnexpectedFailure blk -> ImmutableDBError blk)
-> UnexpectedFailure blk -> ImmutableDBError blk
forall a b. (a -> b) -> a -> b
$
forall blk.
FsPath -> [Char] -> PrettyCallStack -> UnexpectedFailure blk
InvalidFileError
@blk
FsPath
primaryIndexFile
[Char]
"Index file too large"
PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack
(NextRelativeSlot RelativeSlot
slot, Just SecondaryOffset
offset)
| SecondaryOffset
offset SecondaryOffset -> SecondaryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== SecondaryOffset
0 -> HasCallStack =>
Handle h -> NextRelativeSlot -> m (Maybe RelativeSlot)
Handle h -> NextRelativeSlot -> m (Maybe RelativeSlot)
go Handle h
pHnd (HasCallStack => RelativeSlot -> NextRelativeSlot
RelativeSlot -> NextRelativeSlot
nextRelativeSlot RelativeSlot
slot)
| Bool
otherwise -> Maybe RelativeSlot -> m (Maybe RelativeSlot)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RelativeSlot -> m (Maybe RelativeSlot))
-> Maybe RelativeSlot -> m (Maybe RelativeSlot)
forall a b. (a -> b) -> a -> b
$ RelativeSlot -> Maybe RelativeSlot
forall a. a -> Maybe a
Just RelativeSlot
slot
getNextOffset :: Handle h -> m (Maybe SecondaryOffset)
getNextOffset :: Handle h -> m (Maybe SecondaryOffset)
getNextOffset Handle h
pHnd = Word64 -> ByteString -> m (Maybe SecondaryOffset)
goGet Word64
secondaryOffsetSize ByteString
forall a. Monoid a => a
mempty
where
goGet :: Word64 -> Lazy.ByteString -> m (Maybe SecondaryOffset)
goGet :: Word64 -> ByteString -> m (Maybe SecondaryOffset)
goGet Word64
remaining ByteString
acc = do
ByteString
bs <- HasCallStack => Handle h -> Word64 -> m ByteString
Handle h -> Word64 -> m ByteString
hGetSome Handle h
pHnd Word64
remaining
let acc' :: ByteString
acc' = ByteString
acc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
Lazy.fromStrict ByteString
bs
case Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
Strict.length ByteString
bs) of
Word64
0 -> Maybe SecondaryOffset -> m (Maybe SecondaryOffset)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SecondaryOffset
forall a. Maybe a
Nothing
Word64
n | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
remaining
-> Word64 -> ByteString -> m (Maybe SecondaryOffset)
goGet (Word64
remaining Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
n) ByteString
acc'
| Bool
otherwise
-> Bool -> m (Maybe SecondaryOffset) -> m (Maybe SecondaryOffset)
forall a. HasCallStack => Bool -> a -> a
assert (Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
remaining) (m (Maybe SecondaryOffset) -> m (Maybe SecondaryOffset))
-> m (Maybe SecondaryOffset) -> m (Maybe SecondaryOffset)
forall a b. (a -> b) -> a -> b
$ SecondaryOffset -> Maybe SecondaryOffset
forall a. a -> Maybe a
Just (SecondaryOffset -> Maybe SecondaryOffset)
-> m SecondaryOffset -> m (Maybe SecondaryOffset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Proxy blk
-> FsPath -> Get SecondaryOffset -> ByteString -> m SecondaryOffset
forall blk a (m :: * -> *).
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m a
runGet Proxy blk
pb FsPath
primaryIndexFile Get SecondaryOffset
getSecondaryOffset ByteString
acc'
load ::
forall blk m h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
=> Proxy blk
-> HasFS m h
-> ChunkNo
-> m PrimaryIndex
load :: forall blk (m :: * -> *) h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> HasFS m h -> ChunkNo -> m PrimaryIndex
load Proxy blk
pb HasFS m h
hasFS ChunkNo
chunk =
HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m PrimaryIndex)
-> m PrimaryIndex
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
primaryIndexFile OpenMode
ReadMode ((Handle h -> m PrimaryIndex) -> m PrimaryIndex)
-> (Handle h -> m PrimaryIndex) -> m PrimaryIndex
forall a b. (a -> b) -> a -> b
$ \Handle h
pHnd ->
HasFS m h -> Handle h -> m ByteString
forall (m :: * -> *) h.
Monad m =>
HasFS m h -> Handle h -> m ByteString
hGetAll HasFS m h
hasFS Handle h
pHnd m ByteString -> (ByteString -> m PrimaryIndex) -> m PrimaryIndex
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proxy blk
-> FsPath -> Get PrimaryIndex -> ByteString -> m PrimaryIndex
forall blk a (m :: * -> *).
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m a
runGet Proxy blk
pb FsPath
primaryIndexFile Get PrimaryIndex
get
where
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
get :: Get PrimaryIndex
get :: Get PrimaryIndex
get = Get Word8
Get.getWord8 Get Word8 -> (Word8 -> Get PrimaryIndex) -> Get PrimaryIndex
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
versionNumber ->
if Word8
versionNumber Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
currentVersionNumber
then ChunkNo -> Vector SecondaryOffset -> PrimaryIndex
MkPrimaryIndex ChunkNo
chunk (Vector SecondaryOffset -> PrimaryIndex)
-> ([SecondaryOffset] -> Vector SecondaryOffset)
-> [SecondaryOffset]
-> PrimaryIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SecondaryOffset] -> Vector SecondaryOffset
forall a. Unbox a => [a] -> Vector a
V.fromList ([SecondaryOffset] -> PrimaryIndex)
-> Get [SecondaryOffset] -> Get PrimaryIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [SecondaryOffset]
go
else [Char] -> Get PrimaryIndex
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get PrimaryIndex) -> [Char] -> Get PrimaryIndex
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown version number: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
versionNumber
where
go :: Get [SecondaryOffset]
go = do
Bool
isEmpty <- Get Bool
Get.isEmpty
if Bool
isEmpty then [SecondaryOffset] -> Get [SecondaryOffset]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else (:) (SecondaryOffset -> [SecondaryOffset] -> [SecondaryOffset])
-> Get SecondaryOffset
-> Get ([SecondaryOffset] -> [SecondaryOffset])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SecondaryOffset
getSecondaryOffset Get ([SecondaryOffset] -> [SecondaryOffset])
-> Get [SecondaryOffset] -> Get [SecondaryOffset]
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [SecondaryOffset]
go
write ::
(HasCallStack, MonadThrow m)
=> HasFS m h
-> ChunkNo
-> PrimaryIndex
-> m ()
write :: forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h -> ChunkNo -> PrimaryIndex -> m ()
write hasFS :: HasFS m h
hasFS@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 } ChunkNo
chunk (MkPrimaryIndex ChunkNo
_ Vector SecondaryOffset
offsets) =
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
primaryIndexFile (AllowExisting -> OpenMode
AppendMode AllowExisting
AllowExisting) ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
pHnd -> do
HasCallStack => Handle h -> Word64 -> m ()
Handle h -> Word64 -> m ()
hTruncate Handle h
pHnd Word64
0
m Word64 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Word64 -> m ()) -> m Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ HasFS m h -> Handle h -> Builder -> m Word64
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> Builder -> m Word64
hPut HasFS m h
hasFS Handle h
pHnd (Builder -> m Word64) -> Builder -> m Word64
forall a b. (a -> b) -> a -> b
$ Put -> Builder
forall a. PutM a -> Builder
Put.execPut (Put -> Builder) -> Put -> Builder
forall a b. (a -> b) -> a -> b
$
Word8 -> Put
Put.putWord8 Word8
currentVersionNumber Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<>
(SecondaryOffset -> Put) -> [SecondaryOffset] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SecondaryOffset -> Put
putSecondaryOffset (Vector SecondaryOffset -> [SecondaryOffset]
forall a. Unbox a => Vector a -> [a]
V.toList Vector SecondaryOffset
offsets)
where
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
truncateToSlot :: ChunkInfo -> RelativeSlot -> PrimaryIndex -> PrimaryIndex
truncateToSlot :: ChunkInfo -> RelativeSlot -> PrimaryIndex -> PrimaryIndex
truncateToSlot ChunkInfo
chunkInfo RelativeSlot
relSlot primary :: PrimaryIndex
primary@(MkPrimaryIndex ChunkNo
_ Vector SecondaryOffset
offsets) =
case ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
getLastSlot ChunkInfo
chunkInfo PrimaryIndex
primary of
Just RelativeSlot
lastSlot | HasCallStack => RelativeSlot -> RelativeSlot -> Ordering
RelativeSlot -> RelativeSlot -> Ordering
compareRelativeSlot RelativeSlot
lastSlot RelativeSlot
relSlot Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT ->
PrimaryIndex
primary { primaryIndexOffsets = V.take (fromIntegral slot + 2) offsets }
Maybe RelativeSlot
_otherwise ->
PrimaryIndex
primary
where
slot :: Word64
slot = HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex PrimaryIndex
primary RelativeSlot
relSlot
truncateToSlotFS ::
(HasCallStack, MonadThrow m)
=> HasFS m h
-> ChunkNo
-> RelativeSlot
-> m ()
truncateToSlotFS :: forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h -> ChunkNo -> RelativeSlot -> m ()
truncateToSlotFS hasFS :: HasFS m h
hasFS@HasFS { HasCallStack => Handle h -> Word64 -> m ()
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hTruncate, HasCallStack => Handle h -> m Word64
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hGetSize :: HasCallStack => Handle h -> m Word64
hGetSize } ChunkNo
chunk RelativeSlot
relSlot =
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
primaryIndexFile (AllowExisting -> OpenMode
AppendMode AllowExisting
AllowExisting) ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
pHnd -> do
Word64
size <- HasCallStack => Handle h -> m Word64
Handle h -> m Word64
hGetSize Handle h
pHnd
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
offset Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
size) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Handle h -> Word64 -> m ()
Handle h -> Word64 -> m ()
hTruncate Handle h
pHnd Word64
offset
where
slot :: Word64
slot = HasCallStack => ChunkNo -> RelativeSlot -> Word64
ChunkNo -> RelativeSlot -> Word64
assertRelativeSlotInChunk ChunkNo
chunk RelativeSlot
relSlot
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
offset :: Word64
offset = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int
forall a. Storable a => a -> Int
sizeOf Word8
currentVersionNumber)
Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
slot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
2) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
secondaryOffsetSize
unfinalise ::
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
=> Proxy blk
-> HasFS m h
-> ChunkInfo
-> ChunkNo
-> m ()
unfinalise :: forall (m :: * -> *) blk h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> HasFS m h -> ChunkInfo -> ChunkNo -> m ()
unfinalise Proxy blk
pb HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk = do
PrimaryIndex
primaryIndex <- 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
load Proxy blk
pb HasFS m h
hasFS ChunkNo
chunk
case HasCallStack => ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
lastFilledSlot ChunkInfo
chunkInfo PrimaryIndex
primaryIndex of
Maybe RelativeSlot
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just RelativeSlot
slot -> HasFS m h -> ChunkNo -> RelativeSlot -> m ()
forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h -> ChunkNo -> RelativeSlot -> m ()
truncateToSlotFS HasFS m h
hasFS ChunkNo
chunk RelativeSlot
slot
open ::
(HasCallStack, MonadCatch m)
=> HasFS m h
-> ChunkNo
-> AllowExisting
-> m (Handle h)
open :: forall (m :: * -> *) h.
(HasCallStack, MonadCatch m) =>
HasFS m h -> ChunkNo -> AllowExisting -> m (Handle h)
open hasFS :: HasFS m h
hasFS@HasFS { HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen, HasCallStack => Handle h -> m ()
hClose :: HasCallStack => Handle h -> m ()
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hClose } ChunkNo
chunk AllowExisting
allowExisting = do
Handle h
pHnd <- HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> OpenMode -> m (Handle h)
hOpen FsPath
primaryIndexFile (AllowExisting -> OpenMode
AppendMode AllowExisting
allowExisting)
(m (Handle h) -> m () -> m (Handle h))
-> m () -> m (Handle h) -> m (Handle h)
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (Handle h) -> m () -> m (Handle h)
forall a b. m a -> m b -> m a
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
onException (HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose Handle h
pHnd) (m (Handle h) -> m (Handle h)) -> m (Handle h) -> m (Handle h)
forall a b. (a -> b) -> a -> b
$ do
case AllowExisting
allowExisting of
AllowExisting
AllowExisting -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
AllowExisting
MustBeNew -> m Word64 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Word64 -> m ()) -> m Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ HasFS m h -> Handle h -> Builder -> m Word64
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> Builder -> m Word64
hPut HasFS m h
hasFS Handle h
pHnd (Builder -> m Word64) -> Builder -> m Word64
forall a b. (a -> b) -> a -> b
$ Put -> Builder
forall a. PutM a -> Builder
Put.execPut (Put -> Builder) -> Put -> Builder
forall a b. (a -> b) -> a -> b
$
Word8 -> Put
Put.putWord8 Word8
currentVersionNumber Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<>
SecondaryOffset -> Put
putSecondaryOffset SecondaryOffset
0
Handle h -> m (Handle h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Handle h
pHnd
where
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
appendOffsets ::
(Monad m, Foldable f, HasCallStack)
=> HasFS m h
-> Handle h
-> f SecondaryOffset
-> m ()
appendOffsets :: forall (m :: * -> *) (f :: * -> *) h.
(Monad m, Foldable f, HasCallStack) =>
HasFS m h -> Handle h -> f SecondaryOffset -> m ()
appendOffsets HasFS m h
hasFS Handle h
pHnd f SecondaryOffset
offsets =
m Word64 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Word64 -> m ()) -> m Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ HasFS m h -> Handle h -> Builder -> m Word64
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> Builder -> m Word64
hPut HasFS m h
hasFS Handle h
pHnd (Builder -> m Word64) -> Builder -> m Word64
forall a b. (a -> b) -> a -> b
$ Put -> Builder
forall a. PutM a -> Builder
Put.execPut (Put -> Builder) -> Put -> Builder
forall a b. (a -> b) -> a -> b
$ (SecondaryOffset -> Put) -> f SecondaryOffset -> Put
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SecondaryOffset -> Put
putSecondaryOffset f SecondaryOffset
offsets
lastOffset :: PrimaryIndex -> SecondaryOffset
lastOffset :: PrimaryIndex -> SecondaryOffset
lastOffset (MkPrimaryIndex ChunkNo
_ Vector SecondaryOffset
offsets)
| Vector SecondaryOffset -> Bool
forall a. Unbox a => Vector a -> Bool
V.null Vector SecondaryOffset
offsets = SecondaryOffset
0
| Bool
otherwise = Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! (Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
getLastSlot :: ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
getLastSlot :: ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
getLastSlot ChunkInfo
chunkInfo (MkPrimaryIndex ChunkNo
chunk Vector SecondaryOffset
offsets) = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
RelativeSlot -> Maybe RelativeSlot
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelativeSlot -> Maybe RelativeSlot)
-> RelativeSlot -> Maybe RelativeSlot
forall a b. (a -> b) -> a -> b
$ ChunkInfo -> ChunkNo -> Int -> RelativeSlot
forall a.
(HasCallStack, Integral a) =>
ChunkInfo -> ChunkNo -> a -> RelativeSlot
nthBlockOrEBB ChunkInfo
chunkInfo ChunkNo
chunk (Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
containsSlot :: PrimaryIndex -> RelativeSlot -> Bool
containsSlot :: PrimaryIndex -> RelativeSlot -> Bool
containsSlot primary :: PrimaryIndex
primary@(MkPrimaryIndex ChunkNo
_ Vector SecondaryOffset
offsets) RelativeSlot
relSlot =
Word64
slot Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
where
slot :: Word64
slot = HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex PrimaryIndex
primary RelativeSlot
relSlot
offsetOfSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> SecondaryOffset
offsetOfSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> SecondaryOffset
offsetOfSlot primary :: PrimaryIndex
primary@(MkPrimaryIndex ChunkNo
_ Vector SecondaryOffset
offsets) RelativeSlot
relSlot =
Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot
where
slot :: Word64
slot = HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex PrimaryIndex
primary RelativeSlot
relSlot
sizeOfSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> Word32
sizeOfSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> SecondaryOffset
sizeOfSlot primary :: PrimaryIndex
primary@(MkPrimaryIndex ChunkNo
_ Vector SecondaryOffset
offsets) RelativeSlot
relSlot =
SecondaryOffset
offsetAfter SecondaryOffset -> SecondaryOffset -> SecondaryOffset
forall a. Num a => a -> a -> a
- SecondaryOffset
offsetAt
where
slot :: Word64
slot = HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex PrimaryIndex
primary RelativeSlot
relSlot
i :: Int
i = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot
offsetAt :: SecondaryOffset
offsetAt = Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! Int
i
offsetAfter :: SecondaryOffset
offsetAfter = Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
isFilledSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> Bool
isFilledSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> Bool
isFilledSlot PrimaryIndex
primary RelativeSlot
slot = HasCallStack => PrimaryIndex -> RelativeSlot -> SecondaryOffset
PrimaryIndex -> RelativeSlot -> SecondaryOffset
sizeOfSlot PrimaryIndex
primary RelativeSlot
slot SecondaryOffset -> SecondaryOffset -> Bool
forall a. Eq a => a -> a -> Bool
/= SecondaryOffset
0
nextFilledSlot :: ChunkInfo -> PrimaryIndex -> RelativeSlot -> Maybe RelativeSlot
nextFilledSlot :: ChunkInfo -> PrimaryIndex -> RelativeSlot -> Maybe RelativeSlot
nextFilledSlot ChunkInfo
chunkInfo primary :: PrimaryIndex
primary@(MkPrimaryIndex ChunkNo
chunk Vector SecondaryOffset
offsets) RelativeSlot
relSlot =
Int -> Maybe RelativeSlot
go (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
slot :: Word64
slot = HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex PrimaryIndex
primary RelativeSlot
relSlot
len :: Int
len :: Int
len = Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets
go :: Int -> Maybe RelativeSlot
go :: Int -> Maybe RelativeSlot
go Int
i
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
= Maybe RelativeSlot
forall a. Maybe a
Nothing
| Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! Int
i SecondaryOffset -> SecondaryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
= Int -> Maybe RelativeSlot
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise
= RelativeSlot -> Maybe RelativeSlot
forall a. a -> Maybe a
Just (ChunkInfo -> ChunkNo -> Int -> RelativeSlot
forall a.
(HasCallStack, Integral a) =>
ChunkInfo -> ChunkNo -> a -> RelativeSlot
nthBlockOrEBB ChunkInfo
chunkInfo ChunkNo
chunk Int
i)
firstFilledSlot :: ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
firstFilledSlot :: ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
firstFilledSlot ChunkInfo
chunkInfo (MkPrimaryIndex ChunkNo
chunk Vector SecondaryOffset
offsets) = Int -> Maybe RelativeSlot
go Int
1
where
len :: Int
len :: Int
len = Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets
go :: Int -> Maybe RelativeSlot
go :: Int -> Maybe RelativeSlot
go Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
= Maybe RelativeSlot
forall a. Maybe a
Nothing
| Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! Int
i SecondaryOffset -> SecondaryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== SecondaryOffset
0
= Int -> Maybe RelativeSlot
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise
= RelativeSlot -> Maybe RelativeSlot
forall a. a -> Maybe a
Just (ChunkInfo -> ChunkNo -> Int -> RelativeSlot
forall a.
(HasCallStack, Integral a) =>
ChunkInfo -> ChunkNo -> a -> RelativeSlot
nthBlockOrEBB ChunkInfo
chunkInfo ChunkNo
chunk (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
filledSlots :: ChunkInfo -> PrimaryIndex -> [RelativeSlot]
filledSlots :: ChunkInfo -> PrimaryIndex -> [RelativeSlot]
filledSlots ChunkInfo
chunkInfo PrimaryIndex
primary = Maybe RelativeSlot -> [RelativeSlot]
go (ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
firstFilledSlot ChunkInfo
chunkInfo PrimaryIndex
primary)
where
go :: Maybe RelativeSlot -> [RelativeSlot]
go Maybe RelativeSlot
Nothing = []
go (Just RelativeSlot
slot) = RelativeSlot
slot RelativeSlot -> [RelativeSlot] -> [RelativeSlot]
forall a. a -> [a] -> [a]
: Maybe RelativeSlot -> [RelativeSlot]
go (ChunkInfo -> PrimaryIndex -> RelativeSlot -> Maybe RelativeSlot
nextFilledSlot ChunkInfo
chunkInfo PrimaryIndex
primary RelativeSlot
slot)
lastFilledSlot :: HasCallStack => ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
lastFilledSlot :: HasCallStack => ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
lastFilledSlot ChunkInfo
chunkInfo (MkPrimaryIndex ChunkNo
chunk Vector SecondaryOffset
offsets) =
Int -> Maybe RelativeSlot
go (Vector SecondaryOffset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector SecondaryOffset
offsets Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
go :: Int -> Maybe RelativeSlot
go :: Int -> Maybe RelativeSlot
go Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
= Maybe RelativeSlot
forall a. Maybe a
Nothing
| Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! Int
i SecondaryOffset -> SecondaryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== Vector SecondaryOffset
offsets Vector SecondaryOffset -> Int -> SecondaryOffset
forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
= Int -> Maybe RelativeSlot
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise
= RelativeSlot -> Maybe RelativeSlot
forall a. a -> Maybe a
Just (ChunkInfo -> ChunkNo -> Int -> RelativeSlot
forall a.
(HasCallStack, Integral a) =>
ChunkInfo -> ChunkNo -> a -> RelativeSlot
nthBlockOrEBB ChunkInfo
chunkInfo ChunkNo
chunk (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
backfill ::
RelativeSlot
-> RelativeSlot
-> SecondaryOffset
-> [SecondaryOffset]
backfill :: RelativeSlot
-> RelativeSlot -> SecondaryOffset -> [SecondaryOffset]
backfill RelativeSlot
slot RelativeSlot
nextExpected SecondaryOffset
offset =
Int -> SecondaryOffset -> [SecondaryOffset]
forall a. Int -> a -> [a]
replicate (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
gap) SecondaryOffset
offset
where
gap :: Word64
gap = RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
slot
Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
nextExpected
backfillChunk ::
ChunkInfo
-> ChunkNo
-> NextRelativeSlot
-> SecondaryOffset
-> [SecondaryOffset]
backfillChunk :: ChunkInfo
-> ChunkNo
-> NextRelativeSlot
-> SecondaryOffset
-> [SecondaryOffset]
backfillChunk ChunkInfo
_ ChunkNo
_ NextRelativeSlot
NoMoreRelativeSlots SecondaryOffset
_ =
[]
backfillChunk ChunkInfo
chunkInfo ChunkNo
chunk (NextRelativeSlot RelativeSlot
nextExpected) SecondaryOffset
offset =
Int -> SecondaryOffset -> [SecondaryOffset]
forall a. Int -> a -> [a]
replicate (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
gap) SecondaryOffset
offset
where
finalSlot :: RelativeSlot
finalSlot = ChunkInfo -> ChunkNo -> RelativeSlot
maxRelativeSlot ChunkInfo
chunkInfo ChunkNo
chunk
gap :: Word64
gap = RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
finalSlot
Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
nextExpected
Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
(!) :: (HasCallStack, V.Unbox a) => Vector a -> Int -> a
Vector a
v ! :: forall a. (HasCallStack, Unbox a) => Vector a -> Int -> a
! Int
i
| Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector a
v
= Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector a
v Int
i
| Bool
otherwise
= [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
[Char]
"Index " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" out of bounds (0, " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (Vector a -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
{-# INLINE (!) #-}