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

module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Secondary (
    BlockOffset (..)
  , BlockSize (..)
  , Entry (..)
  , HeaderOffset (..)
  , HeaderSize (..)
  , appendEntry
  , entrySize
  , readAllEntries
  , readEntries
  , readEntry
  , truncateToEntry
  , writeAllEntries
  ) where

import           Control.Exception (assert)
import           Control.Monad (forM)
import           Data.Binary (Binary (..), Get, Put)
import qualified Data.Binary.Get as Get
import qualified Data.Binary.Put as Put
import qualified Data.ByteString.Lazy as Lazy
import           Data.Functor.Identity (Identity (..))
import           Data.Typeable (Typeable)
import           Data.Word
import           Foreign.Storable (Storable (sizeOf))
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)
import           Ouroboros.Consensus.Block hiding (headerHash)
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary
                     (SecondaryOffset)
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types
                     (BlockOrEBB (..), WithBlockSize (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util
                     (fsPathSecondaryIndexFile, runGet, runGetWithUnconsumed)
import           Ouroboros.Consensus.Util.IOLike
import           System.FS.API.Lazy
import           System.FS.CRC

{------------------------------------------------------------------------------
  Types
------------------------------------------------------------------------------}

newtype BlockOffset = BlockOffset { BlockOffset -> Word64
unBlockOffset :: Word64 }
  deriving stock   (Int -> BlockOffset -> ShowS
[BlockOffset] -> ShowS
BlockOffset -> String
(Int -> BlockOffset -> ShowS)
-> (BlockOffset -> String)
-> ([BlockOffset] -> ShowS)
-> Show BlockOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockOffset -> ShowS
showsPrec :: Int -> BlockOffset -> ShowS
$cshow :: BlockOffset -> String
show :: BlockOffset -> String
$cshowList :: [BlockOffset] -> ShowS
showList :: [BlockOffset] -> ShowS
Show)
  deriving newtype (BlockOffset -> BlockOffset -> Bool
(BlockOffset -> BlockOffset -> Bool)
-> (BlockOffset -> BlockOffset -> Bool) -> Eq BlockOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockOffset -> BlockOffset -> Bool
== :: BlockOffset -> BlockOffset -> Bool
$c/= :: BlockOffset -> BlockOffset -> Bool
/= :: BlockOffset -> BlockOffset -> Bool
Eq, Eq BlockOffset
Eq BlockOffset =>
(BlockOffset -> BlockOffset -> Ordering)
-> (BlockOffset -> BlockOffset -> Bool)
-> (BlockOffset -> BlockOffset -> Bool)
-> (BlockOffset -> BlockOffset -> Bool)
-> (BlockOffset -> BlockOffset -> Bool)
-> (BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset -> BlockOffset)
-> Ord BlockOffset
BlockOffset -> BlockOffset -> Bool
BlockOffset -> BlockOffset -> Ordering
BlockOffset -> BlockOffset -> BlockOffset
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockOffset -> BlockOffset -> Ordering
compare :: BlockOffset -> BlockOffset -> Ordering
$c< :: BlockOffset -> BlockOffset -> Bool
< :: BlockOffset -> BlockOffset -> Bool
$c<= :: BlockOffset -> BlockOffset -> Bool
<= :: BlockOffset -> BlockOffset -> Bool
$c> :: BlockOffset -> BlockOffset -> Bool
> :: BlockOffset -> BlockOffset -> Bool
$c>= :: BlockOffset -> BlockOffset -> Bool
>= :: BlockOffset -> BlockOffset -> Bool
$cmax :: BlockOffset -> BlockOffset -> BlockOffset
max :: BlockOffset -> BlockOffset -> BlockOffset
$cmin :: BlockOffset -> BlockOffset -> BlockOffset
min :: BlockOffset -> BlockOffset -> BlockOffset
Ord, Int -> BlockOffset
BlockOffset -> Int
BlockOffset -> [BlockOffset]
BlockOffset -> BlockOffset
BlockOffset -> BlockOffset -> [BlockOffset]
BlockOffset -> BlockOffset -> BlockOffset -> [BlockOffset]
(BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset)
-> (Int -> BlockOffset)
-> (BlockOffset -> Int)
-> (BlockOffset -> [BlockOffset])
-> (BlockOffset -> BlockOffset -> [BlockOffset])
-> (BlockOffset -> BlockOffset -> [BlockOffset])
-> (BlockOffset -> BlockOffset -> BlockOffset -> [BlockOffset])
-> Enum BlockOffset
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BlockOffset -> BlockOffset
succ :: BlockOffset -> BlockOffset
$cpred :: BlockOffset -> BlockOffset
pred :: BlockOffset -> BlockOffset
$ctoEnum :: Int -> BlockOffset
toEnum :: Int -> BlockOffset
$cfromEnum :: BlockOffset -> Int
fromEnum :: BlockOffset -> Int
$cenumFrom :: BlockOffset -> [BlockOffset]
enumFrom :: BlockOffset -> [BlockOffset]
$cenumFromThen :: BlockOffset -> BlockOffset -> [BlockOffset]
enumFromThen :: BlockOffset -> BlockOffset -> [BlockOffset]
$cenumFromTo :: BlockOffset -> BlockOffset -> [BlockOffset]
enumFromTo :: BlockOffset -> BlockOffset -> [BlockOffset]
$cenumFromThenTo :: BlockOffset -> BlockOffset -> BlockOffset -> [BlockOffset]
enumFromThenTo :: BlockOffset -> BlockOffset -> BlockOffset -> [BlockOffset]
Enum, Num BlockOffset
Ord BlockOffset
(Num BlockOffset, Ord BlockOffset) =>
(BlockOffset -> Rational) -> Real BlockOffset
BlockOffset -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: BlockOffset -> Rational
toRational :: BlockOffset -> Rational
Real, Enum BlockOffset
Real BlockOffset
(Real BlockOffset, Enum BlockOffset) =>
(BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset -> (BlockOffset, BlockOffset))
-> (BlockOffset -> BlockOffset -> (BlockOffset, BlockOffset))
-> (BlockOffset -> Integer)
-> Integral BlockOffset
BlockOffset -> Integer
BlockOffset -> BlockOffset -> (BlockOffset, BlockOffset)
BlockOffset -> BlockOffset -> BlockOffset
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: BlockOffset -> BlockOffset -> BlockOffset
quot :: BlockOffset -> BlockOffset -> BlockOffset
$crem :: BlockOffset -> BlockOffset -> BlockOffset
rem :: BlockOffset -> BlockOffset -> BlockOffset
$cdiv :: BlockOffset -> BlockOffset -> BlockOffset
div :: BlockOffset -> BlockOffset -> BlockOffset
$cmod :: BlockOffset -> BlockOffset -> BlockOffset
mod :: BlockOffset -> BlockOffset -> BlockOffset
$cquotRem :: BlockOffset -> BlockOffset -> (BlockOffset, BlockOffset)
quotRem :: BlockOffset -> BlockOffset -> (BlockOffset, BlockOffset)
$cdivMod :: BlockOffset -> BlockOffset -> (BlockOffset, BlockOffset)
divMod :: BlockOffset -> BlockOffset -> (BlockOffset, BlockOffset)
$ctoInteger :: BlockOffset -> Integer
toInteger :: BlockOffset -> Integer
Integral, Integer -> BlockOffset
BlockOffset -> BlockOffset
BlockOffset -> BlockOffset -> BlockOffset
(BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset)
-> (BlockOffset -> BlockOffset)
-> (Integer -> BlockOffset)
-> Num BlockOffset
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: BlockOffset -> BlockOffset -> BlockOffset
+ :: BlockOffset -> BlockOffset -> BlockOffset
$c- :: BlockOffset -> BlockOffset -> BlockOffset
- :: BlockOffset -> BlockOffset -> BlockOffset
$c* :: BlockOffset -> BlockOffset -> BlockOffset
* :: BlockOffset -> BlockOffset -> BlockOffset
$cnegate :: BlockOffset -> BlockOffset
negate :: BlockOffset -> BlockOffset
$cabs :: BlockOffset -> BlockOffset
abs :: BlockOffset -> BlockOffset
$csignum :: BlockOffset -> BlockOffset
signum :: BlockOffset -> BlockOffset
$cfromInteger :: Integer -> BlockOffset
fromInteger :: Integer -> BlockOffset
Num, Ptr BlockOffset -> IO BlockOffset
Ptr BlockOffset -> Int -> IO BlockOffset
Ptr BlockOffset -> Int -> BlockOffset -> IO ()
Ptr BlockOffset -> BlockOffset -> IO ()
BlockOffset -> Int
(BlockOffset -> Int)
-> (BlockOffset -> Int)
-> (Ptr BlockOffset -> Int -> IO BlockOffset)
-> (Ptr BlockOffset -> Int -> BlockOffset -> IO ())
-> (forall b. Ptr b -> Int -> IO BlockOffset)
-> (forall b. Ptr b -> Int -> BlockOffset -> IO ())
-> (Ptr BlockOffset -> IO BlockOffset)
-> (Ptr BlockOffset -> BlockOffset -> IO ())
-> Storable BlockOffset
forall b. Ptr b -> Int -> IO BlockOffset
forall b. Ptr b -> Int -> BlockOffset -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: BlockOffset -> Int
sizeOf :: BlockOffset -> Int
$calignment :: BlockOffset -> Int
alignment :: BlockOffset -> Int
$cpeekElemOff :: Ptr BlockOffset -> Int -> IO BlockOffset
peekElemOff :: Ptr BlockOffset -> Int -> IO BlockOffset
$cpokeElemOff :: Ptr BlockOffset -> Int -> BlockOffset -> IO ()
pokeElemOff :: Ptr BlockOffset -> Int -> BlockOffset -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BlockOffset
peekByteOff :: forall b. Ptr b -> Int -> IO BlockOffset
$cpokeByteOff :: forall b. Ptr b -> Int -> BlockOffset -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> BlockOffset -> IO ()
$cpeek :: Ptr BlockOffset -> IO BlockOffset
peek :: Ptr BlockOffset -> IO BlockOffset
$cpoke :: Ptr BlockOffset -> BlockOffset -> IO ()
poke :: Ptr BlockOffset -> BlockOffset -> IO ()
Storable, Context -> BlockOffset -> IO (Maybe ThunkInfo)
Proxy BlockOffset -> String
(Context -> BlockOffset -> IO (Maybe ThunkInfo))
-> (Context -> BlockOffset -> IO (Maybe ThunkInfo))
-> (Proxy BlockOffset -> String)
-> NoThunks BlockOffset
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy BlockOffset -> String
showTypeOf :: Proxy BlockOffset -> String
NoThunks)

instance Binary BlockOffset where
  get :: Get BlockOffset
get = Word64 -> BlockOffset
BlockOffset (Word64 -> BlockOffset) -> Get Word64 -> Get BlockOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
Get.getWord64be
  put :: BlockOffset -> Put
put = Word64 -> Put
Put.putWord64be (Word64 -> Put) -> (BlockOffset -> Word64) -> BlockOffset -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockOffset -> Word64
unBlockOffset

newtype HeaderOffset = HeaderOffset { HeaderOffset -> Word16
unHeaderOffset :: Word16 }
  deriving stock   (Int -> HeaderOffset -> ShowS
[HeaderOffset] -> ShowS
HeaderOffset -> String
(Int -> HeaderOffset -> ShowS)
-> (HeaderOffset -> String)
-> ([HeaderOffset] -> ShowS)
-> Show HeaderOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeaderOffset -> ShowS
showsPrec :: Int -> HeaderOffset -> ShowS
$cshow :: HeaderOffset -> String
show :: HeaderOffset -> String
$cshowList :: [HeaderOffset] -> ShowS
showList :: [HeaderOffset] -> ShowS
Show)
  deriving newtype (HeaderOffset -> HeaderOffset -> Bool
(HeaderOffset -> HeaderOffset -> Bool)
-> (HeaderOffset -> HeaderOffset -> Bool) -> Eq HeaderOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderOffset -> HeaderOffset -> Bool
== :: HeaderOffset -> HeaderOffset -> Bool
$c/= :: HeaderOffset -> HeaderOffset -> Bool
/= :: HeaderOffset -> HeaderOffset -> Bool
Eq, Ptr HeaderOffset -> IO HeaderOffset
Ptr HeaderOffset -> Int -> IO HeaderOffset
Ptr HeaderOffset -> Int -> HeaderOffset -> IO ()
Ptr HeaderOffset -> HeaderOffset -> IO ()
HeaderOffset -> Int
(HeaderOffset -> Int)
-> (HeaderOffset -> Int)
-> (Ptr HeaderOffset -> Int -> IO HeaderOffset)
-> (Ptr HeaderOffset -> Int -> HeaderOffset -> IO ())
-> (forall b. Ptr b -> Int -> IO HeaderOffset)
-> (forall b. Ptr b -> Int -> HeaderOffset -> IO ())
-> (Ptr HeaderOffset -> IO HeaderOffset)
-> (Ptr HeaderOffset -> HeaderOffset -> IO ())
-> Storable HeaderOffset
forall b. Ptr b -> Int -> IO HeaderOffset
forall b. Ptr b -> Int -> HeaderOffset -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: HeaderOffset -> Int
sizeOf :: HeaderOffset -> Int
$calignment :: HeaderOffset -> Int
alignment :: HeaderOffset -> Int
$cpeekElemOff :: Ptr HeaderOffset -> Int -> IO HeaderOffset
peekElemOff :: Ptr HeaderOffset -> Int -> IO HeaderOffset
$cpokeElemOff :: Ptr HeaderOffset -> Int -> HeaderOffset -> IO ()
pokeElemOff :: Ptr HeaderOffset -> Int -> HeaderOffset -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO HeaderOffset
peekByteOff :: forall b. Ptr b -> Int -> IO HeaderOffset
$cpokeByteOff :: forall b. Ptr b -> Int -> HeaderOffset -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> HeaderOffset -> IO ()
$cpeek :: Ptr HeaderOffset -> IO HeaderOffset
peek :: Ptr HeaderOffset -> IO HeaderOffset
$cpoke :: Ptr HeaderOffset -> HeaderOffset -> IO ()
poke :: Ptr HeaderOffset -> HeaderOffset -> IO ()
Storable, Context -> HeaderOffset -> IO (Maybe ThunkInfo)
Proxy HeaderOffset -> String
(Context -> HeaderOffset -> IO (Maybe ThunkInfo))
-> (Context -> HeaderOffset -> IO (Maybe ThunkInfo))
-> (Proxy HeaderOffset -> String)
-> NoThunks HeaderOffset
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> HeaderOffset -> IO (Maybe ThunkInfo)
noThunks :: Context -> HeaderOffset -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> HeaderOffset -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> HeaderOffset -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy HeaderOffset -> String
showTypeOf :: Proxy HeaderOffset -> String
NoThunks)

instance Binary HeaderOffset where
  get :: Get HeaderOffset
get = Word16 -> HeaderOffset
HeaderOffset (Word16 -> HeaderOffset) -> Get Word16 -> Get HeaderOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16be
  put :: HeaderOffset -> Put
put = Word16 -> Put
Put.putWord16be (Word16 -> Put) -> (HeaderOffset -> Word16) -> HeaderOffset -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderOffset -> Word16
unHeaderOffset

newtype HeaderSize = HeaderSize { HeaderSize -> Word16
unHeaderSize :: Word16 }
  deriving stock   (Int -> HeaderSize -> ShowS
[HeaderSize] -> ShowS
HeaderSize -> String
(Int -> HeaderSize -> ShowS)
-> (HeaderSize -> String)
-> ([HeaderSize] -> ShowS)
-> Show HeaderSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeaderSize -> ShowS
showsPrec :: Int -> HeaderSize -> ShowS
$cshow :: HeaderSize -> String
show :: HeaderSize -> String
$cshowList :: [HeaderSize] -> ShowS
showList :: [HeaderSize] -> ShowS
Show)
  deriving newtype (HeaderSize -> HeaderSize -> Bool
(HeaderSize -> HeaderSize -> Bool)
-> (HeaderSize -> HeaderSize -> Bool) -> Eq HeaderSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderSize -> HeaderSize -> Bool
== :: HeaderSize -> HeaderSize -> Bool
$c/= :: HeaderSize -> HeaderSize -> Bool
/= :: HeaderSize -> HeaderSize -> Bool
Eq, Ptr HeaderSize -> IO HeaderSize
Ptr HeaderSize -> Int -> IO HeaderSize
Ptr HeaderSize -> Int -> HeaderSize -> IO ()
Ptr HeaderSize -> HeaderSize -> IO ()
HeaderSize -> Int
(HeaderSize -> Int)
-> (HeaderSize -> Int)
-> (Ptr HeaderSize -> Int -> IO HeaderSize)
-> (Ptr HeaderSize -> Int -> HeaderSize -> IO ())
-> (forall b. Ptr b -> Int -> IO HeaderSize)
-> (forall b. Ptr b -> Int -> HeaderSize -> IO ())
-> (Ptr HeaderSize -> IO HeaderSize)
-> (Ptr HeaderSize -> HeaderSize -> IO ())
-> Storable HeaderSize
forall b. Ptr b -> Int -> IO HeaderSize
forall b. Ptr b -> Int -> HeaderSize -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: HeaderSize -> Int
sizeOf :: HeaderSize -> Int
$calignment :: HeaderSize -> Int
alignment :: HeaderSize -> Int
$cpeekElemOff :: Ptr HeaderSize -> Int -> IO HeaderSize
peekElemOff :: Ptr HeaderSize -> Int -> IO HeaderSize
$cpokeElemOff :: Ptr HeaderSize -> Int -> HeaderSize -> IO ()
pokeElemOff :: Ptr HeaderSize -> Int -> HeaderSize -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO HeaderSize
peekByteOff :: forall b. Ptr b -> Int -> IO HeaderSize
$cpokeByteOff :: forall b. Ptr b -> Int -> HeaderSize -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> HeaderSize -> IO ()
$cpeek :: Ptr HeaderSize -> IO HeaderSize
peek :: Ptr HeaderSize -> IO HeaderSize
$cpoke :: Ptr HeaderSize -> HeaderSize -> IO ()
poke :: Ptr HeaderSize -> HeaderSize -> IO ()
Storable, Context -> HeaderSize -> IO (Maybe ThunkInfo)
Proxy HeaderSize -> String
(Context -> HeaderSize -> IO (Maybe ThunkInfo))
-> (Context -> HeaderSize -> IO (Maybe ThunkInfo))
-> (Proxy HeaderSize -> String)
-> NoThunks HeaderSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> HeaderSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> HeaderSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> HeaderSize -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> HeaderSize -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy HeaderSize -> String
showTypeOf :: Proxy HeaderSize -> String
NoThunks)

instance Binary HeaderSize where
  get :: Get HeaderSize
get = Word16 -> HeaderSize
HeaderSize (Word16 -> HeaderSize) -> Get Word16 -> Get HeaderSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16be
  put :: HeaderSize -> Put
put = Word16 -> Put
Put.putWord16be (Word16 -> Put) -> (HeaderSize -> Word16) -> HeaderSize -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderSize -> Word16
unHeaderSize

getBlockOrEBB :: IsEBB -> Get BlockOrEBB
getBlockOrEBB :: IsEBB -> Get BlockOrEBB
getBlockOrEBB IsEBB
IsEBB    = EpochNo -> BlockOrEBB
EBB   (EpochNo -> BlockOrEBB)
-> (Word64 -> EpochNo) -> Word64 -> BlockOrEBB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochNo
EpochNo (Word64 -> BlockOrEBB) -> Get Word64 -> Get BlockOrEBB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
Get.getWord64be
getBlockOrEBB IsEBB
IsNotEBB = SlotNo -> BlockOrEBB
Block (SlotNo -> BlockOrEBB)
-> (Word64 -> SlotNo) -> Word64 -> BlockOrEBB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo  (Word64 -> BlockOrEBB) -> Get Word64 -> Get BlockOrEBB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
Get.getWord64be

putBlockOrEBB :: BlockOrEBB -> Put
putBlockOrEBB :: BlockOrEBB -> Put
putBlockOrEBB BlockOrEBB
blockOrEBB = Word64 -> Put
Put.putWord64be (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ case BlockOrEBB
blockOrEBB of
    Block SlotNo
slotNo  -> SlotNo -> Word64
unSlotNo SlotNo
slotNo
    EBB   EpochNo
epochNo -> EpochNo -> Word64
unEpochNo EpochNo
epochNo

{------------------------------------------------------------------------------
  Entry
------------------------------------------------------------------------------}

data Entry blk = Entry {
      forall blk. Entry blk -> BlockOffset
blockOffset  :: !BlockOffset
    , forall blk. Entry blk -> HeaderOffset
headerOffset :: !HeaderOffset
    , forall blk. Entry blk -> HeaderSize
headerSize   :: !HeaderSize
    , forall blk. Entry blk -> CRC
checksum     :: !CRC
    , forall blk. Entry blk -> HeaderHash blk
headerHash   :: !(HeaderHash blk)
    , forall blk. Entry blk -> BlockOrEBB
blockOrEBB   :: !BlockOrEBB
    }
  deriving ((forall x. Entry blk -> Rep (Entry blk) x)
-> (forall x. Rep (Entry blk) x -> Entry blk)
-> Generic (Entry blk)
forall x. Rep (Entry blk) x -> Entry blk
forall x. Entry blk -> Rep (Entry blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (Entry blk) x -> Entry blk
forall blk x. Entry blk -> Rep (Entry blk) x
$cfrom :: forall blk x. Entry blk -> Rep (Entry blk) x
from :: forall x. Entry blk -> Rep (Entry blk) x
$cto :: forall blk x. Rep (Entry blk) x -> Entry blk
to :: forall x. Rep (Entry blk) x -> Entry blk
Generic)

deriving instance StandardHash blk => Eq       (Entry blk)
deriving instance StandardHash blk => Show     (Entry blk)
deriving instance StandardHash blk => NoThunks (Entry blk)

getEntry :: forall blk. ConvertRawHash blk => IsEBB -> Get (Entry blk)
getEntry :: forall blk. ConvertRawHash blk => IsEBB -> Get (Entry blk)
getEntry IsEBB
isEBB = do
    BlockOffset
blockOffset  <- Get BlockOffset
forall t. Binary t => Get t
get
    HeaderOffset
headerOffset <- Get HeaderOffset
forall t. Binary t => Get t
get
    HeaderSize
headerSize   <- Get HeaderSize
forall t. Binary t => Get t
get
    CRC
checksum     <- Word32 -> CRC
CRC (Word32 -> CRC) -> Get Word32 -> Get CRC
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Get.getWord32be
    HeaderHash blk
headerHash   <- Proxy blk -> Get (HeaderHash blk)
forall blk. ConvertRawHash blk => Proxy blk -> Get (HeaderHash blk)
getHash Proxy blk
pb
    BlockOrEBB
blockOrEBB   <- IsEBB -> Get BlockOrEBB
getBlockOrEBB IsEBB
isEBB
    Entry blk -> Get (Entry blk)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Entry {CRC
HeaderHash blk
BlockOrEBB
HeaderSize
HeaderOffset
BlockOffset
blockOffset :: BlockOffset
headerOffset :: HeaderOffset
headerSize :: HeaderSize
checksum :: CRC
headerHash :: HeaderHash blk
blockOrEBB :: BlockOrEBB
blockOffset :: BlockOffset
headerOffset :: HeaderOffset
headerSize :: HeaderSize
checksum :: CRC
headerHash :: HeaderHash blk
blockOrEBB :: BlockOrEBB
..}
  where
    pb :: Proxy blk
    pb :: Proxy blk
pb = Proxy blk
forall {k} (t :: k). Proxy t
Proxy

putEntry :: forall blk. ConvertRawHash blk => Entry blk -> Put
putEntry :: forall blk. ConvertRawHash blk => Entry blk -> Put
putEntry Entry {CRC
HeaderHash blk
BlockOrEBB
HeaderSize
HeaderOffset
BlockOffset
blockOffset :: forall blk. Entry blk -> BlockOffset
headerOffset :: forall blk. Entry blk -> HeaderOffset
headerSize :: forall blk. Entry blk -> HeaderSize
checksum :: forall blk. Entry blk -> CRC
headerHash :: forall blk. Entry blk -> HeaderHash blk
blockOrEBB :: forall blk. Entry blk -> BlockOrEBB
blockOffset :: BlockOffset
headerOffset :: HeaderOffset
headerSize :: HeaderSize
checksum :: CRC
headerHash :: HeaderHash blk
blockOrEBB :: BlockOrEBB
..} = [Put] -> Put
forall a. Monoid a => [a] -> a
mconcat [
      BlockOffset -> Put
forall t. Binary t => t -> Put
put                BlockOffset
blockOffset
    , HeaderOffset -> Put
forall t. Binary t => t -> Put
put                HeaderOffset
headerOffset
    , HeaderSize -> Put
forall t. Binary t => t -> Put
put                HeaderSize
headerSize
    , Word32 -> Put
Put.putWord32be    (CRC -> Word32
getCRC CRC
checksum)
    , Proxy blk -> HeaderHash blk -> Put
forall blk.
ConvertRawHash blk =>
Proxy blk -> HeaderHash blk -> Put
putHash         Proxy blk
pb HeaderHash blk
headerHash
    , BlockOrEBB -> Put
putBlockOrEBB      BlockOrEBB
blockOrEBB
    ]
  where
    pb :: Proxy blk
    pb :: Proxy blk
pb = Proxy blk
forall {k} (t :: k). Proxy t
Proxy

entrySize :: ConvertRawHash blk => Proxy blk -> Word32
entrySize :: forall blk. ConvertRawHash blk => Proxy blk -> Word32
entrySize Proxy blk
pb =
    Word32 -> String -> (Entry Any -> BlockOffset) -> Word32
forall a blk.
Storable a =>
Word32 -> String -> (Entry blk -> a) -> Word32
size Word32
8 String
"blockOffset"  Entry Any -> BlockOffset
forall blk. Entry blk -> BlockOffset
blockOffset
  Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> String -> (Entry Any -> HeaderOffset) -> Word32
forall a blk.
Storable a =>
Word32 -> String -> (Entry blk -> a) -> Word32
size Word32
2 String
"headerOffset" Entry Any -> HeaderOffset
forall blk. Entry blk -> HeaderOffset
headerOffset
  Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> String -> (Entry Any -> HeaderSize) -> Word32
forall a blk.
Storable a =>
Word32 -> String -> (Entry blk -> a) -> Word32
size Word32
2 String
"headerSize"   Entry Any -> HeaderSize
forall blk. Entry blk -> HeaderSize
headerSize
  Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> String -> (Entry Any -> CRC) -> Word32
forall a blk.
Storable a =>
Word32 -> String -> (Entry blk -> a) -> Word32
size Word32
4 String
"checksum"     Entry Any -> CRC
forall blk. Entry blk -> CRC
checksum
  Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Proxy blk -> Word32
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> Word32
forall (proxy :: * -> *). proxy blk -> Word32
hashSize Proxy blk
pb
  Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
8 -- blockOrEBB
  where
    size :: Storable a => Word32 -> String -> (Entry blk -> a) -> Word32
    size :: forall a blk.
Storable a =>
Word32 -> String -> (Entry blk -> a) -> Word32
size Word32
expected String
name Entry blk -> a
field = Bool -> Word32 -> Word32
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Word32
expected Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
actual) Word32
actual
      where
        actual :: Word32
actual = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Storable a => a -> Int
sizeOf (Entry blk -> a
field (String -> Entry blk
forall a. (?callStack::CallStack) => String -> a
error String
name)))

data BlockSize
  = BlockSize Word32
  | LastEntry
    -- ^ In case of the last entry, we don't have any entry and thus block
    -- offset after it that we can use to calculate the size of the block.
  deriving (BlockSize -> BlockSize -> Bool
(BlockSize -> BlockSize -> Bool)
-> (BlockSize -> BlockSize -> Bool) -> Eq BlockSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockSize -> BlockSize -> Bool
== :: BlockSize -> BlockSize -> Bool
$c/= :: BlockSize -> BlockSize -> Bool
/= :: BlockSize -> BlockSize -> Bool
Eq, Int -> BlockSize -> ShowS
[BlockSize] -> ShowS
BlockSize -> String
(Int -> BlockSize -> ShowS)
-> (BlockSize -> String)
-> ([BlockSize] -> ShowS)
-> Show BlockSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockSize -> ShowS
showsPrec :: Int -> BlockSize -> ShowS
$cshow :: BlockSize -> String
show :: BlockSize -> String
$cshowList :: [BlockSize] -> ShowS
showList :: [BlockSize] -> ShowS
Show, (forall x. BlockSize -> Rep BlockSize x)
-> (forall x. Rep BlockSize x -> BlockSize) -> Generic BlockSize
forall x. Rep BlockSize x -> BlockSize
forall x. BlockSize -> Rep BlockSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockSize -> Rep BlockSize x
from :: forall x. BlockSize -> Rep BlockSize x
$cto :: forall x. Rep BlockSize x -> BlockSize
to :: forall x. Rep BlockSize x -> BlockSize
Generic, Context -> BlockSize -> IO (Maybe ThunkInfo)
Proxy BlockSize -> String
(Context -> BlockSize -> IO (Maybe ThunkInfo))
-> (Context -> BlockSize -> IO (Maybe ThunkInfo))
-> (Proxy BlockSize -> String)
-> NoThunks BlockSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy BlockSize -> String
showTypeOf :: Proxy BlockSize -> String
NoThunks)

-- | Read the entry at the given 'SecondaryOffset'. Interpret it as an EBB
-- depending on the given 'IsEBB'.
readEntry ::
     forall m blk h.
     ( HasCallStack
     , ConvertRawHash blk
     , MonadThrow m
     , StandardHash blk
     , Typeable blk
     )
  => HasFS m h
  -> ChunkNo
  -> IsEBB
  -> SecondaryOffset
  -> m (Entry blk, BlockSize)
readEntry :: forall (m :: * -> *) blk h.
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m,
 StandardHash blk, Typeable blk) =>
HasFS m h -> ChunkNo -> IsEBB -> Word32 -> m (Entry blk, BlockSize)
readEntry HasFS m h
hasFS ChunkNo
chunk IsEBB
isEBB Word32
slotOffset = Identity (Entry blk, BlockSize) -> (Entry blk, BlockSize)
forall a. Identity a -> a
runIdentity (Identity (Entry blk, BlockSize) -> (Entry blk, BlockSize))
-> m (Identity (Entry blk, BlockSize)) -> m (Entry blk, BlockSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    HasFS m h
-> ChunkNo
-> Identity (IsEBB, Word32)
-> m (Identity (Entry blk, BlockSize))
forall (m :: * -> *) blk h (t :: * -> *).
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m,
 StandardHash blk, Typeable blk, Traversable t) =>
HasFS m h
-> ChunkNo -> t (IsEBB, Word32) -> m (t (Entry blk, BlockSize))
readEntries HasFS m h
hasFS ChunkNo
chunk ((IsEBB, Word32) -> Identity (IsEBB, Word32)
forall a. a -> Identity a
Identity (IsEBB
isEBB, Word32
slotOffset))

-- | Same as 'readEntry', but for multiple entries.
--
-- NOTE: only use this for a few entries, as we will seek (@pread@) for each
-- entry. Use 'readAllEntries' if you want to read all entries in the
-- secondary index file.
readEntries ::
     forall m blk h t.
     ( HasCallStack
     , ConvertRawHash blk
     , MonadThrow m
     , StandardHash blk
     , Typeable blk
     , Traversable t
     )
  => HasFS m h
  -> ChunkNo
  -> t (IsEBB, SecondaryOffset)
  -> m (t (Entry blk, BlockSize))
readEntries :: forall (m :: * -> *) blk h (t :: * -> *).
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m,
 StandardHash blk, Typeable blk, Traversable t) =>
