pureMD5 2.1.2.1 → 2.1.3
raw patch · 3 files changed
+142/−58 lines, 3 filesdep +QuickCheckdep +crypto-api-testsdep +pretty-hexdep ~basedep ~binarydep ~bytestring
Dependencies added: QuickCheck, crypto-api-tests, pretty-hex, pureMD5, test-framework, test-framework-quickcheck2
Dependency ranges changed: base, binary, bytestring, cereal
Files
- Data/Digest/Pure/MD5.hs +87/−55
- Test/main.hs +36/−0
- pureMD5.cabal +19/−3
Data/Digest/Pure/MD5.hs view
@@ -1,25 +1,27 @@-{-# LANGUAGE BangPatterns, ForeignFunctionInterface, MultiParamTypeClasses, CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- -- Module : Data.Digest.Pure.MD5 -- License : BSD3 -- Maintainer : Thomas.DuBuisson@gmail.com -- Stability : experimental--- Portability : portable, requires bang patterns and ByteString--- Tested with : GHC-6.8.1+-- Portability : portable+-- Tested with : GHC-7.6.3 -- -- | It is suggested you use the 'crypto-api' class-based interface to access the MD5 algorithm. -- Either rely on type inference or provide an explicit type: -- -- @--- hashFileStrict = liftM hash' B.readFile--- hashFileLazyBS = liftM hash B.readFile+-- hashFileStrict = liftM hash' . B.readFile+-- hashFileLazyBS = liftM hash . B.readFile -- @ -- ----------------------------------------------------------------------------- module Data.Digest.Pure.MD5- (+ ( -- * Types MD5Context , MD5Digest@@ -29,23 +31,23 @@ , md5 , md5Update , md5Finalize- -- * Crypto-API interface- , Hash(..)+ , md5DigestBytes+ -- * Crypto-API interface+ , Hash(..) ) where -import Data.ByteString.Unsafe (unsafeUseAsCString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L-import Data.ByteString.Unsafe (unsafeDrop)+import Data.ByteString.Unsafe (unsafeDrop,unsafeUseAsCString) import Data.ByteString.Internal+#if MIN_VERSION_binary(0,8,3)+import Data.ByteString.Builder.Extra as B+#endif import Data.Bits import Data.List-import Data.Int (Int64) import Data.Word import Foreign.Storable-import Foreign.Ptr-import Foreign.ForeignPtr-import System.IO+import Foreign.Ptr (castPtr) import Data.Binary import Data.Binary.Get import Data.Binary.Put@@ -53,16 +55,19 @@ import qualified Data.Serialize.Put as P import qualified Data.Serialize as S import Crypto.Classes (Hash(..), hash)+import Control.Monad (replicateM_) import Data.Tagged import Numeric+#ifdef FastWordExtract+import System.IO.Unsafe (unsafePerformIO)+#endif -- | Block size in bits md5BlockSize :: Int md5BlockSize = 512 +blockSizeBytes :: Int blockSizeBytes = md5BlockSize `div` 8-blockSizeBytesI64 = (fromIntegral blockSizeBytes) :: Int64-blockSizeBits = (fromIntegral md5BlockSize) :: Word64 -- | The type for intermediate results (from md5Update) data MD5Partial = MD5Par {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32@@ -79,6 +84,8 @@ -- | The initial context to use when calling md5Update for the first time md5InitialContext :: MD5Context md5InitialContext = MD5Ctx (MD5Par h0 h1 h2 h3) 0++h0,h1,h2,h3 :: Word32 h0 = 0x67452301 h1 = 0xEFCDAB89 h2 = 0x98BADCFE@@ -91,13 +98,12 @@ -- | Closes an MD5 context, thus producing the digest. md5Finalize :: MD5Context -> B.ByteString -> MD5Digest-md5Finalize !ctx@(MD5Ctx par@(MD5Par a b c d) !totLen) end =+md5Finalize (MD5Ctx par !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' )+ padBS = P.runPut $ do P.putByteString end+ P.putWord8 0x80+ replicateM_ lenZeroPad (P.putWord8 0)+ P.putWord64le totLen' in MD5Digest $ blockAndDo par padBS where l = B.length end@@ -112,31 +118,32 @@ 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) }+ | 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 :: MD5Partial -> B.ByteString -> MD5Partial blockAndDo !ctx bs | B.length bs == 0 = ctx- | otherwise = - let !new = performMD5Update ctx bs- in blockAndDo new (unsafeDrop blockSizeBytes bs)+ | otherwise =+ let !new = performMD5Update ctx bs+ in blockAndDo new (unsafeDrop blockSizeBytes bs) {-# INLINE blockAndDo #-} --- Assumes ByteString length == blockSizeBytes, will fold the +-- Assumes ByteString length == blockSizeBytes, will fold the -- context across calls to applyMD5Rounds. performMD5Update :: MD5Partial -> B.ByteString -> MD5Partial-performMD5Update !par@(MD5Par !a !b !c !d) !bs =+performMD5Update par@(MD5Par !a !b !c !d) !bs = let MD5Par a' b' c' d' = applyMD5Rounds par bs- in MD5Par (a' + a) (b' + b) (c' + c) (d' + d)+ in MD5Par (a' + a) (b' + b) (c' + c) (d' + d) {-# INLINE performMD5Update #-} +isAligned :: ByteString -> Bool isAligned (PS _ off _) = off `rem` 4 == 0 applyMD5Rounds :: MD5Partial -> ByteString -> MD5Partial-applyMD5Rounds par@(MD5Par a b c d) w = {-# SCC "applyMD5Rounds" #-}+applyMD5Rounds (MD5Par a b c d) w = {-# SCC "applyMD5Rounds" #-} let -- Round 1 !r0 = ff a b c d (w!!0) 7 3614090360 !r1 = ff d r0 b c (w!!1) 12 3905402710@@ -240,31 +247,51 @@ {-# INLINE applyMD5Rounds #-} #ifdef FastWordExtract-getNthWord n b = inlinePerformIO (unsafeUseAsCString b (flip peekElemOff n . castPtr))+getNthWord n b = unsafePerformIO (unsafeUseAsCString b (flip peekElemOff n . castPtr))+{-# INLINE getNthWord #-} #else getNthWord :: Int -> B.ByteString -> Word32 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 .<.-(.<.) :: Word8 -> Int -> Word32-(.<.) w i = (fromIntegral w) `shiftL` i+-- | The raw bytes of an 'MD5Digest'. It is always 16 bytes long.+--+-- You can also use the 'Binary' or 'S.Serialize' instances to output the raw+-- bytes. Alternatively you can use 'show' to prodce the standard hex+-- representation.+--+md5DigestBytes :: MD5Digest -> B.ByteString+md5DigestBytes (MD5Digest h) = md5PartialBytes h +md5PartialBytes :: MD5Partial -> B.ByteString+md5PartialBytes =+ toBs . (put :: MD5Partial -> Put)+ where+ toBs :: Put -> B.ByteString+#if MIN_VERSION_binary(0,8,3)+ -- with later binary versions we can control the buffer size precisely:+ toBs = L.toStrict+ . B.toLazyByteStringWith (B.untrimmedStrategy 16 0) L.empty+ . execPut+#else+ toBs = B.concat . L.toChunks . runPut+ -- note L.toStrict is only in newer bytestring versions+#endif+ ----- Some quick and dirty instances follow ----- instance Show MD5Digest where show (MD5Digest h) = show h instance Show MD5Partial where- show (MD5Par a b c d) = - let bs = runPut $ putWord32be d >> putWord32be c >> putWord32be b >> putWord32be a- in foldl' (\str w -> let c = showHex w str- in if length c < length str + 2- then '0':c- else c) "" (L.unpack bs)+ show md5par =+ let bs = md5PartialBytes md5par+ in foldl' (\str w -> let cx = showHex w str+ in if length cx < length str + 2+ then '0':cx+ else cx) "" (B.unpack (B.reverse bs)) instance Binary MD5Digest where put (MD5Digest p) = put p@@ -300,16 +327,21 @@ 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- get = do a <- G.getWord32le- b <- G.getWord32le- c <- G.getWord32le- d <- G.getWord32le- return $ MD5Par a b c d+ put (MD5Par a b c d) = do+ P.putWord32le a+ P.putWord32le b+ P.putWord32le c+ P.putWord32le d+ get = do+ a <- G.getWord32le+ b <- G.getWord32le+ 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+ outputLength = Tagged 128+ blockLength = Tagged 512+ initialCtx = md5InitialContext+ updateCtx = md5Update+ finalize = md5Finalize
+ Test/main.hs view
@@ -0,0 +1,36 @@+module Main where++import Test.Framework+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.MD5+import Data.Digest.Pure.MD5+import Data.Char (isSpace)+import Data.ByteString.Lazy (toStrict, ByteString)+import qualified Data.Binary as B+import qualified Data.Serialize as S+import Hexdump++main :: IO ()+main = defaultMain+ [ testGroup "MD5 functional correctness tests" base_tests+ , testGroup "Serialization order correctness tests" serialization_tests+ ]++-- | Use the crypto-api-tests, piddly as they are, to give evidence of+-- functional correctness.+base_tests :: [Test]+base_tests = makeMD5Tests (undefined :: MD5Digest)++-- | Ensure the output of `show`, `Serialize`, `Binary`, and `md5DigestBytes`+-- are all consistent.+serialization_tests :: [Test]+serialization_tests =+ [ testProperty "show == simple_hex . Serialize.encode"+ (\bs -> let d = hsh bs in show d == filter (not . isSpace) (simpleHex (S.encode d)))+ , testProperty "Serialize.encode == toStrict . Binary.encode"+ (\bs -> let d = hsh bs in toStrict (B.encode d) == S.encode d)+ , testProperty "Serialize.encode == md5DigestBytes"+ (\bs -> let d = hsh bs in S.encode d == md5DigestBytes d)+ ]+ where+ hsh = hash :: ByteString -> MD5Digest
pureMD5.cabal view
@@ -1,5 +1,5 @@ name: pureMD5-version: 2.1.2.1+version: 2.1.3 license: BSD3 license-file: LICENSE author: Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -10,8 +10,8 @@ category: Data, Cryptography stability: stable build-type: Simple-cabal-version: >= 1.6-tested-with: GHC == 6.12.1+cabal-version: >= 1.10+tested-with: GHC == 7.10.3 extra-source-files: Test/MD5.hs flag test@@ -21,10 +21,26 @@ Library Build-Depends: base == 4.*, bytestring >= 0.9, binary >= 0.4.0, cereal >= 0.2, crypto-api, tagged ghc-options: -O2 -funfolding-use-threshold66 -funfolding-creation-threshold66 -funbox-strict-fields+ default-language: Haskell2010 hs-source-dirs: exposed-modules: Data.Digest.Pure.MD5 if arch(i386) || arch(x86_64) cpp-options: -DFastWordExtract++Test-Suite MD5Tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ build-depends: base >=4.6 && < 5,+ pureMD5,+ crypto-api-tests,+ QuickCheck,+ test-framework >= 0.8,+ test-framework-quickcheck2,+ binary, cereal, pretty-hex,+ bytestring+ ghc-options: -Wall+ hs-source-dirs: Test+ main-is: main.hs source-repository head type: git