{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}

-- | Primary Index
--
-- Intended for qualified import
-- > import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary as PrimaryIndex
module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary (
    -- * SecondaryOffset
    SecondaryOffset
    -- * PrimaryIndex
  , 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
    -- * Exported for testing purposes
  , 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.Util.CallStack
import           Ouroboros.Consensus.Util.IOLike

import           Ouroboros.Consensus.Storage.FS.API
import           Ouroboros.Consensus.Storage.FS.API.Types (AbsOffset (..),
                     AllowExisting (..), OpenMode (..), SeekMode (..))

import           Ouroboros.Consensus.Storage.ImmutableDB.API
                     (ImmutableDBError (..), UnexpectedFailure (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util
                     (fsPathPrimaryIndexFile, runGet)

{------------------------------------------------------------------------------
  SecondaryOffset
------------------------------------------------------------------------------}

-- | An offset in the secondary index file.
--
-- We need 4 bytes ('Word32') because the secondary index file can grow to
-- +1MiB.
type SecondaryOffset = Word32

getSecondaryOffset :: Get SecondaryOffset
getSecondaryOffset :: Get SecondaryOffset
getSecondaryOffset = Get SecondaryOffset
Get.getWord32be

putSecondaryOffset :: SecondaryOffset -> Put
putSecondaryOffset :: SecondaryOffset -> Put
putSecondaryOffset = SecondaryOffset -> Put
Put.putWord32be

-- | The size of each entry in the primary index file, i.e., the size of a
-- 'SecondaryOffset'.
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 #-}

{------------------------------------------------------------------------------
  PrimaryIndex
------------------------------------------------------------------------------}

-- | In-memory representation of the primary index file.
--
-- The primary index maps relative slots to offsets in the secondary index
-- file. The first offset is always 0, as the first entry in the secondary
-- index file will always start at offset 0. The second offset will be equal
-- to the size of a secondary index entry, unless the slot is empty, in which
-- case it will be 0. In general, an offset will either be a repetition of the
-- offset before it, to indicate the slot is empty, or the offset before it +
-- the fixed size of a secondary index entry, in case the slot is filled.
--
-- The size of a secondary index entry can be computed by subtracting the
-- offset corresponding to the respective slot from the offset corresponding
-- to the slot after it.
--
-- For example, if slots 0, 1 and 4 are filled, we'd have the following
-- offsets in the primary index file:
--
-- > slot:       0   1   2   3   4
-- >         ┌───┬───┬───┬───┬───┬───┐
-- > offset: │ 0 │ x │ y │ y │ y │ z │
-- >         └───┴───┴───┴───┴───┴───┘
--
-- We use @x, y, z@ in the example above, but in practice these will be
-- multiples of the (fixed) size of an entry in secondary index.
--
-- TODO As all entries have the same size, we could use a bitvector instead,
-- see #1234.
--
-- The serialisation of a primary index file starts with
-- @currentVersionNumber@ followed by all its offset.
data PrimaryIndex = MkPrimaryIndex {
      -- | The 'ChunkNo' of the chunk this index is associated with
      PrimaryIndex -> ChunkNo
primaryIndexChunkNo :: !ChunkNo

      -- | The entries in the index proper
    , 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
/= :: PrimaryIndex -> PrimaryIndex -> Bool
$c/= :: PrimaryIndex -> PrimaryIndex -> Bool
== :: PrimaryIndex -> PrimaryIndex -> Bool
$c== :: 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
showList :: [PrimaryIndex] -> ShowS
$cshowList :: [PrimaryIndex] -> ShowS
show :: PrimaryIndex -> [Char]
$cshow :: PrimaryIndex -> [Char]
showsPrec :: Int -> PrimaryIndex -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep PrimaryIndex x -> PrimaryIndex
$cfrom :: forall x. PrimaryIndex -> Rep PrimaryIndex x
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
showTypeOf :: Proxy PrimaryIndex -> [Char]
$cshowTypeOf :: Proxy PrimaryIndex -> [Char]
wNoThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
noThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PrimaryIndex -> IO (Maybe ThunkInfo)
NoThunks)

assertInPrimaryIndex :: HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex :: 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

-- | Smart constructor: checks that the offsets are non-decreasing, there is
-- at least one offset, and that the first offset is 0.
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

-- | Return the 'SecondaryOffset's in the 'PrimaryIndex'.
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

-- | Version number of the index format
currentVersionNumber :: Word8
currentVersionNumber :: Word8
currentVersionNumber = Word8
1

-- | Count the number of (filled or unfilled) slots currently in the index
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

-- | Read the 'SecondaryOffset' corresponding to the given relative slot in
-- the primary index. Return 'Nothing' when the slot is empty.
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
-> 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)

-- | Same as 'readOffset', but for multiple offsets.
--
-- NOTE: only use this for a few offsets, as we will seek (@pread@) for each
-- offset. Use 'load' if you want to read the whole primary index.
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))
       -- ^ The offset in the secondary index file corresponding to the given
       -- slot. 'Nothing' when the slot is empty.
