mirror of https://github.com/voidlizard/hbs2
wip, seems references work
This commit is contained in:
parent
c4c368f19f
commit
ce36509c67
|
@ -66,7 +66,10 @@
|
||||||
(import-blocks)
|
(import-blocks)
|
||||||
(import-refs)
|
(import-refs)
|
||||||
|
|
||||||
|
(debug)
|
||||||
|
|
||||||
; ; (println OKAY)
|
(ncq:fossilize ncq)
|
||||||
|
|
||||||
|
(println done)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -539,7 +539,9 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
|
||||||
fsize <- getFdStatus fh <&> PFS.fileSize
|
fsize <- getFdStatus fh <&> PFS.fileSize
|
||||||
pure (0,fromIntegral fsize)
|
pure (0,fromIntegral fsize)
|
||||||
|
|
||||||
if sz < ncqMinLog then do
|
now <- readTVarIO ncqIndexNow
|
||||||
|
|
||||||
|
if sz < ncqMinLog && now <= 0 then do
|
||||||
((h, (fromIntegral off, fromIntegral len)) : ) <$> next (written', rest)
|
((h, (fromIntegral off, fromIntegral len)) : ) <$> next (written', rest)
|
||||||
else do
|
else do
|
||||||
pure [(h, (fromIntegral off, fromIntegral len))]
|
pure [(h, (fromIntegral off, fromIntegral len))]
|
||||||
|
@ -568,7 +570,7 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
|
||||||
bw <- readTVar wbytes
|
bw <- readTVar wbytes
|
||||||
writeTVar ncqNotWritten (max 0 (b0 - bw))
|
writeTVar ncqNotWritten (max 0 (b0 - bw))
|
||||||
|
|
||||||
indexNow <- readTVarIO ncqIndexNow
|
indexNow <- atomically $ stateTVar ncqIndexNow (,0)
|
||||||
|
|
||||||
when (fromIntegral size >= ncqMinLog || indexNow > 0) do
|
when (fromIntegral size >= ncqMinLog || indexNow > 0) do
|
||||||
|
|
||||||
|
@ -596,7 +598,6 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
|
||||||
-- то есть должны отнять 1 после индексации.
|
-- то есть должны отнять 1 после индексации.
|
||||||
modifyTVar ncqCurrentUsage (IntMap.insertWith (+) (fromIntegral fdr) 1)
|
modifyTVar ncqCurrentUsage (IntMap.insertWith (+) (fromIntegral fdr) 1)
|
||||||
writeTQueue indexQ (fdr, fossilized)
|
writeTQueue indexQ (fdr, fossilized)
|
||||||
writeTVar ncqIndexNow 0
|
|
||||||
|
|
||||||
closeFd fh
|
closeFd fh
|
||||||
writeBinaryFileDurable (ncqGetCurrentSizeName ncq) (N.bytestring64 0)
|
writeBinaryFileDurable (ncqGetCurrentSizeName ncq) (N.bytestring64 0)
|
||||||
|
|
|
@ -16,6 +16,10 @@ import HBS2.Merkle
|
||||||
import HBS2.Storage
|
import HBS2.Storage
|
||||||
import HBS2.Storage.Simple
|
import HBS2.Storage.Simple
|
||||||
import HBS2.Storage.Operations.ByteString
|
import HBS2.Storage.Operations.ByteString
|
||||||
|
import HBS2.Net.Auth.Credentials
|
||||||
|
import HBS2.Peer.Proto.RefLog
|
||||||
|
import HBS2.Peer.Proto.LWWRef
|
||||||
|
import HBS2.Data.Types.SignedBox
|
||||||
|
|
||||||
import HBS2.System.Logger.Simple.ANSI
|
import HBS2.System.Logger.Simple.ANSI
|
||||||
|
|
||||||
|
@ -319,10 +323,37 @@ main = do
|
||||||
[ isOpaqueOf @TCQ -> Just tcq, HashLike w ] -> lift do
|
[ isOpaqueOf @TCQ -> Just tcq, HashLike w ] -> lift do
|
||||||
ncq <- getNCQ tcq
|
ncq <- getNCQ tcq
|
||||||
ref <- ncqStorageGetRef ncq w
|
ref <- ncqStorageGetRef ncq w
|
||||||
|
debug $ "ref" <+> pretty w <+> pretty ref
|
||||||
pure $ maybe nil (mkSym . show . pretty) ref
|
pure $ maybe nil (mkSym . show . pretty) ref
|
||||||
|
|
||||||
e -> throwIO $ BadFormException @C (mkList e)
|
e -> throwIO $ BadFormException @C (mkList e)
|
||||||
|
|
||||||
|
entry $ bindMatch "ncq:get:reflog" $ \case
|
||||||
|
[ isOpaqueOf @TCQ -> Just tcq, SignPubKeyLike reflog ] -> lift do
|
||||||
|
ncq <- getNCQ tcq
|
||||||
|
let sto = AnyStorage ncq
|
||||||
|
let ha = hashObject @HbSync (RefLogKey @HBS2Basic reflog)
|
||||||
|
debug $ "refhash" <+> pretty ha
|
||||||
|
ref <- getRef sto (RefLogKey @HBS2Basic reflog)
|
||||||
|
pure $ maybe nil (mkSym . show . pretty) ref
|
||||||
|
|
||||||
|
e -> throwIO $ BadFormException @C (mkList e)
|
||||||
|
|
||||||
|
entry $ bindMatch "ncq:get:lwwref" $ \case
|
||||||
|
[ isOpaqueOf @TCQ -> Just tcq, SignPubKeyLike lww ] -> lift do
|
||||||
|
ncq <- getNCQ tcq
|
||||||
|
let sto = AnyStorage ncq
|
||||||
|
val <- runMaybeT do
|
||||||
|
rv <- getRef sto (LWWRefKey @HBS2Basic lww) >>= toMPlus
|
||||||
|
getBlock sto rv >>= toMPlus
|
||||||
|
<&> unboxSignedBox @(LWWRef 'HBS2Basic) @HBS2Basic
|
||||||
|
>>= toMPlus
|
||||||
|
<&> snd
|
||||||
|
|
||||||
|
pure $ maybe nil (mkSym . show . pretty) val
|
||||||
|
|
||||||
|
e -> throwIO $ BadFormException @C (mkList e)
|
||||||
|
|
||||||
entry $ bindMatch "ncq:refhash" $ \case
|
entry $ bindMatch "ncq:refhash" $ \case
|
||||||
[ isOpaqueOf @TCQ -> Just tcq, HashLike w ] -> lift do
|
[ isOpaqueOf @TCQ -> Just tcq, HashLike w ] -> lift do
|
||||||
ncq <- getNCQ tcq
|
ncq <- getNCQ tcq
|
||||||
|
|
Loading…
Reference in New Issue