From 10ff2ceaff23638dd5e27c81aaae43af9a1600b0 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Fri, 17 Jan 2025 07:47:17 +0300 Subject: [PATCH] wip, refs calculation --- hbs2-git3/app/Main.hs | 52 +++++++++++++------- hbs2-git3/lib/HBS2/Git3/Prelude.hs | 1 + hbs2-git3/lib/HBS2/Git3/State/Index.hs | 63 +++++++++++++++++++++++++ hbs2-git3/lib/HBS2/Git3/State/RefLog.hs | 9 +++- 4 files changed, 107 insertions(+), 18 deletions(-) diff --git a/hbs2-git3/app/Main.hs b/hbs2-git3/app/Main.hs index 21cc3c97..39ede6b6 100644 --- a/hbs2-git3/app/Main.hs +++ b/hbs2-git3/app/Main.hs @@ -17,6 +17,7 @@ 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 @@ -52,6 +53,7 @@ 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 @@ -81,7 +83,7 @@ import System.Directory (setCurrentDirectory) import System.Random hiding (next) import System.IO.MMap (mmapFileByteString) import System.IO qualified as IO -import System.IO (hPrint) +import System.IO (hPrint,hPutStrLn,hPutStr) import System.IO.Temp as Temp import System.TimeIt @@ -889,7 +891,11 @@ theDict = do forM_ decoded print - entry $ bindMatch "reflog:import:pack" $ nil_ $ \syn -> lift $ connectedDo do + entry $ bindMatch "reflog:refs" $ nil_ $ \syn -> lift $ connectedDo do + rrefs <- importedRefs + liftIO $ print $ pretty rrefs + + entry $ bindMatch "reflog:import" $ nil_ $ \syn -> lift $ connectedDo do updateReflogIndex packs <- findGitDir @@ -898,11 +904,11 @@ theDict = do state <- getStatePathM + sto <- getStorage + let imported = state "imported" - prev <- runMaybeT do - f <- liftIO (try @_ @IOError (readFile imported)) >>= toMPlus - toMPlus (fromStringMay @HashRef f) + prev <- importedCheckpoint excl <- maybe1 prev (pure mempty) $ \p -> do txListAll (Just p) <&> HS.fromList . fmap fst @@ -911,20 +917,34 @@ theDict = do hxs <- txList ( pure . not . flip HS.member excl ) rv - forConcurrently_ hxs $ \case - (_, TxCheckpoint{}) -> none - (h, TxSegment tree) -> do - s <- writeAsGitPack packs tree + cp' <- flip fix (fmap snd hxs, Nothing) $ \next -> \case + ([], r) -> pure (gitTxTree <$> r) + (TxSegment{}:xs, l) -> next (xs, l) + (cp@(TxCheckpoint n tree) : xs, l) -> do + full <- findMissedBlocks sto tree <&> L.null + if full && Just n > (getGitTxRank <$> l) then do + next (xs, Just cp) + else do + next (xs, l) - for_ s $ \file -> do - gitRunCommand [qc|git index-pack {file}|] - >>= orThrowPassIO + void $ runMaybeT do + cp <- toMPlus cp' + notice $ "found checkpoint" <+> pretty cp + txs <- lift $ txList ( pure . not . flip HS.member excl ) (Just cp) - notice $ "imported" <+> pretty h + lift do + forConcurrently_ txs $ \case + (_, TxCheckpoint{}) -> none + (h, TxSegment tree) -> do + s <- writeAsGitPack packs tree - for_ rv $ \r -> do - liftIO $ UIO.withBinaryFileAtomic imported WriteMode $ \fh -> do - IO.hPutStr fh (show $ pretty r) + for_ s $ \file -> do + gitRunCommand [qc|git index-pack {file}|] + >>= orThrowPassIO + + notice $ "imported" <+> pretty h + + updateImportedCheckpoint cp exportEntries "reflog:" diff --git a/hbs2-git3/lib/HBS2/Git3/Prelude.hs b/hbs2-git3/lib/HBS2/Git3/Prelude.hs index fa5cc778..b1747afb 100644 --- a/hbs2-git3/lib/HBS2/Git3/Prelude.hs +++ b/hbs2-git3/lib/HBS2/Git3/Prelude.hs @@ -49,6 +49,7 @@ import Data.HashSet qualified as HS import Data.Kind import System.Exit qualified as Q import System.IO.MMap as Exported +import System.FilePattern as Exported import GHC.Natural as Exported import UnliftIO as Exported diff --git a/hbs2-git3/lib/HBS2/Git3/State/Index.hs b/hbs2-git3/lib/HBS2/Git3/State/Index.hs index fad6fe69..f325becd 100644 --- a/hbs2-git3/lib/HBS2/Git3/State/Index.hs +++ b/hbs2-git3/lib/HBS2/Git3/State/Index.hs @@ -11,6 +11,7 @@ import HBS2.Git3.Git import HBS2.Data.Log.Structured import Data.ByteString qualified as BS +import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Lazy ( ByteString ) import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Lazy.Char8 qualified as LBS8 @@ -32,6 +33,8 @@ import Data.Word import Data.Config.Suckless import Data.Config.Suckless.Script.File +import System.IO (hPrint) + import Streaming.Prelude qualified as S import System.TimeIt @@ -378,3 +381,63 @@ updateReflogIndex = do UIO.withBinaryFileAtomic name WriteMode $ \wh -> do for_ es $ \s -> LBS8.hPutStrLn wh s + +importedCheckpoint :: forall m . ( Git3Perks m + , MonadReader Git3Env m + , HasClientAPI RefLogAPI UNIX m + , HasStorage m + ) => m (Maybe HashRef) + +importedCheckpoint = do + state <- getStatePathM + let imported = state "imported" + runMaybeT do + f <- liftIO (try @_ @IOError (readFile imported)) >>= toMPlus + toMPlus (fromStringMay @HashRef f) + +{- HLINT ignore "Functor law"-} +importedRefs :: forall m . ( Git3Perks m + , MonadReader Git3Env m + , HasClientAPI RefLogAPI UNIX m + , HasStorage m + ) => m [(GitRef, GitHash)] + +importedRefs = do + + state <- getStatePathM + + refs <- dirFiles state + <&> filter ( (== ".ref") . takeExtension ) + >>= mapM (try @_ @IOError . liftIO . readFile) + <&> unlines . rights + <&> parseTop + <&> fromRight mempty + + txh <- maybe mempty HS.fromList <$> runMaybeT do + cp <- lift importedCheckpoint >>= toMPlus + fmap fst <$> lift (txListAll (Just cp)) + + let rrefs = [ (n,((GitRef (BS8.pack n),g),r)) + | ListVal [ SymbolVal "R" + , HashLike th + , LitIntVal r + , GitHashLike g + , StringLike n ] <- refs + , HS.member th txh + ] & HM.fromListWith (\(a,t1) (b,t2) -> if t1 > t2 then (a,t1) else (b,t2)) + & fmap fst . HM.elems + + pure rrefs + +updateImportedCheckpoint :: forall m . ( Git3Perks m + , MonadReader Git3Env m + , HasClientAPI RefLogAPI UNIX m + , HasStorage m + ) => HashRef -> m () + +updateImportedCheckpoint cp = do + state <- getStatePathM + let imported = state "imported" + liftIO $ UIO.withBinaryFileAtomic imported WriteMode $ \fh -> do + hPrint fh (show $ pretty cp) + diff --git a/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs b/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs index c8b468bf..e746fcd1 100644 --- a/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs +++ b/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs @@ -8,8 +8,13 @@ import Data.Maybe import Streaming.Prelude qualified as S data GitTx = - TxSegment HashRef - | TxCheckpoint Natural HashRef + TxSegment { gitTxTree :: HashRef } + | TxCheckpoint { gitTxRank :: Natural, gitTxTree :: HashRef } + +getGitTxRank :: GitTx -> Natural +getGitTxRank = \case + TxSegment _ -> 0 + TxCheckpoint n _ -> n data RefLogException = RefLogRPCException