HasFS m h
-> ChunkNo -> t (IsEBB, Word32) -> m (t (Entry blk, BlockSize))
readEntries HasFS m h
hasFS ChunkNo
chunk t (IsEBB, Word32)
toRead =
    HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m (t (Entry blk, BlockSize)))
-> m (t (Entry blk, BlockSize))
forall (m :: * -> *) h a.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
secondaryIndexFile OpenMode
ReadMode ((Handle h -> m (t (Entry blk, BlockSize)))
 -> m (t (Entry blk, BlockSize)))
-> (Handle h -> m (t (Entry blk, BlockSize)))
-> m (t (Entry blk, BlockSize))
forall a b. (a -> b) -> a -> b
$ \Handle h
sHnd -> do
      -- TODO can we avoid this call to 'hGetSize'?
      Word64
size <- (?callStack::CallStack) => Handle h -> m Word64
Handle h -> m Word64
hGetSize Handle h
sHnd
      t (IsEBB, Word32)
-> ((IsEBB, Word32) -> m (Entry blk, BlockSize))
-> m (t (Entry blk, BlockSize))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t (IsEBB, Word32)
toRead (((IsEBB, Word32) -> m (Entry blk, BlockSize))
 -> m (t (Entry blk, BlockSize)))
-> ((IsEBB, Word32) -> m (Entry blk, BlockSize))
-> m (t (Entry blk, BlockSize))
forall a b. (a -> b) -> a -> b
$ \(IsEBB
isEBB, Word32
slotOffset) -> do
        let offset :: AbsOffset
offset = Word64 -> AbsOffset
AbsOffset (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
slotOffset)
            -- Is there another entry after the entry we need to read so that
            -- we can read its 'blockOffset' that will allow us to calculate
            -- the size of the block.
            anotherEntryAfter :: Bool
anotherEntryAfter = Word64
size Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>=
              AbsOffset -> Word64
unAbsOffset AbsOffset
offset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
nbBytes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
nbBlockOffsetBytes
        if Bool
anotherEntryAfter then do
          (Entry blk
entry, BlockOffset
nextBlockOffset) <-
            HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
forall (m :: * -> *) h.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
hGetExactlyAt HasFS m h
hasFS Handle h
sHnd (Word64
nbBytes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
nbBlockOffsetBytes) AbsOffset
offset m ByteString
-> (ByteString -> m (Entry blk, BlockOffset))
-> m (Entry blk, BlockOffset)
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 (Entry blk, BlockOffset)
-> ByteString
-> m (Entry blk, BlockOffset)
forall blk a (m :: * -> *).
(?callStack::CallStack, MonadThrow m, StandardHash blk,
 Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m a
runGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) FsPath
secondaryIndexFile
              ((,) (Entry blk -> BlockOffset -> (Entry blk, BlockOffset))
-> Get (Entry blk) -> Get (BlockOffset -> (Entry blk, BlockOffset))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IsEBB -> Get (Entry blk)
forall blk. ConvertRawHash blk => IsEBB -> Get (Entry blk)
getEntry IsEBB
isEBB Get (BlockOffset -> (Entry blk, BlockOffset))
-> Get BlockOffset -> Get (Entry blk, BlockOffset)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BlockOffset
forall t. Binary t => Get t
get)
          let blockSize :: Word32
