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

some fixes to migration procedure

This commit is contained in:
voidlizard 2025-06-04 13:56:54 +03:00
parent 3a5a35005e
commit 050914ac7a
1 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
hbs2-peer/app/Migrate.hs
View File

@ -186,6 +186,8 @@ migrate syn = flip runContT pure $ callCC \exit -> do
next next
cnt <- newTVarIO 0
glob ["**/*"] [] b $ \fn -> flip runContT pure $ callCC \next -> do glob ["**/*"] [] b $ \fn -> flip runContT pure $ callCC \next -> do
sz <- liftIO $ getFileSize fn sz <- liftIO $ getFileSize fn
@ -198,7 +200,7 @@ migrate syn = flip runContT pure $ callCC \exit -> do
let hs = nameToHash fn let hs = nameToHash fn
bs <- liftIO $ BS.readFile fn bs <- liftIO $ BS.copy <$> BS.readFile fn
let h = HashRef $ hashObject @HbSync bs let h = HashRef $ hashObject @HbSync bs
unless ( h == hs ) do unless ( h == hs ) do
@ -207,10 +209,22 @@ migrate syn = flip runContT pure $ callCC \exit -> do
placed <- liftIO $ ncqStoragePutBlock ncq (LBS.fromStrict bs) placed <- liftIO $ ncqStoragePutBlock ncq (LBS.fromStrict bs)
flush <- atomically do
n <- readTVar cnt
if n > 1000 then do
writeTVar cnt 0
pure True
else do
modifyTVar cnt succ
pure False
unless ( placed == Just hs ) do unless ( placed == Just hs ) do
err $ red "NCQ write error" <+> pretty fn err $ red "NCQ write error" <+> pretty fn
next True next True
when flush do
liftIO (ncqStorageFlush ncq)
for_ placed $ \hx -> atomically do for_ placed $ \hx -> atomically do
writeTQueue checkQ (Just hx) writeTQueue checkQ (Just hx)
modifyTVar checkN succ modifyTVar checkN succ