From 1eb0159b2d874f12b21553a494196cdc6c00d580 Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Mon, 9 Jun 2025 09:21:09 +0300
Subject: [PATCH] wip

---
 hbs2-peer/app/Migrate.hs                        |  2 +-
 hbs2-peer/lib/HBS2/Peer/RPC/Internal/Storage.hs | 16 ++++++++--------
 hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs        |  2 +-
 3 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/hbs2-peer/app/Migrate.hs b/hbs2-peer/app/Migrate.hs
index 6e68e806..78bde91b 100644
--- a/hbs2-peer/app/Migrate.hs
+++ b/hbs2-peer/app/Migrate.hs
@@ -247,7 +247,7 @@ migrate syn = flip runContT pure $ callCC \exit -> do
       refTo <- liftIO (readFile fn)
                 <&> coerce @_ @HashRef . fromString @(Hash HbSync)
 
-      here <- ncqLocate ncq refTo
+      here <- liftIO (ncqLocate ncq refTo)
 
       if isJust here then         do
         liftIO $ ncqStorageSetRef ncq ref refTo
diff --git a/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Storage.hs b/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Storage.hs
index f4589282..94a7b508 100644
--- a/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Storage.hs
+++ b/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Storage.hs
@@ -25,35 +25,35 @@ type StorageContext m = (MonadIO m, HasStorage m)
 instance (StorageContext m) => HandleMethod m RpcStorageHasBlock where
 
   handleMethod href = do
-    debug $ "rpc.storage.hasBlock" <+> pretty href
+    -- debug $ "rpc.storage.hasBlock" <+> pretty href
     sto <- getStorage
     liftIO $ hasBlock sto (fromHashRef href)
 
 instance (StorageContext m) => HandleMethod m RpcStorageGetBlock where
 
   handleMethod href = do
-    debug $ "rpc.storage.getBlock" <+> pretty href
+    -- debug $ "rpc.storage.getBlock" <+> pretty href
     sto <- getStorage
     liftIO $ getBlock sto (fromHashRef href)
 
 instance (StorageContext m) => HandleMethod m RpcStorageEnqueueBlock where
 
   handleMethod lbs = do
-    debug $ "rpc.storage.enqueueBlock"
+    -- debug $ "rpc.storage.enqueueBlock"
     sto <- getStorage
     liftIO $ enqueueBlock sto lbs <&> fmap HashRef
 
 instance (StorageContext m) => HandleMethod m RpcStoragePutBlock where
 
   handleMethod lbs = do
-    debug $ "rpc.storage.putBlock"
+    -- debug $ "rpc.storage.putBlock"
     sto <- getStorage
     liftIO $ putBlock sto lbs <&> fmap HashRef
 
 instance (StorageContext m) => HandleMethod m RpcStorageDelBlock where
 
   handleMethod href = do
-    debug $ "rpc.storage.delBlock" <+> pretty href
+    -- debug $ "rpc.storage.delBlock" <+> pretty href
     sto <- getStorage
     liftIO $ delBlock sto (fromHashRef href)
 
@@ -66,21 +66,21 @@ instance (StorageContext m) => HandleMethod m RpcStorageGetChunk where
 instance (StorageContext m) => HandleMethod m RpcStorageGetRef where
 
   handleMethod ref = do
-    debug $ "rpc.storage.getRef" <+> pretty ref
+    trace $ "rpc.storage.getRef" <+> pretty ref
     sto <- getStorage
     liftIO $ getRef sto ref <&> fmap HashRef
 
 instance (StorageContext m) => HandleMethod m RpcStorageUpdateRef where
 
   handleMethod (ref, val) = do
-    debug $ "rpc.storage.updateRef" <+> pretty ref <+> pretty (refMetaData ref)
+    trace $ "rpc.storage.updateRef" <+> pretty ref <+> pretty (refMetaData ref)
     sto <- getStorage
     liftIO $ updateRef sto ref (fromHashRef val)
 
 instance (StorageContext m) => HandleMethod m RpcStorageDelRef where
 
   handleMethod ref = do
-    debug $ "rpc.storage.delRef" <+> pretty ref
+    trace $ "rpc.storage.delRef" <+> pretty ref
     sto <- getStorage
     liftIO $ delRef sto ref
 
diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
index b7e2780a..c8a71b9d 100644
--- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
+++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
@@ -1012,7 +1012,7 @@ ncqStorageGet_ ncq@NCQStorage{..} = \case
       r <- atomically do
         a <- newEmptyTMVar
         inRQ <- readTVar ncqCurrentReadReq <&> Seq.length
-        when (inRQ > 4 * ncqCapabilities) STM.retry
+        when (inRQ > 1024 * ncqCapabilities) STM.retry
         modifyTVar ncqCurrentUsage (IntMap.insertWith (+) (fromIntegral fd) 1)
         modifyTVar ncqCurrentReadReq (|> (fd, o, l, a))
         pure a