wip

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

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)

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)]
+
+

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

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)
+
+

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

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)
 

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

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