diff --git a/docs/devlog.md b/docs/devlog.md index c6a34fb1..bdaef89a 100644 --- a/docs/devlog.md +++ b/docs/devlog.md @@ -1,5 +1,7 @@ ## 2023-10-12 +... + PR: hbs2-file-logger branch: fastpok-file-logger commit: e411e292461179a83a5fc0a0d78f98233c7323f9 diff --git a/hbs2-git/lib/HBS2Git/App.hs b/hbs2-git/lib/HBS2Git/App.hs index 51cedf74..2d2a7857 100644 --- a/hbs2-git/lib/HBS2Git/App.hs +++ b/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 diff --git a/hbs2-git/lib/HBS2Git/Export.hs b/hbs2-git/lib/HBS2Git/Export.hs index 213760a9..b978336d 100644 --- a/hbs2-git/lib/HBS2Git/Export.hs +++ b/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 diff --git a/hbs2-git/lib/HBS2Git/Import.hs b/hbs2-git/lib/HBS2Git/Import.hs index 4d042dcb..8b721865 100644 --- a/hbs2-git/lib/HBS2Git/Import.hs +++ b/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) diff --git a/hbs2-git/lib/HBS2Git/KeysMetaData.hs b/hbs2-git/lib/HBS2Git/KeysMetaData.hs index d91817e3..41a40c79 100644 --- a/hbs2-git/lib/HBS2Git/KeysMetaData.hs +++ b/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 diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs index f996d3a8..b154bda7 100644 --- a/hbs2-peer/app/BlockDownload.hs +++ b/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) diff --git a/hbs2-peer/app/RefLog.hs b/hbs2-peer/app/RefLog.hs index b73edbfa..30055d32 100644 --- a/hbs2-peer/app/RefLog.hs +++ 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 ()