blockSize = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$
                BlockOffset -> Word64
unBlockOffset BlockOffset
nextBlockOffset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-
                BlockOffset -> Word64
unBlockOffset (Entry blk -> BlockOffset
forall blk. Entry blk -> BlockOffset
blockOffset Entry blk
entry)
          (Entry blk, BlockSize) -> m (Entry blk, BlockSize)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry blk
entry, Word32 -> BlockSize
BlockSize Word32
blockSize)
        else do
          Entry blk
entry <- HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
forall (m :: * -> *) h.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> Handle h -> Word64 -> AbsOffset -> m ByteString
hGetExactlyAt HasFS m h
hasFS Handle h
sHnd Word64
nbBytes AbsOffset
offset m ByteString -> (ByteString -> m (Entry blk)) -> m (Entry blk)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            Proxy blk
-> FsPath -> Get (Entry blk) -> ByteString -> m (Entry blk)
forall blk a (m :: * -> *).
(?callStack::CallStack, MonadThrow m, StandardHash blk,
 Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m a
runGet (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) FsPath
secondaryIndexFile (IsEBB -> Get (Entry blk)
forall blk. ConvertRawHash blk => IsEBB -> Get (Entry blk)
getEntry IsEBB
isEBB)
          (Entry blk, BlockSize) -> m (Entry blk, BlockSize)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry blk
entry, BlockSize
LastEntry)
  where
    secondaryIndexFile :: FsPath
