voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, export checkpoints

This commit is contained in:
voidlizard 2025-01-15 08:14:10 +03:00
parent bde53133a9
commit be512971d6
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
hbs2-git3/lib/HBS2/Git3/Export.hs
View File

@ -324,8 +324,9 @@ exportEntries prefix = do
) )
=> Timeout 'Seconds => Timeout 'Seconds
-> HashSet HashRef -> HashSet HashRef
-> m1 HashRef -> m1 (Maybe HashRef)
postCheckPoint _ txq | HS.null txq = pure Nothing
postCheckPoint t txq = perform >>= either (const $ throwIO ExportWriteTimeout) pure postCheckPoint t txq = perform >>= either (const $ throwIO ExportWriteTimeout) pure
where where
perform = race (pause t) do perform = race (pause t) do
@ -354,11 +355,13 @@ exportEntries prefix = do
else else
pure x pure x
let payload = pure $ LBS.toStrict $ serialise (AnnotatedHashRef Nothing cp) t0 <- liftIO getPOSIXTime <&> round
let payload = pure $ LBS.toStrict $ serialise (SequentialRef t0 (AnnotatedHashRef Nothing cp))
tx <- mkRefLogUpdateFrom (coerce reflog) payload tx <- mkRefLogUpdateFrom (coerce reflog) payload
callRpcWaitMay @RpcRefLogPost (TimeoutSec 2) api tx callRpcWaitMay @RpcRefLogPost (TimeoutSec 2) api tx
>>= orThrow ExportWriteTimeout >>= orThrow ExportWriteTimeout
pure $ HashRef (hashObject @HbSync (serialise tx)) pure $ Just $ HashRef (hashObject @HbSync (serialise tx))