pureMD5 1.1.0.0 → 2.0.0.0

raw patch · 4 files changed

+83/−120 lines, 4 filesdep +QuickCheckdep +crypto-apidep +taggeddep ~basedep ~bytestringdep ~cerealnew-component:exe:md5TestPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, crypto-api, tagged

Dependency ranges changed: base, bytestring, cereal

API changes (from Hackage documentation)

Files

• Data/Digest/Pure/MD5.hs +56/−51
• Test/MD5.hs +2/−64
• Test/main.hs +3/−0
• pureMD5.cabal +22/−5

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, ForeignFunctionInterface #-}+{-# LANGUAGE BangPatterns, ForeignFunctionInterface, MultiParamTypeClasses, CPP #-} ----------------------------------------------------------------------------- -- -- Module      : Data.Digest.Pure.MD5@@ -32,6 +32,7 @@         , md5Finalize         ) where +import Data.ByteString.Unsafe (unsafeUseAsCString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString.Internal@@ -49,15 +50,17 @@ import qualified Data.Serialize.Get as G import qualified Data.Serialize.Put as P import qualified Data.Serialize as S+import Crypto.Classes+import Data.Tagged import Numeric  -- | Block size in bits-blockSize :: Int-blockSize = 512+md5BlockSize :: Int+md5BlockSize = 512 -blockSizeBytes = blockSize `div` 8+blockSizeBytes = md5BlockSize `div` 8 blockSizeBytesI64 = (fromIntegral blockSizeBytes) :: Int64-blockSizeBits = (fromIntegral blockSize) :: Word64+blockSizeBits = (fromIntegral md5BlockSize) :: Word64  -- | The type for intermediate results (from md5Update) data MD5Partial = MD5Par !Word32 !Word32 !Word32 !Word32@@ -65,7 +68,6 @@  -- | The type for final results. data MD5Context = MD5Ctx { mdPartial  :: !MD5Partial,-                           mdLeftOver :: !ByteString,                            mdTotalLen :: !Word64 }  -- |After finalizing a context, using md5Finalize, a new type@@ -74,7 +76,7 @@  -- | The initial context to use when calling md5Update for the first time md5InitialContext :: MD5Context-md5InitialContext = MD5Ctx (MD5Par h0 h1 h2 h3) B.empty 0+md5InitialContext = MD5Ctx (MD5Par h0 h1 h2 h3) 0 h0 = 0x67452301 h1 = 0xEFCDAB89 h2 = 0x98BADCFE@@ -83,51 +85,50 @@ -- | Processes a lazy ByteString and returns the md5 digest. --   This is probably what you want. md5 :: L.ByteString -> MD5Digest-md5 bs = md5Finalize $ md5Update md5InitialContext bs+md5 = hash  -- | Closes an MD5 context, thus producing the digest.-md5Finalize :: MD5Context -> MD5Digest-md5Finalize !ctx@(MD5Ctx (MD5Par a b c d) rem !totLen) =-        let totLen' = (totLen + 8*fromIntegral l) :: Word64-            padBS = L.toChunks $ runPut ( do-                        putWord8 0x80-                        mapM_ putWord8 (replicate lenZeroPad 0)-                        putWord64le totLen' )-        in MD5Digest $ mdPartial $ md5Update ctx (L.fromChunks padBS)+md5Finalize :: MD5Context -> B.ByteString -> MD5Digest+md5Finalize !ctx@(MD5Ctx par@(MD5Par a b c d) !totLen) end =+        let totLen' = 8*(totLen + fromIntegral l) :: Word64+            padBS = P.runPut ( do+			P.putByteString end+                        P.putWord8 0x80+                        mapM_ P.putWord8 (replicate lenZeroPad 0)+                        P.putWord64le totLen' )+        in MD5Digest $ blockAndDo par padBS     where-    l = B.length rem+    l = B.length end     lenZeroPad = if (l + 1) <= blockSizeBytes - 8                      then (blockSizeBytes - 8) - (l + 1)                      else (2 * blockSizeBytes - 8) - (l + 1)  -- | Alters the MD5Context with a partial digest of the data.-md5Update :: MD5Context -> L.ByteString -> MD5Context-md5Update !ctx@(MD5Ctx _ !leftover _) bsLazy =-    let bs = L.fromChunks (leftover:L.toChunks bsLazy)-    in blockAndDo ctx bs --foldl' performMD5Update ctx blks+--+-- The input bytestring MUST be a multiple of the blockSize+-- or bad things can happen (incorrect digest results)!+md5Update :: MD5Context -> B.ByteString -> MD5Context+md5Update ctx bs+  | B.length bs `rem` blockSizeBytes /= 0 = error "Invalid use of hash update routine (see crypto-api Hash class semantics)"+  | otherwise = +	let bs' = if isAligned bs then bs else B.copy bs -- copying has been measured as a net win on my x86 system+	    new =  blockAndDo (mdPartial ctx) bs'+	in ctx { mdPartial = new, mdTotalLen = mdTotalLen ctx + fromIntegral (B.length bs) } -blockAndDo :: MD5Context -> L.ByteString -> MD5Context-blockAndDo !ctx bs =-    if B.length blk == blockSizeBytes-        then let !newCtx = performMD5Update ctx blk-             in blockAndDo newCtx rest-        else ctx { mdLeftOver = blk }-  where-  blk = if isAligned blk' then blk' else B.copy blk'-  blk' = B.concat $ L.toChunks top-  (top,rest) = L.splitAt blockSizeBytesI64 bs+blockAndDo :: MD5Partial -> B.ByteString -> MD5Partial+blockAndDo !ctx bs+  | B.length bs == 0 = ctx+  | otherwise = +	let !new = performMD5Update ctx bs+	in blockAndDo new (B.drop blockSizeBytes bs) {-# INLINE blockAndDo #-}  -- Assumes ByteString length == blockSizeBytes, will fold the  -- context across calls to applyMD5Rounds.-performMD5Update :: MD5Context -> ByteString -> MD5Context-performMD5Update !ctx@(MD5Ctx !par@(MD5Par !a !b !c !d) _ !len) !bs = {-# SCC "performMD5Update" #-}+performMD5Update :: MD5Partial -> B.ByteString -> MD5Partial+performMD5Update !par@(MD5Par !a !b !c !d) !bs =         let MD5Par a' b' c' d' = applyMD5Rounds par bs-        in MD5Ctx {-                        mdPartial = MD5Par (a' + a) (b' + b) (c' + c) (d' + d),-                        mdLeftOver = B.empty,-                        mdTotalLen = len + blockSizeBits-                        }+	in MD5Par (a' + a) (b' + b) (c' + c) (d' + d) {-# INLINE performMD5Update #-}  isAligned (PS _ off _) = off `rem` 4 == 0@@ -236,12 +237,14 @@         {-# INLINE (!!) #-} {-# INLINE applyMD5Rounds #-} +#ifdef LittleEndian+getNthWord n b = inlinePerformIO (unsafeUseAsCString b (flip peekElemOff n . castPtr))+#else getNthWord :: Int -> B.ByteString -> Word32-getNthWord n = right . G.runGet (do-                G.uncheckedSkip (n * sizeOf (undefined :: Word32))-                G.getWord32le)+getNthWord n = right . G.runGet G.getWord32le . B.drop (n * sizeOf (undefined :: Word32))   where   right x = case x of Right y -> y+#endif {-# INLINE getNthWord #-}  infix 9 .<.@@ -268,13 +271,10 @@         return $ MD5Digest p  instance Binary MD5Context where-        put (MD5Ctx p r l) = put p >> putWord8 (fromIntegral (B.length r)) >> -                             putByteString r >> putWord64be l+        put (MD5Ctx p l) = put p >> putWord64be l         get = do p <- get-                 s <- getWord8-                 r <- getByteString (fromIntegral s)                  l <- getWord64be-                 return $ MD5Ctx p r l+                 return $ MD5Ctx p l  instance Binary MD5Partial where         put (MD5Par a b c d) = putWord32le a >> putWord32le b >> putWord32le c >> putWord32le d@@ -291,13 +291,11 @@         return $ MD5Digest p  instance S.Serialize MD5Context where-        put (MD5Ctx p r l) = S.put p >> P.putWord8 (fromIntegral (B.length r)) >>-                             P.putByteString r >> P.putWord64be l+        put (MD5Ctx p l) = S.put p >>+                             P.putWord64be l         get = do p <- S.get-                 s <- G.getWord8-                 r <- G.getByteString (fromIntegral s)                  l <- G.getWord64be-                 return $ MD5Ctx p r l+                 return $ MD5Ctx p l  instance S.Serialize MD5Partial where 	put (MD5Par a b c d) = P.putWord32le a >> P.putWord32le b >> P.putWord32le c >> P.putWord32le d@@ -306,3 +304,10 @@ 		 c <- G.getWord32le 		 d <- G.getWord32le 		 return $ MD5Par a b c d++instance Hash MD5Context MD5Digest where+	outputLength = Tagged 128+	blockLength  = Tagged 512+	initialCtx   = md5InitialContext+	updateCtx    = md5Update+	finalize     = md5Finalize

@@ -2,69 +2,7 @@ module Test.MD5 where  import Test.QuickCheck+import Test.Crypto import Data.Digest.Pure.MD5-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString as S-import Control.Monad (forM)-import Data.Word (Word8)-import Data.Binary -instance Arbitrary Word8 where-    arbitrary = (arbitrary :: Gen Int) >>= return . fromIntegral--instance Arbitrary S.ByteString where-    arbitrary = do-        len <- choose (0,4096) :: Gen Int-        words <- forM [0..len] (\_ -> arbitrary)-        return $ S.pack words--instance Arbitrary L.ByteString where-    arbitrary = do-        len <- choose (0,10) :: Gen Int-        chunks <- vector len-        return $ L.fromChunks chunks--prop_PartsEqWhole lps =-    let lpsChunks   = map (L.fromChunks . (:[])) (L.toChunks lps)-        incremental = foldl md5Update md5InitialContext lpsChunks-        final = md5Finalize incremental-    in md5 lps == final--prop_ShowLen bs = 32 == (length $ show (md5 bs))--prop_BinaryLen bs = 16 == (L.length $ encode (md5 bs))--prop_GetPut bs =-    let dg = md5 bs-    in decode (encode dg) == dg--prop_ShowElem bs =-    let digest = md5 bs-        valids = \c -> (c >= 'a' && c <= 'f') || (c >= '0' && c <= '9')-    in [] == filter (not . valids) (show digest)--prop_KnownAnswers =-  let mds = show . md5 . pk-      pk  = L.pack . (map (fromIntegral . fromEnum))-  in mds ("") == "d41d8cd98f00b204e9800998ecf8427e" &&-     mds ("a") == "0cc175b9c0f1b6a831c399e269772661" &&-     mds ("abc") == "900150983cd24fb0d6963f7d28e17f72" &&-     mds ("message digest") == "f96b697d7cb7938d525a2f31aaf161d0" &&-     mds ("abcdefghijklmnopqrstuvwxyz") == "c3fcd3d76192e4007dfb496cca67e13b" &&-     mds ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") ==-       "d174ab98d277d9f5a5611c2c9f419d9f" &&-     mds ("12345678901234567890123456789012345678901234567890123456789012345678901234567890") == "57edf4a22be3c955ac49da2e2107b67a"--tests = [ T prop_PartsEqWhole "PartsEqWhole"-        , T prop_ShowLen "ShowLen"-        , T prop_BinaryLen "BinaryLen"-        , T prop_GetPut "GetPut"-        , T prop_ShowElem "ShowElem"-        , T prop_KnownAnswers "KnownAnswers"]--data Test = forall a. Testable a => T a String-runTest (T a s) = do-    putStr ("prop_" ++ s ++ ": ")-    quickCheck a--runTests = mapM_ runTest tests+test = runTests (makeMD5Tests (undefined :: MD5Digest))

@@ -0,0 +1,3 @@+import Test.MD5++main = test

@@ -1,20 +1,37 @@ name:		pureMD5-version:	1.1.0.0+version:	2.0.0.0 license:	BSD3 license-file:	LICENSE author:		Thomas DuBuisson <thomas.dubuisson@gmail.com> maintainer:	Thomas DuBuisson-description:	An unrolled implementation of MD5 purely in Haskell.-synopsis:	MD5 implementations that should become part of a ByteString Crypto package.+description:	A Haskell-only implementation of the MD5 digest (hash) algorithm.  This now supports+                the crypto-api class interface.+synopsis:	A Haskell-only implementation of the MD5 digest (hash) algorithm. category:	Data, Cryptography stability:	stable build-type:	Simple cabal-version:	>= 1.6-tested-with:	GHC == 6.10.1+tested-with:	GHC == 6.12.1 extra-source-files: Test/MD5.hs Test/md5test.hs +flag LittleEndian+  description: Set to true if the architecture is little endian (uses native Word32 loads instead of bytes + shifts, overall 40% speed-up)+  default: False++flag test+  description: Build a test program+  default: False+ Library-  Build-Depends: base == 4.*, bytestring >= 0.9 && < 0.10, binary >= 0.4.0 && < 0.6.0, cereal >= 0.2+  Build-Depends: base == 4.*, bytestring >= 0.9 && < 0.10, binary >= 0.4.0 && < 0.6.0, cereal >= 0.2, crypto-api >= 0.0.0.1, tagged   ghc-options:	-O2 -funfolding-use-threshold66 -funfolding-creation-threshold66 -fexcess-precision -funbox-strict-fields   hs-source-dirs:   exposed-modules: Data.Digest.Pure.MD5+  if flag(LittleEndian)+    cpp-options: -DLittleEndian++Executable md5Test+  main-is: Test/main.hs+  Build-Depends: base, QuickCheck, crypto-api, bytestring, cereal+  if !flag(test)+    buildable: False