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

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

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

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"
 

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

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

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

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.
-	}

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)

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
 

Utility/Hash.hs

@@ -1,4 +1,11 @@
-{- Convenience wrapper around cryptonite's hashing. -}
+{- Convenience wrapper around cryptonite's hashing.
+ -
+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>
+ -
+ - 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
+		}