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 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue