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

View file

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