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

fixed As13ga9cvf git-push-always-up-to-date

This commit is contained in:
Dmitry Zuikov 2023-03-24 12:26:04 +03:00
parent 9bd95bf579
commit 3a0d21ebff
4 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.fixme/log
View File

@ -315,4 +315,5 @@ fixme-del "6JM2L56F8k"
fixme-del "FS3sZqqMX3" fixme-del "FS3sZqqMX3"
(fixme-set "workflow" "wip" "As13ga9cvf") (fixme-set "workflow" "wip" "As13ga9cvf")
(fixme-set "assigned" "voidlizard" "As13ga9cvf") (fixme-set "assigned" "voidlizard" "As13ga9cvf")
(fixme-set "workflow" "test" "5JB9TJn4qM") (fixme-set "workflow" "test" "5JB9TJn4qM")
(fixme-set "workflow" "test" "As13ga9cvf")

2
docs/devlog.md
View File

@ -2,7 +2,7 @@
## 2023-03-24 ## 2023-03-24
проверка: wip95 проверка: wip97
TODO: storage-reliable-write TODO: storage-reliable-write
Надёжную процедуру записи блока. Надёжную процедуру записи блока.

21
hbs2-git/git-hbs2/GitRemoteMain.hs
View File

@ -119,9 +119,8 @@ loop args = do
hdRefOld <- readHeadDef db hdRefOld <- readHeadDef db
updateLocalState ref -- updateLocalState ref
-- hd <- readHeadDef db
hd <- readHeadDef db
hashes <- withDB db stateGetAllObjects hashes <- withDB db stateGetAllObjects
@ -170,11 +169,8 @@ loop args = do
liftIO $ atomically $ writeTVar batch False liftIO $ atomically $ writeTVar batch False
-- -- FIXME: wtf -- -- FIXME: wtf
-- when isBatch next -- when isBatch next
if isBatch then do sendEol
sendEol when isBatch next
next
else do
updateLocalState ref
["capabilities"] -> do ["capabilities"] -> do
trace $ "send capabilities" <+> pretty (BS.unpack capabilities) trace $ "send capabilities" <+> pretty (BS.unpack capabilities)
@ -183,6 +179,8 @@ loop args = do
["list"] -> do ["list"] -> do
updateLocalState ref
hd <- readHeadDef db
hl <- liftIO $ readTVarIO jobNumT hl <- liftIO $ readTVarIO jobNumT
pb <- newProgressMonitor "storing git objects" hl pb <- newProgressMonitor "storing git objects" hl
@ -217,13 +215,18 @@ loop args = do
["fetch", sha1, x] -> do ["fetch", sha1, x] -> do
trace $ "fetch" <+> pretty (BS.unpack sha1) <+> pretty (BS.unpack x) trace $ "fetch" <+> pretty (BS.unpack sha1) <+> pretty (BS.unpack x)
liftIO $ atomically $ writeTVar batch True liftIO $ atomically $ writeTVar batch True
sendEol
next next
["push", rr] -> do ["push", rr] -> do
let bra = BS.split ':' rr let bra = BS.split ':' rr
let pu = fmap (fromString' . BS.unpack) bra let pu = fmap (fromString' . BS.unpack) bra
liftIO $ atomically $ writeTVar batch True liftIO $ atomically $ writeTVar batch True
push ref pu pushed <- push ref pu
hPrint stderr (pretty pushed)
case pushed of
Nothing -> sendEol
Just re -> sendLn [qc|ok {pretty re}|]
next next
other -> die $ show other other -> die $ show other

7
hbs2-git/git-hbs2/GitRemotePush.hs
View File

@ -61,7 +61,7 @@ push :: forall m . ( MonadIO m
, HasProgress (RunWithConfig (GitRemoteApp m)) , HasProgress (RunWithConfig (GitRemoteApp m))
) )
=> RepoRef -> [Maybe GitRef] -> GitRemoteApp m () => RepoRef -> [Maybe GitRef] -> GitRemoteApp m (Maybe GitRef)
push remote [bFrom , Just br] = do push remote [bFrom , Just br] = do
@ -96,6 +96,9 @@ push remote [bFrom , Just br] = do
info $ "head:" <+> pretty hh info $ "head:" <+> pretty hh
info $ "merkle:" <+> pretty root info $ "merkle:" <+> pretty root
pure (Just br)
push r w = warn $ "ignoring weird push" <+> pretty w <+> pretty r push r w = do
warn $ "ignoring weird push" <+> pretty w <+> pretty r
pure Nothing