wip, store original hash in ref value

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Class.hs

@@ -107,6 +107,17 @@ ncqRefHash NCQStorage{..} h =
   HashRef (hashObject (coerce @_ @ByteString h <> coerce ncqSalt))
 {-# INLINE ncqRefHash #-}
 
+
+-- R: Reference format
+-- SALTED_HASH:BYTES(32) VALUE:BYTES(32) ORIG_HASH:BYTES(32)
+-- ^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+--   KEY                  VALUE
+--   LEN(PAYLOAD) = 2 * LEN(KEY)
+--
+-- We may need this ORIG_HASH in order to restore original
+-- reference hash during migrations, fsck or something like
+-- this, according to NCQv1 experience.
+
 -- | Get ref value (hash) by logical ref key.
 --   Returns Nothing for tomb/absent/invalid.
 ncqStorageGetRef :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe HashRef)
@@ -116,8 +127,8 @@ ncqStorageGetRef ncq ref = runMaybeT $ do
   guard (not $ ncqIsTomb loc)
   bs  <- lift (ncqGetEntryBS ncq loc) >>= toMPlus
   case snd (ncqEntryUnwrap bs) of
-    Right (R, payload) | BS.length payload == ncqKeyLen
-      -> pure (coerce payload)
+    Right (R, payload) | BS.length payload == 2*ncqKeyLen
+      -> pure (coerce $ BS.take ncqKeyLen payload)
     _ -> mzero
 {-# INLINE ncqStorageGetRef #-}
 
@@ -127,9 +138,10 @@ ncqStorageSetRef ncq ref val = do
   cur <- ncqStorageGetRef ncq ref
   unless (cur == Just val) $ do
     let rkey    = ncqRefHash ncq ref
+        orig    = coerce @_ @ByteString ref
         payload = coerce @_ @ByteString val
     -- Section type R, fixed key = rkey, payload = value hash bytes
-    void $ ncqPutBS ncq (Just R) (Just rkey) payload
+    void $ ncqPutBS ncq (Just R) (Just rkey) (payload <> orig)
 {-# INLINE ncqStorageSetRef #-}
 
 -- | Delete ref (write tomb for ref key), no-op if absent.

hbs2-tests/test/NCQ3.hs

@@ -67,6 +67,8 @@ import Streaming.Prelude qualified as S
 {-HLINT ignore "Functor law"-}
 
 
+failure :: forall a m . (Show a, MonadIO m) => Doc a -> m ()
+failure = liftIO . assertFailure . show
 
 ncq3Tests :: forall m . MonadUnliftIO m => MakeDictM C m ()
 ncq3Tests = do
@@ -681,6 +683,37 @@ ncq3Tests = do
 
         liftIO $ assertBool (show $ "hash eq" <+> pretty h0 <+> pretty lbs1) (h0 == lbs1)
 
+  entry $ bindMatch "test:ncq3:refs:shape" $ nil_ $ \_ -> runTest $ \TestEnv{..} -> do
+    ncqWithStorage testEnvDir $ \sto -> do
+      -- random 32B ref & val
+      g   <- liftIO MWC.createSystemRandom
+      ref <- HashRef . coerce <$> liftIO (genRandomBS g ncqKeyLen)
+      val <- HashRef . coerce <$> liftIO (genRandomBS g ncqKeyLen)
+
+      -- roundtrip via API
+      ncqStorageSetRef sto ref val
+      m <- ncqStorageGetRef sto ref
+      when (m /= Just val) $
+        failure "refs:shape: getRef mismatch (expected Just val)"
+
+      -- raw check
+      let rkey = ncqRefHash sto ref
+      loc <- ncqLocate sto rkey >>= orThrowUser "refs:shape: locate failed"
+      bs  <- ncqGetEntryBS sto loc >>= orThrowUser "refs:shape: ncqGetEntryBS failed"
+
+      payload <- case snd (ncqEntryUnwrap bs) of
+                   Right (R, p) -> pure p
+                   _            -> error "refs:shape: unexpected section type (not R)"
+
+      when (BS.length payload /= 2 * ncqKeyLen) $
+        failure "refs:shape: payload length != 64"
+
+      let (val', raw) = BS.splitAt ncqKeyLen payload
+      when (val' /= coerce val) $
+        failure "refs:shape: first 32B != VAL_HASH"
+      when (raw /= coerce ref) $
+        failure "refs:shape: last 32B != RAW_REF_KEY"
+
 
   entry $ bindMatch "test:ncq3:storage:basic" $ nil_ $ \e -> do
     let (opts,args) = splitOpts [] e