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

wip, fixed ncqCheckDeleted

This commit is contained in:
Dmitry Zuykov 2025-05-13 14:36:50 +03:00
parent 407bfadbff
commit 41ce441f82
2 changed files with 27 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -137,10 +137,9 @@ data NCQStorage =
data Location = data Location =
InWriteQueue LBS.ByteString InWriteQueue WQItem
| InCurrent (Word64, Word64) | InCurrent (Word64, Word64)
| InFossil CachedEntry (Word64, Word64) | InFossil CachedEntry (Word64, Word64)
deriving stock (Show)
instance Pretty Location where instance Pretty Location where
pretty = \case pretty = \case
@ -595,10 +594,9 @@ ncqStoragePutFaster = ncqStoragePut_ False
ncqLocatedSize :: Location -> Integer ncqLocatedSize :: Location -> Integer
ncqLocatedSize = \case ncqLocatedSize = \case
InWriteQueue lbs -> fromIntegral $ LBS.length lbs InWriteQueue WQItem{..} -> fromIntegral $ maybe 0 LBS.length wqData
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
@ -634,8 +632,8 @@ ncqLocate ncq@NCQStorage{..} h = flip runContT pure $ callCC \exit -> do
inQ <- readTVar ncqWriteQueue inQ <- readTVar ncqWriteQueue
<&> (fmap snd . HPSQ.lookup h) <&> (fmap snd . HPSQ.lookup h)
<&> \case <&> \case
Just (WQItem{ wqData = Just bs}) -> Just (InWriteQueue bs) Just wq -> Just (InWriteQueue wq)
_ -> Nothing _ -> Nothing
inC <- readTVar ncqWaitIndex <&> (fmap snd . HPSQ.lookup h) <&> fmap InCurrent inC <- readTVar ncqWaitIndex <&> (fmap snd . HPSQ.lookup h) <&> fmap InCurrent
pure (inQ <|> inC) pure (inQ <|> inC)
@ -699,9 +697,9 @@ ncqCheckDeleted :: Monad m
ncqCheckDeleted _ Nothing _ = pure Nothing ncqCheckDeleted _ Nothing _ = pure Nothing
ncqCheckDeleted h (Just loc) act = case loc of ncqCheckDeleted h (Just loc) act = case loc of
InWriteQueue bs InWriteQueue WQItem{ wqData = Nothing } -> pure Nothing
| LBS.null bs && h /= ncqEmptyDataHash -> pure Nothing
| otherwise -> act loc InWriteQueue WQItem{ wqData = Just _ } -> act loc
InFossil _ (_, l) InFossil _ (_, l)
| l == 0 && h /= ncqEmptyDataHash -> pure Nothing | l == 0 && h /= ncqEmptyDataHash -> pure Nothing
@ -748,11 +746,10 @@ ncqStorageGet :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe LBS.ByteSt
ncqStorageGet ncq@NCQStorage{..} h = do ncqStorageGet ncq@NCQStorage{..} h = do
location <- ncqLocate ncq h location <- ncqLocate ncq h
ncqCheckDeleted h location \case ncqCheckDeleted h location \case
InWriteQueue lbs -> InWriteQueue WQItem{ wqData = Just lbs } -> do
pure $ Just lbs pure $ Just lbs
InCurrent (o,l) -> do InCurrent (o,l) -> do
debug $ "IN FUCKIN CURRENT" <+> pretty l
r <- atomically do r <- atomically do
a <- newEmptyTMVar a <- newEmptyTMVar
fd <- readTVar ncqCurrentHandleR fd <- readTVar ncqCurrentHandleR
@ -768,6 +765,7 @@ ncqStorageGet ncq@NCQStorage{..} h = do
let chunk = BS.take (fromIntegral l) (BS.drop (fromIntegral o + 4 + 32) (cachedMmapedData ce)) let chunk = BS.take (fromIntegral l) (BS.drop (fromIntegral o + 4 + 32) (cachedMmapedData ce))
pure $ Just $ LBS.fromStrict chunk pure $ Just $ LBS.fromStrict chunk
_ -> pure Nothing
ncqStorageGetRef :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe HashRef) ncqStorageGetRef :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe HashRef)
ncqStorageGetRef NCQStorage{..} ref = readTVarIO ncqRefsMem <&> HM.lookup ref ncqStorageGetRef NCQStorage{..} ref = readTVarIO ncqRefsMem <&> HM.lookup ref

17
hbs2-tests/test/TCQ.hs
View File

@ -189,6 +189,22 @@ main = do
e -> throwIO $ BadFormException @C (mkList e) e -> throwIO $ BadFormException @C (mkList e)
entry $ bindMatch "ncq:close" $ nil_ \case
[ isOpaqueOf @TCQ -> Just tcq ] -> lift do
ncq <- getNCQ tcq
ncqStorageStop ncq
void $ runMaybeT do
(s,r) <- readTVarIO instances
<&> HM.lookup (coerce tcq)
>>= toMPlus
wait r
atomically $ modifyTVar instances (HM.delete (coerce tcq))
e -> throwIO $ BadFormException @C (mkList e)
entry $ bindMatch "ncq:cached:entries" $ \case entry $ bindMatch "ncq:cached:entries" $ \case
[ isOpaqueOf @TCQ -> Just tcq ] -> lift do [ isOpaqueOf @TCQ -> Just tcq ] -> lift do
NCQStorage{..} <- getNCQ tcq NCQStorage{..} <- getNCQ tcq
@ -207,7 +223,6 @@ main = do
e -> throwIO $ BadFormException @C (mkList e) e -> throwIO $ BadFormException @C (mkList e)
entry $ bindMatch "ncq:has" $ \case entry $ bindMatch "ncq:has" $ \case
[ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do
ncq <- getNCQ tcq ncq <- getNCQ tcq