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 39077f661682d03d59b38e6038059ae061b69646..e60abe9cce8600b78816a308d965118c275eefe2 100644 (file)
--- 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 c41a793f622c1802ee61f2441f35bc0e742aba9e..3df646b7a8265b1dcb0310f96fb28edc074d8752 100644 (file)
--- 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 ba1dced2c3dc0d4b2c5e2078f63f03506c13ee7c..bd66cb698ebd92a0d05f658ff20af1f6964e040b 100644 (file)
--- 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 cd7f24d86397828942e775c6a24c6f73a6c04cf0..1c998ae70c99c3bd3380cc1f7e228961b9992b92 100644 (file)
--- 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 f22f7d636a77ff123f0cb7cd3f0541baad911b87..2bd2c26bc76d846bec9ab1dc5a9a7682f2ea8294 100644 (file)
--- 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 92f9dc1d648b7f1c65e4e6ea0db7506aa73957a1..b888727ab25af6e775b6cb69034557b1f15e7214 100644 (file)
--- 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 50ab34c0f15082f77ce8b468ca5676f88988afdf..ae45f3a744564ce23f7df8eedcc216b1c24532d3 100644 (file)
--- 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 709d16da2fcc1adb49b71ae8cbc840b6f52fbe93..de04e698595188575eb2376ab6ae69ecd8eaa109 100644 (file)
--- 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 f31ba35fc9380bd05f9421d87387b911db1343c2..82bfa8272b2f47f1ff97cbb2900d547f0718df69 100644 (file)
--- 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 c74df4183b6c0f5e873dc5455483c31563b57e19..7fa2175a1068b602e2a939e0888b1ff174c09cb8 100644 (file)
--- 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 <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
+               }