From: Joey Hess Date: Wed, 18 Aug 2021 17:19:02 +0000 (-0400) Subject: refactor X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~87^2~83 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=449851225aa903a73ad0a4b3a82d8fa8c7112622;p=git-annex.git refactor IncrementalVerifier moved to Utility.Hash, which will let Utility.Url use it later. It's perhaps not really specific to hashing, but making a separate module just for the data type seemed unncessary. Sponsored-by: Dartmouth College's DANDI project --- diff --git a/Annex/CopyFile.hs b/Annex/CopyFile.hs index 39077f6616..e60abe9cce 100644 --- a/Annex/CopyFile.hs +++ b/Annex/CopyFile.hs @@ -14,7 +14,7 @@ import Utility.Metered import Utility.CopyFile import Utility.FileMode import Utility.Touch -import Types.Backend +import Utility.Hash (IncrementalVerifier(..)) import Control.Concurrent import qualified Data.ByteString as S diff --git a/Annex/Verify.hs b/Annex/Verify.hs index c41a793f62..3df646b7a8 100644 --- a/Annex/Verify.hs +++ b/Annex/Verify.hs @@ -25,9 +25,9 @@ import qualified Annex import qualified Types.Remote import Types.Remote (VerifyConfigA(..)) import qualified Types.Backend -import Types.Backend (IncrementalVerifier(..)) import qualified Backend import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..)) +import Utility.Hash (IncrementalVerifier(..)) import Annex.WorkerPool import Types.WorkerPool import Types.Key diff --git a/Backend/Hash.hs b/Backend/Hash.hs index ba1dced2c3..bd66cb698e 100644 --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -6,7 +6,6 @@ -} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE BangPatterns #-} module Backend.Hash ( backends, @@ -29,7 +28,6 @@ import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Control.DeepSeq import Control.Exception (evaluate) -import Data.IORef data Hash = MD5Hash @@ -222,7 +220,7 @@ hasher (Blake2sHash hashsize) = blake2sHasher hashsize hasher (Blake2spHash hashsize) = blake2spHasher hashsize mkHasher :: HashAlgorithm h => (L.ByteString -> Digest h) -> Context h -> Hasher -mkHasher h c = (show . h, mkIncrementalVerifier c) +mkHasher h c = (show . h, mkIncrementalVerifier c descChecksum . sameCheckSum) sha2Hasher :: HashSize -> Hasher sha2Hasher (HashSize hashsize) @@ -279,30 +277,6 @@ sha1Hasher = mkHasher sha1 sha1_context md5Hasher :: Hasher md5Hasher = mkHasher md5 md5_context -mkIncrementalVerifier :: HashAlgorithm h => Context h -> Key -> IO IncrementalVerifier -mkIncrementalVerifier ctx key = do - v <- newIORef (Just (ctx, 0)) - return $ IncrementalVerifier - { updateIncremental = \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 = - readIORef v >>= \case - (Just (ctx', _)) -> do - let digest = hashFinalize ctx' - return $ sameCheckSum key (show digest) - Nothing -> return False - , failIncremental = writeIORef v Nothing - , positionIncremental = readIORef v >>= \case - Just (_, n) -> return (Just n) - Nothing -> return Nothing - , descVerify = descChecksum - } - descChecksum :: String descChecksum = "checksum" diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs index cd7f24d863..1c998ae70c 100644 --- a/P2P/Protocol.hs +++ b/P2P/Protocol.hs @@ -17,9 +17,9 @@ import qualified Utility.SimpleProtocol as Proto import Types (Annex) import Types.Key import Types.UUID -import Types.Remote (Verification(..)) -import Types.Backend (IncrementalVerifier(..)) import Types.Transfer +import Types.Remote (Verification(..)) +import Utility.Hash (IncrementalVerifier(..)) import Utility.AuthToken import Utility.Applicative import Utility.PartialPrelude diff --git a/Remote/Helper/Http.hs b/Remote/Helper/Http.hs index f22f7d636a..2bd2c26bc7 100644 --- a/Remote/Helper/Http.hs +++ b/Remote/Helper/Http.hs @@ -11,9 +11,9 @@ module Remote.Helper.Http where import Annex.Common import Types.StoreRetrieve -import Types.Backend import Remote.Helper.Special import Utility.Metered +import Utility.Hash (IncrementalVerifier(..)) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 92f9dc1d64..b888727ab2 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -28,7 +28,6 @@ import Control.Concurrent.STM hiding (check) import Annex.Common import Types.Remote import Types.Export -import Types.Backend import qualified Git import qualified Annex import Config @@ -41,6 +40,7 @@ import qualified Remote.Helper.Chunked.Legacy as Legacy import Creds import Utility.Metered import Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionContent) +import Utility.Hash (IncrementalVerifier(..)) import Annex.UUID import Remote.WebDAV.DavLocation import Types.ProposedAccepted diff --git a/Types/Backend.hs b/Types/Backend.hs index 50ab34c0f1..ae45f3a744 100644 --- a/Types/Backend.hs +++ b/Types/Backend.hs @@ -13,8 +13,7 @@ import Types.Key import Types.KeySource import Utility.Metered import Utility.FileSystemEncoding - -import Data.ByteString (ByteString) +import Utility.Hash (IncrementalVerifier) data BackendA a = Backend { backendVariety :: KeyVariety @@ -43,19 +42,3 @@ instance Show (BackendA a) where instance Eq (BackendA a) where a == b = backendVariety a == backendVariety b - -data IncrementalVerifier = IncrementalVerifier - { updateIncremental :: ByteString -> IO () - -- ^ Called repeatedly on each peice of the content. - , finalizeIncremental :: IO Bool - -- ^ Called once the full content has been sent, returns true - -- if the hash verified. - , failIncremental :: IO () - -- ^ Call if the incremental verification needs to fail. - , positionIncremental :: IO (Maybe Integer) - -- ^ Returns the number of bytes that have been fed to this - -- incremental verifier so far. (Nothing if failIncremental was - -- called.) - , descVerify :: String - -- ^ A description of what is done to verify the content. - } diff --git a/Types/Remote.hs b/Types/Remote.hs index 709d16da2f..de04e69859 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -42,7 +42,7 @@ import Types.NumCopies import Types.Export import Types.Import import Types.RemoteConfig -import Types.Backend (IncrementalVerifier) +import Utility.Hash (IncrementalVerifier) import Config.Cost import Utility.Metered import Git.Types (RemoteName) diff --git a/Types/StoreRetrieve.hs b/Types/StoreRetrieve.hs index f31ba35fc9..82bfa8272b 100644 --- a/Types/StoreRetrieve.hs +++ b/Types/StoreRetrieve.hs @@ -11,7 +11,7 @@ module Types.StoreRetrieve where import Annex.Common import Utility.Metered -import Types.Backend (IncrementalVerifier) +import Utility.Hash (IncrementalVerifier) import qualified Data.ByteString.Lazy as L diff --git a/Utility/Hash.hs b/Utility/Hash.hs index c74df4183b..7fa2175a10 100644 --- a/Utility/Hash.hs +++ b/Utility/Hash.hs @@ -1,4 +1,11 @@ -{- Convenience wrapper around cryptonite's hashing. -} +{- Convenience wrapper around cryptonite's hashing. + - + - Copyright 2013-2021 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE BangPatterns #-} module Utility.Hash ( sha1, @@ -57,12 +64,15 @@ module Utility.Hash ( Mac(..), calcMac, props_macs_stable, + IncrementalVerifier(..), + mkIncrementalVerifier, ) where import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Data.IORef import "cryptonite" Crypto.MAC.HMAC hiding (Context) import "cryptonite" Crypto.Hash @@ -269,3 +279,43 @@ props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac mac where key = T.encodeUtf8 $ T.pack "foo" msg = T.encodeUtf8 $ T.pack "bar" + +data IncrementalVerifier = IncrementalVerifier + { updateIncremental :: S.ByteString -> IO () + -- ^ Called repeatedly on each peice of the content. + , finalizeIncremental :: IO Bool + -- ^ Called once the full content has been sent, returns true + -- if the hash verified. + , failIncremental :: IO () + -- ^ Call if the incremental verification needs to fail. + , positionIncremental :: IO (Maybe Integer) + -- ^ Returns the number of bytes that have been fed to this + -- incremental verifier so far. (Nothing if failIncremental was + -- called.) + , descVerify :: String + -- ^ A description of what is done to verify the content. + } + +mkIncrementalVerifier :: HashAlgorithm h => Context h -> String -> (String -> Bool) -> IO IncrementalVerifier +mkIncrementalVerifier ctx descverify samechecksum = do + v <- newIORef (Just (ctx, 0)) + return $ IncrementalVerifier + { updateIncremental = \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 = + readIORef v >>= \case + (Just (ctx', _)) -> do + let digest = hashFinalize ctx' + return $ samechecksum (show digest) + Nothing -> return False + , failIncremental = writeIORef v Nothing + , positionIncremental = readIORef v >>= \case + Just (_, n) -> return (Just n) + Nothing -> return Nothing + , descVerify = descverify + }