Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fixups

Ignore-this: de155965ee82a540b28a5c5d4b27e293

darcs-hash:20090616023950-cef97-20d18a79e2d18a5df915d15221d275312fbd0747.gz
  • Loading branch information...
commit e9769778391e66cbb39af96250e12456c9163347 1 parent b2b18f6
@TomMD authored
Showing with 29 additions and 21 deletions.
  1. +18 −17 Data/Digest/Pure/MD5.hs
  2. +10 −3 Test/MD5.hs
  3. +1 −1  pureMD5.cabal
View
35 Data/Digest/Pure/MD5.hs
@@ -1,9 +1,9 @@
-{-# OPTIONS_GHC -XBangPatterns #-}
+{-# LANGUAGE BangPatterns, ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
--
--- Module : Data.Digest.MD5
+-- Module : Data.Digest.Pure.MD5
-- License : BSD3
--- Maintainer : Thomas.DuBuisson@mail.google.com
+-- Maintainer : Thomas.DuBuisson@gmail.com
-- Stability : experimental
-- Portability : portable, requires bang patterns and ByteString
-- Tested with : GHC-6.8.1
@@ -56,17 +56,18 @@ blockSizeBytes = blockSize `div` 8
blockSizeBytesI64 = (fromIntegral blockSizeBytes) :: Int64
blockSizeBits = (fromIntegral blockSize) :: Word64
+-- | The type for intermediate results (from md5Update)
data MD5Partial = MD5Par !Word32 !Word32 !Word32 !Word32
deriving (Ord, Eq)
--- | The type for intermediate and final results.
+-- | The type for final results.
data MD5Context = MD5Ctx { mdPartial :: !MD5Partial,
- mdLeftOver :: ByteString,
+ mdLeftOver :: !ByteString,
mdTotalLen :: !Word64 }
-- |After finalizing a context, using md5Finalize, a new type
-- is returned to prevent 're-finalizing' the structure.
-newtype MD5Digest = MD5Digest MD5Context
+newtype MD5Digest = MD5Digest !MD5Context
-- | The initial context to use when calling md5Update for the first time
md5InitialContext :: MD5Context
@@ -116,7 +117,7 @@ blockAndDo !ctx bs =
-- 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 =
+performMD5Update !ctx@(MD5Ctx !par@(MD5Par !a !b !c !d) _ !len) !bs = {-# SCC "performMD5Update" #-}
let MD5Par a' b' c' d' = applyMD5Rounds par bs
in MD5Ctx {
mdPartial = MD5Par (a' + a) (b' + b) (c' + c) (d' + d),
@@ -126,7 +127,7 @@ performMD5Update !ctx@(MD5Ctx !par@(MD5Par !a !b !c !d) _ !len) !bs =
{-# INLINE performMD5Update #-}
applyMD5Rounds :: MD5Partial -> ByteString -> MD5Partial
-applyMD5Rounds par@(MD5Par a b c d) w =
+applyMD5Rounds par@(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
@@ -205,22 +206,22 @@ applyMD5Rounds par@(MD5Par a b c d) w =
{-# INLINE h #-}
i !x !y !z = y `xor` (x .|. (complement z))
{-# INLINE i #-}
- ff a b c d x s ac =
+ ff a b c d !x s ac = {-# SCC "ff" #-}
let !a' = f b c d + x + ac + a
!a'' = rotateL a' s
in a'' + b
{-# INLINE ff #-}
- gg a b c d x s ac =
+ gg a b c d !x s ac = {-# SCC "gg" #-}
let !a' = g b c d + x + ac + a
!a'' = rotateL a' s
in a'' + b
{-# INLINE gg #-}
- hh a b c d x s ac =
+ hh a b c d !x s ac = {-# SCC "hh" #-}
let !a' = h b c d + x + ac + a
!a'' = rotateL a' s
in a'' + b
{-# INLINE hh #-}
- ii a b c d x s ac =
+ ii a b c d !x s ac = {-# SCC "ii" #-}
let !a' = i b c d + x + ac + a
!a'' = rotateL a' s
in a'' + b
@@ -269,9 +270,9 @@ instance Binary MD5Context where
return $ MD5Ctx p r l
instance Binary MD5Partial where
- put (MD5Par a b c d) = putWord32be a >> putWord32be b >> putWord32be c >> putWord32be d
- get = do a <- getWord32be
- b <- getWord32be
- c <- getWord32be
- d <- getWord32be
+ put (MD5Par a b c d) = putWord32le a >> putWord32le b >> putWord32le c >> putWord32le d
+ get = do a <- getWord32le
+ b <- getWord32le
+ c <- getWord32le
+ d <- getWord32le
return $ MD5Par a b c d
View
13 Test/MD5.hs
@@ -4,6 +4,7 @@ module Test.MD5 where
import Test.QuickCheck
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
@@ -11,11 +12,17 @@ import Data.Binary
instance Arbitrary Word8 where
arbitrary = (arbitrary :: Gen Int) >>= return . fromIntegral
-instance Arbitrary L.ByteString where
+instance Arbitrary S.ByteString where
arbitrary = do
- len <- choose (0,10000) :: Gen Int
+ len <- choose (0,4096) :: Gen Int
words <- forM [0..len] (\_ -> arbitrary)
- return $ L.pack words
+ return $ S.pack words
+
+instance Arbitrary L.ByteString where
+ arbitrary = do
+ len <- choose (0,1000) :: Gen Int
+ chunks <- vector len
+ return $ L.fromChunks chunks
prop_PartsEqWhole lps =
let lpsChunks = map (L.fromChunks . (:[])) (L.toChunks lps)
View
2  pureMD5.cabal
@@ -18,7 +18,7 @@ Flag small_base
Library
if flag(small_base)
- Build-Depends: base >= 3, bytestring >= 0.9, binary >= 0.4.0
+ Build-Depends: base >= 3 && < 5, bytestring >= 0.9 && < 0.10, binary >= 0.4.0 && < 0.5.0
else
Build-Depends: base >= 3, bytestring, binary >= 0.4.0
hs-source-dirs:
Please sign in to comment.
Something went wrong with that request. Please try again.