diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs index b7d88356..916499cb 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs @@ -707,7 +707,9 @@ ncqCheckDeleted h (Just loc) act = case loc of | l == 0 && h /= ncqEmptyDataHash -> pure Nothing | otherwise -> act loc - _ -> act loc + InCurrent (_, l) + | l == 0 && h /= ncqEmptyDataHash -> pure Nothing + | otherwise -> act loc ncqStorageHasBlock :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe Integer) ncqStorageHasBlock ncq h = do @@ -750,6 +752,7 @@ ncqStorageGet ncq@NCQStorage{..} h = do pure $ Just lbs InCurrent (o,l) -> do + debug $ "IN FUCKIN CURRENT" <+> pretty l r <- atomically do a <- newEmptyTMVar fd <- readTVar ncqCurrentHandleR @@ -794,7 +797,10 @@ ncqStorageDel ncq@NCQStorage{..} h = flip runContT pure $ callCC \exit -> do ncqLocate ncq h >>= atomically . \case Just (InFossil _ _) -> writeTombstone (WQItem False Nothing) - Just (InCurrent _) -> writeTombstone (WQItem False Nothing) + Just (InCurrent _) -> do + modifyTVar ncqWaitIndex (HPSQ.delete h) + writeTombstone (WQItem False Nothing) + Just (InWriteQueue _) -> writeTombstone (WQItem True Nothing) _ -> pure () @@ -1002,6 +1008,9 @@ ncqStorageInit_ check path = do pure ncq +ncqStorageFlush :: MonadUnliftIO m => NCQStorage -> m () +ncqStorageFlush = ncqStorageSync + ncqIndexRightNow :: MonadUnliftIO m => NCQStorage -> m () ncqIndexRightNow NCQStorage{..} = atomically $ modifyTVar ncqIndexNow succ diff --git a/hbs2-tests/test/TCQ.hs b/hbs2-tests/test/TCQ.hs index d0ae01fb..248065c8 100644 --- a/hbs2-tests/test/TCQ.hs +++ b/hbs2-tests/test/TCQ.hs @@ -189,6 +189,13 @@ main = do e -> throwIO $ BadFormException @C (mkList e) + entry $ bindMatch "ncq:cached:entries" $ \case + [ isOpaqueOf @TCQ -> Just tcq ] -> lift do + NCQStorage{..} <- getNCQ tcq + readTVarIO ncqCachedEntries <&> mkInt + + e -> throwIO $ BadFormException @C (mkList e) + entry $ bindMatch "ncq:locate" $ \case [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do ncq <- getNCQ tcq @@ -200,6 +207,14 @@ main = do e -> throwIO $ BadFormException @C (mkList e) + + entry $ bindMatch "ncq:has" $ \case + [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do + ncq <- getNCQ tcq + ncqStorageHasBlock ncq hash <&> maybe nil mkInt + + e -> throwIO $ BadFormException @C (mkList e) + entry $ bindMatch "ncq:get" $ \case [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do ncq <- getNCQ tcq @@ -207,6 +222,20 @@ main = do e -> throwIO $ BadFormException @C (mkList e) + entry $ bindMatch "ncq:del" $ nil_ \case + [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do + ncq <- getNCQ tcq + ncqStorageDel ncq hash + + e -> throwIO $ BadFormException @C (mkList e) + + entry $ bindMatch "ncq:flush" $ nil_ \case + [ isOpaqueOf @TCQ -> Just tcq ] -> lift do + ncq <- getNCQ tcq + ncqStorageFlush ncq + + e -> throwIO $ BadFormException @C (mkList e) + entry $ bindMatch "ncq:put" $ \syn -> do (tcq,bs) <- case syn of [ isOpaqueOf @TCQ -> Just tcq, isOpaqueOf @ByteString -> Just bs ] -> lift do