secondaryIndexFile = ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk
    nbBytes :: Word64
nbBytes            = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Proxy blk -> Word32
forall blk. ConvertRawHash blk => Proxy blk -> Word32
entrySize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
    nbBlockOffsetBytes :: Word64
nbBlockOffsetBytes = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockOffset -> Int
forall a. Storable a => a -> Int
sizeOf (Entry Any -> BlockOffset
forall blk. Entry blk -> BlockOffset
blockOffset (String -> Entry Any
forall a. (?callStack::CallStack) => String -> a
error String
"blockOffset")))
    HasFS { (?callStack::CallStack) => Handle h -> m Word64
hGetSize :: (?callStack::CallStack) => Handle h -> m Word64
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> m Word64
hGetSize } = HasFS m h
hasFS

-- | Read all entries in a secondary index file, starting from the given
-- 'SecondaryOffset' until the stop condition is true or until the end of the
-- file is reached. The entry for which the stop condition is true will be the
-- last in the returned list of entries.
readAllEntries ::
     forall m blk h.
     ( HasCallStack
     , ConvertRawHash blk
     , MonadThrow m
     , StandardHash blk
     , Typeable blk
     )
  => HasFS m h
  -> SecondaryOffset      -- ^ Start from this offset
  -> ChunkNo
  -> (Entry blk -> Bool)  -- ^ Stop condition: stop after this entry
  -> Word64               -- ^ The size of the chunk file, used to compute
                          -- the size of the last block.
  -> IsEBB                -- ^ Is the first entry to read an EBB?
  -> m [WithBlockSize (Entry blk)]
