wip

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
 

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