readOffsets :: 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 :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hGetSize :: 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
          -- Don't try reading if the file doesn't contain enough bytes
          Maybe SecondaryOffset -> m (Maybe SecondaryOffset)
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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SecondaryOffset
getSecondaryOffset

-- | Return the first filled slot in the primary index file, or 'Nothing' in
-- case there are no filled slots.
--
-- PRECONDITION: the index file must exist and contain at least the version
-- number and offset 0.
--
-- May throw 'InvalidPrimaryIndexException'.
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
-> 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 :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hSeek, HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome :: 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 the version number and the first offset, which is always 0.
    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

    -- | Read offset per offset until we find a non-zero one. In the
    -- Byron-era, the first slot is always filled with an EBB, so we only need
    -- to read one 4-byte offset. In the Shelley era, approximately one in ten
    -- slots is filled, so on average we need to read 5 4-byte offsets. The OS
    -- will buffer this anyway.
    go :: HasCallStack => Handle h -> NextRelativeSlot -> m (Maybe RelativeSlot)
    go :: 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 (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) ->
          -- Reached end of file, no filled slot
          Maybe RelativeSlot -> m (Maybe RelativeSlot)
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 (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
$
            FsPath -> [Char] -> PrettyCallStack -> UnexpectedFailure blk
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 (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

    -- | We don't know in advance if there are bytes left to read, so it could
    -- be that 'hGetSome' returns 0 bytes, in which case we reached EOF and
    -- return 'Nothing'.
    --
    -- NOTE: when using 'hGetSome' directly, we can get partial reads, which
    -- we should handle appropriately.
    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 (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  -- Partial read, read some more
              -> Word64 -> ByteString -> m (Maybe SecondaryOffset)
goGet (Word64
remaining Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
n) ByteString
acc'
              | Bool
otherwise      -- All bytes read, 'Get' the offset
              -> 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 a primary index file in memory.
load
  :: forall blk m h.
     (HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
  => Proxy blk
  -> HasFS m h
  -> ChunkNo
  -> m PrimaryIndex
load :: 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 (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

    -- TODO incremental?
    get :: Get PrimaryIndex
    get :: Get PrimaryIndex
get = Get Word8
Get.getWord8 Get Word8 -> (Word8 -> Get PrimaryIndex) -> Get PrimaryIndex
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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [SecondaryOffset]
go

-- | Write a primary index to a file.
--
-- Property: for @hasFS@, @err@, @chunk@
--
-- > 'write' hasFS chunk primaryIndex
-- > primaryIndex' <- 'load' hasFS err chunk
--
-- Then it must be that:
--
-- > primaryIndex === primaryIndex'
--
write
  :: (HasCallStack, MonadThrow m)
  => HasFS m h
  -> ChunkNo
  -> PrimaryIndex
  -> m ()
write :: HasFS m h -> ChunkNo -> PrimaryIndex -> m ()
write 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 } 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
      -- NOTE: open it in AppendMode and truncate it first, otherwise we might
      -- just overwrite part of the data stored in the index file.
      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
$
        -- The version number
        Word8 -> Put
Put.putWord8 Word8
currentVersionNumber Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<>
        -- Hopefully the intermediary list is fused away
        (SecondaryOffset -> Put) -> [SecondaryOffset] -> Put
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

-- | Truncate the primary index so that the given 'RelativeSlot' will be the
-- last slot (filled or not) in the primary index, unless the primary index
-- didn't contain the 'RelativeSlot' in the first place.
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 :: Vector SecondaryOffset
primaryIndexOffsets = Int -> Vector SecondaryOffset -> Vector SecondaryOffset
forall a. Unbox a => Int -> Vector a -> Vector a
V.take (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
2) Vector SecondaryOffset
offsets }
      Maybe RelativeSlot
_otherwise ->
        PrimaryIndex
primary
  where
    slot :: Word64
slot = HasCallStack => PrimaryIndex -> RelativeSlot -> Word64
PrimaryIndex -> RelativeSlot -> Word64
assertInPrimaryIndex PrimaryIndex
primary RelativeSlot
relSlot

-- | On-disk variant of 'truncateToSlot'. The truncation is done without
-- reading the primary index from disk.
truncateToSlotFS
  :: (HasCallStack, MonadThrow m)
  => HasFS m h
  -> ChunkNo
  -> RelativeSlot
  -> m ()
truncateToSlotFS :: HasFS m h -> ChunkNo -> RelativeSlot -> m ()
truncateToSlotFS 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, 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 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

-- | Remove all trailing empty slots that were added during the
-- finalisation/backfilling of the primary index.
--
-- POSTCONDITION: the last slot of the primary index file will be filled,
-- unless the index itself is empty.
unfinalise
  :: (HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
  => Proxy blk
  -> HasFS m h
  -> ChunkInfo
  -> ChunkNo
  -> m ()
unfinalise :: Proxy blk -> HasFS m h -> ChunkInfo -> ChunkNo -> m ()
unfinalise Proxy blk
pb HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk = do
    -- TODO optimise so that we only need to open the file once
    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 (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 a primary index file for the given chunk and return a handle to it.
--
-- The file is opened with the given 'AllowExisting' value. When given
-- 'MustBeNew', the version number is written to the file.
open
  :: (HasCallStack, MonadCatch m)
  => HasFS m h
  -> ChunkNo
  -> AllowExisting
  -> m (Handle h)
open :: HasFS m h -> ChunkNo -> AllowExisting -> m (Handle h)
open hasFS :: HasFS m h
hasFS@HasFS { HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen, HasCallStack => Handle h -> m ()
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hClose :: HasCallStack => Handle h -> m ()
hClose } ChunkNo
chunk AllowExisting
allowExisting = do
    -- TODO we rely on the fact that if the file exists, it already contains
    -- the version number and the first offset. What if that is not the case?
    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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
        -- If the file is new, write the version number and the first offset,
        -- i.e. 0.
        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 (m :: * -> *) a. Monad m => a -> m a
return Handle h
pHnd
  where
    primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk

-- | Append the given 'SecondaryOffset' to the end of the file (passed as a
-- handle).
appendOffsets
  :: (Monad m, Foldable f, HasCallStack)
  => HasFS m h
  -> Handle h
  -> f SecondaryOffset
  -> m ()
appendOffsets :: 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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SecondaryOffset -> Put
putSecondaryOffset f SecondaryOffset
offsets

-- | Return the last 'SecondaryOffset' in the primary index file.
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)

-- | Return the last slot of the primary index (empty or not).
--
-- Returns 'Nothing' if the index is empty.
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 (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)

-- | Check whether the given slot is within the primary index.
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

-- | Return the offset for the given slot.
--
-- Precondition: the given slot must be within the primary index
-- ('containsSlot').
offsetOfSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> SecondaryOffset
offsetOfSlot :: 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

-- | Return the size of the given slot according to the primary index.
--
-- Precondition: the given slot must be within the primary index
-- ('containsSlot').
sizeOfSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> Word32
sizeOfSlot :: 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)

-- | Return 'True' when the given slot is filled.
--
-- Precondition: the given slot must be within the primary index
-- ('containsSlot').
isFilledSlot :: HasCallStack => PrimaryIndex -> RelativeSlot -> Bool
isFilledSlot :: 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

-- | Find the next filled (length > zero) slot after the given slot in the
-- primary index. If there is none, return 'Nothing'.
--
-- Precondition: the given slot must be within the primary index
-- ('containsSlot').
--
-- Example: given the primary index below and slot 1:
--
-- > slot:       0   1   2   3   4
-- >         ┌───┬───┬───┬───┬───┬───┐
-- > offset: │ 0 │ x │ y │ y │ y │ z │
-- >         └───┴───┴───┴───┴───┴───┘
--
-- Return slot 4.
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)

-- | Find the first filled (length > zero) slot in the primary index. If there
-- is none, return 'Nothing'.
--
-- Example: given the primary index below:
--
-- > slot:       0   1
-- >         ┌───┬───┬───┐
-- > offset: │ 0 │ 0 │ x │
-- >         └───┴───┴───┘
--
-- Return slot 1.
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))

