update progress meter while hashing files

The hash was actually not being fully evaluated before, used rnf to fix
that.

The added dependency on deepseq is a free dependency, because eg text
depends on it.
This commit is contained in:
Joey Hess 2019-06-25 13:10:06 -04:00
parent 26c54d6ea3
commit 554b307931
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 15 additions and 9 deletions

View file

@ -25,6 +25,8 @@ import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.Char
import Control.DeepSeq
import Control.Exception (evaluate)
data Hash
= MD5Hash
@ -88,10 +90,10 @@ hashKeyVariety (Blake2spHash size) he = Blake2spKey size he
{- A key is a hash of its contents. -}
keyValue :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key)
keyValue hash source meterupate = do
keyValue hash source meterupdate = do
let file = contentLocation source
filesize <- liftIO $ getFileSize file
s <- hashFile hash file
s <- hashFile hash file meterupdate
return $ Just $ stubKey
{ keyName = encodeBS s
, keyVariety = hashKeyVariety hash (HasExt False)
@ -134,7 +136,7 @@ checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
case (exists, fast) of
(True, False) -> do
showAction "checksum"
check <$> hashFile hash file
check <$> hashFile hash file nullMeterUpdate
_ -> return True
where
expected = decodeBS (keyHash key)
@ -206,11 +208,14 @@ trivialMigrate' oldkey newbackend afile maxextlen
oldvariety = keyVariety oldkey
newvariety = backendVariety newbackend
hashFile :: Hash -> FilePath -> Annex String
hashFile hash file = liftIO $ do
h <- hasher <$> L.readFile file
-- Force full evaluation so file is read and closed.
return (length h `seq` h)
hashFile :: Hash -> FilePath -> MeterUpdate -> Annex String
hashFile hash file meterupdate =
liftIO $ withMeteredFile file meterupdate $ \b -> do
let h = hasher b
-- Force full evaluation of hash so whole file is read
-- before returning.
evaluate (rnf h)
return h
where
hasher = case hash of
MD5Hash -> md5Hasher

View file

@ -358,6 +358,7 @@ Executable git-annex
crypto-api,
cryptonite,
memory,
deepseq,
split,
attoparsec,
concurrent-output (>= 1.6),
@ -593,7 +594,7 @@ Executable git-annex
CPP-Options: -DWITH_MAGICMIME
if flag(Benchmark)
Build-Depends: criterion, deepseq
Build-Depends: criterion
CPP-Options: -DWITH_BENCHMARK
if flag(DebugLocks)