readAllEntries :: forall (m :: * -> *) blk h.
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m,
 StandardHash blk, Typeable blk) =>
HasFS m h
-> Word32
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
readAllEntries HasFS m h
hasFS Word32
secondaryOffset ChunkNo
chunk Entry blk -> Bool
stopAfter Word64
chunkFileSize = \IsEBB
isEBB ->
    HasFS m h
-> FsPath
-> OpenMode
-> (Handle h -> m [WithBlockSize (Entry blk)])
-> m [WithBlockSize (Entry blk)]
forall (m :: * -> *) h a.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
secondaryIndexFile OpenMode
ReadMode ((Handle h -> m [WithBlockSize (Entry blk)])
 -> m [WithBlockSize (Entry blk)])
-> (Handle h -> m [WithBlockSize (Entry blk)])
-> m [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ \Handle h
sHnd -> do
      ByteString
bl <- HasFS m h -> Handle h -> AbsOffset -> m ByteString
forall (m :: * -> *) h.
Monad m =>
HasFS m h -> Handle h -> AbsOffset -> m ByteString
hGetAllAt HasFS m h
hasFS Handle h
sHnd (Word64 -> AbsOffset
AbsOffset (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
secondaryOffset))
      IsEBB
-> ByteString
-> [WithBlockSize (Entry blk)]
-> Maybe (Entry blk)
-> m [WithBlockSize (Entry blk)]
go IsEBB
isEBB ByteString
bl [] Maybe (Entry blk)
forall a. Maybe a
Nothing
  where
    secondaryIndexFile :: FsPath
secondaryIndexFile = ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk

    go :: IsEBB  -- ^ Interpret the next entry as an EBB?
       -> Lazy.ByteString
       -> [WithBlockSize (Entry blk)]  -- ^ Accumulator
       -> Maybe (Entry blk)
          -- ^ The previous entry we read. We can only add it to the
          -- accumulator when we know its block size, which we compute based
          -- on the next entry's offset.
       -> m [WithBlockSize (Entry blk)]
    go :: IsEBB
-> ByteString
-> [WithBlockSize (Entry blk)]
-> Maybe (Entry blk)
-> m [WithBlockSize (Entry blk)]
go IsEBB
isEBB ByteString
bl [WithBlockSize (Entry blk)]
acc Maybe (Entry blk)
mbPrevEntry
      | ByteString -> Bool
Lazy.null ByteString
bl = [WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. [a] -> [a]
reverse ([WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$
        (Word64 -> Entry blk -> WithBlockSize (Entry blk)
addBlockSize Word64
chunkFileSize (Entry blk -> WithBlockSize (Entry blk))
-> Maybe (Entry blk) -> Maybe (WithBlockSize (Entry blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Entry blk)
mbPrevEntry) Maybe (WithBlockSize (Entry blk))
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. Maybe a -> [a] -> [a]
`consMaybe` [WithBlockSize (Entry blk)]
acc
      | Bool
otherwise    = do
        (ByteString
remaining, Entry blk
entry) <-
          Proxy blk
-> FsPath
-> Get (Entry blk)
-> ByteString
-> m (ByteString, Entry blk)
forall blk a (m :: * -> *).
(?callStack::CallStack, MonadThrow m, StandardHash blk,
 Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m (ByteString, a)
runGetWithUnconsumed (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) FsPath
secondaryIndexFile (IsEBB -> Get (Entry blk)
forall blk. ConvertRawHash blk => IsEBB -> Get (Entry blk)
getEntry IsEBB
isEBB) ByteString
bl
        let offsetAfterPrevBlock :: Word64
offsetAfterPrevBlock = BlockOffset -> Word64
unBlockOffset (Entry blk -> BlockOffset
forall blk. Entry blk -> BlockOffset
blockOffset Entry blk
entry)
            acc' :: [WithBlockSize (Entry blk)]
acc' = (Word64 -> Entry blk -> WithBlockSize (Entry blk)
addBlockSize Word64
offsetAfterPrevBlock (Entry blk -> WithBlockSize (Entry blk))
-> Maybe (Entry blk) -> Maybe (WithBlockSize (Entry blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Entry blk)
mbPrevEntry)
              Maybe (WithBlockSize (Entry blk))
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. Maybe a -> [a] -> [a]
`consMaybe` [WithBlockSize (Entry blk)]
acc
        if Entry blk -> Bool
stopAfter Entry blk
entry then

          if ByteString -> Bool
Lazy.null ByteString
remaining then
            [WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. [a] -> [a]
reverse ([WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ Word64 -> Entry blk -> WithBlockSize (Entry blk)
addBlockSize Word64
chunkFileSize Entry blk
entry WithBlockSize (Entry blk)
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. a -> [a] -> [a]
: [WithBlockSize (Entry blk)]
acc'
          else do
            -- Read the next blockOffset so we can compute the size of the
            -- last block we read.
            --
            -- We know @remaining@ is not empty, so it contains at least the
            -- next entry (unless the file is invalid) and definitely the
            -- next entry's block offset.
            (ByteString
_, Word64
nextBlockOffset) <-
              Proxy blk
-> FsPath -> Get Word64 -> ByteString -> m (ByteString, Word64)
forall blk a (m :: * -> *).
(?callStack::CallStack, MonadThrow m, StandardHash blk,
 Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m (ByteString, a)
runGetWithUnconsumed (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) FsPath
secondaryIndexFile Get Word64
forall t. Binary t => Get t
get ByteString
remaining
            [WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> m [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. [a] -> [a]
reverse ([WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ Word64 -> Entry blk -> WithBlockSize (Entry blk)
addBlockSize Word64
nextBlockOffset Entry blk
entry WithBlockSize (Entry blk)
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. a -> [a] -> [a]
: [WithBlockSize (Entry blk)]
acc'

        else
          -- Pass 'IsNotEBB' because there can only be one EBB and that must
          -- be the first one in the file.
          IsEBB
-> ByteString
-> [WithBlockSize (Entry blk)]
-> Maybe (Entry blk)
-> m [WithBlockSize (Entry blk)]
go IsEBB
IsNotEBB ByteString
remaining [WithBlockSize (Entry blk)]
acc' (Entry blk -> Maybe (Entry blk)
forall a. a -> Maybe a
Just Entry blk
entry)

    -- | Add the block size to an entry, it is computed by subtracting the
    -- entry's block offset from the offset after the entry's block, i.e.,
    -- where the next block starts.
    addBlockSize :: Word64 -> Entry blk -> WithBlockSize (Entry blk)
    addBlockSize :: Word64 -> Entry blk -> WithBlockSize (Entry blk)
addBlockSize Word64
offsetAfter Entry blk
entry = Word32 -> Entry blk -> WithBlockSize (Entry blk)
forall a. Word32 -> a -> WithBlockSize a
WithBlockSize Word32
size Entry blk
entry
      where
        size :: Word32
size = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64
offsetAfter Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- BlockOffset -> Word64
unBlockOffset (Entry blk -> BlockOffset
forall blk. Entry blk -> BlockOffset
blockOffset Entry blk
entry)

    consMaybe :: Maybe a -> [a] -> [a]
    consMaybe :: forall a. Maybe a -> [a] -> [a]
consMaybe = ([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id (:)

appendEntry ::
     forall m blk h. (HasCallStack, ConvertRawHash blk, MonadThrow m)
  => HasFS m h
  -> Handle h
  -> Entry blk
  -> m Word64
     -- ^ The number of bytes written
appendEntry :: forall (m :: * -> *) blk h.
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m) =>
HasFS m h -> Handle h -> Entry blk -> m Word64
appendEntry HasFS m h
hasFS Handle h
sHnd Entry blk
entry = do
    Word64
bytesWritten <- HasFS m h -> Handle h -> Builder -> m Word64
forall (m :: * -> *) h.
(?callStack::CallStack, Monad m) =>
HasFS m h -> Handle h -> Builder -> m Word64
hPut HasFS m h
hasFS Handle h
sHnd (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
$ Entry blk -> Put
forall blk. ConvertRawHash blk => Entry blk -> Put
putEntry Entry blk
entry
    Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$
      Bool -> Word64 -> Word64
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Word64
bytesWritten Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy blk -> Word32
forall blk. ConvertRawHash blk => Proxy blk -> Word32
entrySize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk))) Word64
bytesWritten

-- | Remove all entries after the entry at the given 'SecondaryOffset'. That
-- entry will now be the last entry in the secondary index file.
truncateToEntry ::
     forall m blk h. (HasCallStack, ConvertRawHash blk, MonadThrow m)
  => Proxy blk
  -> HasFS m h
  -> ChunkNo
  -> SecondaryOffset
  -> m ()
truncateToEntry :: forall (m :: * -> *) blk h.
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m) =>
Proxy blk -> HasFS m h -> ChunkNo -> Word32 -> m ()
truncateToEntry Proxy blk
pb HasFS m h
hasFS ChunkNo
chunk Word32
secondaryOffset =
    HasFS m h -> FsPath -> OpenMode -> (Handle h -> m ()) -> m ()
forall (m :: * -> *) h a.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
secondaryIndexFile (AllowExisting -> OpenMode
AppendMode AllowExisting
AllowExisting) ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
sHnd ->
      (?callStack::CallStack) => Handle h -> Word64 -> m ()
Handle h -> Word64 -> m ()
hTruncate Handle h
sHnd Word64
offset
  where
    secondaryIndexFile :: FsPath
secondaryIndexFile  = ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk
    HasFS { (?callStack::CallStack) => Handle h -> Word64 -> m ()
hTruncate :: (?callStack::CallStack) => Handle h -> Word64 -> m ()
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> Word64 -> m ()
hTruncate } = HasFS m h
hasFS
    offset :: Word64
offset              = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
secondaryOffset Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Proxy blk -> Word32
forall blk. ConvertRawHash blk => Proxy blk -> Word32
entrySize Proxy blk
pb)

writeAllEntries ::
     forall m blk h. (HasCallStack, ConvertRawHash blk, MonadThrow m)
  => HasFS m h
  -> ChunkNo
  -> [Entry blk]
  -> m ()
writeAllEntries :: forall (m :: * -> *) blk h.
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m) =>
HasFS m h -> ChunkNo -> [Entry blk] -> m ()
writeAllEntries HasFS m h
hasFS ChunkNo
chunk [Entry blk]
entries =
    HasFS m h -> FsPath -> OpenMode -> (Handle h -> m ()) -> m ()
forall (m :: * -> *) h a.
(?callStack::CallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
secondaryIndexFile (AllowExisting -> OpenMode
AppendMode AllowExisting
AllowExisting) ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
sHnd -> do
      -- First truncate the file, otherwise we might leave some old contents
      -- at the end if the new contents are smaller than the previous contents
      (?callStack::CallStack) => Handle h -> Word64 -> m ()
Handle h -> Word64 -> m ()
hTruncate Handle h
sHnd Word64
0
      (Entry blk -> m Word64) -> [Entry blk] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HasFS m h -> Handle h -> Entry blk -> m Word64
forall (m :: * -> *) blk h.
(?callStack::CallStack, ConvertRawHash blk, MonadThrow m) =>
HasFS m h -> Handle h -> Entry blk -> m Word64
appendEntry HasFS m h
hasFS Handle h
sHnd) [Entry blk]
entries
  where
    secondaryIndexFile :: FsPath
secondaryIndexFile  = ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk
    HasFS { (?callStack::CallStack) => Handle h -> Word64 -> m ()
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> (?callStack::CallStack) => Handle h -> Word64 -> m ()
hTruncate :: (?callStack::CallStack) => Handle h -> Word64 -> m ()
hTruncate } = HasFS m h
hasFS

{------------------------------------------------------------------------------
  Binary functions
------------------------------------------------------------------------------}

getHash :: ConvertRawHash blk => Proxy blk -> Get (HeaderHash blk)
getHash :: forall blk. ConvertRawHash blk => Proxy blk -> Get (HeaderHash blk)
getHash Proxy blk
pb = do
    ByteString
bytes <- Int -> Get ByteString
Get.getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy blk -> Word32
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> Word32
forall (proxy :: * -> *). proxy blk -> Word32
hashSize Proxy blk
pb))
    HeaderHash blk -> Get (HeaderHash blk)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (HeaderHash blk -> Get (HeaderHash blk))
-> HeaderHash blk -> Get (HeaderHash blk)
forall a b. (a -> b) -> a -> b
$! Proxy blk -> ByteString -> HeaderHash blk
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ByteString -> HeaderHash blk
forall (proxy :: * -> *). proxy blk -> ByteString -> HeaderHash blk
fromRawHash Proxy blk
pb ByteString
bytes

putHash :: ConvertRawHash blk => Proxy blk -> HeaderHash blk -> Put
putHash :: forall blk.
ConvertRawHash blk =>
Proxy blk -> HeaderHash blk -> Put
putHash Proxy blk
pb = ShortByteString -> Put
Put.putShortByteString (ShortByteString -> Put)
-> (HeaderHash blk -> ShortByteString) -> HeaderHash blk -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> HeaderHash blk -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy blk -> HeaderHash blk -> ShortByteString
toShortRawHash Proxy blk
pb