From 59e9f8a718221676c58e1a1214ea8b3e10f99e7a Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Thu, 14 Aug 2025 09:53:00 +0300
Subject: [PATCH] wip, 3x speed degradation on read+write scenario against NCQ1

---
 .../lib/HBS2/Storage/NCQ3/Internal.hs         |  4 +-
 .../lib/HBS2/Storage/NCQ3/Internal/Index.hs   |  1 +
 hbs2-tests/test/NCQ3.hs                       | 49 +++++++++++++++++--
 3 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs
index b1d148dd..54e6fa16 100644
--- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs
+++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs
@@ -30,7 +30,7 @@ ncqStorageOpen fp upd = do
   let ncqGen            = 0
   let ncqFsync          = 16 * megabytes
   let ncqWriteQLen      = 1024 * 4
-  let ncqMinLog         = 1  * gigabytes
+  let ncqMinLog         = 2  * gigabytes
   let ncqMaxLog         = 32 * gigabytes
   let ncqWriteBlock     = max 128 $ ncqWriteQLen `div` 2
   let ncqMaxCachedIndex = 64
@@ -109,7 +109,7 @@ ncqPutBlock0 :: MonadUnliftIO m
              -> LBS.ByteString
              -> Bool
              -> m (Maybe HashRef)
-ncqPutBlock0 sto lbs wait =
+ncqPutBlock0 sto lbs wait = do
   ncqLocate sto ohash >>= \case
     Nothing -> Just <$> work sto (Just B) (Just ohash) bs
     _       -> pure (Just ohash)
diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs
index 66f69cd1..fb6e01d1 100644
--- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs
+++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs
@@ -78,6 +78,7 @@ ncqLocate_ f me@NCQStorage{..} href = ncqOperation me (pure Nothing) do
     writeTQueue ncqReadReq (href, answ)
 
   atomically $ takeTMVar answ
+{-# INLINE ncqLocate_ #-}
 
 ncqLocate :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe Location)
 ncqLocate me href = ncqOperation me (pure Nothing) do
diff --git a/hbs2-tests/test/NCQ3.hs b/hbs2-tests/test/NCQ3.hs
index da36c0d2..2cb26a90 100644
--- a/hbs2-tests/test/NCQ3.hs
+++ b/hbs2-tests/test/NCQ3.hs
@@ -590,6 +590,32 @@ ncq3Tests = do
     notice $ "second must fail" <+> pretty wx <+> "=>" <+> viaShow r
 
 
+  entry $ bindMatch "test:ncq3:merkle:file" $ nil_ $ \e -> runTest $ \TestEnv{..} -> do
+
+    let (opts,args) = splitOpts [] e
+    let n  = headDef (1 * gigabytes) [ fromIntegral x | LitIntVal x <- args ]
+
+    fn <- orThrowUser "no file given" (headMay [ x | StringLike x <- args ])
+
+    ncqWithStorage testEnvDir $ \ncq -> do
+
+      let sto = AnyStorage ncq
+      -- lbs <- liftIO $ LBS.readFile fn
+
+      lbs <- liftIO $ LBS.readFile fn
+
+      chu <- S.toList_ (readChunkedBS lbs (256*1024))
+      hashes <- forConcurrently chu $ \chunk -> do
+        ncqTossBlock ncq chunk >>= orThrowUser "can't save"
+
+      -- FIXME: handle-hardcode
+      let pt = toPTree (MaxSize 1024) (MaxNum 256) hashes -- FIXME: settings
+
+      m <- makeMerkle 0 pt $ \(_,_,bss) -> liftIO do
+             void $ ncqPutBlock ncq bss >>= orThrowUser "can't save"
+
+      notice $ pretty m
+
   entry $ bindMatch "test:ncq3:merkle" $ nil_ $ \e -> runTest $ \TestEnv{..} -> do
 
     let (opts,args) = splitOpts [] e
@@ -630,13 +656,26 @@ ncq3Tests = do
 
       h0 <- liftIO (LBS.readFile fn) <&> HashRef . hashObject @HbSync
 
-      lbs1 <- runExceptT (getTreeContents sto tree)
-                >>= orThrowPassIO
-                <&> HashRef . hashObject @HbSync
+      debug $ pretty h0
 
-      notice $ "found" <+> pretty tree <+> pretty lbs1 <+> pretty h0
+      notice "full compact index first"
 
-      liftIO $ assertBool (show $ "hash eq" <+> pretty h0 <+> pretty lbs1) (h0 == lbs1)
+      -- ncqIndexCompactFull ncq
+
+      replicateM_ 3 do
+
+        t1 <- getTimeCoarse
+        lbs1 <- runExceptT (getTreeContents sto tree)
+                  >>= orThrowPassIO
+                  <&> HashRef . hashObject @HbSync
+
+        debug $ pretty lbs1
+
+        t3 <- getTimeCoarse
+
+        notice $ "found" <+> pretty (sec2 (1e-9 * realToFrac (t3 - t1))) <+> pretty lbs1 <+> pretty h0
+
+        liftIO $ assertBool (show $ "hash eq" <+> pretty h0 <+> pretty lbs1) (h0 == lbs1)
 
 
   entry $ bindMatch "test:ncq3:storage:basic" $ nil_ $ \e -> do