From e7081e495c518256651640c98c4a08ad5f2d7cb1 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Mon, 20 Jan 2025 08:19:10 +0300 Subject: [PATCH] wip, code removing --- hbs2-git3/lib/HBS2/Git3/Repo.hs | 7 -- hbs2-git3/lib/HBS2/Git3/Run.hs | 130 +------------------------------- 2 files changed, 2 insertions(+), 135 deletions(-) diff --git a/hbs2-git3/lib/HBS2/Git3/Repo.hs b/hbs2-git3/lib/HBS2/Git3/Repo.hs index 23990bfa..253b7f03 100644 --- a/hbs2-git3/lib/HBS2/Git3/Repo.hs +++ b/hbs2-git3/lib/HBS2/Git3/Repo.hs @@ -12,10 +12,6 @@ import HBS2.Git3.State import HBS2.CLI.Run.MetaData import HBS2.Net.Auth.Credentials -import HBS2.Data.Detect ( readLogThrow ) -import HBS2.CLI.Run.Internal.Merkle (getTreeContents) -import HBS2.CLI.Run.RefLog (getCredentialsForReflog,mkRefLogUpdateFrom) - import HBS2.Git3.Config.Local import HBS2.KeyMan.Keys.Direct @@ -24,9 +20,6 @@ import Data.Config.Suckless.Script import Data.Config.Suckless.Almost.RPC import Data.ByteString.Lazy.Char8 qualified as LBS8 -import Data.ByteString.Lazy qualified as LBS -import Data.Text.Encoding qualified as TE -import Data.Text.Encoding.Error qualified as TE import Data.Word import Lens.Micro.Platform diff --git a/hbs2-git3/lib/HBS2/Git3/Run.hs b/hbs2-git3/lib/HBS2/Git3/Run.hs index 292c3ca5..02809e70 100644 --- a/hbs2-git3/lib/HBS2/Git3/Run.hs +++ b/hbs2-git3/lib/HBS2/Git3/Run.hs @@ -1,24 +1,12 @@ module HBS2.Git3.Run where import HBS2.Git3.Prelude -import HBS2.Git3.Git.Pack - -import HBS2.Peer.CLI.Detect -import HBS2.Peer.RPC.API.LWWRef -import HBS2.Peer.RPC.API.Storage -import HBS2.Peer.RPC.Client.StorageClient -import HBS2.Storage.Operations.Missed - --- move to Data.Config.Suckless.Script.Filea sepatate library import HBS2.Data.Log.Structured import HBS2.CLI.Run.Internal.Merkle (getTreeContents) -import HBS2.CLI.Run.RefLog (getCredentialsForReflog,mkRefLogUpdateFrom) import HBS2.System.Dir -import HBS2.Git3.Types -import HBS2.Git3.Config.Local import HBS2.Git3.Git import HBS2.Git3.Export import HBS2.Git3.Import @@ -26,79 +14,35 @@ import HBS2.Git3.State import HBS2.Git3.Repo qualified as Repo import Data.Config.Suckless.Script -import Data.Config.Suckless.Almost.RPC -import Codec.Compression.Zstd.Streaming qualified as ZstdS -import Codec.Compression.Zstd.Streaming (Result(..)) import Codec.Compression.Zstd.Lazy qualified as ZstdL import Codec.Compression.Zlib qualified as Zlib import Data.HashPSQ qualified as HPSQ -import Data.HashPSQ (HashPSQ) import Data.Maybe -import Data.List qualified as L -import Data.List (sortBy) -import Data.List.Split (chunksOf) import Data.ByteString.Lazy.Char8 qualified as LBS8 import Data.ByteString.Lazy qualified as LBS import Data.ByteString qualified as BS -import Data.ByteString.Char8 qualified as BS8 -import Data.ByteString.Lazy ( ByteString ) -import Data.ByteString.Builder as Builder import Network.ByteOrder qualified as N -import Data.Text qualified as T -import Data.Text.Encoding qualified as TE -import Data.Text.Encoding.Error qualified as TE import Text.InterpolatedString.Perl6 (qc) -import Data.Set qualified as Set import Data.HashSet qualified as HS -import Data.HashSet (HashSet(..)) -import Data.HashMap.Strict qualified as HM -import Data.HashMap.Strict (HashMap(..)) -import Data.Word +import Data.HashSet (HashSet) import Data.Fixed -import Data.Either -import Data.Ord (comparing) -import Data.Generics.Labels -import Data.Generics.Product import Lens.Micro.Platform import Streaming.Prelude qualified as S import System.Exit qualified as Q -import System.Environment qualified as E -import System.Process.Typed -import Control.Monad.State qualified as State -import Control.Monad.Trans.Writer.CPS qualified as Writer import Control.Concurrent.STM qualified as STM import System.Directory (setCurrentDirectory) -import System.Random hiding (next) -import System.IO.MMap (mmapFileByteString) -import System.IO qualified as IO -import System.IO (hPrint,hPutStrLn,hPutStr) -import System.IO.Temp as Temp import System.TimeIt - -import Data.Vector qualified as Vector -import Data.Vector.Algorithms.Search qualified as MV +import System.IO (hPrint) import UnliftIO.Concurrent -import UnliftIO.IO.File qualified as UIO - -import Control.Monad.ST -import Data.BloomFilter qualified as Bloom -import Data.BloomFilter.Mutable qualified as MBloom - -import Crypto.Hash qualified as C - theDict :: forall m . ( HBS2GitPerks m - -- , HasClientAPI PeerAPI UNIX m - -- , HasStorage m - -- , HasGitRemoteKey m - -- , HasStateDB m ) => Dict C (Git3 m) theDict = do makeDict @C do @@ -232,45 +176,6 @@ theDict = do liftIO $ print $ "object" <+> pretty h <+> pretty s - entry $ bindMatch "test:git:log:list:refs" $ nil_ $ \syn -> do - let (_, argz) = splitOpts [] syn - - let fs = [fn | StringLike fn <- argz] - - for_ fs $ \f -> do - lbs <- liftIO$ LBS.readFile f - runConsumeLBS (ZstdL.decompress lbs) $ readLogFileLBS () $ \h s lbs -> do - let (sign,rest) = LBS.splitAt 1 lbs - - let tp = fromStringMay @(Short SegmentObjectType) (LBS8.unpack sign) - - case tp of - Just (Short RefObject) -> do - liftIO $ LBS.hPutStr stdout rest - - _ -> pure () - - entry $ bindMatch "test:git:log:index:flat:dump" $ nil_ $ \syn -> lift do - let (_, argz) = splitOpts [] syn - fname <- headMay [ x | StringLike x <- argz] & orThrowUser "no file" - - bs <- liftIO $ mmapFileByteString fname Nothing - - runConsumeBS bs $ flip fix 0 \go n -> do - done <- noBytesLeft - if done then pure () - else do - ssize <- readBytesMaybe 4 - >>= orThrow SomeReadLogError - <&> fromIntegral . N.word32 . LBS.toStrict - - hash <- readBytesMaybe 20 - >>= orThrow SomeReadLogError - <&> GitHash . LBS.toStrict - - liftIO $ print $ pretty hash <+> pretty ssize - go (succ n) - entry $ bindMatch "test:reflog:index:search:binary:test:2" $ nil_ $ const $ lift do r <- newTQueueIO idx <- openIndex @@ -363,17 +268,6 @@ theDict = do for_ trees $ \tree -> do writeAsGitPack dir tree - - entry $ bindMatch "reflog:index:count:missed" $ nil_ $ const $ lift $ flip runContT pure do - - hashes <- gitRunCommand [qc|git rev-list --all --objects|] - >>= orThrowPassIO - <&> LBS8.lines - <&> mapMaybe (fromStringMay @GitHash . LBS8.unpack) - - for_ hashes $ \h -> do - liftIO $ print $ pretty h - entry $ bindMatch "reflog:index:list:fast" $ nil_ $ const $ lift $ connectedDo do files <- listObjectIndexFiles forConcurrently_ files $ \(f,_) -> do @@ -600,26 +494,6 @@ theDict = do entry $ bindMatch "repo:init" $ nil_ $ \syn -> lift $ connectedDo do Repo.initRepo syn - -- conf <- getConfigRootFile - -- mbKey <- getGitRepoKey - - -- case mbKey of - -- Nothing -> do - - -- notice "TODO: 1. create new key" - -- notice "TODO: 4. subscribe lwwref" - - -- answ <- callProc "hbs2-cli" [] [mkSym "hbs2:lwwref:create"] - - -- pk <- [ puk | ListVal [SymbolVal "pk", SignPubKeyLike puk] <- answ ] - -- & lastMay - -- & orThrowUser "failed to create new lww ref" - - -- liftIO $ print $ pretty (AsBase58 pk) - - -- notice "TODO: 2. derive reflog key" - -- notice "TODO: 3. init lwwblock" - -- notice "TODO: 5. subscribe reflog" exportEntries "reflog:"