wip

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

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
 

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