-- to be used for the other urls.
case iv of
Just iv' ->
- liftIO $ positionIncremental iv' >>= \case
- Just n | n > 0 -> unableIncremental iv'
+ liftIO $ positionIncrementalVerifier iv' >>= \case
+ Just n | n > 0 -> unableIncrementalVerifier iv'
_ -> noop
Nothing -> noop
go us ((u, err) : errs)
fileCopier copycowtried src dest meterupdate iv =
ifM (liftIO $ tryCopyCoW copycowtried src dest meterupdate)
( do
- liftIO $ maybe noop unableIncremental iv
+ liftIO $ maybe noop unableIncrementalVerifier iv
return CopiedCoW
, docopy
)
else do
let sofar' = addBytesProcessed sofar (S.length s)
S.hPut hdest s
- maybe noop (flip updateIncremental s) iv
+ maybe noop (flip updateIncrementalVerifier s) iv
meterupdate sofar'
docopy' hdest hsrc sofar'
s' <- getnoshort (S.length s) hsrc
if s == s'
then do
- maybe noop (flip updateIncremental s) iv
+ maybe noop (flip updateIncrementalVerifier s) iv
let sofar' = addBytesProcessed sofar (S.length s)
meterupdate sofar'
compareexisting hdest hsrc sofar'
Just verifier -> verifier k f
resumeVerifyKeyContent :: Key -> RawFilePath -> IncrementalVerifier -> Annex Bool
-resumeVerifyKeyContent k f iv = liftIO (positionIncremental iv) >>= \case
+resumeVerifyKeyContent k f iv = liftIO (positionIncrementalVerifier iv) >>= \case
Nothing -> fallback
Just endpos -> do
fsz <- liftIO $ catchDefaultIO 0 $ getFileSize f
go fsz endpos
| fsz == endpos =
liftIO $ catchDefaultIO (Just False) $
- finalizeIncremental iv
+ finalizeIncrementalVerifier iv
| otherwise = do
- showAction (descVerify iv)
+ showAction (descIncrementalVerifier iv)
liftIO $ catchDefaultIO (Just False) $
withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do
hSeek h AbsoluteSeek endpos
feedincremental h
- finalizeIncremental iv
+ finalizeIncrementalVerifier iv
feedincremental h = do
b <- S.hGetSome h chunk
if S.null b
then return ()
else do
- updateIncremental iv b
+ updateIncrementalVerifier iv b
feedincremental h
chunk = 65536
finishVerifyKeyContentIncrementally Nothing =
return (True, UnVerified)
finishVerifyKeyContentIncrementally (Just iv) =
- liftIO (finalizeIncremental iv) >>= \case
+ liftIO (finalizeIncrementalVerifier iv) >>= \case
Just True -> return (True, Verified)
Just False -> do
warning "verification of content failed"
tailVerify iv f finished =
tryNonAsync go >>= \case
Right r -> return r
- Left _ -> unableIncremental iv
+ Left _ -> unableIncrementalVerifier iv
where
-- Watch the directory containing the file, and wait for
-- the file to be modified. It's possible that the file already
let cleanup = void . tryNonAsync . INotify.removeWatch
let stop w = do
cleanup w
- unableIncremental iv
+ unableIncrementalVerifier iv
waitopen modified >>= \case
Nothing -> stop wd
Just h -> do
<$> takeTMVar finished)
cont
else do
- updateIncremental iv b
+ updateIncrementalVerifier iv b
atomically (tryTakeTMVar finished) >>= \case
Nothing -> follow h modified
Just () -> return ()
chunk = 65536
#else
-tailVerify iv _ _ = unableIncremental iv
+tailVerify iv _ _ = unableIncrementalVerifier iv
#endif
then defaultChunkSize
else fromIntegral n
b <- S.hGet h c
- updateIncremental iv b
+ updateIncrementalVerifier iv b
unless (b == S.empty) $
go iv (n - fromIntegral (S.length b))
Nothing -> \c -> S.hPut h c
Just iv -> \c -> do
S.hPut h c
- updateIncremental iv c
+ updateIncrementalVerifier iv c
meteredWrite p' writechunk b
indicatetransferred ti
runner validitycheck >>= \case
Right (Just Valid) -> case incrementalverifier of
Just iv
- | rightsize -> liftIO (finalizeIncremental iv) >>= \case
+ | rightsize -> liftIO (finalizeIncrementalVerifier iv) >>= \case
Nothing -> return (True, UnVerified)
Just True -> return (True, Verified)
Just False -> return (False, UnVerified)
finalize (Right Nothing) = return UnVerified
finalize (Right (Just iv)) =
- liftIO (finalizeIncremental iv) >>= \case
+ liftIO (finalizeIncrementalVerifier iv) >>= \case
Just True -> return Verified
_ -> return UnVerified
finalize (Left v) = return v
Just p ->
let writer = case miv of
Just iv -> \s -> do
- updateIncremental iv s
+ updateIncrementalVerifier iv s
S.hPut h s
Nothing -> S.hPut h
in meteredWrite p writer b
let sofar' = addBytesProcessed sofar $ S.length b
S.hPut h b
meterupdate sofar'
- maybe noop (flip updateIncremental b) iv
+ maybe noop (flip updateIncrementalVerifier b) iv
go sofar' h
withDavHandle hv $ \dav -> case cc of
LegacyChunks _ -> do
-- Not doing incremental verification for chunks.
- liftIO $ maybe noop unableIncremental iv
+ liftIO $ maybe noop unableIncrementalVerifier iv
retrieveLegacyChunked (fromRawFilePath d) k p dav
_ -> liftIO $ goDAV dav $
retrieveHelper (keyLocation k) (fromRawFilePath d) p iv
Mac(..),
calcMac,
props_macs_stable,
+ IncrementalHasher(..),
+ mkIncrementalHasher,
IncrementalVerifier(..),
mkIncrementalVerifier,
) where
key = T.encodeUtf8 $ T.pack "foo"
msg = T.encodeUtf8 $ T.pack "bar"
-data IncrementalVerifier = IncrementalVerifier
- { updateIncremental :: S.ByteString -> IO ()
+data IncrementalHasher = IncrementalHasher
+ { updateIncrementalHasher :: S.ByteString -> IO ()
-- ^ Called repeatedly on each peice of the content.
- , finalizeIncremental :: IO (Maybe Bool)
- -- ^ Called once the full content has been sent, returns True
- -- if the hash verified, False if it did not, and Nothing if
- -- incremental verification was unable to be done.
- , unableIncremental :: IO ()
- -- ^ Call if the incremental verification is unable to be done.
- , positionIncremental :: IO (Maybe Integer)
+ , finalizeIncrementalHasher :: IO (Maybe String)
+ -- ^ Called once the full content has been sent, returns
+ -- the hash. (Nothing if unableIncremental was called.)
+ , unableIncrementalHasher :: IO ()
+ -- ^ Call if the incremental hashing is unable to be done.
+ , positionIncrementalHasher :: IO (Maybe Integer)
-- ^ Returns the number of bytes that have been fed to this
- -- incremental verifier so far. (Nothing if unableIncremental was
+ -- incremental hasher so far. (Nothing if unableIncremental was
-- called.)
- , descVerify :: String
- -- ^ A description of what is done to verify the content.
+ , descIncrementalHasher :: String
}
-mkIncrementalVerifier :: HashAlgorithm h => Context h -> String -> (String -> Bool) -> IO IncrementalVerifier
-mkIncrementalVerifier ctx descverify samechecksum = do
+mkIncrementalHasher :: HashAlgorithm h => Context h -> String -> IO IncrementalHasher
+mkIncrementalHasher ctx desc = do
v <- newIORef (Just (ctx, 0))
- return $ IncrementalVerifier
- { updateIncremental = \b ->
+ return $ IncrementalHasher
+ { updateIncrementalHasher = \b ->
modifyIORef' v $ \case
(Just (ctx', n)) ->
let !ctx'' = hashUpdate ctx' b
!n' = n + fromIntegral (S.length b)
in (Just (ctx'', n'))
Nothing -> Nothing
- , finalizeIncremental =
+ , finalizeIncrementalHasher =
readIORef v >>= \case
(Just (ctx', _)) -> do
let digest = hashFinalize ctx'
- return $ Just $
- samechecksum (show digest)
+ return $ Just $ show digest
Nothing -> return Nothing
- , unableIncremental = writeIORef v Nothing
- , positionIncremental = readIORef v >>= \case
+ , unableIncrementalHasher = writeIORef v Nothing
+ , positionIncrementalHasher = readIORef v >>= \case
Just (_, n) -> return (Just n)
Nothing -> return Nothing
- , descVerify = descverify
+ , descIncrementalHasher = desc
+ }
+
+data IncrementalVerifier = IncrementalVerifier
+ { updateIncrementalVerifier :: S.ByteString -> IO ()
+ , finalizeIncrementalVerifier :: IO (Maybe Bool)
+ , unableIncrementalVerifier :: IO ()
+ , positionIncrementalVerifier :: IO (Maybe Integer)
+ , descIncrementalVerifier :: String
+ }
+
+mkIncrementalVerifier :: HashAlgorithm h => Context h -> String -> (String -> Bool) -> IO IncrementalVerifier
+mkIncrementalVerifier ctx desc samechecksum = do
+ hasher <- mkIncrementalHasher ctx desc
+ return $ IncrementalVerifier
+ { updateIncrementalVerifier = updateIncrementalHasher hasher
+ , finalizeIncrementalVerifier =
+ maybe Nothing (Just . samechecksum)
+ <$> finalizeIncrementalHasher hasher
+ , unableIncrementalVerifier = unableIncrementalHasher hasher
+ , positionIncrementalVerifier = positionIncrementalHasher hasher
+ , descIncrementalVerifier = descIncrementalHasher hasher
}
Nothing -> throwIO ex
followredir _ ex = throwIO ex
- noverification = maybe noop unableIncremental iv
+ noverification = maybe noop unableIncrementalVerifier iv
{- Download a perhaps large file using conduit, with auto-resume
- of incomplete downloads.
() <- signalsuccess False
throwM e
- noverification = maybe noop unableIncremental iv
+ noverification = maybe noop unableIncrementalVerifier iv
{- Sinks a Response's body to a file. The file can either be appended to
- (AppendMode), or written from the start of the response (WriteMode).
sinkResponseFile meterupdate iv initialp file mode resp = do
ui <- case (iv, mode) of
(Just iv', AppendMode) -> do
- liftIO $ unableIncremental iv'
+ liftIO $ unableIncrementalVerifier iv'
return (const noop)
- (Just iv', _) -> return (updateIncremental iv')
+ (Just iv', _) -> return (updateIncrementalVerifier iv')
(Nothing, _) -> return (const noop)
(fr, fh) <- allocate (openBinaryFile file mode) hClose
runConduit $ responseBody resp .| go ui initialp fh
projects / git-annex.git / commitdiff