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

new encrypted repo push bugfix

This commit is contained in:
Dmitry Zuikov 2023-10-16 17:12:28 +03:00
parent b7d0e1730d
commit 3be12d8304
2 changed files with 8 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -130,12 +130,6 @@ loop args = do
checkRef <- readRef ref <&> isJust checkRef <- readRef ref <&> isJust
unless checkRef do
warn $ "reference" <+> pretty ref <+> "missing"
warn "trying to init reference --- may be it's ours"
liftIO $ runApp WithLog (runExport Nothing ref)
importRefLogNew True ref
let getHeads upd = do let getHeads upd = do
when upd do importRefLogNew False ref when upd do importRefLogNew False ref
refsNew <- withDB db stateGetActualRefs refsNew <- withDB db stateGetActualRefs

20
hbs2-git/lib/HBS2Git/Import.hs
View File

@ -52,8 +52,6 @@ import Streaming.Zip qualified as SZip
import HBS2Git.PrettyStuff import HBS2Git.PrettyStuff
import System.Environment
data RunImportOpts = data RunImportOpts =
RunImportOpts RunImportOpts
{ _runImportDry :: Maybe Bool { _runImportDry :: Maybe Bool
@ -76,13 +74,12 @@ findMissedBlocks href = do
walkMerkle (fromHashRef href) (lift . getBlock sto) $ \(hr :: Either (Hash HbSync) [HashRef]) -> do walkMerkle (fromHashRef href) (lift . getBlock sto) $ \(hr :: Either (Hash HbSync) [HashRef]) -> do
case hr of case hr of
-- FIXME: investigate-this-wtf -- FIXME: investigate-this-wtf
Left{} -> pure () -- err ("ONE" <+> pretty hx) >> S.yield (HashRef hx) Left{} -> pure ()
Right (hrr :: [HashRef]) -> do Right (hrr :: [HashRef]) -> do
forM_ hrr $ \hx -> runMaybeT do forM_ hrr $ \hx -> runMaybeT do
blk <- lift $ getBlock sto (fromHashRef hx) blk <- lift $ getBlock sto (fromHashRef hx)
unless (isJust blk) do unless (isJust blk) do
-- err $ "TWO" <+> pretty hx
lift $ S.yield hx lift $ S.yield hx
maybe1 blk none $ \bs -> do maybe1 blk none $ \bs -> do
@ -177,9 +174,9 @@ importRefLogNew opts ref = runResourceT do
db <- makeDbPath ref >>= dbEnv db <- makeDbPath ref >>= dbEnv
do void $ runMaybeT do
trace $ "importRefLogNew" <+> pretty ref trace $ "importRefLogNew" <+> pretty ref
logRoot <- lift $ readRef ref `orDie` [qc|can't read ref {pretty ref}|] logRoot <- toMPlus =<< readRef ref
trace $ "ROOT" <+> pretty logRoot trace $ "ROOT" <+> pretty logRoot
trans <- withDB db $ stateGetAllTranImported <&> Set.fromList trans <- withDB db $ stateGetAllTranImported <&> Set.fromList
@ -204,8 +201,7 @@ importRefLogNew opts ref = runResourceT do
if null missed then do if null missed then do
S.yield e S.yield e
else do else do
-- forM_ missed $ \m -> do trace $ "missed blocks in tree" <+> pretty e -- <+> pretty m
err $ "missed blocks in tree" <+> pretty e -- <+> pretty m
pCommit <- liftIO $ startGitHashObject Commit pCommit <- liftIO $ startGitHashObject Commit
pTree <- liftIO $ startGitHashObject Tree pTree <- liftIO $ startGitHashObject Tree
@ -220,7 +216,7 @@ importRefLogNew opts ref = runResourceT do
sp0 <- withDB db savepointNew sp0 <- withDB db savepointNew
withDB db $ savepointBegin sp0 withDB db $ savepointBegin sp0
decrypt <- lift enumEncryptionKeys decrypt <- lift $ lift enumEncryptionKeys
debug $ "Decrypt" <> vcat (fmap pretty decrypt) debug $ "Decrypt" <> vcat (fmap pretty decrypt)
@ -252,7 +248,7 @@ importRefLogNew opts ref = runResourceT do
(keyFh, fh) <- allocate (openBinaryFile fpath AppendMode) hClose (keyFh, fh) <- allocate (openBinaryFile fpath AppendMode) hClose
runMaybeT $ do void $ runMaybeT $ do
refData <- toMPlus =<< parseTx e refData <- toMPlus =<< parseTx e
-- NOTE: good-place-to-process-hash-log-update-first -- NOTE: good-place-to-process-hash-log-update-first
@ -338,11 +334,11 @@ importRefLogNew opts ref = runResourceT do
oMon <- newProgressMonitor name num oMon <- newProgressMonitor name num
lift $ gitRepoLogScan True fpathReal $ \entry s -> do lift $ lift $ gitRepoLogScan True fpathReal $ \entry s -> void $ runMaybeT do
updateProgress oMon 1 updateProgress oMon 1
lbs <- pure s `orDie` [qc|git object not read from log|] lbs <- toMPlus s
withDB db do withDB db do