From e7f4adb9a1d31edadfd155c7c1fcd840285ddb2a Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Tue, 17 Oct 2023 05:14:23 +0300
Subject: [PATCH] fix-empty-pushes

---
 docs/todo/wait-reference-download.txt | 13 +++++++++++
 hbs2-git/lib/HBS2Git/Export.hs        | 33 ++++++++++++++++++++-------
 2 files changed, 38 insertions(+), 8 deletions(-)
 create mode 100644 docs/todo/wait-reference-download.txt

diff --git a/docs/todo/wait-reference-download.txt b/docs/todo/wait-reference-download.txt
new file mode 100644
index 00000000..a039e253
--- /dev/null
+++ b/docs/todo/wait-reference-download.txt
@@ -0,0 +1,13 @@
+TODO: wait-reference-download
+
+  при git glone / git fetch ждать, пока полностью не
+  скачается журнал. сделать это поведением по умолчанию.
+  добавить переменную, которая сделает так, то бы не ждало.
+
+  как сделать: поллить функцию findMissedBlocks  (дорого!),
+  как только вернёт список - ехать дальше.
+
+  как проверить: в процессе работы, или разово закоммитить
+  большой репозиторий, и сразу же склонить в другом месте,
+  что бы был заметный процесс скачивания.
+
diff --git a/hbs2-git/lib/HBS2Git/Export.hs b/hbs2-git/lib/HBS2Git/Export.hs
index b978336d..58ee240f 100644
--- a/hbs2-git/lib/HBS2Git/Export.hs
+++ b/hbs2-git/lib/HBS2Git/Export.hs
@@ -33,7 +33,6 @@ import Control.Monad.Reader
 import Control.Concurrent.STM
 import Data.ByteString.Lazy.Char8 qualified as LBS
 import Data.Foldable (for_)
-import Data.Functor
 import Data.HashMap.Strict qualified as HashMap
 import Data.HashSet qualified as HashSet
 import Data.HashSet (HashSet)
@@ -207,6 +206,10 @@ writeLogSegments onProgress repo val objs chunkSize trailing = do
   --   такое и будет жить всегда
   let compressOpts = defaultCompressParams { compressLevel = bestSpeed }
 
+  rank <- fromMaybe 0 <$> runMaybeT do
+            h <- MaybeT $ readRef remote
+            calcRank h <&> fromIntegral
+
   -- FIXME: fix-code-dup
   let meta = fromString $ show
                         $     "hbs2-git"
@@ -219,7 +222,13 @@ writeLogSegments onProgress repo val objs chunkSize trailing = do
   let segments = chunksOf chunkSize objs
   let totalSegments = length segments
 
-  forM (zip segments [1..]) $ \(segment, segmentIndex) -> do
+  -- TODO: no-sense-in-temp-files
+  --   временные файлы больше не имеют смысла, т.к мы
+  --   1) нарезаем на небольшие сегменты
+  --   2) всё равно их читаем обратно в память, что бы сжать gzip
+  --   нужно удалить, будет работать чуть быстрее
+
+  r <- forM (zip segments [1..]) $ \(segment, segmentIndex) -> do
     let fpath = dir </> fname <> "_" <> show segmentIndex
     bracket (liftIO $ openBinaryFile fpath AppendMode)
             (const $ pure ()) $ \fh -> do
@@ -258,15 +267,23 @@ writeLogSegments onProgress repo val objs chunkSize trailing = do
       trace $ "PUSH LOG HASH: " <+> pretty logMerkle
       trace $ "POSTING REFERENCE UPDATE TRANSACTION" <+> pretty remote <+> pretty logMerkle
 
-
-      r <- fromMaybe 0 <$> runMaybeT do
-              h <- MaybeT $ readRef remote
-              calcRank h <&> fromIntegral
-
-      lift $ postRefUpdate remote r logMerkle
+      lift $ postRefUpdate remote rank logMerkle
 
       pure logMerkle
 
+
+  if not (null r) then do
+    pure r
+  else do
+    let content = foldMap (uncurry (gitRepoLogMakeEntry opts)) trailing
+                   & compressWith compressOpts
+
+    logMerkle <- lift $ storeObject repo meta content `orDie` [qc|Can't store push log|]
+
+    lift $ postRefUpdate remote rank logMerkle
+
+    pure [logMerkle]
+
 -- | Exports only one ref to the repo.
 --   Corresponds to a single ```git push``` operation
 exportRefOnly :: forall  o m . ( MonadIO m