diff --git a/hbs2-git3/lib/HBS2/Git3/Export.hs b/hbs2-git3/lib/HBS2/Git3/Export.hs index 18a0e0a4..8e3c0d63 100644 --- a/hbs2-git3/lib/HBS2/Git3/Export.hs +++ b/hbs2-git3/lib/HBS2/Git3/Export.hs @@ -1,7 +1,7 @@ {-# Language UndecidableInstances #-} {-# Language AllowAmbiguousTypes #-} -module HBS2.Git3.Export (exportEntries,export) where +module HBS2.Git3.Export (exportEntries,export,genRefLogUpdate,postNullTx) where import HBS2.Git3.Prelude import HBS2.Git3.State @@ -19,6 +19,7 @@ import HBS2.Git3.Config.Local import Data.Config.Suckless.Script +import Codec.Compression.Zstd qualified as Zstd import Codec.Compression.Zstd.Streaming qualified as ZstdS import Codec.Compression.Zstd.Streaming (Result(..)) import Data.ByteString.Builder as Builder @@ -61,6 +62,20 @@ genRefLogUpdate txraw = do (puk,privk) <- getRepoRefLogCredentials makeRefLogUpdate @L4Proto @'HBS2Basic puk privk txraw +postNullTx :: forall m . MonadUnliftIO m => Git3 m () +postNullTx = do + let nullBs = Zstd.compress 10 mempty & LBS.fromStrict + sto <- getStorage + reflogAPI <- getClientAPI @RefLogAPI @UNIX + + href <- createTreeWithMetadata sto Nothing mempty nullBs >>= orThrowPassIO + + let payload = LBS.toStrict $ serialise (AnnotatedHashRef Nothing href) + tx <- genRefLogUpdate payload + + callRpcWaitMay @RpcRefLogPost (TimeoutSec 2) reflogAPI tx + >>= orThrowUser "rpc timeout" + exportEntries :: forall m . (HBS2GitPerks m) => Id -> MakeDictM C (Git3 m) () exportEntries prefix = do entry $ bindMatch (prefix <> "export") $ nil_ $ \syn -> lift $ connectedDo do diff --git a/hbs2-git3/lib/HBS2/Git3/Repo/Init.hs b/hbs2-git3/lib/HBS2/Git3/Repo/Init.hs index e564c7c0..6b724cff 100644 --- a/hbs2-git3/lib/HBS2/Git3/Repo/Init.hs +++ b/hbs2-git3/lib/HBS2/Git3/Repo/Init.hs @@ -6,6 +6,7 @@ import HBS2.Git3.Prelude import HBS2.Git3.State import HBS2.Git3.Repo.Types import HBS2.Git3.Repo.Tools +import HBS2.Git3.Export import HBS2.System.Dir @@ -194,4 +195,8 @@ initRepo syn = do liftIO $ print $ pretty "added git remote" <+> pretty remoteName <+> pretty remoteVal + when new do + postNullTx + +