{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Cache (
CacheConfig (..)
, CacheEnv
, checkInvariants
, newEnv
, expireUnusedChunks
, close
, restart
, appendOffsets
, openPrimaryIndex
, readFirstFilledSlot
, readOffsets
, appendEntry
, readAllEntries
, readEntries
) where
import Cardano.Prelude (forceElemsToWHNF)
import Control.Exception (assert)
import Control.Monad (forM, forM_, forever, unless, void, when)
import Control.Monad.Except (throwError)
import Control.Tracer (Tracer, traceWith)
import Data.Foldable (toList)
import Data.Functor ((<&>))
import Data.IntPSQ (IntPSQ)
import qualified Data.IntPSQ as PSQ
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as Seq
import Data.Typeable (Typeable)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Void (Void)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Ouroboros.Consensus.Block (ConvertRawHash, IsEBB (..),
StandardHash)
import Ouroboros.Consensus.Storage.ImmutableDB.API
(UnexpectedFailure (..), throwUnexpectedFailure)
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Layout
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary
(PrimaryIndex, SecondaryOffset)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Primary as Primary
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Secondary
(BlockSize (..))
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Secondary as Secondary
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types
(TraceCacheEvent (..), WithBlockSize (..))
import Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util
(fsPathChunkFile, fsPathPrimaryIndexFile,
fsPathSecondaryIndexFile)
import Ouroboros.Consensus.Util (takeUntil, whenJust)
import Ouroboros.Consensus.Util.CallStack
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.ResourceRegistry
import System.FS.API (HasFS (..), withFile)
import System.FS.API.Types (AllowExisting (..), Handle,
OpenMode (ReadMode))
data CacheConfig = CacheConfig
{ CacheConfig -> Word32
pastChunksToCache :: Word32
, CacheConfig -> DiffTime
expireUnusedAfter :: DiffTime
}
deriving (CacheConfig -> CacheConfig -> Bool
(CacheConfig -> CacheConfig -> Bool)
-> (CacheConfig -> CacheConfig -> Bool) -> Eq CacheConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheConfig -> CacheConfig -> Bool
== :: CacheConfig -> CacheConfig -> Bool
$c/= :: CacheConfig -> CacheConfig -> Bool
/= :: CacheConfig -> CacheConfig -> Bool
Eq, Int -> CacheConfig -> ShowS
[CacheConfig] -> ShowS
CacheConfig -> String
(Int -> CacheConfig -> ShowS)
-> (CacheConfig -> String)
-> ([CacheConfig] -> ShowS)
-> Show CacheConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheConfig -> ShowS
showsPrec :: Int -> CacheConfig -> ShowS
$cshow :: CacheConfig -> String
show :: CacheConfig -> String
$cshowList :: [CacheConfig] -> ShowS
showList :: [CacheConfig] -> ShowS
Show)
type Entry blk = WithBlockSize (Secondary.Entry blk)
data CurrentChunkInfo blk = CurrentChunkInfo
{ forall blk. CurrentChunkInfo blk -> ChunkNo
currentChunkNo :: !ChunkNo
, forall blk. CurrentChunkInfo blk -> StrictSeq Word32
currentChunkOffsets :: !(StrictSeq SecondaryOffset)
, forall blk. CurrentChunkInfo blk -> StrictSeq (Entry blk)
currentChunkEntries :: !(StrictSeq (Entry blk))
}
deriving (Int -> CurrentChunkInfo blk -> ShowS
[CurrentChunkInfo blk] -> ShowS
CurrentChunkInfo blk -> String
(Int -> CurrentChunkInfo blk -> ShowS)
-> (CurrentChunkInfo blk -> String)
-> ([CurrentChunkInfo blk] -> ShowS)
-> Show (CurrentChunkInfo blk)
forall blk.
StandardHash blk =>
Int -> CurrentChunkInfo blk -> ShowS
forall blk. StandardHash blk => [CurrentChunkInfo blk] -> ShowS
forall blk. StandardHash blk => CurrentChunkInfo blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> CurrentChunkInfo blk -> ShowS
showsPrec :: Int -> CurrentChunkInfo blk -> ShowS
$cshow :: forall blk. StandardHash blk => CurrentChunkInfo blk -> String
show :: CurrentChunkInfo blk -> String
$cshowList :: forall blk. StandardHash blk => [CurrentChunkInfo blk] -> ShowS
showList :: [CurrentChunkInfo blk] -> ShowS
Show, (forall x. CurrentChunkInfo blk -> Rep (CurrentChunkInfo blk) x)
-> (forall x. Rep (CurrentChunkInfo blk) x -> CurrentChunkInfo blk)
-> Generic (CurrentChunkInfo blk)
forall x. Rep (CurrentChunkInfo blk) x -> CurrentChunkInfo blk
forall x. CurrentChunkInfo blk -> Rep (CurrentChunkInfo blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (CurrentChunkInfo blk) x -> CurrentChunkInfo blk
forall blk x. CurrentChunkInfo blk -> Rep (CurrentChunkInfo blk) x
$cfrom :: forall blk x. CurrentChunkInfo blk -> Rep (CurrentChunkInfo blk) x
from :: forall x. CurrentChunkInfo blk -> Rep (CurrentChunkInfo blk) x
$cto :: forall blk x. Rep (CurrentChunkInfo blk) x -> CurrentChunkInfo blk
to :: forall x. Rep (CurrentChunkInfo blk) x -> CurrentChunkInfo blk
Generic, Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo)
Proxy (CurrentChunkInfo blk) -> String
(Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo))
-> (Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo))
-> (Proxy (CurrentChunkInfo blk) -> String)
-> NoThunks (CurrentChunkInfo blk)
forall blk.
StandardHash blk =>
Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo)
forall blk.
StandardHash blk =>
Proxy (CurrentChunkInfo blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk.
StandardHash blk =>
Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
StandardHash blk =>
Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CurrentChunkInfo blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk.
StandardHash blk =>
Proxy (CurrentChunkInfo blk) -> String
showTypeOf :: Proxy (CurrentChunkInfo blk) -> String
NoThunks)
emptyCurrentChunkInfo :: ChunkNo -> CurrentChunkInfo blk
emptyCurrentChunkInfo :: forall blk. ChunkNo -> CurrentChunkInfo blk
emptyCurrentChunkInfo ChunkNo
chunk = CurrentChunkInfo
{ $sel:currentChunkNo:CurrentChunkInfo :: ChunkNo
currentChunkNo = ChunkNo
chunk
, $sel:currentChunkOffsets:CurrentChunkInfo :: StrictSeq Word32
currentChunkOffsets = Word32 -> StrictSeq Word32
forall a. a -> StrictSeq a
Seq.singleton Word32
0
, $sel:currentChunkEntries:CurrentChunkInfo :: StrictSeq (Entry blk)
currentChunkEntries = StrictSeq (Entry blk)
forall a. StrictSeq a
Seq.empty
}
toPastChunkInfo :: CurrentChunkInfo blk -> PastChunkInfo blk
toPastChunkInfo :: forall blk. CurrentChunkInfo blk -> PastChunkInfo blk
toPastChunkInfo CurrentChunkInfo{StrictSeq Word32
StrictSeq (Entry blk)
ChunkNo
$sel:currentChunkNo:CurrentChunkInfo :: forall blk. CurrentChunkInfo blk -> ChunkNo
$sel:currentChunkOffsets:CurrentChunkInfo :: forall blk. CurrentChunkInfo blk -> StrictSeq Word32
$sel:currentChunkEntries:CurrentChunkInfo :: forall blk. CurrentChunkInfo blk -> StrictSeq (Entry blk)
currentChunkNo :: ChunkNo
currentChunkOffsets :: StrictSeq Word32
currentChunkEntries :: StrictSeq (Entry blk)
..} =
PastChunkInfo
{ $sel:pastChunkOffsets:PastChunkInfo :: PrimaryIndex
pastChunkOffsets =
PrimaryIndex -> Maybe PrimaryIndex -> PrimaryIndex
forall a. a -> Maybe a -> a
fromMaybe (String -> PrimaryIndex
forall a. HasCallStack => String -> a
error String
"invalid current chunk") (Maybe PrimaryIndex -> PrimaryIndex)
-> Maybe PrimaryIndex -> PrimaryIndex
forall a b. (a -> b) -> a -> b
$
ChunkNo -> [Word32] -> Maybe PrimaryIndex
Primary.mk ChunkNo
currentChunkNo (StrictSeq Word32 -> [Word32]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq Word32
currentChunkOffsets)
, $sel:pastChunkEntries:PastChunkInfo :: Vector (Entry blk)
pastChunkEntries =
[Entry blk] -> Vector (Entry blk)
forall a. [a] -> Vector a
Vector.fromList ([Entry blk] -> Vector (Entry blk))
-> [Entry blk] -> Vector (Entry blk)
forall a b. (a -> b) -> a -> b
$ StrictSeq (Entry blk) -> [Entry blk]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Entry blk)
currentChunkEntries
}
data PastChunkInfo blk = PastChunkInfo
{ forall blk. PastChunkInfo blk -> PrimaryIndex
pastChunkOffsets :: !PrimaryIndex
, forall blk. PastChunkInfo blk -> Vector (Entry blk)
pastChunkEntries :: !(Vector (Entry blk))
}
deriving ((forall x. PastChunkInfo blk -> Rep (PastChunkInfo blk) x)
-> (forall x. Rep (PastChunkInfo blk) x -> PastChunkInfo blk)
-> Generic (PastChunkInfo blk)
forall x. Rep (PastChunkInfo blk) x -> PastChunkInfo blk
forall x. PastChunkInfo blk -> Rep (PastChunkInfo blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (PastChunkInfo blk) x -> PastChunkInfo blk
forall blk x. PastChunkInfo blk -> Rep (PastChunkInfo blk) x
$cfrom :: forall blk x. PastChunkInfo blk -> Rep (PastChunkInfo blk) x
from :: forall x. PastChunkInfo blk -> Rep (PastChunkInfo blk) x
$cto :: forall blk x. Rep (PastChunkInfo blk) x -> PastChunkInfo blk
to :: forall x. Rep (PastChunkInfo blk) x -> PastChunkInfo blk
Generic, Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo)
Proxy (PastChunkInfo blk) -> String
(Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo))
-> (Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo))
-> (Proxy (PastChunkInfo blk) -> String)
-> NoThunks (PastChunkInfo blk)
forall blk.
StandardHash blk =>
Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo)
forall blk. StandardHash blk => Proxy (PastChunkInfo blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk.
StandardHash blk =>
Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
StandardHash blk =>
Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PastChunkInfo blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk. StandardHash blk => Proxy (PastChunkInfo blk) -> String
showTypeOf :: Proxy (PastChunkInfo blk) -> String
NoThunks)
newtype LastUsed = LastUsed Time
deriving newtype (LastUsed -> LastUsed -> Bool
(LastUsed -> LastUsed -> Bool)
-> (LastUsed -> LastUsed -> Bool) -> Eq LastUsed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LastUsed -> LastUsed -> Bool
== :: LastUsed -> LastUsed -> Bool
$c/= :: LastUsed -> LastUsed -> Bool
/= :: LastUsed -> LastUsed -> Bool
Eq, Eq LastUsed
Eq LastUsed =>
(LastUsed -> LastUsed -> Ordering)
-> (LastUsed -> LastUsed -> Bool)
-> (LastUsed -> LastUsed -> Bool)
-> (LastUsed -> LastUsed -> Bool)
-> (LastUsed -> LastUsed -> Bool)
-> (LastUsed -> LastUsed -> LastUsed)
-> (LastUsed -> LastUsed -> LastUsed)
-> Ord LastUsed
LastUsed -> LastUsed -> Bool
LastUsed -> LastUsed -> Ordering
LastUsed -> LastUsed -> LastUsed
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 :: LastUsed -> LastUsed -> Ordering
compare :: LastUsed -> LastUsed -> Ordering
$c< :: LastUsed -> LastUsed -> Bool
< :: LastUsed -> LastUsed -> Bool
$c<= :: LastUsed -> LastUsed -> Bool
<= :: LastUsed -> LastUsed -> Bool
$c> :: LastUsed -> LastUsed -> Bool
> :: LastUsed -> LastUsed -> Bool
$c>= :: LastUsed -> LastUsed -> Bool
>= :: LastUsed -> LastUsed -> Bool
$cmax :: LastUsed -> LastUsed -> LastUsed
max :: LastUsed -> LastUsed -> LastUsed
$cmin :: LastUsed -> LastUsed -> LastUsed
min :: LastUsed -> LastUsed -> LastUsed
Ord, Int -> LastUsed -> ShowS
[LastUsed] -> ShowS
LastUsed -> String
(Int -> LastUsed -> ShowS)
-> (LastUsed -> String) -> ([LastUsed] -> ShowS) -> Show LastUsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LastUsed -> ShowS
showsPrec :: Int -> LastUsed -> ShowS
$cshow :: LastUsed -> String
show :: LastUsed -> String
$cshowList :: [LastUsed] -> ShowS
showList :: [LastUsed] -> ShowS
Show, Context -> LastUsed -> IO (Maybe ThunkInfo)
Proxy LastUsed -> String
(Context -> LastUsed -> IO (Maybe ThunkInfo))
-> (Context -> LastUsed -> IO (Maybe ThunkInfo))
-> (Proxy LastUsed -> String)
-> NoThunks LastUsed
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LastUsed -> IO (Maybe ThunkInfo)
noThunks :: Context -> LastUsed -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LastUsed -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LastUsed -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LastUsed -> String
showTypeOf :: Proxy LastUsed -> String
NoThunks)
data Cached blk = Cached
{ forall blk. Cached blk -> ChunkNo
currentChunk :: !ChunkNo
, forall blk. Cached blk -> CurrentChunkInfo blk
currentChunkInfo :: !(CurrentChunkInfo blk)
, forall blk. Cached blk -> IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo :: !(IntPSQ LastUsed (PastChunkInfo blk))
, forall blk. Cached blk -> Word32
nbPastChunks :: !Word32
}
deriving ((forall x. Cached blk -> Rep (Cached blk) x)
-> (forall x. Rep (Cached blk) x -> Cached blk)
-> Generic (Cached blk)
forall x. Rep (Cached blk) x -> Cached blk
forall x. Cached blk -> Rep (Cached blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (Cached blk) x -> Cached blk
forall blk x. Cached blk -> Rep (Cached blk) x
$cfrom :: forall blk x. Cached blk -> Rep (Cached blk) x
from :: forall x. Cached blk -> Rep (Cached blk) x
$cto :: forall blk x. Rep (Cached blk) x -> Cached blk
to :: forall x. Rep (Cached blk) x -> Cached blk
Generic, Context -> Cached blk -> IO (Maybe ThunkInfo)
Proxy (Cached blk) -> String
(Context -> Cached blk -> IO (Maybe ThunkInfo))
-> (Context -> Cached blk -> IO (Maybe ThunkInfo))
-> (Proxy (Cached blk) -> String)
-> NoThunks (Cached blk)
forall blk.
StandardHash blk =>
Context -> Cached blk -> IO (Maybe ThunkInfo)
forall blk. StandardHash blk => Proxy (Cached blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk.
StandardHash blk =>
Context -> Cached blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> Cached blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
StandardHash blk =>
Context -> Cached blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Cached blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk. StandardHash blk => Proxy (Cached blk) -> String
showTypeOf :: Proxy (Cached blk) -> String
NoThunks)
checkInvariants ::
Word32
-> Cached blk
-> Maybe String
checkInvariants :: forall blk. Word32 -> Cached blk -> Maybe String
checkInvariants Word32
pastChunksToCache Cached {Word32
IntPSQ LastUsed (PastChunkInfo blk)
ChunkNo
CurrentChunkInfo blk
$sel:currentChunk:Cached :: forall blk. Cached blk -> ChunkNo
$sel:currentChunkInfo:Cached :: forall blk. Cached blk -> CurrentChunkInfo blk
$sel:pastChunksInfo:Cached :: forall blk. Cached blk -> IntPSQ LastUsed (PastChunkInfo blk)
$sel:nbPastChunks:Cached :: forall blk. Cached blk -> Word32
currentChunk :: ChunkNo
currentChunkInfo :: CurrentChunkInfo blk
pastChunksInfo :: IntPSQ LastUsed (PastChunkInfo blk)
nbPastChunks :: Word32
..} = (String -> Maybe String)
-> (() -> Maybe String) -> Either String () -> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Maybe String
forall a. a -> Maybe a
Just (Maybe String -> () -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) (Either String () -> Maybe String)
-> Either String () -> Maybe String
forall a b. (a -> b) -> a -> b
$ do
[Int] -> (Int -> Either String ()) -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntPSQ LastUsed (PastChunkInfo blk) -> [Int]
forall p v. IntPSQ p v -> [Int]
PSQ.keys IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo) ((Int -> Either String ()) -> Either String ())
-> (Int -> Either String ()) -> Either String ()
forall a b. (a -> b) -> a -> b
$ \Int
pastChunk ->
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
pastChunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ChunkNo -> Int
chunkNoToInt ChunkNo
currentChunk) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
String
"past chunk (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
pastChunk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") >= current chunk (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
ChunkNo -> String
forall a. Show a => a -> String
show ChunkNo
currentChunk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IntPSQ LastUsed (PastChunkInfo blk) -> Int
forall p v. IntPSQ p v -> Int
PSQ.size IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pastChunksToCache) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
String
"PSQ.size pastChunksInfo (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (IntPSQ LastUsed (PastChunkInfo blk) -> Int
forall p v. IntPSQ p v -> Int
PSQ.size IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
") > pastChunksToCache (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
pastChunksToCache String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
nbPastChunks Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPSQ LastUsed (PastChunkInfo blk) -> Int
forall p v. IntPSQ p v -> Int
PSQ.size IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo)) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
String
"nbPastChunks (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
nbPastChunks String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
") /= PSQ.size pastChunksInfo (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (IntPSQ LastUsed (PastChunkInfo blk) -> Int
forall p v. IntPSQ p v -> Int
PSQ.size IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
")"
addPastChunkInfo ::
ChunkNo
-> LastUsed
-> PastChunkInfo blk
-> Cached blk
-> Cached blk
addPastChunkInfo :: forall blk.
ChunkNo
-> LastUsed -> PastChunkInfo blk -> Cached blk -> Cached blk
addPastChunkInfo ChunkNo
chunk LastUsed
lastUsed PastChunkInfo blk
pastChunkInfo Cached blk
cached =
Bool -> Cached blk -> Cached blk
forall a. HasCallStack => Bool -> a -> a
assert (ChunkNo
chunk ChunkNo -> ChunkNo -> Bool
forall a. Ord a => a -> a -> Bool
< Cached blk -> ChunkNo
forall blk. Cached blk -> ChunkNo
currentChunk Cached blk
cached) (Cached blk -> Cached blk) -> Cached blk -> Cached blk
forall a b. (a -> b) -> a -> b
$
Cached blk
cached
{ pastChunksInfo = pastChunksInfo'
, nbPastChunks = nbPastChunks'
}
where
Cached { IntPSQ LastUsed (PastChunkInfo blk)
$sel:pastChunksInfo:Cached :: forall blk. Cached blk -> IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo :: IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo, Word32
$sel:nbPastChunks:Cached :: forall blk. Cached blk -> Word32
nbPastChunks :: Word32
nbPastChunks } = Cached blk
cached
(Maybe (LastUsed, PastChunkInfo blk)
mbAlreadyPresent, IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo') =
Int
-> LastUsed
-> PastChunkInfo blk
-> IntPSQ LastUsed (PastChunkInfo blk)
-> (Maybe (LastUsed, PastChunkInfo blk),
IntPSQ LastUsed (PastChunkInfo blk))
forall p v.
Ord p =>
Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
PSQ.insertView (ChunkNo -> Int
chunkNoToInt ChunkNo
chunk) LastUsed
lastUsed PastChunkInfo blk
pastChunkInfo IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo
nbPastChunks' :: Word32
nbPastChunks'
| Just (LastUsed, PastChunkInfo blk)
_ <- Maybe (LastUsed, PastChunkInfo blk)
mbAlreadyPresent
= Word32
nbPastChunks
| Bool
otherwise
= Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
nbPastChunks
evictIfNecessary ::
Word32
-> Cached blk
-> (Cached blk, Maybe ChunkNo)
evictIfNecessary :: forall blk. Word32 -> Cached blk -> (Cached blk, Maybe ChunkNo)
evictIfNecessary Word32
maxNbPastChunks Cached blk
cached
| Word32
nbPastChunks Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
maxNbPastChunks
= Bool -> (Cached blk, Maybe ChunkNo) -> (Cached blk, Maybe ChunkNo)
forall a. HasCallStack => Bool -> a -> a
assert (Word32
nbPastChunks Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
maxNbPastChunks Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) ((Cached blk, Maybe ChunkNo) -> (Cached blk, Maybe ChunkNo))
-> (Cached blk, Maybe ChunkNo) -> (Cached blk, Maybe ChunkNo)
forall a b. (a -> b) -> a -> b
$
case IntPSQ LastUsed (PastChunkInfo blk)
-> Maybe
(Int, LastUsed, PastChunkInfo blk,
IntPSQ LastUsed (PastChunkInfo blk))
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
PSQ.minView IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo of
Maybe
(Int, LastUsed, PastChunkInfo blk,
IntPSQ LastUsed (PastChunkInfo blk))
Nothing -> String -> (Cached blk, Maybe ChunkNo)
forall a. HasCallStack => String -> a
error
String
"nbPastChunks > maxNbPastChunks but pastChunksInfo was empty"
Just (Int
chunkNo, LastUsed
_p, PastChunkInfo blk
_v, IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo') ->
(Cached blk
cached', ChunkNo -> Maybe ChunkNo
forall a. a -> Maybe a
Just (ChunkNo -> Maybe ChunkNo) -> ChunkNo -> Maybe ChunkNo
forall a b. (a -> b) -> a -> b
$ Int -> ChunkNo
chunkNoFromInt Int
chunkNo)
where
cached' :: Cached blk
cached' = Cached blk
cached
{ nbPastChunks = maxNbPastChunks
, pastChunksInfo = pastChunksInfo'
}
| Bool
otherwise
= (Cached blk
cached, Maybe ChunkNo
forall a. Maybe a
Nothing)
where
Cached { Word32
$sel:nbPastChunks:Cached :: forall blk. Cached blk -> Word32
nbPastChunks :: Word32
nbPastChunks, IntPSQ LastUsed (PastChunkInfo blk)
$sel:pastChunksInfo:Cached :: forall blk. Cached blk -> IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo :: IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo } = Cached blk
cached
{-# INLINE evictIfNecessary #-}
lookupPastChunkInfo ::
ChunkNo
-> LastUsed
-> Cached blk
-> Maybe (PastChunkInfo blk, Cached blk)
lookupPastChunkInfo :: forall blk.
ChunkNo
-> LastUsed -> Cached blk -> Maybe (PastChunkInfo blk, Cached blk)
lookupPastChunkInfo ChunkNo
chunk LastUsed
lastUsed cached :: Cached blk
cached@Cached { IntPSQ LastUsed (PastChunkInfo blk)
$sel:pastChunksInfo:Cached :: forall blk. Cached blk -> IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo :: IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo } =
case (Maybe (LastUsed, PastChunkInfo blk)
-> (Maybe (PastChunkInfo blk),
Maybe (LastUsed, PastChunkInfo blk)))
-> Int
-> IntPSQ LastUsed (PastChunkInfo blk)
-> (Maybe (PastChunkInfo blk), IntPSQ LastUsed (PastChunkInfo blk))
forall p v b.
Ord p =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> Int -> IntPSQ p v -> (b, IntPSQ p v)
PSQ.alter Maybe (LastUsed, PastChunkInfo blk)
-> (Maybe (PastChunkInfo blk), Maybe (LastUsed, PastChunkInfo blk))
forall blk.
Maybe (LastUsed, PastChunkInfo blk)
-> (Maybe (PastChunkInfo blk), Maybe (LastUsed, PastChunkInfo blk))
lookupAndUpdateLastUsed (ChunkNo -> Int
chunkNoToInt ChunkNo
chunk) IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo of
(Maybe (PastChunkInfo blk)
Nothing, IntPSQ LastUsed (PastChunkInfo blk)
_) -> Maybe (PastChunkInfo blk, Cached blk)
forall a. Maybe a
Nothing
(Just PastChunkInfo blk
pastChunkInfo, IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo') -> (PastChunkInfo blk, Cached blk)
-> Maybe (PastChunkInfo blk, Cached blk)
forall a. a -> Maybe a
Just (PastChunkInfo blk
pastChunkInfo, Cached blk
cached')
where
cached' :: Cached blk
cached' = Cached blk
cached { pastChunksInfo = pastChunksInfo' }
where
lookupAndUpdateLastUsed
:: Maybe (LastUsed, PastChunkInfo blk)
-> (Maybe (PastChunkInfo blk), Maybe (LastUsed, PastChunkInfo blk))
lookupAndUpdateLastUsed :: forall blk.
Maybe (LastUsed, PastChunkInfo blk)
-> (Maybe (PastChunkInfo blk), Maybe (LastUsed, PastChunkInfo blk))
lookupAndUpdateLastUsed = \case
Maybe (LastUsed, PastChunkInfo blk)
Nothing -> (Maybe (PastChunkInfo blk)
forall a. Maybe a
Nothing, Maybe (LastUsed, PastChunkInfo blk)
forall a. Maybe a
Nothing)
Just (LastUsed
_lastUsed, PastChunkInfo blk
info) -> (PastChunkInfo blk -> Maybe (PastChunkInfo blk)
forall a. a -> Maybe a
Just PastChunkInfo blk
info, (LastUsed, PastChunkInfo blk)
-> Maybe (LastUsed, PastChunkInfo blk)
forall a. a -> Maybe a
Just (LastUsed
lastUsed, PastChunkInfo blk
info))
openChunk ::
ChunkNo
-> LastUsed
-> CurrentChunkInfo blk
-> Cached blk
-> Cached blk
openChunk :: forall blk.
ChunkNo
-> LastUsed -> CurrentChunkInfo blk -> Cached blk -> Cached blk
openChunk ChunkNo
chunk LastUsed
lastUsed CurrentChunkInfo blk
newCurrentChunkInfo Cached blk
cached
| ChunkNo
currentChunk ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkNo
chunk
= Cached blk
cached
{ currentChunkInfo = newCurrentChunkInfo }
| ChunkNo -> ChunkNo
nextChunkNo ChunkNo
currentChunk ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkNo
chunk
= Cached
{ $sel:currentChunk:Cached :: ChunkNo
currentChunk = ChunkNo
chunk
, $sel:currentChunkInfo:Cached :: CurrentChunkInfo blk
currentChunkInfo = CurrentChunkInfo blk
newCurrentChunkInfo
, $sel:pastChunksInfo:Cached :: IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo = Int
-> LastUsed
-> PastChunkInfo blk
-> IntPSQ LastUsed (PastChunkInfo blk)
-> IntPSQ LastUsed (PastChunkInfo blk)
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
PSQ.insert (ChunkNo -> Int
chunkNoToInt ChunkNo
currentChunk) LastUsed
lastUsed
(CurrentChunkInfo blk -> PastChunkInfo blk
forall blk. CurrentChunkInfo blk -> PastChunkInfo blk
toPastChunkInfo CurrentChunkInfo blk
currentChunkInfo) IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo
, $sel:nbPastChunks:Cached :: Word32
nbPastChunks = Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
nbPastChunks
}
| Bool
otherwise
= String -> Cached blk
forall a. HasCallStack => String -> a
error (String -> Cached blk) -> String -> Cached blk
forall a b. (a -> b) -> a -> b
$ String
"Going from chunk " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> String
forall a. Show a => a -> String
show ChunkNo
currentChunk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> String
forall a. Show a => a -> String
show ChunkNo
chunk
where
Cached
{ ChunkNo
$sel:currentChunk:Cached :: forall blk. Cached blk -> ChunkNo
currentChunk :: ChunkNo
currentChunk, CurrentChunkInfo blk
$sel:currentChunkInfo:Cached :: forall blk. Cached blk -> CurrentChunkInfo blk
currentChunkInfo :: CurrentChunkInfo blk
currentChunkInfo, IntPSQ LastUsed (PastChunkInfo blk)
$sel:pastChunksInfo:Cached :: forall blk. Cached blk -> IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo :: IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo, Word32
$sel:nbPastChunks:Cached :: forall blk. Cached blk -> Word32
nbPastChunks :: Word32
nbPastChunks
} = Cached blk
cached
emptyCached ::
ChunkNo
-> CurrentChunkInfo blk
-> Cached blk
emptyCached :: forall blk. ChunkNo -> CurrentChunkInfo blk -> Cached blk
emptyCached ChunkNo
currentChunk CurrentChunkInfo blk
currentChunkInfo = Cached
{ ChunkNo
$sel:currentChunk:Cached :: ChunkNo
currentChunk :: ChunkNo
currentChunk
, CurrentChunkInfo blk
$sel:currentChunkInfo:Cached :: CurrentChunkInfo blk
currentChunkInfo :: CurrentChunkInfo blk
currentChunkInfo
, $sel:pastChunksInfo:Cached :: IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo = IntPSQ LastUsed (PastChunkInfo blk)
forall p v. IntPSQ p v
PSQ.empty
, $sel:nbPastChunks:Cached :: Word32
nbPastChunks = Word32
0
}
data CacheEnv m blk h = CacheEnv
{ forall (m :: * -> *) blk h. CacheEnv m blk h -> HasFS m h
hasFS :: HasFS m h
, forall (m :: * -> *) blk h. CacheEnv m blk h -> ResourceRegistry m
registry :: ResourceRegistry m
, forall (m :: * -> *) blk h.
CacheEnv m blk h -> Tracer m TraceCacheEvent
tracer :: Tracer m TraceCacheEvent
, forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Cached blk)
cacheVar :: StrictMVar m (Cached blk)
, forall (m :: * -> *) blk h. CacheEnv m blk h -> CacheConfig
cacheConfig :: CacheConfig
, forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Maybe (Thread m Void))
bgThreadVar :: StrictMVar m (Maybe (Thread m Void))
, forall (m :: * -> *) blk h. CacheEnv m blk h -> ChunkInfo
chunkInfo :: ChunkInfo
}
newEnv ::
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> HasFS m h
-> ResourceRegistry m
-> Tracer m TraceCacheEvent
-> CacheConfig
-> ChunkInfo
-> ChunkNo
-> m (CacheEnv m blk h)
newEnv :: forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h
-> ResourceRegistry m
-> Tracer m TraceCacheEvent
-> CacheConfig
-> ChunkInfo
-> ChunkNo
-> m (CacheEnv m blk h)
newEnv HasFS m h
hasFS ResourceRegistry m
registry Tracer m TraceCacheEvent
tracer CacheConfig
cacheConfig ChunkInfo
chunkInfo ChunkNo
chunk = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
pastChunksToCache Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. HasCallStack => String -> a
error String
"pastChunksToCache must be > 0"
CurrentChunkInfo blk
currentChunkInfo <- HasFS m h -> ChunkInfo -> ChunkNo -> m (CurrentChunkInfo blk)
forall (m :: * -> *) h blk.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkInfo -> ChunkNo -> m (CurrentChunkInfo blk)
loadCurrentChunkInfo HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk
StrictMVar m (Cached blk)
cacheVar <- Cached blk -> m (StrictMVar m (Cached blk))
newMVarWithInvariants (Cached blk -> m (StrictMVar m (Cached blk)))
-> Cached blk -> m (StrictMVar m (Cached blk))
forall a b. (a -> b) -> a -> b
$ ChunkNo -> CurrentChunkInfo blk -> Cached blk
forall blk. ChunkNo -> CurrentChunkInfo blk -> Cached blk
emptyCached ChunkNo
chunk CurrentChunkInfo blk
currentChunkInfo
StrictMVar m (Maybe (Thread m Void))
bgThreadVar <- Maybe (Thread m Void) -> m (StrictMVar m (Maybe (Thread m Void)))
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m, NoThunks a) =>
a -> m (StrictMVar m a)
newMVar Maybe (Thread m Void)
forall a. Maybe a
Nothing
let cacheEnv :: CacheEnv m blk h
cacheEnv = CacheEnv {Tracer m TraceCacheEvent
HasFS m h
StrictMVar m (Maybe (Thread m Void))
StrictMVar m (Cached blk)
ChunkInfo
ResourceRegistry m
CacheConfig
$sel:hasFS:CacheEnv :: HasFS m h
$sel:registry:CacheEnv :: ResourceRegistry m
$sel:tracer:CacheEnv :: Tracer m TraceCacheEvent
$sel:cacheVar:CacheEnv :: StrictMVar m (Cached blk)
$sel:cacheConfig:CacheEnv :: CacheConfig
$sel:bgThreadVar:CacheEnv :: StrictMVar m (Maybe (Thread m Void))
$sel:chunkInfo:CacheEnv :: ChunkInfo
hasFS :: HasFS m h
registry :: ResourceRegistry m
tracer :: Tracer m TraceCacheEvent
cacheConfig :: CacheConfig
chunkInfo :: ChunkInfo
cacheVar :: StrictMVar m (Cached blk)
bgThreadVar :: StrictMVar m (Maybe (Thread m Void))
..}
m () -> m ()
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictMVar m (Maybe (Thread m Void))
-> (Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ StrictMVar m (Maybe (Thread m Void))
bgThreadVar ((Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ())
-> (Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ()
forall a b. (a -> b) -> a -> b
$ \Maybe (Thread m Void)
_mustBeNothing -> do
!Thread m Void
bgThread <- ResourceRegistry m -> String -> m Void -> m (Thread m Void)
forall (m :: * -> *) a.
(IOLike m, HasCallStack) =>
ResourceRegistry m -> String -> m a -> m (Thread m a)
forkLinkedThread ResourceRegistry m
registry String
"ImmutableDB.expireUnusedChunks" (m Void -> m (Thread m Void)) -> m Void -> m (Thread m Void)
forall a b. (a -> b) -> a -> b
$
CacheEnv m blk h -> m Void
forall (m :: * -> *) blk h.
(HasCallStack, IOLike m) =>
CacheEnv m blk h -> m Void
expireUnusedChunks CacheEnv m blk h
cacheEnv
Maybe (Thread m Void) -> m (Maybe (Thread m Void))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Thread m Void) -> m (Maybe (Thread m Void)))
-> Maybe (Thread m Void) -> m (Maybe (Thread m Void))
forall a b. (a -> b) -> a -> b
$ Thread m Void -> Maybe (Thread m Void)
forall a. a -> Maybe a
Just Thread m Void
bgThread
CacheEnv m blk h -> m (CacheEnv m blk h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CacheEnv m blk h
cacheEnv
where
CacheConfig { Word32
$sel:pastChunksToCache:CacheConfig :: CacheConfig -> Word32
pastChunksToCache :: Word32
pastChunksToCache } = CacheConfig
cacheConfig
newMVarWithInvariants :: Cached blk -> m (StrictMVar m (Cached blk))
newMVarWithInvariants =
(Cached blk -> Maybe String)
-> Cached blk -> m (StrictMVar m (Cached blk))
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m, NoThunks a) =>
(a -> Maybe String) -> a -> m (StrictMVar m a)
newMVarWithInvariant ((Cached blk -> Maybe String)
-> Cached blk -> m (StrictMVar m (Cached blk)))
-> (Cached blk -> Maybe String)
-> Cached blk
-> m (StrictMVar m (Cached blk))
forall a b. (a -> b) -> a -> b
$ Word32 -> Cached blk -> Maybe String
forall blk. Word32 -> Cached blk -> Maybe String
checkInvariants Word32
pastChunksToCache
expireUnusedChunks ::
(HasCallStack, IOLike m)
=> CacheEnv m blk h
-> m Void
expireUnusedChunks :: forall (m :: * -> *) blk h.
(HasCallStack, IOLike m) =>
CacheEnv m blk h -> m Void
expireUnusedChunks CacheEnv { StrictMVar m (Cached blk)
$sel:cacheVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Cached blk)
cacheVar :: StrictMVar m (Cached blk)
cacheVar, CacheConfig
$sel:cacheConfig:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> CacheConfig
cacheConfig :: CacheConfig
cacheConfig, Tracer m TraceCacheEvent
$sel:tracer:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> Tracer m TraceCacheEvent
tracer :: Tracer m TraceCacheEvent
tracer } =
m () -> m Void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m Void) -> m () -> m Void
forall a b. (a -> b) -> a -> b
$ do
Time
now <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
Maybe TraceCacheEvent
mbTraceMsg <- StrictMVar m (Cached blk)
-> (Cached blk -> m (Cached blk, Maybe TraceCacheEvent))
-> m (Maybe TraceCacheEvent)
forall (m :: * -> *) a b.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m (Cached blk)
cacheVar ((Cached blk -> m (Cached blk, Maybe TraceCacheEvent))
-> m (Maybe TraceCacheEvent))
-> (Cached blk -> m (Cached blk, Maybe TraceCacheEvent))
-> m (Maybe TraceCacheEvent)
forall a b. (a -> b) -> a -> b
$ (Cached blk, Maybe TraceCacheEvent)
-> m (Cached blk, Maybe TraceCacheEvent)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Cached blk, Maybe TraceCacheEvent)
-> m (Cached blk, Maybe TraceCacheEvent))
-> (Cached blk -> (Cached blk, Maybe TraceCacheEvent))
-> Cached blk
-> m (Cached blk, Maybe TraceCacheEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Cached blk -> (Cached blk, Maybe TraceCacheEvent)
forall blk.
Time -> Cached blk -> (Cached blk, Maybe TraceCacheEvent)
garbageCollect Time
now
(TraceCacheEvent -> m ()) -> Maybe TraceCacheEvent -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Tracer m TraceCacheEvent -> TraceCacheEvent -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceCacheEvent
tracer) Maybe TraceCacheEvent
mbTraceMsg
DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
expireUnusedAfter
where
CacheConfig { DiffTime
$sel:expireUnusedAfter:CacheConfig :: CacheConfig -> DiffTime
expireUnusedAfter :: DiffTime
expireUnusedAfter } = CacheConfig
cacheConfig
garbageCollect
:: Time
-> Cached blk
-> (Cached blk, Maybe TraceCacheEvent)
garbageCollect :: forall blk.
Time -> Cached blk -> (Cached blk, Maybe TraceCacheEvent)
garbageCollect Time
now cached :: Cached blk
cached@Cached { IntPSQ LastUsed (PastChunkInfo blk)
$sel:pastChunksInfo:Cached :: forall blk. Cached blk -> IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo :: IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo, Word32
$sel:nbPastChunks:Cached :: forall blk. Cached blk -> Word32
nbPastChunks :: Word32
nbPastChunks } =
case [(Int, LastUsed, PastChunkInfo blk)]
expiredPastChunks of
[] -> (Cached blk
cached, Maybe TraceCacheEvent
forall a. Maybe a
Nothing)
[(Int, LastUsed, PastChunkInfo blk)]
_ -> (Cached blk
cached', TraceCacheEvent -> Maybe TraceCacheEvent
forall a. a -> Maybe a
Just TraceCacheEvent
traceMsg)
where
expiredLastUsedTime :: LastUsed
expiredLastUsedTime :: LastUsed
expiredLastUsedTime = Time -> LastUsed
LastUsed (Time -> LastUsed) -> Time -> LastUsed
forall a b. (a -> b) -> a -> b
$
DiffTime -> Time
Time (Time
now Time -> Time -> DiffTime
`diffTime` DiffTime -> Time
Time DiffTime
expireUnusedAfter)
([(Int, LastUsed, PastChunkInfo blk)]
expiredPastChunks, IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo') =
LastUsed
-> IntPSQ LastUsed (PastChunkInfo blk)
-> ([(Int, LastUsed, PastChunkInfo blk)],
IntPSQ LastUsed (PastChunkInfo blk))
forall p v. Ord p => p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
PSQ.atMostView LastUsed
expiredLastUsedTime IntPSQ LastUsed (PastChunkInfo blk)
pastChunksInfo
nbPastChunks' :: Word32
nbPastChunks' = Word32
nbPastChunks Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Int, LastUsed, PastChunkInfo blk)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, LastUsed, PastChunkInfo blk)]
expiredPastChunks)
cached' :: Cached blk
cached' = Cached blk
cached
{ pastChunksInfo = pastChunksInfo'
, nbPastChunks = nbPastChunks'
}
!traceMsg :: TraceCacheEvent
traceMsg = [ChunkNo] -> Word32 -> TraceCacheEvent
TracePastChunksExpired
([ChunkNo] -> [ChunkNo]
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF
[ Int -> ChunkNo
chunkNoFromInt (Int -> ChunkNo) -> Int -> ChunkNo
forall a b. (a -> b) -> a -> b
$ Int
chunk
| (Int
chunk, LastUsed
_, PastChunkInfo blk
_) <- [(Int, LastUsed, PastChunkInfo blk)]
expiredPastChunks
])
Word32
nbPastChunks'
readPrimaryIndex ::
(HasCallStack, IOLike m, Typeable blk, StandardHash blk)
=> Proxy blk
-> HasFS m h
-> ChunkInfo
-> ChunkNo
-> m (PrimaryIndex, IsEBB)
readPrimaryIndex :: forall (m :: * -> *) blk h.
(HasCallStack, IOLike m, Typeable blk, StandardHash blk) =>
Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (PrimaryIndex, IsEBB)
readPrimaryIndex Proxy blk
pb HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk = do
PrimaryIndex
primaryIndex <- Proxy blk -> HasFS m h -> ChunkNo -> m PrimaryIndex
forall blk (m :: * -> *) h.
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> HasFS m h -> ChunkNo -> m PrimaryIndex
Primary.load Proxy blk
pb HasFS m h
hasFS ChunkNo
chunk
let firstIsEBB :: IsEBB
firstIsEBB
| PrimaryIndex -> RelativeSlot -> Bool
Primary.containsSlot PrimaryIndex
primaryIndex RelativeSlot
firstRelativeSlot
, HasCallStack => PrimaryIndex -> RelativeSlot -> Bool
PrimaryIndex -> RelativeSlot -> Bool
Primary.isFilledSlot PrimaryIndex
primaryIndex RelativeSlot
firstRelativeSlot
= RelativeSlot -> IsEBB
relativeSlotIsEBB RelativeSlot
firstRelativeSlot
| Bool
otherwise
= IsEBB
IsNotEBB
(PrimaryIndex, IsEBB) -> m (PrimaryIndex, IsEBB)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimaryIndex
primaryIndex, IsEBB
firstIsEBB)
where
firstRelativeSlot :: RelativeSlot
firstRelativeSlot :: RelativeSlot
firstRelativeSlot = ChunkInfo -> ChunkNo -> RelativeSlot
firstBlockOrEBB ChunkInfo
chunkInfo ChunkNo
chunk
readSecondaryIndex ::
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> HasFS m h
-> ChunkNo
-> IsEBB
-> m [Entry blk]
readSecondaryIndex :: forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkNo -> IsEBB -> m [Entry blk]
readSecondaryIndex hasFS :: HasFS m h
hasFS@HasFS { HasCallStack => Handle h -> m Word64
hGetSize :: HasCallStack => Handle h -> m Word64
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hGetSize } ChunkNo
chunk IsEBB
firstIsEBB = do
!Word64
chunkFileSize <- HasFS m h
-> FsPath -> OpenMode -> (Handle h -> m Word64) -> m Word64
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS FsPath
chunkFile OpenMode
ReadMode HasCallStack => Handle h -> m Word64
Handle h -> m Word64
hGetSize
HasFS m h
-> Word32
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [Entry blk]
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, MonadThrow m, StandardHash blk,
Typeable blk) =>
HasFS m h
-> Word32
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
Secondary.readAllEntries HasFS m h
hasFS Word32
secondaryOffset
ChunkNo
chunk Entry blk -> Bool
forall {b}. b -> Bool
stopCondition Word64
chunkFileSize IsEBB
firstIsEBB
where
chunkFile :: FsPath
chunkFile = ChunkNo -> FsPath
fsPathChunkFile ChunkNo
chunk
secondaryOffset :: Word32
secondaryOffset = Word32
0
stopCondition :: b -> Bool
stopCondition = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False
loadCurrentChunkInfo ::
forall m h blk.
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> HasFS m h
-> ChunkInfo
-> ChunkNo
-> m (CurrentChunkInfo blk)
loadCurrentChunkInfo :: forall (m :: * -> *) h blk.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkInfo -> ChunkNo -> m (CurrentChunkInfo blk)
loadCurrentChunkInfo HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk = do
Bool
chunkExists <- HasFS m h -> HasCallStack => FsPath -> m Bool
forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesFileExist HasFS m h
hasFS FsPath
primaryIndexFile
if Bool
chunkExists then do
(PrimaryIndex
primaryIndex, IsEBB
firstIsEBB) <-
Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (PrimaryIndex, IsEBB)
forall (m :: * -> *) blk h.
(HasCallStack, IOLike m, Typeable blk, StandardHash blk) =>
Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (PrimaryIndex, IsEBB)
readPrimaryIndex (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk
[Entry blk]
entries <- HasFS m h -> ChunkNo -> IsEBB -> m [Entry blk]
forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkNo -> IsEBB -> m [Entry blk]
readSecondaryIndex HasFS m h
hasFS ChunkNo
chunk IsEBB
firstIsEBB
CurrentChunkInfo blk -> m (CurrentChunkInfo blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CurrentChunkInfo
{ $sel:currentChunkNo:CurrentChunkInfo :: ChunkNo
currentChunkNo = ChunkNo
chunk
, $sel:currentChunkOffsets:CurrentChunkInfo :: StrictSeq Word32
currentChunkOffsets =
[Word32] -> StrictSeq Word32
forall a. [a] -> StrictSeq a
Seq.fromList ([Word32] -> StrictSeq Word32)
-> (PrimaryIndex -> [Word32]) -> PrimaryIndex -> StrictSeq Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimaryIndex -> [Word32]
Primary.toSecondaryOffsets (PrimaryIndex -> StrictSeq Word32)
-> PrimaryIndex -> StrictSeq Word32
forall a b. (a -> b) -> a -> b
$ PrimaryIndex
primaryIndex
, $sel:currentChunkEntries:CurrentChunkInfo :: StrictSeq (Entry blk)
currentChunkEntries = [Entry blk] -> StrictSeq (Entry blk)
forall a. [a] -> StrictSeq a
Seq.fromList [Entry blk]
entries
}
else
CurrentChunkInfo blk -> m (CurrentChunkInfo blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CurrentChunkInfo blk -> m (CurrentChunkInfo blk))
-> CurrentChunkInfo blk -> m (CurrentChunkInfo blk)
forall a b. (a -> b) -> a -> b
$ ChunkNo -> CurrentChunkInfo blk
forall blk. ChunkNo -> CurrentChunkInfo blk
emptyCurrentChunkInfo ChunkNo
chunk
where
primaryIndexFile :: FsPath
primaryIndexFile = ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
loadPastChunkInfo ::
forall blk m h.
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> HasFS m h
-> ChunkInfo
-> ChunkNo
-> m (PastChunkInfo blk)
loadPastChunkInfo :: forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkInfo -> ChunkNo -> m (PastChunkInfo blk)
loadPastChunkInfo HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk = do
(PrimaryIndex
primaryIndex, IsEBB
firstIsEBB) <- Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (PrimaryIndex, IsEBB)
forall (m :: * -> *) blk h.
(HasCallStack, IOLike m, Typeable blk, StandardHash blk) =>
Proxy blk
-> HasFS m h -> ChunkInfo -> ChunkNo -> m (PrimaryIndex, IsEBB)
readPrimaryIndex (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk
[Entry blk]
entries <- HasFS m h -> ChunkNo -> IsEBB -> m [Entry blk]
forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkNo -> IsEBB -> m [Entry blk]
readSecondaryIndex HasFS m h
hasFS ChunkNo
chunk IsEBB
firstIsEBB
PastChunkInfo blk -> m (PastChunkInfo blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return PastChunkInfo
{ $sel:pastChunkOffsets:PastChunkInfo :: PrimaryIndex
pastChunkOffsets = PrimaryIndex
primaryIndex
, $sel:pastChunkEntries:PastChunkInfo :: Vector (Entry blk)
pastChunkEntries = [Entry blk] -> Vector (Entry blk)
forall a. [a] -> Vector a
Vector.fromList ([Entry blk] -> Vector (Entry blk))
-> [Entry blk] -> Vector (Entry blk)
forall a b. (a -> b) -> a -> b
$ [Entry blk] -> [Entry blk]
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF [Entry blk]
entries
}
getChunkInfo ::
forall m blk h.
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> CacheEnv m blk h
-> ChunkNo
-> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
getChunkInfo :: forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
getChunkInfo CacheEnv m blk h
cacheEnv ChunkNo
chunk = do
LastUsed
lastUsed <- Time -> LastUsed
LastUsed (Time -> LastUsed) -> m Time -> m LastUsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
mbCacheHit, TraceCacheEvent
tr) <- StrictMVar m (Cached blk)
-> (Cached blk
-> m (Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent)))
-> m (Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent)
forall (m :: * -> *) a b.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m (Cached blk)
cacheVar ((Cached blk
-> m (Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent)))
-> m (Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent))
-> (Cached blk
-> m (Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent)))
-> m (Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent)
forall a b. (a -> b) -> a -> b
$
\cached :: Cached blk
cached@Cached { ChunkNo
$sel:currentChunk:Cached :: forall blk. Cached blk -> ChunkNo
currentChunk :: ChunkNo
currentChunk, CurrentChunkInfo blk
$sel:currentChunkInfo:Cached :: forall blk. Cached blk -> CurrentChunkInfo blk
currentChunkInfo :: CurrentChunkInfo blk
currentChunkInfo, Word32
$sel:nbPastChunks:Cached :: forall blk. Cached blk -> Word32
nbPastChunks :: Word32
nbPastChunks } -> if
| ChunkNo
chunk ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
== ChunkNo
currentChunk -> do
(Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent))
-> m (Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Cached blk
cached
, (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a. a -> Maybe a
Just (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)))
-> Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a b. (a -> b) -> a -> b
$ CurrentChunkInfo blk
-> Either (CurrentChunkInfo blk) (PastChunkInfo blk)
forall a b. a -> Either a b
Left CurrentChunkInfo blk
currentChunkInfo, ChunkNo -> Word32 -> TraceCacheEvent
TraceCurrentChunkHit ChunkNo
chunk Word32
nbPastChunks)
)
| Just (PastChunkInfo blk
pastChunkInfo, Cached blk
cached') <- ChunkNo
-> LastUsed -> Cached blk -> Maybe (PastChunkInfo blk, Cached blk)
forall blk.
ChunkNo
-> LastUsed -> Cached blk -> Maybe (PastChunkInfo blk, Cached blk)
lookupPastChunkInfo ChunkNo
chunk LastUsed
lastUsed Cached blk
cached -> do
(Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent))
-> m (Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Cached blk
cached'
, (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a. a -> Maybe a
Just (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)))
-> Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a b. (a -> b) -> a -> b
$ PastChunkInfo blk
-> Either (CurrentChunkInfo blk) (PastChunkInfo blk)
forall a b. b -> Either a b
Right PastChunkInfo blk
pastChunkInfo, ChunkNo -> Word32 -> TraceCacheEvent
TracePastChunkHit ChunkNo
chunk Word32
nbPastChunks)
)
| Bool
otherwise -> do
(Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent))
-> m (Cached blk,
(Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk)),
TraceCacheEvent))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Cached blk
cached
, (Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a. Maybe a
Nothing, ChunkNo -> Word32 -> TraceCacheEvent
TracePastChunkMiss ChunkNo
chunk Word32
nbPastChunks)
)
Tracer m TraceCacheEvent -> TraceCacheEvent -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceCacheEvent
tracer TraceCacheEvent
tr
case Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
mbCacheHit of
Just Either (CurrentChunkInfo blk) (PastChunkInfo blk)
hit -> Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either (CurrentChunkInfo blk) (PastChunkInfo blk)
hit
Maybe (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
Nothing -> do
PastChunkInfo blk
pastChunkInfo <- HasFS m h -> ChunkInfo -> ChunkNo -> m (PastChunkInfo blk)
forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkInfo -> ChunkNo -> m (PastChunkInfo blk)
loadPastChunkInfo HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk
LastUsed
lastUsed' <- Time -> LastUsed
LastUsed (Time -> LastUsed) -> m Time -> m LastUsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
Maybe ChunkNo
mbEvicted <- StrictMVar m (Cached blk)
-> (Cached blk -> m (Cached blk, Maybe ChunkNo))
-> m (Maybe ChunkNo)
forall (m :: * -> *) a b.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m (Cached blk)
cacheVar ((Cached blk -> m (Cached blk, Maybe ChunkNo))
-> m (Maybe ChunkNo))
-> (Cached blk -> m (Cached blk, Maybe ChunkNo))
-> m (Maybe ChunkNo)
forall a b. (a -> b) -> a -> b
$
(Cached blk, Maybe ChunkNo) -> m (Cached blk, Maybe ChunkNo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Cached blk, Maybe ChunkNo) -> m (Cached blk, Maybe ChunkNo))
-> (Cached blk -> (Cached blk, Maybe ChunkNo))
-> Cached blk
-> m (Cached blk, Maybe ChunkNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Word32 -> Cached blk -> (Cached blk, Maybe ChunkNo)
forall blk. Word32 -> Cached blk -> (Cached blk, Maybe ChunkNo)
evictIfNecessary Word32
pastChunksToCache (Cached blk -> (Cached blk, Maybe ChunkNo))
-> (Cached blk -> Cached blk)
-> Cached blk
-> (Cached blk, Maybe ChunkNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ChunkNo
-> LastUsed -> PastChunkInfo blk -> Cached blk -> Cached blk
forall blk.
ChunkNo
-> LastUsed -> PastChunkInfo blk -> Cached blk -> Cached blk
addPastChunkInfo ChunkNo
chunk LastUsed
lastUsed' PastChunkInfo blk
pastChunkInfo
Maybe ChunkNo -> (ChunkNo -> m ()) -> m ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe ChunkNo
mbEvicted ((ChunkNo -> m ()) -> m ()) -> (ChunkNo -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ChunkNo
evicted ->
Tracer m TraceCacheEvent -> TraceCacheEvent -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceCacheEvent
tracer (TraceCacheEvent -> m ()) -> TraceCacheEvent -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> Word32 -> TraceCacheEvent
TracePastChunkEvict ChunkNo
evicted Word32
pastChunksToCache
Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk)))
-> Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall a b. (a -> b) -> a -> b
$ PastChunkInfo blk
-> Either (CurrentChunkInfo blk) (PastChunkInfo blk)
forall a b. b -> Either a b
Right PastChunkInfo blk
pastChunkInfo
where
CacheEnv { HasFS m h
$sel:hasFS:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, StrictMVar m (Cached blk)
$sel:cacheVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Cached blk)
cacheVar :: StrictMVar m (Cached blk)
cacheVar, CacheConfig
$sel:cacheConfig:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> CacheConfig
cacheConfig :: CacheConfig
cacheConfig, Tracer m TraceCacheEvent
$sel:tracer:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> Tracer m TraceCacheEvent
tracer :: Tracer m TraceCacheEvent
tracer, ChunkInfo
$sel:chunkInfo:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> ChunkInfo
chunkInfo :: ChunkInfo
chunkInfo } = CacheEnv m blk h
cacheEnv
CacheConfig { Word32
$sel:pastChunksToCache:CacheConfig :: CacheConfig -> Word32
pastChunksToCache :: Word32
pastChunksToCache } = CacheConfig
cacheConfig
close :: IOLike m => CacheEnv m blk h -> m ()
close :: forall (m :: * -> *) blk h. IOLike m => CacheEnv m blk h -> m ()
close CacheEnv { StrictMVar m (Maybe (Thread m Void))
$sel:bgThreadVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Maybe (Thread m Void))
bgThreadVar :: StrictMVar m (Maybe (Thread m Void))
bgThreadVar } =
m () -> m ()
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictMVar m (Maybe (Thread m Void))
-> (Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ StrictMVar m (Maybe (Thread m Void))
bgThreadVar ((Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ())
-> (Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ()
forall a b. (a -> b) -> a -> b
$ \Maybe (Thread m Void)
mbBgThread -> do
(Thread m Void -> m ()) -> Maybe (Thread m Void) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Thread m Void -> m ()
forall (m :: * -> *) a. IOLike m => Thread m a -> m ()
cancelThread Maybe (Thread m Void)
mbBgThread
Maybe (Thread m Void) -> m (Maybe (Thread m Void))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Thread m Void)
forall a. Maybe a
Nothing
restart ::
(ConvertRawHash blk, IOLike m, StandardHash blk, Typeable blk)
=> CacheEnv m blk h
-> ChunkNo
-> m ()
restart :: forall blk (m :: * -> *) h.
(ConvertRawHash blk, IOLike m, StandardHash blk, Typeable blk) =>
CacheEnv m blk h -> ChunkNo -> m ()
restart CacheEnv m blk h
cacheEnv ChunkNo
chunk = do
CurrentChunkInfo blk
currentChunkInfo <- HasFS m h -> ChunkInfo -> ChunkNo -> m (CurrentChunkInfo blk)
forall (m :: * -> *) h blk.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkInfo -> ChunkNo -> m (CurrentChunkInfo blk)
loadCurrentChunkInfo HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk
m (Cached blk) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Cached blk) -> m ()) -> m (Cached blk) -> m ()
forall a b. (a -> b) -> a -> b
$ StrictMVar m (Cached blk) -> Cached blk -> m (Cached blk)
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> a -> m a
swapMVar StrictMVar m (Cached blk)
cacheVar (Cached blk -> m (Cached blk)) -> Cached blk -> m (Cached blk)
forall a b. (a -> b) -> a -> b
$ ChunkNo -> CurrentChunkInfo blk -> Cached blk
forall blk. ChunkNo -> CurrentChunkInfo blk -> Cached blk
emptyCached ChunkNo
chunk CurrentChunkInfo blk
currentChunkInfo
m () -> m ()
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictMVar m (Maybe (Thread m Void))
-> (Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ StrictMVar m (Maybe (Thread m Void))
bgThreadVar ((Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ())
-> (Maybe (Thread m Void) -> m (Maybe (Thread m Void))) -> m ()
forall a b. (a -> b) -> a -> b
$ \Maybe (Thread m Void)
mbBgThread ->
case Maybe (Thread m Void)
mbBgThread of
Just Thread m Void
_ -> IOError -> m (Maybe (Thread m Void))
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOError -> m (Maybe (Thread m Void)))
-> IOError -> m (Maybe (Thread m Void))
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"background thread still running"
Maybe (Thread m Void)
Nothing -> do
!Thread m Void
bgThread <- ResourceRegistry m -> String -> m Void -> m (Thread m Void)
forall (m :: * -> *) a.
(IOLike m, HasCallStack) =>
ResourceRegistry m -> String -> m a -> m (Thread m a)
forkLinkedThread ResourceRegistry m
registry String
"ImmutableDB.expireUnusedChunks" (m Void -> m (Thread m Void)) -> m Void -> m (Thread m Void)
forall a b. (a -> b) -> a -> b
$
CacheEnv m blk h -> m Void
forall (m :: * -> *) blk h.
(HasCallStack, IOLike m) =>
CacheEnv m blk h -> m Void
expireUnusedChunks CacheEnv m blk h
cacheEnv
Maybe (Thread m Void) -> m (Maybe (Thread m Void))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Thread m Void) -> m (Maybe (Thread m Void)))
-> Maybe (Thread m Void) -> m (Maybe (Thread m Void))
forall a b. (a -> b) -> a -> b
$ Thread m Void -> Maybe (Thread m Void)
forall a. a -> Maybe a
Just Thread m Void
bgThread
where
CacheEnv { HasFS m h
$sel:hasFS:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, ResourceRegistry m
$sel:registry:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> ResourceRegistry m
registry :: ResourceRegistry m
registry, StrictMVar m (Cached blk)
$sel:cacheVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Cached blk)
cacheVar :: StrictMVar m (Cached blk)
cacheVar, StrictMVar m (Maybe (Thread m Void))
$sel:bgThreadVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Maybe (Thread m Void))
bgThreadVar :: StrictMVar m (Maybe (Thread m Void))
bgThreadVar, ChunkInfo
$sel:chunkInfo:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> ChunkInfo
chunkInfo :: ChunkInfo
chunkInfo } = CacheEnv m blk h
cacheEnv
readOffsets ::
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
, Traversable t
)
=> CacheEnv m blk h
-> ChunkNo
-> t RelativeSlot
-> m (t (Maybe SecondaryOffset), Maybe (StrictSeq SecondaryOffset))
readOffsets :: forall blk (m :: * -> *) (t :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk, Traversable t) =>
CacheEnv m blk h
-> ChunkNo
-> t RelativeSlot
-> m (t (Maybe Word32), Maybe (StrictSeq Word32))
readOffsets CacheEnv m blk h
cacheEnv ChunkNo
chunk t RelativeSlot
relSlots = do
Either (CurrentChunkInfo blk) (PastChunkInfo blk)
ci <- CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
getChunkInfo CacheEnv m blk h
cacheEnv ChunkNo
chunk
(t (Maybe Word32), Maybe (StrictSeq Word32))
-> m (t (Maybe Word32), Maybe (StrictSeq Word32))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((t (Maybe Word32), Maybe (StrictSeq Word32))
-> m (t (Maybe Word32), Maybe (StrictSeq Word32)))
-> (t (Maybe Word32), Maybe (StrictSeq Word32))
-> m (t (Maybe Word32), Maybe (StrictSeq Word32))
forall a b. (a -> b) -> a -> b
$ case Either (CurrentChunkInfo blk) (PastChunkInfo blk)
ci of
Left CurrentChunkInfo { StrictSeq Word32
$sel:currentChunkOffsets:CurrentChunkInfo :: forall blk. CurrentChunkInfo blk -> StrictSeq Word32
currentChunkOffsets :: StrictSeq Word32
currentChunkOffsets } ->
(StrictSeq Word32 -> RelativeSlot -> Maybe Word32
getOffsetFromSecondaryOffsets StrictSeq Word32
currentChunkOffsets (RelativeSlot -> Maybe Word32)
-> t RelativeSlot -> t (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t RelativeSlot
relSlots, StrictSeq Word32 -> Maybe (StrictSeq Word32)
forall a. a -> Maybe a
Just StrictSeq Word32
currentChunkOffsets)
Right PastChunkInfo { PrimaryIndex
$sel:pastChunkOffsets:PastChunkInfo :: forall blk. PastChunkInfo blk -> PrimaryIndex
pastChunkOffsets :: PrimaryIndex
pastChunkOffsets } ->
(PrimaryIndex -> RelativeSlot -> Maybe Word32
getOffsetFromPrimaryIndex PrimaryIndex
pastChunkOffsets (RelativeSlot -> Maybe Word32)
-> t RelativeSlot -> t (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t RelativeSlot
relSlots, Maybe (StrictSeq Word32)
forall a. Maybe a
Nothing)
where
getOffsetFromSecondaryOffsets
:: StrictSeq SecondaryOffset
-> RelativeSlot
-> Maybe SecondaryOffset
getOffsetFromSecondaryOffsets :: StrictSeq Word32 -> RelativeSlot -> Maybe Word32
getOffsetFromSecondaryOffsets StrictSeq Word32
offsets RelativeSlot
relSlot =
let s :: Word64
s = HasCallStack => ChunkNo -> RelativeSlot -> Word64
ChunkNo -> RelativeSlot -> Word64
assertRelativeSlotInChunk ChunkNo
chunk RelativeSlot
relSlot in
case Int -> StrictSeq Word32 -> (StrictSeq Word32, StrictSeq Word32)
forall a. Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
Seq.splitAt (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) StrictSeq Word32
offsets of
(StrictSeq Word32
_ Seq.:|> Word32
offset, Word32
offsetAfter Seq.:<| StrictSeq Word32
_)
| Word32
offset Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
offsetAfter
-> Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
offset
(StrictSeq Word32, StrictSeq Word32)
_ -> Maybe Word32
forall a. Maybe a
Nothing
getOffsetFromPrimaryIndex
:: PrimaryIndex
-> RelativeSlot
-> Maybe SecondaryOffset
getOffsetFromPrimaryIndex :: PrimaryIndex -> RelativeSlot -> Maybe Word32
getOffsetFromPrimaryIndex PrimaryIndex
index RelativeSlot
relSlot
| PrimaryIndex -> RelativeSlot -> Bool
Primary.containsSlot PrimaryIndex
index RelativeSlot
relSlot
, HasCallStack => PrimaryIndex -> RelativeSlot -> Bool
PrimaryIndex -> RelativeSlot -> Bool
Primary.isFilledSlot PrimaryIndex
index RelativeSlot
relSlot
= Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Word32 -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ HasCallStack => PrimaryIndex -> RelativeSlot -> Word32
PrimaryIndex -> RelativeSlot -> Word32
Primary.offsetOfSlot PrimaryIndex
index RelativeSlot
relSlot
| Bool
otherwise
= Maybe Word32
forall a. Maybe a
Nothing
readFirstFilledSlot ::
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> CacheEnv m blk h
-> ChunkNo
-> m (Maybe RelativeSlot)
readFirstFilledSlot :: forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h -> ChunkNo -> m (Maybe RelativeSlot)
readFirstFilledSlot CacheEnv m blk h
cacheEnv ChunkNo
chunk =
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
getChunkInfo CacheEnv m blk h
cacheEnv ChunkNo
chunk m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
-> (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> Maybe RelativeSlot)
-> m (Maybe RelativeSlot)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Left CurrentChunkInfo { StrictSeq Word32
$sel:currentChunkOffsets:CurrentChunkInfo :: forall blk. CurrentChunkInfo blk -> StrictSeq Word32
currentChunkOffsets :: StrictSeq Word32
currentChunkOffsets } ->
StrictSeq Word32 -> Maybe RelativeSlot
firstFilledSlotInSeq StrictSeq Word32
currentChunkOffsets
Right PastChunkInfo { PrimaryIndex
$sel:pastChunkOffsets:PastChunkInfo :: forall blk. PastChunkInfo blk -> PrimaryIndex
pastChunkOffsets :: PrimaryIndex
pastChunkOffsets } ->
ChunkInfo -> PrimaryIndex -> Maybe RelativeSlot
Primary.firstFilledSlot ChunkInfo
chunkInfo PrimaryIndex
pastChunkOffsets
where
CacheEnv { ChunkInfo
$sel:chunkInfo:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> ChunkInfo
chunkInfo :: ChunkInfo
chunkInfo } = CacheEnv m blk h
cacheEnv
firstFilledSlotInSeq :: StrictSeq SecondaryOffset -> Maybe RelativeSlot
firstFilledSlotInSeq :: StrictSeq Word32 -> Maybe RelativeSlot
firstFilledSlotInSeq = (Int -> RelativeSlot) -> Maybe Int -> Maybe RelativeSlot
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> RelativeSlot
indexToRelativeSlot (Maybe Int -> Maybe RelativeSlot)
-> (StrictSeq Word32 -> Maybe Int)
-> StrictSeq Word32
-> Maybe RelativeSlot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Bool) -> StrictSeq Word32 -> Maybe Int
forall a. (a -> Bool) -> StrictSeq a -> Maybe Int
Seq.findIndexL (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0)
where
indexToRelativeSlot :: Int -> RelativeSlot
indexToRelativeSlot :: Int -> RelativeSlot
indexToRelativeSlot = HasCallStack => ChunkInfo -> ChunkNo -> Word64 -> RelativeSlot
ChunkInfo -> ChunkNo -> Word64 -> RelativeSlot
mkRelativeSlot ChunkInfo
chunkInfo ChunkNo
chunk (Word64 -> RelativeSlot) -> (Int -> Word64) -> Int -> RelativeSlot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (Int -> Int) -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred
openPrimaryIndex ::
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> CacheEnv m blk h
-> ChunkNo
-> AllowExisting
-> m (Handle h)
openPrimaryIndex :: forall blk (m :: * -> *) h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h -> ChunkNo -> AllowExisting -> m (Handle h)
openPrimaryIndex CacheEnv m blk h
cacheEnv ChunkNo
chunk AllowExisting
allowExisting = do
LastUsed
lastUsed <- Time -> LastUsed
LastUsed (Time -> LastUsed) -> m Time -> m LastUsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
Handle h
pHnd <- HasFS m h -> ChunkNo -> AllowExisting -> m (Handle h)
forall (m :: * -> *) h.
(HasCallStack, MonadCatch m) =>
HasFS m h -> ChunkNo -> AllowExisting -> m (Handle h)
Primary.open HasFS m h
hasFS ChunkNo
chunk AllowExisting
allowExisting
(m (Handle h) -> m () -> m (Handle h))
-> m () -> m (Handle h) -> m (Handle h)
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (Handle h) -> m () -> m (Handle h)
forall a b. m a -> m b -> m a
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
onException (HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose Handle h
pHnd) (m (Handle h) -> m (Handle h)) -> m (Handle h) -> m (Handle h)
forall a b. (a -> b) -> a -> b
$ do
CurrentChunkInfo blk
newCurrentChunkInfo <- case AllowExisting
allowExisting of
AllowExisting
MustBeNew -> CurrentChunkInfo blk -> m (CurrentChunkInfo blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CurrentChunkInfo blk -> m (CurrentChunkInfo blk))
-> CurrentChunkInfo blk -> m (CurrentChunkInfo blk)
forall a b. (a -> b) -> a -> b
$ ChunkNo -> CurrentChunkInfo blk
forall blk. ChunkNo -> CurrentChunkInfo blk
emptyCurrentChunkInfo ChunkNo
chunk
AllowExisting
AllowExisting -> HasFS m h -> ChunkInfo -> ChunkNo -> m (CurrentChunkInfo blk)
forall (m :: * -> *) h blk.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
HasFS m h -> ChunkInfo -> ChunkNo -> m (CurrentChunkInfo blk)
loadCurrentChunkInfo HasFS m h
hasFS ChunkInfo
chunkInfo ChunkNo
chunk
Maybe ChunkNo
mbEvicted <- StrictMVar m (Cached blk)
-> (Cached blk -> m (Cached blk, Maybe ChunkNo))
-> m (Maybe ChunkNo)
forall (m :: * -> *) a b.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m (Cached blk)
cacheVar ((Cached blk -> m (Cached blk, Maybe ChunkNo))
-> m (Maybe ChunkNo))
-> (Cached blk -> m (Cached blk, Maybe ChunkNo))
-> m (Maybe ChunkNo)
forall a b. (a -> b) -> a -> b
$
(Cached blk, Maybe ChunkNo) -> m (Cached blk, Maybe ChunkNo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Cached blk, Maybe ChunkNo) -> m (Cached blk, Maybe ChunkNo))
-> (Cached blk -> (Cached blk, Maybe ChunkNo))
-> Cached blk
-> m (Cached blk, Maybe ChunkNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Word32 -> Cached blk -> (Cached blk, Maybe ChunkNo)
forall blk. Word32 -> Cached blk -> (Cached blk, Maybe ChunkNo)
evictIfNecessary Word32
pastChunksToCache (Cached blk -> (Cached blk, Maybe ChunkNo))
-> (Cached blk -> Cached blk)
-> Cached blk
-> (Cached blk, Maybe ChunkNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ChunkNo
-> LastUsed -> CurrentChunkInfo blk -> Cached blk -> Cached blk
forall blk.
ChunkNo
-> LastUsed -> CurrentChunkInfo blk -> Cached blk -> Cached blk
openChunk ChunkNo
chunk LastUsed
lastUsed CurrentChunkInfo blk
newCurrentChunkInfo
Maybe ChunkNo -> (ChunkNo -> m ()) -> m ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe ChunkNo
mbEvicted ((ChunkNo -> m ()) -> m ()) -> (ChunkNo -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ChunkNo
evicted ->
Tracer m TraceCacheEvent -> TraceCacheEvent -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceCacheEvent
tracer (TraceCacheEvent -> m ()) -> TraceCacheEvent -> m ()
forall a b. (a -> b) -> a -> b
$ ChunkNo -> Word32 -> TraceCacheEvent
TracePastChunkEvict ChunkNo
evicted Word32
pastChunksToCache
Handle h -> m (Handle h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Handle h
pHnd
where
CacheEnv { HasFS m h
$sel:hasFS:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, StrictMVar m (Cached blk)
$sel:cacheVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Cached blk)
cacheVar :: StrictMVar m (Cached blk)
cacheVar, CacheConfig
$sel:cacheConfig:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> CacheConfig
cacheConfig :: CacheConfig
cacheConfig, Tracer m TraceCacheEvent
$sel:tracer:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> Tracer m TraceCacheEvent
tracer :: Tracer m TraceCacheEvent
tracer, ChunkInfo
$sel:chunkInfo:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> ChunkInfo
chunkInfo :: ChunkInfo
chunkInfo } = CacheEnv m blk h
cacheEnv
HasFS { HasCallStack => Handle h -> m ()
hClose :: HasCallStack => Handle h -> m ()
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hClose } = HasFS m h
hasFS
CacheConfig { Word32
$sel:pastChunksToCache:CacheConfig :: CacheConfig -> Word32
pastChunksToCache :: Word32
pastChunksToCache } = CacheConfig
cacheConfig
appendOffsets ::
(HasCallStack, Foldable f, IOLike m)
=> CacheEnv m blk h
-> Handle h
-> f SecondaryOffset
-> m ()
appendOffsets :: forall (f :: * -> *) (m :: * -> *) blk h.
(HasCallStack, Foldable f, IOLike m) =>
CacheEnv m blk h -> Handle h -> f Word32 -> m ()
appendOffsets CacheEnv { HasFS m h
$sel:hasFS:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, StrictMVar m (Cached blk)
$sel:cacheVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Cached blk)
cacheVar :: StrictMVar m (Cached blk)
cacheVar } Handle h
pHnd f Word32
offsets = do
HasFS m h -> Handle h -> f Word32 -> m ()
forall (m :: * -> *) (f :: * -> *) h.
(Monad m, Foldable f, HasCallStack) =>
HasFS m h -> Handle h -> f Word32 -> m ()
Primary.appendOffsets HasFS m h
hasFS Handle h
pHnd f Word32
offsets
StrictMVar m (Cached blk) -> (Cached blk -> m (Cached blk)) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ StrictMVar m (Cached blk)
cacheVar ((Cached blk -> m (Cached blk)) -> m ())
-> (Cached blk -> m (Cached blk)) -> m ()
forall a b. (a -> b) -> a -> b
$ Cached blk -> m (Cached blk)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cached blk -> m (Cached blk))
-> (Cached blk -> Cached blk) -> Cached blk -> m (Cached blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached blk -> Cached blk
forall blk. Cached blk -> Cached blk
addCurrentChunkOffsets
where
addCurrentChunkOffsets :: Cached blk -> Cached blk
addCurrentChunkOffsets :: forall blk. Cached blk -> Cached blk
addCurrentChunkOffsets cached :: Cached blk
cached@Cached { CurrentChunkInfo blk
$sel:currentChunkInfo:Cached :: forall blk. Cached blk -> CurrentChunkInfo blk
currentChunkInfo :: CurrentChunkInfo blk
currentChunkInfo } = Cached blk
cached
{ currentChunkInfo = currentChunkInfo
{ currentChunkOffsets = currentChunkOffsets currentChunkInfo <>
Seq.fromList (toList offsets)
}
}
readEntries ::
forall m blk h t.
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
, Traversable t
)
=> CacheEnv m blk h
-> ChunkNo
-> t (IsEBB, SecondaryOffset)
-> m (t (Secondary.Entry blk, BlockSize))
readEntries :: forall (m :: * -> *) blk h (t :: * -> *).
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk, Traversable t) =>
CacheEnv m blk h
-> ChunkNo -> t (IsEBB, Word32) -> m (t (Entry blk, BlockSize))
readEntries CacheEnv m blk h
cacheEnv ChunkNo
chunk t (IsEBB, Word32)
toRead =
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
getChunkInfo CacheEnv m blk h
cacheEnv ChunkNo
chunk m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
-> (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> m (t (Entry blk, BlockSize)))
-> m (t (Entry blk, BlockSize))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left CurrentChunkInfo { StrictSeq (Entry blk)
$sel:currentChunkEntries:CurrentChunkInfo :: forall blk. CurrentChunkInfo blk -> StrictSeq (Entry blk)
currentChunkEntries :: StrictSeq (Entry blk)
currentChunkEntries } ->
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
secondaryOffset) ->
case StrictSeq (Entry blk)
currentChunkEntries StrictSeq (Entry blk) -> Int -> Maybe (Entry blk)
forall a. StrictSeq a -> Int -> Maybe a
Seq.!? Word32 -> Int
indexForOffset Word32
secondaryOffset of
Just (WithBlockSize Word32
size 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
size)
Maybe (Entry blk)
Nothing -> Word32 -> m (Entry blk, BlockSize)
forall a. Word32 -> m a
noEntry Word32
secondaryOffset
Right PastChunkInfo { Vector (Entry blk)
$sel:pastChunkEntries:PastChunkInfo :: forall blk. PastChunkInfo blk -> Vector (Entry blk)
pastChunkEntries :: Vector (Entry blk)
pastChunkEntries } ->
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
secondaryOffset) ->
case Vector (Entry blk)
pastChunkEntries Vector (Entry blk) -> Int -> Maybe (Entry blk)
forall a. Vector a -> Int -> Maybe a
Vector.!? Word32 -> Int
indexForOffset Word32
secondaryOffset of
Just (WithBlockSize Word32
size 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
size)
Maybe (Entry blk)
Nothing -> Word32 -> m (Entry blk, BlockSize)
forall a. Word32 -> m a
noEntry Word32
secondaryOffset
where
indexForOffset :: SecondaryOffset -> Int
indexForOffset :: Word32 -> Int
indexForOffset Word32
secondaryOffset = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$
Word32
secondaryOffset Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Proxy blk -> Word32
forall blk. ConvertRawHash blk => Proxy blk -> Word32
Secondary.entrySize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
noEntry :: SecondaryOffset -> m a
noEntry :: forall a. Word32 -> m a
noEntry Word32
secondaryOffset = UnexpectedFailure blk -> m a
forall blk (m :: * -> *) a.
(StandardHash blk, Typeable blk, MonadThrow m) =>
UnexpectedFailure blk -> m a
throwUnexpectedFailure (UnexpectedFailure blk -> m a) -> UnexpectedFailure blk -> m a
forall a b. (a -> b) -> a -> b
$ forall blk.
FsPath -> String -> PrettyCallStack -> UnexpectedFailure blk
InvalidFileError @blk
(ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk)
(String
"no entry missing for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
secondaryOffset)
PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack
readAllEntries ::
forall m blk h.
( HasCallStack
, ConvertRawHash blk
, IOLike m
, StandardHash blk
, Typeable blk
)
=> CacheEnv m blk h
-> SecondaryOffset
-> ChunkNo
-> (Secondary.Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Secondary.Entry blk)]
readAllEntries :: forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h
-> Word32
-> ChunkNo
-> (Entry blk -> Bool)
-> Word64
-> IsEBB
-> m [WithBlockSize (Entry blk)]
readAllEntries CacheEnv m blk h
cacheEnv Word32
secondaryOffset ChunkNo
chunk Entry blk -> Bool
stopCondition
Word64
_chunkFileSize IsEBB
_firstIsEBB =
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m, StandardHash blk,
Typeable blk) =>
CacheEnv m blk h
-> ChunkNo -> m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
getChunkInfo CacheEnv m blk h
cacheEnv ChunkNo
chunk m (Either (CurrentChunkInfo blk) (PastChunkInfo blk))
-> (Either (CurrentChunkInfo blk) (PastChunkInfo blk)
-> [WithBlockSize (Entry blk)])
-> m [WithBlockSize (Entry blk)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Left CurrentChunkInfo { StrictSeq (WithBlockSize (Entry blk))
$sel:currentChunkEntries:CurrentChunkInfo :: forall blk. CurrentChunkInfo blk -> StrictSeq (Entry blk)
currentChunkEntries :: StrictSeq (WithBlockSize (Entry blk))
currentChunkEntries } ->
(WithBlockSize (Entry blk) -> Bool)
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil (Entry blk -> Bool
stopCondition (Entry blk -> Bool)
-> (WithBlockSize (Entry blk) -> Entry blk)
-> WithBlockSize (Entry blk)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithBlockSize (Entry blk) -> Entry blk
forall a. WithBlockSize a -> a
withoutBlockSize) ([WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$
StrictSeq (WithBlockSize (Entry blk))
-> [WithBlockSize (Entry blk)]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (WithBlockSize (Entry blk))
-> [WithBlockSize (Entry blk)])
-> StrictSeq (WithBlockSize (Entry blk))
-> [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ Int
-> StrictSeq (WithBlockSize (Entry blk))
-> StrictSeq (WithBlockSize (Entry blk))
forall a. Int -> StrictSeq a -> StrictSeq a
Seq.drop Int
toDrop StrictSeq (WithBlockSize (Entry blk))
currentChunkEntries
Right PastChunkInfo { Vector (WithBlockSize (Entry blk))
$sel:pastChunkEntries:PastChunkInfo :: forall blk. PastChunkInfo blk -> Vector (Entry blk)
pastChunkEntries :: Vector (WithBlockSize (Entry blk))
pastChunkEntries } ->
(WithBlockSize (Entry blk) -> Bool)
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil (Entry blk -> Bool
stopCondition (Entry blk -> Bool)
-> (WithBlockSize (Entry blk) -> Entry blk)
-> WithBlockSize (Entry blk)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithBlockSize (Entry blk) -> Entry blk
forall a. WithBlockSize a -> a
withoutBlockSize) ([WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)])
-> [WithBlockSize (Entry blk)] -> [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$
Vector (WithBlockSize (Entry blk)) -> [WithBlockSize (Entry blk)]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (WithBlockSize (Entry blk)) -> [WithBlockSize (Entry blk)])
-> Vector (WithBlockSize (Entry blk))
-> [WithBlockSize (Entry blk)]
forall a b. (a -> b) -> a -> b
$ Int
-> Vector (WithBlockSize (Entry blk))
-> Vector (WithBlockSize (Entry blk))
forall a. Int -> Vector a -> Vector a
Vector.drop Int
toDrop Vector (WithBlockSize (Entry blk))
pastChunkEntries
where
toDrop :: Int
toDrop :: Int
toDrop = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$
Word32
secondaryOffset Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Proxy blk -> Word32
forall blk. ConvertRawHash blk => Proxy blk -> Word32
Secondary.entrySize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
appendEntry ::
forall m blk h. (HasCallStack, ConvertRawHash blk, IOLike m)
=> CacheEnv m blk h
-> ChunkNo
-> Handle h
-> Entry blk
-> m Word64
appendEntry :: forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, IOLike m) =>
CacheEnv m blk h -> ChunkNo -> Handle h -> Entry blk -> m Word64
appendEntry CacheEnv { HasFS m h
$sel:hasFS:CacheEnv :: forall (m :: * -> *) blk h. CacheEnv m blk h -> HasFS m h
hasFS :: HasFS m h
hasFS, StrictMVar m (Cached blk)
$sel:cacheVar:CacheEnv :: forall (m :: * -> *) blk h.
CacheEnv m blk h -> StrictMVar m (Cached blk)
cacheVar :: StrictMVar m (Cached blk)
cacheVar } ChunkNo
chunk Handle h
sHnd Entry blk
entry = do
Word64
nbBytes <- HasFS m h -> Handle h -> Entry blk -> m Word64
forall (m :: * -> *) blk h.
(HasCallStack, ConvertRawHash blk, MonadThrow m) =>
HasFS m h -> Handle h -> Entry blk -> m Word64
Secondary.appendEntry HasFS m h
hasFS Handle h
sHnd (Entry blk -> Entry blk
forall a. WithBlockSize a -> a
withoutBlockSize Entry blk
entry)
StrictMVar m (Cached blk) -> (Cached blk -> m (Cached blk)) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ StrictMVar m (Cached blk)
cacheVar ((Cached blk -> m (Cached blk)) -> m ())
-> (Cached blk -> m (Cached blk)) -> m ()
forall a b. (a -> b) -> a -> b
$ Cached blk -> m (Cached blk)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cached blk -> m (Cached blk))
-> (Cached blk -> Cached blk) -> Cached blk -> m (Cached blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached blk -> Cached blk
addCurrentChunkEntry
Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
nbBytes
where
addCurrentChunkEntry :: Cached blk -> Cached blk
addCurrentChunkEntry :: Cached blk -> Cached blk
addCurrentChunkEntry cached :: Cached blk
cached@Cached { ChunkNo
$sel:currentChunk:Cached :: forall blk. Cached blk -> ChunkNo
currentChunk :: ChunkNo
currentChunk, CurrentChunkInfo blk
$sel:currentChunkInfo:Cached :: forall blk. Cached blk -> CurrentChunkInfo blk
currentChunkInfo :: CurrentChunkInfo blk
currentChunkInfo }
| ChunkNo
currentChunk ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
/= ChunkNo
chunk
= String -> Cached blk
forall a. HasCallStack => String -> a
error (String -> Cached blk) -> String -> Cached blk
forall a b. (a -> b) -> a -> b
$
String
"Appending to chunk " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> String
forall a. Show a => a -> String
show ChunkNo
chunk String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" while the index is still in " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> String
forall a. Show a => a -> String
show ChunkNo
currentChunk
| Bool
otherwise
= Cached blk
cached
{ currentChunkInfo = currentChunkInfo
{ currentChunkEntries =
currentChunkEntries currentChunkInfo Seq.|> entry
}
}