From f26cae04a375ce4b840fd17e58dd30216ac8e5f3 Mon Sep 17 00:00:00 2001
From: Dmitry Zuykov <dzuikov@gmail.com>
Date: Wed, 14 May 2025 13:29:01 +0300
Subject: [PATCH] wip, references

---
 hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs | 20 ++++++++--
 hbs2-tests/test/TCQ.hs                   | 50 ++++++++++++++++++++----
 2 files changed, 59 insertions(+), 11 deletions(-)

diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
index 533b4f61..dc62434e 100644
--- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
+++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
@@ -755,14 +755,28 @@ ncqStorageGet ncq@NCQStorage{..} h = do
 
     _ -> pure Nothing
 
+ncqRefHash :: NCQStorage -> HashRef -> HashRef
+ncqRefHash NCQStorage{..} h = HashRef (hashObject (coerce @_ @ByteString h <> coerce ncqSalt))
+
 ncqStorageGetRef :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe HashRef)
-ncqStorageGetRef NCQStorage{..} ref = error "not implemented"
+ncqStorageGetRef ncq ref = runMaybeT do
+  lbs <- lift (ncqStorageGet ncq h) >>= toMPlus
+  guard (ncqIsNotTomb lbs)
+  let hbs = LBS.toStrict (LBS.drop (fromIntegral ncqPrefixLen) lbs)
+  guard (BS.length hbs == 32)
+  pure $ coerce hbs
+  where h = ncqRefHash ncq ref
 
 ncqStorageSetRef :: MonadUnliftIO m => NCQStorage -> HashRef -> HashRef -> m ()
-ncqStorageSetRef NCQStorage{..} ref val = error "not implemented"
+ncqStorageSetRef ncq ref val = do
+  current <- ncqStorageGetRef ncq ref
+  unless (current == Just val) do
+    void $ ncqStoragePut_ False ncq h (LBS.fromStrict $ ncqRefPrefix <> coerce val)
+  where h = ncqRefHash ncq ref
 
 ncqStorageDelRef :: MonadUnliftIO m => NCQStorage -> HashRef -> m ()
-ncqStorageDelRef NCQStorage{..} ref = error "not implemented"
+ncqStorageDelRef ncq ref = ncqStorageDel ncq h
+  where h = ncqRefHash ncq ref
 
 ncqStorageDel :: MonadUnliftIO m => NCQStorage -> HashRef -> m ()
 ncqStorageDel ncq@NCQStorage{..} h = flip runContT pure $ callCC \exit -> do
diff --git a/hbs2-tests/test/TCQ.hs b/hbs2-tests/test/TCQ.hs
index a8d4f433..5846dabb 100644
--- a/hbs2-tests/test/TCQ.hs
+++ b/hbs2-tests/test/TCQ.hs
@@ -112,11 +112,11 @@ instance MonadUnliftIO m => Storage NCQStorage HbSync LBS.ByteString  m where
     putBlock ncq lbs = fmap coerce <$> ncqStoragePutBlock ncq lbs
     enqueueBlock ncq lbs  = fmap coerce <$> ncqStoragePutBlock ncq lbs
     getBlock ncq h = ncqStorageGet ncq (coerce h)
-    getChunk _ _ _  = error "getChunk not defined"
     hasBlock ncq = hasBlock ncq . coerce
+    delBlock ncq = ncqStorageDel ncq . coerce
+    getChunk _ _ _  = error "getChunk not defined"
     updateRef = error "updateRef not defined"
     getRef = error "getRef not no defined"
-    delBlock = error "delBlock not defined"
     delRef = error "delRef not defined"
 
 main :: IO ()
@@ -254,12 +254,6 @@ main = do
 
           e -> throwIO $ BadFormException @C (mkList e)
 
-        entry $ bindMatch "ncq:get" $ \case
-          [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do
-            ncq <- getNCQ tcq
-            ncqStorageGetBlock ncq hash >>= maybe (pure nil) mkOpaque
-
-          e -> throwIO $ BadFormException @C (mkList e)
 
         entry $ bindMatch "ncq:del" $ nil_ \case
           [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do
@@ -275,6 +269,39 @@ main = do
 
           e -> throwIO $ BadFormException @C (mkList e)
 
+
+        entry $ bindMatch "ncq:set:ref" $ \case
+          [ isOpaqueOf @TCQ -> Just tcq, HashLike ref , HashLike val ] -> lift do
+              ncq <- getNCQ tcq
+              ncqStorageSetRef ncq ref val
+              pure nil
+
+          e -> throwIO $ BadFormException @C (mkList e)
+
+        entry $ bindMatch "ncq:del:ref" $ \case
+          [ isOpaqueOf @TCQ -> Just tcq , HashLike ref ] -> lift do
+              ncq <- getNCQ tcq
+              ncqStorageDelRef ncq ref
+              pure nil
+
+          e -> throwIO $ BadFormException @C (mkList e)
+
+        entry $ bindMatch "ncq:get:ref" $ \case
+            [ isOpaqueOf @TCQ -> Just tcq, HashLike w ] -> lift do
+              ncq <- getNCQ tcq
+              ref <- ncqStorageGetRef ncq w
+              pure $ maybe nil (mkSym . show . pretty) ref
+
+            e -> throwIO $ BadFormException @C (mkList e)
+
+        entry $ bindMatch "ncq:refhash" $ \case
+            [ isOpaqueOf @TCQ -> Just tcq, HashLike w ] -> lift do
+              ncq <- getNCQ tcq
+              let rf = ncqRefHash ncq w
+              pure $ mkSym ( show $ pretty $ rf )
+
+            e -> throwIO $ BadFormException @C (mkList e)
+
         entry $ bindMatch "ncq:hash" $ \case
             [ isOpaqueOf @ByteString -> Just bs ] -> lift do
               pure $ mkSym ( show $ pretty $ hashObject @HbSync bs )
@@ -284,6 +311,13 @@ main = do
 
             e -> pure nil
 
+        entry $ bindMatch "ncq:get" $ \case
+          [ isOpaqueOf @TCQ -> Just tcq, HashLike hash ] -> lift do
+            ncq <- getNCQ tcq
+            ncqStorageGetBlock ncq hash >>= maybe (pure nil) mkOpaque
+
+          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