This commit is contained in:
voidlizard 2025-01-30 13:05:56 +03:00
parent 7b7e44414f
commit a3bffd2f00
3 changed files with 24 additions and 2 deletions

View File

@ -135,6 +135,8 @@ export mbh refs = withStateDo do
reflog <- getGitRemoteKey reflog <- getGitRemoteKey
>>= orThrowUser "reflog not set" >>= orThrowUser "reflog not set"
gk' <- getGK
lift $ fix \next -> atomically (readTBQueue hbs2Q) >>= \case lift $ fix \next -> atomically (readTBQueue hbs2Q) >>= \case
Nothing -> none Nothing -> none
Just (fn,_) -> void $ flip runContT pure do Just (fn,_) -> void $ flip runContT pure do
@ -143,14 +145,16 @@ export mbh refs = withStateDo do
ts <- liftIO getPOSIXTime <&> round ts <- liftIO getPOSIXTime <&> round
lbs <- LBS.readFile fn lbs <- LBS.readFile fn
let meta = mempty let meta = mempty
let gk = Nothing
exported <- readTVarIO _exported exported <- readTVarIO _exported
debug $ red "EXPORTED" <+> pretty exported debug $ red "EXPORTED" <+> pretty exported
let gkh = fst <$> gk'
let gk = snd <$> gk'
when (exported > 0) do when (exported > 0) do
href <- createTreeWithMetadata sto gk meta lbs >>= orThrowPassIO href <- createTreeWithMetadata sto gk meta lbs >>= orThrowPassIO
writeLogEntry ("tree" <+> pretty ts <+> pretty href) writeLogEntry ("tree" <+> pretty ts <+> pretty href )
debug $ "SENDING" <+> pretty href <+> pretty fn debug $ "SENDING" <+> pretty href <+> pretty fn
let payload = LBS.toStrict $ serialise (AnnotatedHashRef Nothing href) let payload = LBS.toStrict $ serialise (AnnotatedHashRef Nothing href)

View File

@ -14,6 +14,7 @@ import HBS2.Git3.State
import HBS2.Git3.Repo qualified as Repo import HBS2.Git3.Repo qualified as Repo
import HBS2.Git3.Repo import HBS2.Git3.Repo
import HBS2.Git3.Logger import HBS2.Git3.Logger
import HBS2.Net.Auth.GroupKeySymm
import Data.Config.Suckless.Script import Data.Config.Suckless.Script
import Data.Config.Suckless.Almost.RPC import Data.Config.Suckless.Almost.RPC
@ -440,6 +441,12 @@ compression ; prints compression level
(p,_) <- getRepoRefLogCredentials (p,_) <- getRepoRefLogCredentials
liftIO $ print $ pretty $ mkForm @C "matched" [mkSym (show $ pretty ( AsBase58 p) )] liftIO $ print $ pretty $ mkForm @C "matched" [mkSym (show $ pretty ( AsBase58 p) )]
entry $ bindMatch "repo:gk" $ nil_ $ \syn -> lift $ connectedDo $ do
resolveRepoKeyThrow syn >>= setGitRepoKey
gk' <- getGK
for_ gk' $ \(gkh, _) -> do
liftIO $ print $ pretty $ mkForm @C "gk" [ mkSym (show $ pretty gkh) ]
entry $ bindMatch "repo:init" $ nil_ $ \syn -> lift $ connectedDo do entry $ bindMatch "repo:init" $ nil_ $ \syn -> lift $ connectedDo do
Repo.initRepo syn Repo.initRepo syn

View File

@ -15,6 +15,8 @@ import HBS2.Git3.State.Internal.RefLog as Exported
import HBS2.Git3.State.Internal.Segment as Exported import HBS2.Git3.State.Internal.Segment as Exported
import HBS2.Git3.State.Internal.Index as Exported import HBS2.Git3.State.Internal.Index as Exported
import HBS2.Net.Auth.GroupKeySymm
import HBS2.Storage.Operations.Missed import HBS2.Storage.Operations.Missed
import HBS2.Net.Auth.Credentials import HBS2.Net.Auth.Credentials
import HBS2.KeyMan.Keys.Direct import HBS2.KeyMan.Keys.Direct
@ -44,6 +46,15 @@ import Codec.Compression.Zstd (maxCLevel)
newtype RepoManifest = RepoManifest [Syntax C] newtype RepoManifest = RepoManifest [Syntax C]
-- FIXME: cache
getGK :: forall m . HBS2GitPerks m => Git3 m (Maybe (HashRef, GroupKey 'Symm 'HBS2Basic))
getGK = do
sto <- getStorage
mf <- getRepoManifest
runMaybeT do
gkh <- headMay [ x | ListVal [SymbolVal "gk", HashLike x ] <- coerce mf ] & toMPlus
gk <- loadGroupKeyMaybe sto gkh >>= toMPlus
pure (gkh,gk)
getRefLog :: RepoManifest -> Maybe GitRemoteKey getRefLog :: RepoManifest -> Maybe GitRemoteKey
getRefLog mf = lastMay [ x getRefLog mf = lastMay [ x