From 1da79ea61faaddd71bdb84ee2c5a89bbe04a69ed Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 4 Jul 2012 09:08:20 -0400
Subject: When shaNsum commands cannot be found, use the Haskell SHA library
 (already a dependency) to do the checksumming. This may be slower, but avoids
 portability problems.

Using Crypto's version of the hashes would be another option.
I need to benchmark it. The SHA2 library (which provides SHA1 also,
confusing name) may be the fastest option, but is not currently in Debian.
---
 Backend/SHA.hs | 65 +++++++++++++++++++++++++++++++---------------------------
 1 file changed, 35 insertions(+), 30 deletions(-)

(limited to 'Backend')

diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index 838a97ab8b..6ecc78ff29 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -1,6 +1,6 @@
 {- git-annex SHA backend
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -12,7 +12,10 @@ import qualified Annex
 import Types.Backend
 import Types.Key
 import Types.KeySource
+
 import qualified Build.SysConfig as SysConfig
+import Data.Digest.Pure.SHA
+import qualified Data.ByteString.Lazy as L
 
 type SHASize = Int
 
@@ -25,32 +28,31 @@ backends :: [Backend]
 backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes
 
 genBackend :: SHASize -> Maybe Backend
-genBackend size
-	| isNothing (shaCommand size) = Nothing
-	| otherwise = Just b
-	where
-		b = Backend
-			{ name = shaName size
-			, getKey = keyValue size
-			, fsckKey = Just $ checkKeyChecksum size
-			}
+genBackend size = Just $ Backend
+	{ name = shaName size
+	, getKey = keyValue size
+	, fsckKey = Just $ checkKeyChecksum size
+	}
 
 genBackendE :: SHASize -> Maybe Backend
-genBackendE size =
-	case genBackend size of
-		Nothing -> Nothing
-		Just b -> Just $ b
-			{ name = shaNameE size
-			, getKey = keyValueE size
-			}
+genBackendE size = do
+	b <- genBackend size
+	return $ b 
+		{ name = shaNameE size
+		, getKey = keyValueE size
+		}
 
-shaCommand :: SHASize -> Maybe String
-shaCommand 1 = SysConfig.sha1
-shaCommand 256 = Just SysConfig.sha256
-shaCommand 224 = SysConfig.sha224
-shaCommand 384 = SysConfig.sha384
-shaCommand 512 = SysConfig.sha512
-shaCommand _ = Nothing
+shaCommand :: SHASize -> Either (L.ByteString -> String) String
+shaCommand sz
+	| sz == 1 = use SysConfig.sha1 sha1
+	| sz == 256 = use SysConfig.sha256 sha256
+	| sz == 224 = use SysConfig.sha224 sha224
+	| sz == 384 = use SysConfig.sha384 sha384
+	| sz == 512 = use SysConfig.sha512 sha512
+	| otherwise = error $ "bad sha size " ++ show sz
+	where
+		use Nothing sha = Left $ showDigest . sha
+		use (Just c) _ = Right c
 
 shaName :: SHASize -> String
 shaName size = "SHA" ++ show size
@@ -61,13 +63,16 @@ shaNameE size = shaName size ++ "E"
 shaN :: SHASize -> FilePath -> Annex String
 shaN size file = do
 	showAction "checksum"
-	liftIO $ pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do
-		sha <- fst . separate (== ' ') <$> hGetLine h
-		if null sha
-			then error $ command ++ " parse error"
-			else return sha
+	case shaCommand size of
+		Left sha -> liftIO $ sha <$> L.readFile file
+		Right command -> liftIO $ runcommand command
 	where
-		command = fromJust $ shaCommand size
+		runcommand command =
+			pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do
+				sha <- fst . separate (== ' ') <$> hGetLine h
+				if null sha
+					then error $ command ++ " parse error"
+					else return sha
 
 {- A key is a checksum of its contents. -}
 keyValue :: SHASize -> KeySource -> Annex (Maybe Key)
-- 
cgit v1.2.3