wip, null tx for repo init

This commit is contained in:
voidlizard 2025-01-30 13:42:51 +03:00
parent 148aa69533
commit c38bf86c93
2 changed files with 21 additions and 1 deletions

View File

@ -1,7 +1,7 @@
{-# Language UndecidableInstances #-} {-# Language UndecidableInstances #-}
{-# Language AllowAmbiguousTypes #-} {-# 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.Prelude
import HBS2.Git3.State import HBS2.Git3.State
@ -19,6 +19,7 @@ import HBS2.Git3.Config.Local
import Data.Config.Suckless.Script 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 qualified as ZstdS
import Codec.Compression.Zstd.Streaming (Result(..)) import Codec.Compression.Zstd.Streaming (Result(..))
import Data.ByteString.Builder as Builder import Data.ByteString.Builder as Builder
@ -61,6 +62,20 @@ genRefLogUpdate txraw = do
(puk,privk) <- getRepoRefLogCredentials (puk,privk) <- getRepoRefLogCredentials
makeRefLogUpdate @L4Proto @'HBS2Basic puk privk txraw 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 :: forall m . (HBS2GitPerks m) => Id -> MakeDictM C (Git3 m) ()
exportEntries prefix = do exportEntries prefix = do
entry $ bindMatch (prefix <> "export") $ nil_ $ \syn -> lift $ connectedDo do entry $ bindMatch (prefix <> "export") $ nil_ $ \syn -> lift $ connectedDo do

View File

@ -6,6 +6,7 @@ import HBS2.Git3.Prelude
import HBS2.Git3.State import HBS2.Git3.State
import HBS2.Git3.Repo.Types import HBS2.Git3.Repo.Types
import HBS2.Git3.Repo.Tools import HBS2.Git3.Repo.Tools
import HBS2.Git3.Export
import HBS2.System.Dir import HBS2.System.Dir
@ -194,4 +195,8 @@ initRepo syn = do
liftIO $ print $ pretty "added git remote" <+> pretty remoteName <+> pretty remoteVal liftIO $ print $ pretty "added git remote" <+> pretty remoteName <+> pretty remoteVal
when new do
postNullTx