voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
voidlizard 2025-05-12 11:53:06 +03:00
parent db41293fa2
commit 6708a2d7a7
1 changed files with 19 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
View File

@ -99,6 +99,9 @@ data CachedEntry =
, cachedTs :: TVar TimeSpec , cachedTs :: TVar TimeSpec
} }
instance Show CachedEntry where
show _ = "<CachedEntry>"
data NCQStorage = data NCQStorage =
NCQStorage NCQStorage
{ ncqRoot :: FilePath { ncqRoot :: FilePath
@ -129,14 +132,14 @@ data NCQStorage =
data Location = data Location =
InWriteQueue LBS.ByteString InWriteQueue LBS.ByteString
| InCurrent (Word64, Word64) | InCurrent (Word64, Word64)
| InFossil FileKey (Word64, Word64) | InFossil CachedEntry (Word64, Word64)
deriving stock (Eq,Show) deriving stock (Show)
instance Pretty Location where instance Pretty Location where
pretty = \case pretty = \case
InWriteQueue{} -> "write-queue" InWriteQueue{} -> "write-queue"
InCurrent (o,l) -> pretty $ mkForm @C "current" [mkInt o, mkInt l] InCurrent (o,l) -> pretty $ mkForm @C "current" [mkInt o, mkInt l]
InFossil f (o,l) -> pretty $ mkForm @C "fossil " [mkSym (show (pretty f)), mkList [mkInt o, mkInt l]] InFossil _ (o,l) -> pretty $ mkForm @C "fossil " [mkList [mkInt o, mkInt l]]
type IsHCQKey h = ( Eq (Key h) type IsHCQKey h = ( Eq (Key h)
, Hashable (Key h) , Hashable (Key h)
@ -540,12 +543,11 @@ ncqStoragePut ncq@NCQStorage{..} lbs = flip runContT pure $ callCC \exit -> do
ncqLocatedSize :: Location -> Integer ncqLocatedSize :: Location -> Integer
ncqLocatedSize = \case ncqLocatedSize = \case
InWriteQueue lbs -> fromIntegral $ LBS.length lbs InWriteQueue lbs -> fromIntegral $ LBS.length lbs
InCurrent (_,s) -> fromIntegral s InCurrent (_,s) -> fromIntegral s
InFossil _ (_,s) -> fromIntegral s InFossil _ (_,s) -> fromIntegral s
evictIfNeededSTM :: NCQStorage -> Maybe Int -> STM () evictIfNeededSTM :: NCQStorage -> Maybe Int -> STM ()
evictIfNeededSTM NCQStorage{..} howMany = do evictIfNeededSTM NCQStorage{..} howMany = do
cur <- readTVar ncqCachedEntries cur <- readTVar ncqCachedEntries
@ -591,8 +593,8 @@ ncqLocate ncq@NCQStorage{..} h = flip runContT pure $ callCC \exit -> do
for_ (HPSQ.toList tracked) $ \(fk, prio, mCached) -> do for_ (HPSQ.toList tracked) $ \(fk, prio, mCached) -> do
case mCached of case mCached of
Just (CachedEntry{..}) -> do Just ce@CachedEntry{..} -> do
lookupEntry h (cachedMmapedIdx, cachedNway) <&> fmap (InFossil fk) >>= \case lookupEntry h (cachedMmapedIdx, cachedNway) <&> fmap (InFossil ce) >>= \case
Just loc -> do Just loc -> do
atomically $ writeTVar cachedTs now atomically $ writeTVar cachedTs now
@ -607,13 +609,13 @@ ncqLocate ncq@NCQStorage{..} h = flip runContT pure $ callCC \exit -> do
(idxBs, idxNway) <- liftIO (nwayHashMMapReadOnly indexFile) >>= toMPlus (idxBs, idxNway) <- liftIO (nwayHashMMapReadOnly indexFile) >>= toMPlus
datBs <- liftIO $ mmapFileByteString dataFile Nothing datBs <- liftIO $ mmapFileByteString dataFile Nothing
e <- lookupEntry h (idxBs, idxNway) <&> fmap (InFossil fk) >>= toMPlus ce <- CachedEntry idxBs datBs idxNway <$> newTVarIO now
e <- lookupEntry h (idxBs, idxNway) <&> fmap (InFossil ce) >>= toMPlus
liftIO $ atomically do liftIO $ atomically do
files <- readTVar ncqTrackedFiles files <- readTVar ncqTrackedFiles
case HPSQ.lookup fk files of case HPSQ.lookup fk files of
Just (p, _) -> do Just (p, _) -> do
ce <- CachedEntry idxBs datBs idxNway <$> newTVar now
modifyTVar ncqTrackedFiles (HPSQ.insert fk p (Just ce)) modifyTVar ncqTrackedFiles (HPSQ.insert fk p (Just ce))
modifyTVar ncqCachedEntries (+1) modifyTVar ncqCachedEntries (+1)
evictIfNeededSTM ncq (Just 1) evictIfNeededSTM ncq (Just 1)
@ -692,21 +694,11 @@ ncqStorageGet ncq@NCQStorage{..} h = flip runContT pure $ callCC \exit -> do
pure a pure a
atomically $ takeTMVar answ <&> Just . LBS.fromStrict atomically $ takeTMVar answ <&> Just . LBS.fromStrict
Just (InFossil key (o,l)) -> do Just (InFossil CachedEntry{..} (o,l)) -> do
mCE <- atomically do now <- getTimeCoarse
files <- readTVar ncqTrackedFiles atomically $ writeTVar cachedTs now
pure $ HPSQ.lookup key files >>= snd let chunk = BS.take (fromIntegral l) (BS.drop (fromIntegral o + 4 + 32) cachedMmapedData)
pure $ Just $ LBS.fromStrict chunk
case mCE of
Just CachedEntry{..} -> do
now <- getTimeCoarse
atomically $ writeTVar cachedTs now
let chunk = BS.take (fromIntegral l) (BS.drop (fromIntegral o + 4 + 32) cachedMmapedData)
pure $ Just $ LBS.fromStrict chunk
Nothing -> do
err $ "ncqStorageGet: missing CachedEntry for " <+> pretty key
pure Nothing
ncqStorageGetRef :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe HashRef) ncqStorageGetRef :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe HashRef)