factor out resumeVerifyFromOffset

This commit is contained in:
Joey Hess 2024-07-24 09:08:17 -04:00
parent ad945896c9
commit a2d1844292
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 39 additions and 27 deletions

View file

@ -1,6 +1,6 @@
{- verification {- verification
- -
- Copyright 2010-2022 Joey Hess <id@joeyh.name> - Copyright 2010-2024 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -21,6 +21,7 @@ module Annex.Verify (
finishVerifyKeyContentIncrementally, finishVerifyKeyContentIncrementally,
verifyKeyContentIncrementally, verifyKeyContentIncrementally,
IncrementalVerifier(..), IncrementalVerifier(..),
resumeVerifyFromOffset,
tailVerify, tailVerify,
) where ) where
@ -32,6 +33,7 @@ import qualified Types.Backend
import qualified Backend import qualified Backend
import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..)) import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))
import Utility.Hash (IncrementalVerifier(..)) import Utility.Hash (IncrementalVerifier(..))
import Utility.Metered
import Annex.WorkerPool import Annex.WorkerPool
import Types.WorkerPool import Types.WorkerPool
import Types.Key import Types.Key
@ -213,6 +215,41 @@ verifyKeyContentIncrementally verifyconfig k a = do
a miv a miv
snd <$> finishVerifyKeyContentIncrementally miv snd <$> finishVerifyKeyContentIncrementally miv
{- Given a file handle that is open for reading (and likely also for writing),
- and an offset, feeds the current content of the file up to the offset to
- the IncrementalVerifier. Leaves the file seeked to the offset.
- Also updates the meter to the offset. -}
resumeVerifyFromOffset
:: Integer
-> Maybe IncrementalVerifier
-> MeterUpdate
-> Handle
-> IO MeterUpdate
resumeVerifyFromOffset o incrementalverifier p h
| o /= 0 = do
p' <- case incrementalverifier of
Just iv -> do
go iv o
return p
_ -> return $ offsetMeterUpdate p (toBytesProcessed o)
-- Make sure the handle is seeked to the offset.
-- (Reading the file probably left it there
-- when that was done, but let's be sure.)
hSeek h AbsoluteSeek o
return p'
| otherwise = return p
where
go iv n
| n == 0 = return ()
| otherwise = do
let c = if n > fromIntegral defaultChunkSize
then defaultChunkSize
else fromIntegral n
b <- S.hGet h c
updateIncrementalVerifier iv b
unless (b == S.empty) $
go iv (n - fromIntegral (S.length b))
-- | Runs a writer action that retrieves to a file. In another thread, -- | Runs a writer action that retrieves to a file. In another thread,
-- reads the file as it grows, and feeds it to the incremental verifier. -- reads the file as it grows, and feeds it to the incremental verifier.
-- --

View file

@ -191,37 +191,12 @@ runLocal runst runner a = case a of
-- a client. -- a client.
Client _ -> ta nullMeterUpdate Client _ -> ta nullMeterUpdate
resumefromoffset o incrementalverifier p h
| o /= 0 = do
p' <- case incrementalverifier of
Just iv -> do
go iv o
return p
_ -> return $ offsetMeterUpdate p (toBytesProcessed o)
-- Make sure the handle is seeked to the offset.
-- (Reading the file probably left it there
-- when that was done, but let's be sure.)
hSeek h AbsoluteSeek o
return p'
| otherwise = return p
where
go iv n
| n == 0 = return ()
| otherwise = do
let c = if n > fromIntegral defaultChunkSize
then defaultChunkSize
else fromIntegral n
b <- S.hGet h c
updateIncrementalVerifier iv b
unless (b == S.empty) $
go iv (n - fromIntegral (S.length b))
storefile dest (Offset o) (Len l) getb incrementalverifier validitycheck p ti = do storefile dest (Offset o) (Len l) getb incrementalverifier validitycheck p ti = do
v <- runner getb v <- runner getb
case v of case v of
Right b -> do Right b -> do
liftIO $ withBinaryFile dest ReadWriteMode $ \h -> do liftIO $ withBinaryFile dest ReadWriteMode $ \h -> do
p' <- resumefromoffset o incrementalverifier p h p' <- resumeVerifyFromOffset o incrementalverifier p h
let writechunk = case incrementalverifier of let writechunk = case incrementalverifier of
Nothing -> \c -> S.hPut h c Nothing -> \c -> S.hPut h c
Just iv -> \c -> do Just iv -> \c -> do