voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, references

This commit is contained in:
Dmitry Zuykov 2025-05-14 13:29:01 +03:00
parent 67acde04d6
commit f26cae04a3
2 changed files with 59 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
View File

@ -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

50
hbs2-tests/test/TCQ.hs
View File

@ -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