From fac26127765c229479acb28538cc70a6e94a70de Mon Sep 17 00:00:00 2001 From: voidlizard Date: Sun, 23 Feb 2025 09:23:58 +0300 Subject: [PATCH] wip --- Makefile | 1 + hbs2-cli/lib/HBS2/CLI/Run/Internal.hs | 13 -------- hbs2-cli/lib/HBS2/CLI/Run/Internal/RefLog.hs | 20 ++++++++++++- hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs | 22 +++++++------- hbs2-cli/lib/HBS2/CLI/Run/Tree.hs | 30 +++++++++++++++++++ .../lib/HBS2/Storage/Operations/Missed.hs | 2 -- hbs2-git3/lib/HBS2/Git3/Export.hs | 15 ++++------ hbs2-git3/lib/HBS2/Git3/Run.hs | 2 +- hbs2-peer/hbs2-peer.cabal | 1 + 9 files changed, 69 insertions(+), 37 deletions(-) diff --git a/Makefile b/Makefile index 776e8499..c3c045d0 100644 --- a/Makefile +++ b/Makefile @@ -68,6 +68,7 @@ symlinks: $(BIN_DIR) > fi; \ > done > ln -sfn ../hbs2-git3/bf6/git-hbs2 bin/git-hbs2 +> ln -sfn ../hbs2-git3/bf6/hbs2-git bin/hbs2-git .PHONY: build diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs index e68463f9..9432b150 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs @@ -184,19 +184,6 @@ internalEntries = do pure $ mkList r - -- TODO: move-somewhere - entry $ bindMatch "rm" $ nil_ \case - [ StringLike p ] -> rm p - _ -> throwIO (BadFormException @c nil) - - entry $ bindMatch "touch" $ nil_ \case - [ StringLike p ] -> touch p - _ -> throwIO (BadFormException @c nil) - - entry $ bindMatch "mkdir" $ nil_ \case - [ StringLike p ] -> mkdir p - _ -> throwIO (BadFormException @c nil) - entry $ bindMatch "blob:base58" $ \case [LitStrVal t] -> do bs <- pure (Text.unpack t & BS8.pack & fromBase58) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefLog.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefLog.hs index 059eebca..0edbbb56 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefLog.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefLog.hs @@ -1,5 +1,5 @@ {-# Language AllowAmbiguousTypes #-} -module HBS2.CLI.Run.Internal.RefLog (copyTransactions, RefLogCLIException(..)) where +module HBS2.CLI.Run.Internal.RefLog (copyTransactions, RefLogCLIException(..),decodeRefLogTx) where import HBS2.CLI.Prelude hiding (mapMaybe) import HBS2.CLI.Run.Internal @@ -89,3 +89,21 @@ copyTransactions cre a b = do void $ callService @RpcRefLogPost api n +decodeRefLogTx :: forall c. IsContext c => Maybe HashRef -> LBS.ByteString -> Syntax c +decodeRefLogTx h lbs = do + + let ha = maybe (hashObject @HbSync lbs) coerce h + + case tryDetect ha lbs of + + SeqRef (SequentialRef n (AnnotatedHashRef ann ha)) -> + mkForm "seqref" [mkInt n, mkForm "annref" [mkSym (show $ pretty ann), mkSym (show $ pretty ha)]] + + AnnRef (AnnotatedHashRef ann ha) -> do + mkForm "annref" [mkSym (show $ pretty ann), mkSym (show $ pretty ha)] + + Blob{} -> mkForm "blob" [mkSym (show $ pretty ha)] + + _ -> mkForm "tree" [mkSym (show $ pretty ha)] + + diff --git a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs index 77c7acd4..a4cfa141 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs @@ -10,6 +10,7 @@ import HBS2.CLI.Run.Internal.RefLog import HBS2.Data.Types.Refs import HBS2.Merkle +import HBS2.Data.Detect import HBS2.Storage import HBS2.Peer.RPC.Client import HBS2.Peer.CLI.Detect @@ -182,14 +183,14 @@ reflogEntries = do _ -> throwIO (BadFormException @C nil) - entry $ bindMatch "hbs2:reflog:tx:seqref:decode" $ \case - [ListVal [SymbolVal "blob", LitStrVal s]] -> do - let lbs = Text.unpack s & BS8.pack & LBS.fromStrict + entry $ bindMatch "hbs2:reflog:tx:decode" $ \case + [HashLike s] -> do + sto <- getStorage + blk <- getBlock sto (coerce s) + pure $ maybe1 blk nil (decodeRefLogTx @c (Just s)) - SequentialRef n (AnnotatedHashRef _ h) <- deserialiseOrFail @SequentialRef lbs - & orThrowUser "FUCKED" - - pure $ mkForm "seqref" [mkInt n, mkStr (show $ pretty h)] + [MatchOpaqueVal @_ @(HashRef, ByteString) (ha,bs)] -> do + pure $ decodeRefLogTx @c (Just ha) (LBS.fromStrict bs) e -> throwIO $ BadFormException @c nil @@ -221,14 +222,13 @@ reflogEntries = do >>= orThrowUser "invalid-tx" let bs = view refLogUpdData tx - let bs8 = BS8.unpack bs - lift $ apply_ e [mkForm "blob" [mkStr bs8]] + payload <- mkOpaque (ha,bs) + + lift $ apply_ e [payload] pure $ mkList rr _ -> throwIO (BadFormException @C nil) - - diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs b/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs index 05e90931..80e86536 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs @@ -9,6 +9,7 @@ import HBS2.CLI.Run.Internal.Merkle import HBS2.Defaults +import HBS2.Base58 import HBS2.Data.Types.Refs import HBS2.Merkle import HBS2.Data.Detect @@ -28,6 +29,7 @@ import Data.Coerce import Data.Text qualified as Text import Control.Monad.Except import Codec.Serialise +import Streaming.Prelude qualified as S pattern GroveHashes :: forall {c}. [HashRef] -> [Syntax c] pattern GroveHashes hashes <- ( groveHashes -> hashes ) @@ -126,3 +128,31 @@ It's just an easy way to create a such thing, you may browse it by hbs2 cat -H _ -> throwIO (BadFormException @c nil) + brief "shallow scan of a block/tree" $ + entry $ bindMatch "hbs2:tree:scan" $ \case + [HashLike href] -> do + sto <- getStorage + + r <- S.toList_ $ + deepScan ScanShallow (const none) (coerce href) (getBlock sto) $ \ha -> S.yield ha + + -- let refs = extractBlockRefs (coerce href) blk + pure $ mkList @c (fmap (mkSym . show . pretty . HashRef) r) + + _ -> throwIO (BadFormException @c nil) + + + brief "shallow scan of a block/tree" $ + entry $ bindMatch "hbs2:tree:scan:deep" $ \case + [HashLike href] -> do + sto <- getStorage + + r <- S.toList_ $ + deepScan ScanDeep (const none) (coerce href) (getBlock sto) $ \ha -> S.yield ha + + -- let refs = extractBlockRefs (coerce href) blk + pure $ mkList @c (fmap (mkSym . show . pretty . HashRef) r) + + _ -> throwIO (BadFormException @c nil) + + diff --git a/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs b/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs index 610818d9..73cb1ae0 100644 --- a/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs +++ b/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs @@ -57,8 +57,6 @@ findMissedBlocks2 sto href = void $ runMaybeT do let w = tryDetect (fromHashRef hx) bs let refs = extractBlockRefs (coerce hx) bs - -- err $ "PIZDA!" <+> pretty hx <+> pretty refs - for_ refs $ \r -> do -- findMissedBlocks sto r >>= lift . mapM_ S.yield here <- hasBlock sto (coerce r) <&> isJust diff --git a/hbs2-git3/lib/HBS2/Git3/Export.hs b/hbs2-git3/lib/HBS2/Git3/Export.hs index a07b0617..9a68ba02 100644 --- a/hbs2-git3/lib/HBS2/Git3/Export.hs +++ b/hbs2-git3/lib/HBS2/Git3/Export.hs @@ -268,16 +268,13 @@ export mbh refs = withStateDo do let mbytes = realToFrac b / 1024/1024 & realToFrac @_ @(Fixed E2) - let dbdt = mbytes / tspent + let dbdt = if tspent == 0 then Nothing else Just (mbytes / tspent) - -- liftIO $ IO.hPutStr stderr $ show $ - -- " \r" - -- <+> pretty tspent <> "s" - -- <+> pretty mbytes <> "mb" - -- <+> pretty dbdt <> "mbs" - -- <+> pretty pp <> "%" - - -- liftIO $ IO.hPutStr stderr $ "\r" + status $ "export" + <+> brackets ("commits" <+> pretty p) + <+> brackets ("mb" <+> pretty mbytes) + <+> brackets ("mbs" <+> pretty dbdt) + <+> brackets ("time" <+> pretty tspent) next (t1,b) diff --git a/hbs2-git3/lib/HBS2/Git3/Run.hs b/hbs2-git3/lib/HBS2/Git3/Run.hs index 8eceae7f..e015d23c 100644 --- a/hbs2-git3/lib/HBS2/Git3/Run.hs +++ b/hbs2-git3/lib/HBS2/Git3/Run.hs @@ -463,7 +463,7 @@ compression ; prints compression level resolveRepo syn getRepoManifest >>= liftIO . print . pretty . mkForm "manifest" . coerce - manRemotes $ entry $ bindAlias "remotes" "repo:remotes" + entry $ bindAlias "remotes" "repo:remotes" manRemotes $ entry $ bindMatch "repo:remotes" $ nil_ $ const $ lift do diff --git a/hbs2-peer/hbs2-peer.cabal b/hbs2-peer/hbs2-peer.cabal index 0798ec8e..f6f44327 100644 --- a/hbs2-peer/hbs2-peer.cabal +++ b/hbs2-peer/hbs2-peer.cabal @@ -175,6 +175,7 @@ library HBS2.Peer.RPC.Client HBS2.Peer.RPC.Client.Internal HBS2.Peer.RPC.Client.RefChan + HBS2.Peer.RPC.Client.RefLog HBS2.Peer.RPC.Class HBS2.Peer.RPC.API.Peer