-- | Return a list of all the filled (length > zero) slots in the primary
-- index.
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)

-- | Return the last filled slot in the primary index.
lastFilledSlot :: HasCallStack => ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
lastFilledSlot :: 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))

-- | Return the slots to backfill the primary index file with.
--
-- A situation may arise in which we \"skip\" some relative slots, and we
-- write into the DB, for example, every other relative slot. In this case, we
-- need to backfill the primary index file with offsets for the skipped
-- relative slots. Similarly, before we start a new chunk, we must backfill
-- the primary index file of the current chunk to indicate that the remaining
-- slots in the chunk are empty.
--
-- For example, say we have written to relative slots 0 and 1. We have the
-- following primary index file:
--
-- > slot:       0   1
-- >         ┌───┬───┬───┐
-- > offset: │ 0 │ x │ y │
-- >         └───┴───┴───┘
--
-- Now we want to write to relative slot 4, skipping 2 and 3. We first have to
-- backfill the primary index by repeating the last offset for the two missing
-- slots:
--
-- > slot:       0   1   2   3
-- >         ┌───┬───┬───┬───┬───┐
-- > offset: │ 0 │ x │ y │ y │ y │
-- >         └───┴───┴───┴───┴───┘
--
-- After backfilling (writing the offset @y@ twice), we can write the next
-- offset:
--
-- > slot:       0   1   2   3   4
-- >         ┌───┬───┬───┬───┬───┬───┐
-- > offset: │ 0 │ x │ y │ y │ y │ z │
-- >         └───┴───┴───┴───┴───┴───┘
--
-- For the example above, the output of this function would thus be: @[y, y]@.
--
-- We use @x, y, z@ in the examples above, but in practice these will be
-- multiples of the (fixed) size of an entry in secondary index.
backfill
  :: RelativeSlot     -- ^ The slot to write to (>= next expected slot)
  -> RelativeSlot     -- ^ The next expected slot to write to
  -> SecondaryOffset  -- ^ The last 'SecondaryOffset' written to
  -> [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

-- | Return the slots to backfill the primary index file with when padding it
-- to the chunk size.
--
-- See 'backfill' for more details.
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 -- fill all slots /including/ 'finalSlot'

{------------------------------------------------------------------------------
  Helper for debugging
------------------------------------------------------------------------------}

(!) :: (HasCallStack, V.Unbox a) => Vector a -> Int -> a
Vector a
v ! :: 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 (!) #-}