diff --git a/.fixme/log b/.fixme/log index f63271bd..0d7c95b0 100644 --- a/.fixme/log +++ b/.fixme/log @@ -315,4 +315,5 @@ fixme-del "6JM2L56F8k" fixme-del "FS3sZqqMX3" (fixme-set "workflow" "wip" "As13ga9cvf") (fixme-set "assigned" "voidlizard" "As13ga9cvf") -(fixme-set "workflow" "test" "5JB9TJn4qM") \ No newline at end of file +(fixme-set "workflow" "test" "5JB9TJn4qM") +(fixme-set "workflow" "test" "As13ga9cvf") \ No newline at end of file diff --git a/docs/devlog.md b/docs/devlog.md index 3b03d5fe..f3560b90 100644 --- a/docs/devlog.md +++ b/docs/devlog.md @@ -2,7 +2,7 @@ ## 2023-03-24 -проверка: wip95 +проверка: wip97 TODO: storage-reliable-write Надёжную процедуру записи блока. diff --git a/hbs2-git/git-hbs2/GitRemoteMain.hs b/hbs2-git/git-hbs2/GitRemoteMain.hs index 680f489e..cc396c75 100644 --- a/hbs2-git/git-hbs2/GitRemoteMain.hs +++ b/hbs2-git/git-hbs2/GitRemoteMain.hs @@ -119,9 +119,8 @@ loop args = do hdRefOld <- readHeadDef db - updateLocalState ref - - hd <- readHeadDef db + -- updateLocalState ref + -- hd <- readHeadDef db hashes <- withDB db stateGetAllObjects @@ -170,11 +169,8 @@ loop args = do liftIO $ atomically $ writeTVar batch False -- -- FIXME: wtf -- when isBatch next - if isBatch then do - sendEol - next - else do - updateLocalState ref + sendEol + when isBatch next ["capabilities"] -> do trace $ "send capabilities" <+> pretty (BS.unpack capabilities) @@ -183,6 +179,8 @@ loop args = do ["list"] -> do + updateLocalState ref + hd <- readHeadDef db hl <- liftIO $ readTVarIO jobNumT pb <- newProgressMonitor "storing git objects" hl @@ -217,13 +215,18 @@ loop args = do ["fetch", sha1, x] -> do trace $ "fetch" <+> pretty (BS.unpack sha1) <+> pretty (BS.unpack x) liftIO $ atomically $ writeTVar batch True + sendEol next ["push", rr] -> do let bra = BS.split ':' rr let pu = fmap (fromString' . BS.unpack) bra 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 other -> die $ show other diff --git a/hbs2-git/git-hbs2/GitRemotePush.hs b/hbs2-git/git-hbs2/GitRemotePush.hs index 6a4d38a7..fffb6c82 100644 --- a/hbs2-git/git-hbs2/GitRemotePush.hs +++ b/hbs2-git/git-hbs2/GitRemotePush.hs @@ -61,7 +61,7 @@ push :: forall m . ( MonadIO m , HasProgress (RunWithConfig (GitRemoteApp m)) ) - => RepoRef -> [Maybe GitRef] -> GitRemoteApp m () + => RepoRef -> [Maybe GitRef] -> GitRemoteApp m (Maybe GitRef) push remote [bFrom , Just br] = do @@ -96,6 +96,9 @@ push remote [bFrom , Just br] = do info $ "head:" <+> pretty hh 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