bugfix

docs/devlog.md

@@ -1,5 +1,7 @@
 ## 2023-10-12
 
+...
+
 PR: hbs2-file-logger
   branch: fastpok-file-logger
   commit: e411e292461179a83a5fc0a0d78f98233c7323f9

hbs2-git/lib/HBS2Git/App.hs

@@ -338,7 +338,6 @@ postRefUpdate :: ( MonadIO m
               -> m ()
 
 postRefUpdate ref seqno hash = do
-  info $ "refPostUpdate"  <+> pretty seqno <+> pretty hash
 
   cred <- getCredentials ref
   let pubk = view peerSignPk cred

hbs2-git/lib/HBS2Git/Export.hs

@@ -258,7 +258,12 @@ writeLogSegments onProgress repo val objs chunkSize trailing = do
       trace $ "PUSH LOG HASH: " <+> pretty logMerkle
       trace $ "POSTING REFERENCE UPDATE TRANSACTION" <+> pretty remote <+> pretty logMerkle
 
-      lift $ postRefUpdate remote 0 logMerkle
+
+      r <- fromMaybe 0 <$> runMaybeT do
+              h <- MaybeT $ readRef remote
+              calcRank h <&> fromIntegral
+
+      lift $ postRefUpdate remote r logMerkle
 
       pure logMerkle
 

hbs2-git/lib/HBS2Git/Import.hs

@@ -168,15 +168,25 @@ importRefLogNew opts ref = runResourceT do
       sp0 <- withDB db savepointNew
       withDB db $ savepointBegin sp0
 
-      -- TODO: scan-metadata-transactions-first
-      --   Сканируем транзы, обрабатываем транзакции с метаданными
-      --   Пишем транзакции с журналами, что бы обрабатывались следующим
-      --   проходом только они. Таким образом не меняется сложность.
-
       decrypt <- lift enumEncryptionKeys
 
       debug $ "Decrypt" <> vcat (fmap pretty decrypt)
 
+      pMeta  <- newProgressMonitor [qc|process metadata|]  (length entries)
+
+      forM_ entries $ \e -> runMaybeT do
+        let kDone = serialise ("processmetadata", e)
+
+        updateProgress pMeta 1
+
+        -- guard =<< withDB db (not <$> stateGetProcessed kDone)
+
+        rd <- toMPlus =<< parseRef e
+        let (SequentialRef _ (AnnotatedHashRef ann' h)) = rd
+        forM_ ann' (withDB db . importKeysAnnotations ref e)
+
+        -- withDB db $ statePutProcessed kDone
+
       -- TODO: exclude-metadata-transactions
       forM_ entries $ \e -> do
 
@@ -191,14 +201,12 @@ importRefLogNew opts ref = runResourceT do
         (keyFh, fh) <- allocate (openBinaryFile fpath AppendMode) hClose
 
         runMaybeT $ do
-          bs <- MaybeT $ lift $ readBlock e
-          refupd <- toMPlus $ deserialiseOrFail @(RefLogUpdate HBS2L4Proto) bs
-          payload <- toMPlus $ deserialiseOrFail (LBS.fromStrict $ view refLogUpdData refupd)
 
+          refData <- toMPlus =<< parseRef e
           -- NOTE: good-place-to-process-hash-log-update-first
-          let (SequentialRef _ (AnnotatedHashRef ann' h)) = payload
+          let (SequentialRef _ (AnnotatedHashRef ann' h)) = refData
 
-          forM_ ann' (withDB db . importKeysAnnotations ref e)
+          -- forM_ ann' (withDB db . importKeysAnnotations ref e)
 
           trace $ "PUSH LOG HASH" <+> pretty h
 
@@ -356,6 +364,11 @@ importRefLogNew opts ref = runResourceT do
 
   where
 
+    parseRef e = runMaybeT do
+      bs <- MaybeT $ readBlock e
+      refupd <- toMPlus $ deserialiseOrFail @(RefLogUpdate HBS2L4Proto) bs
+      toMPlus $ deserialiseOrFail (LBS.fromStrict $ view refLogUpdData refupd)
+
     writeIfNew gitHandle dir h (GitObject tp s) = do
       unless (importDontWriteGit opts) do
         let nf = dir </> show (pretty h)

hbs2-git/lib/HBS2Git/KeysMetaData.hs

@@ -242,10 +242,9 @@ importKeysAnnotations :: forall m . ( MonadIO m
 
 importKeysAnnotations repo e href = do
   sto <- lift getStorage
-  -- db <- makeDbPath repo >>= dbEnv
   void $ runMaybeT do
-    -- liftIO $ hPutDoc stderr $ "GOT ANNOTATION" <+> pretty e <+> pretty href <> line
     ebs <- runExceptT $ readFromMerkle sto (SimpleKey (fromHashRef href))
+
     bs <- toMPlus ebs
 
     anns <- toMPlus $ deserialiseOrFail @Annotations bs
@@ -257,8 +256,6 @@ importKeysAnnotations repo e href = do
 
     forM_ entries $ \(GK1 gk0h gk1) -> do
 
-      -- liftIO $ hPutDoc stderr $ "IMPORTING GK1 FOR" <+> pretty gk0h <> line
-
       forM_ (HashMap.toList (recipients gk1)) $ \(pk,box) -> do
         let gk1small = GroupKeySymm @HBS2Basic (HashMap.singleton pk box)
         lift $ statePutGK1 gk0h pk gk1small

hbs2-peer/app/BlockDownload.hs

@@ -142,7 +142,8 @@ processBlock h = do
 
      Just (SeqRef (SequentialRef n (AnnotatedHashRef a' b))) -> do
       maybe1 a' none $ \a -> do
-        addDownload parent (fromHashRef a)
+        debug $ "GOT AnnotatedHashRef" <+> pretty a
+        addDownload mzero (fromHashRef a)
 
       addDownload parent (fromHashRef b)
 

hbs2-peer/app/RefLog.hs

@@ -140,12 +140,14 @@ reflogWorker conf adapter = do
           let bss = view refLogUpdData tran
           let what = tryDetect (hashObject bss) (LBS.fromStrict bss)
           case what of
-            SeqRef (SequentialRef _ (AnnotatedHashRef _ ref)) -> do
+            SeqRef (SequentialRef _ (AnnotatedHashRef ann ref)) -> do
               liftIO $ reflogDownload adapter (fromHashRef ref)
+              liftIO $ forM_ ann (reflogDownload adapter . fromHashRef)
 
             -- TODO: asap-download-annotation-as-well
-            AnnRef (AnnotatedHashRef _ ref) -> do
+            AnnRef (AnnotatedHashRef ann  ref) -> do
               liftIO $ reflogDownload adapter (fromHashRef ref)
+              liftIO $ forM_ ann (reflogDownload adapter . fromHashRef)
 
             -- TODO: support-other-data-structures
             _ -> pure ()