mirror of https://github.com/voidlizard/hbs2
wip, null tx for repo init
This commit is contained in:
parent
148aa69533
commit
c38bf86c93
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue