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:
parent
26c54d6ea3
commit
554b307931
2 changed files with 15 additions and 9 deletions
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue