Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

1) New module layout 2) New API 3) Bug fix from Larsson (eep!)

darcs-hash:20080613034245-cef97-1f840650389ba17b372a1c2a0cc9bfbe2aad9240.gz
  • Loading branch information...
commit df1c80c682834bc8115c2fb5327ed41f64ad6937 1 parent 230e2a1
@TomMD authored
View
277 Data/Digest/Pure/MD5.hs
@@ -0,0 +1,277 @@
+{-# OPTIONS_GHC -XBangPatterns #-}
+-----------------------------------------------------------------------------
+--
+-- Module : Data.Digest.MD5
+-- License : BSD3
+-- Maintainer : Thomas.DuBuisson@mail.google.com
+-- Stability : experimental
+-- Portability : portable, requires bang patterns and ByteString
+-- Tested with : GHC-6.8.1
+--
+-- To get an MD5 digest of a lazy ByteString (you probably want this):
+-- hash = md5 lazyByteString
+--
+-- Alternativly, for a context that can be further updated/finalized:
+-- partialCtx = md5Update md5InitialContext partOfFile
+--
+-- And you finialize the context with:
+-- hash = md5Finalize partialCtx
+-----------------------------------------------------------------------------
+
+module Data.Digest.Pure.MD5
+ -- * Types
+ ( MD5Context
+ , MD5Digest
+ -- * Static data
+ , md5InitialContext
+ , blockSize
+ -- * Functions
+ , md5
+ , md5Update
+ , md5Finalize
+ ) where
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import Data.ByteString.Internal
+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 Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
+import Numeric
+
+-- | Block size in bits
+blockSize :: Int
+blockSize = 512
+
+blockSizeBytes = blockSize `div` 8
+blockSizeBytesI64 = (fromIntegral blockSizeBytes) :: Int64
+blockSizeBits = (fromIntegral blockSize) :: Word64
+
+data MD5Partial = MD5Par !Word32 !Word32 !Word32 !Word32
+
+-- | The type for intermediate and final results.
+data MD5Context = MD5Ctx { mdPartial :: !MD5Partial,
+ 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
+
+-- | The initial context to use when calling md5Update for the first time
+md5InitialContext :: MD5Context
+md5InitialContext = MD5Ctx (MD5Par h0 h1 h2 h3) B.empty 0
+h0 = 0x67452301
+h1 = 0xEFCDAB89
+h2 = 0x98BADCFE
+h3 = 0x10325476
+
+-- | Processes a lazy ByteString and returns the md5 digest.
+-- This is probably what you want.
+md5 :: L.ByteString -> MD5Context
+md5 bs = md5Finalize $ md5Update md5InitialContext bs
+
+-- | 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 $ md5Update ctx (L.fromChunks padBS)
+ where
+ l = B.length rem
+ 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)
+ blks = block bs
+ in foldl' performMD5Update ctx blks
+
+block :: L.ByteString -> [ByteString]
+block bs =
+ if rest /= L.empty
+ then (conv top) : (block rest)
+ else [conv top]
+ where
+ conv = B.concat . L.toChunks
+ (top,rest) = L.splitAt blockSizeBytesI64 bs
+{-# INLINE block #-}
+
+-- 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 =
+ let MD5Par a' b' c' d' = applyMD5Rounds par bs
+ in if B.length bs == blockSizeBytes
+ then MD5Ctx {
+ mdPartial = MD5Par (a' + a) (b' + b) (c' + c) (d' + d),
+ mdLeftOver = B.empty,
+ mdTotalLen = len + blockSizeBits
+ }
+ else ctx { mdLeftOver = bs }
+
+applyMD5Rounds :: MD5Partial -> ByteString -> MD5Partial
+applyMD5Rounds par@(MD5Par a b c d) w =
+ let -- Round 1
+ !r0 = ff a b c d (w!!0) 7 3614090360
+ !r1 = ff d r0 b c (w!!1) 12 3905402710
+ !r2 = ff c r1 r0 b (w!!2) 17 606105819
+ !r3 = ff b r2 r1 r0 (w!!3) 22 3250441966
+ !r4 = ff r0 r3 r2 r1 (w!!4) 7 4118548399
+ !r5 = ff r1 r4 r3 r2 (w!!5) 12 1200080426
+ !r6 = ff r2 r5 r4 r3 (w!!6) 17 2821735955
+ !r7 = ff r3 r6 r5 r4 (w!!7) 22 4249261313
+ !r8 = ff r4 r7 r6 r5 (w!!8) 7 1770035416
+ !r9 = ff r5 r8 r7 r6 (w!!9) 12 2336552879
+ !r10 = ff r6 r9 r8 r7 (w!!10) 17 4294925233
+ !r11 = ff r7 r10 r9 r8 (w!!11) 22 2304563134
+ !r12 = ff r8 r11 r10 r9 (w!!12) 7 1804603682
+ !r13 = ff r9 r12 r11 r10 (w!!13) 12 4254626195
+ !r14 = ff r10 r13 r12 r11 (w!!14) 17 2792965006
+ !r15 = ff r11 r14 r13 r12 (w!!15) 22 1236535329
+ -- Round 2
+ !r16 = gg r12 r15 r14 r13 (w!!1) 5 4129170786
+ !r17 = gg r13 r16 r15 r14 (w!!6) 9 3225465664
+ !r18 = gg r14 r17 r16 r15 (w!!11) 14 643717713
+ !r19 = gg r15 r18 r17 r16 (w!!0) 20 3921069994
+ !r20 = gg r16 r19 r18 r17 (w!!5) 5 3593408605
+ !r21 = gg r17 r20 r19 r18 (w!!10) 9 38016083
+ !r22 = gg r18 r21 r20 r19 (w!!15) 14 3634488961
+ !r23 = gg r19 r22 r21 r20 (w!!4) 20 3889429448
+ !r24 = gg r20 r23 r22 r21 (w!!9) 5 568446438
+ !r25 = gg r21 r24 r23 r22 (w!!14) 9 3275163606
+ !r26 = gg r22 r25 r24 r23 (w!!3) 14 4107603335
+ !r27 = gg r23 r26 r25 r24 (w!!8) 20 1163531501
+ !r28 = gg r24 r27 r26 r25 (w!!13) 5 2850285829
+ !r29 = gg r25 r28 r27 r26 (w!!2) 9 4243563512
+ !r30 = gg r26 r29 r28 r27 (w!!7) 14 1735328473
+ !r31 = gg r27 r30 r29 r28 (w!!12) 20 2368359562
+ -- Round 3
+ !r32 = hh r28 r31 r30 r29 (w!!5) 4 4294588738
+ !r33 = hh r29 r32 r31 r30 (w!!8) 11 2272392833
+ !r34 = hh r30 r33 r32 r31 (w!!11) 16 1839030562
+ !r35 = hh r31 r34 r33 r32 (w!!14) 23 4259657740
+ !r36 = hh r32 r35 r34 r33 (w!!1) 4 2763975236
+ !r37 = hh r33 r36 r35 r34 (w!!4) 11 1272893353
+ !r38 = hh r34 r37 r36 r35 (w!!7) 16 4139469664
+ !r39 = hh r35 r38 r37 r36 (w!!10) 23 3200236656
+ !r40 = hh r36 r39 r38 r37 (w!!13) 4 681279174
+ !r41 = hh r37 r40 r39 r38 (w!!0) 11 3936430074
+ !r42 = hh r38 r41 r40 r39 (w!!3) 16 3572445317
+ !r43 = hh r39 r42 r41 r40 (w!!6) 23 76029189
+ !r44 = hh r40 r43 r42 r41 (w!!9) 4 3654602809
+ !r45 = hh r41 r44 r43 r42 (w!!12) 11 3873151461
+ !r46 = hh r42 r45 r44 r43 (w!!15) 16 530742520
+ !r47 = hh r43 r46 r45 r44 (w!!2) 23 3299628645
+ -- Round 4
+ !r48 = ii r44 r47 r46 r45 (w!!0) 6 4096336452
+ !r49 = ii r45 r48 r47 r46 (w!!7) 10 1126891415
+ !r50 = ii r46 r49 r48 r47 (w!!14) 15 2878612391
+ !r51 = ii r47 r50 r49 r48 (w!!5) 21 4237533241
+ !r52 = ii r48 r51 r50 r49 (w!!12) 6 1700485571
+ !r53 = ii r49 r52 r51 r50 (w!!3) 10 2399980690
+ !r54 = ii r50 r53 r52 r51 (w!!10) 15 4293915773
+ !r55 = ii r51 r54 r53 r52 (w!!1) 21 2240044497
+ !r56 = ii r52 r55 r54 r53 (w!!8) 6 1873313359
+ !r57 = ii r53 r56 r55 r54 (w!!15) 10 4264355552
+ !r58 = ii r54 r57 r56 r55 (w!!6) 15 2734768916
+ !r59 = ii r55 r58 r57 r56 (w!!13) 21 1309151649
+ !r60 = ii r56 r59 r58 r57 (w!!4) 6 4149444226
+ !r61 = ii r57 r60 r59 r58 (w!!11) 10 3174756917
+ !r62 = ii r58 r61 r60 r59 (w!!2) 15 718787259
+ !r63 = ii r59 r62 r61 r60 (w!!9) 21 3951481745
+ in MD5Par r60 r63 r62 r61
+ where
+ f !x !y !z = (x .&. y) .|. ((complement x) .&. z)
+ {-# INLINE f #-}
+ g !x !y !z = (x .&. z) .|. (y .&. (complement z))
+ {-# INLINE g #-}
+ h !x !y !z = (x `xor` y `xor` z)
+ {-# INLINE h #-}
+ i !x !y !z = y `xor` (x .|. (complement z))
+ {-# INLINE i #-}
+ ff a b c d x s ac =
+ 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 =
+ 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 =
+ 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 =
+ let !a' = i b c d + x + ac + a
+ !a'' = rotateL a' s
+ in a'' + b
+ {-# INLINE ii #-}
+ (!!) word32s pos = getNthWord pos word32s
+ {-# INLINE (!!) #-}
+ getNthWord n bs@(PS ptr off len) =
+ inlinePerformIO $ withForeignPtr ptr $ \ptr' -> do
+ let p = castPtr $ plusPtr ptr' off
+ peekElemOff p n
+ {-# INLINE getNthWord #-}
+{-# INLINE applyMD5Rounds #-}
+
+----- Some quick and dirty instances follow -----
+
+instance Show MD5Digest where
+ show (MD5Digest h) = show h
+
+instance Binary MD5Digest where
+ put (MD5Digest (MD5Ctx p _ _)) = put p
+ get = do
+ p <- get
+ return $ MD5Digest $ MD5Ctx p L.empty 0
+
+instance Ord MD5Digest where
+ compare (MD5Digest (MD5Ctx a _ _)) (MD5Digest (MD5Ctx b _ _)) = compare a b
+
+instance Eq MD5Digest where
+ (MD5Digest (MD5Ctx a _ _)) == (MD5Digest (MD5Ctx b _ _)) = a == b
+
+instance Show MD5Context where
+ show (MD5Ctx (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)
+
+instance Binary MD5Context where
+ put (MD5Ctx p r l) = put p >> putWord8 (fromIntegral (B.length r)) >>
+ putByteString r >> putWord64be l
+ get = do p <- get
+ s <- getWord8
+ r <- getByteString (fromIntegral s)
+ l <- getWord64be
+ 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
+ return $ MD5Par a b c d
+
View
4 NOTES
@@ -1,3 +1 @@
-pureMD5 rolled version (MD5.Rolled) is around just for historical purposes,
-but if you want a real challange then try to make a compiler that will compile
-the rolled version to run as fast as the unrolled version.
+The MD5 Rolled is no longer being distributed, but it lives on in the old packages on hackage and on the darcs repo.
View
29 pureMD5.cabal
@@ -1,20 +1,25 @@
name: pureMD5
-version: 0.1.0
+version: 0.2.0
license: BSD3
license-file: LICENSE
-author: Thomas DuBuisson <thomas.dubuisosn@gmail.com>
+author: Thomas DuBuisson <thomas.dubuisson@gmail.com>
maintainer: Thomas DuBuisson
-homepage: None
-description: A rolled (concise yet inefficient) and unrolled (more efficient, much less concise)
- version of MD5 purely in Haskell.
-synopsis: MD5 implementations that should become part of a ByteString crypto package.
-category: Data, Codes
+description: An unrolled implementation of MD5 purely in Haskell.
+synopsis: MD5 implementations that should become part of a ByteString Crypto package.
+category: Data, Cryptography
stability: stable
build-type: Simple
cabal-version: >= 1.2
-tested-with: GHC ==6.8.1
+tested-with: GHC == 6.8.2
-build-depends: base, bytestring >= 0.9, binary >= 0.4.0
-hs-source-dirs: src
-exposed-modules: MD5
-ghc-options: -O2 -funfolding-use-threshold66 -funfolding-creation-threshold66 -funfolding-update-in-place -fvia-c -optc -funroll-all-loops -optc-ffast-math -fexcess-precision
+Flag small_base
+ Description: Choose the split-up base package.
+
+Library
+ if flag(small_base)
+ Build-Depends: base >= 3, bytestring >= 0.9, binary >= 0.4.0
+ else
+ Build-Depends: base >= 3, bytestring, binary >= 0.4.0
+ hs-source-dirs: src
+ exposed-modules: Data.Digest.Pure.MD5
+ ghc-options: -O2 -funfolding-use-threshold66 -funfolding-creation-threshold66 -fvia-C -optc-funroll-all-loops -optc-ffast-math -fexcess-precision -funbox-strict-fields
View
235 src/MD5.hs
@@ -1,235 +0,0 @@
-{-# OPTIONS_GHC -fbang-patterns -funbox-strict-fields -fvia-c -optc-funroll-all-loops -optc-O3 #-}
---
--- Module : Crypto.MD5
--- License : BSD3
--- Maintainer : Thomas.DuBuisson@mail.google.com
--- Stability : experimental
--- Portability : portable, requires bang patterns and ByteString
--- Tested with : GHC-6.8.1
---
-
-module MD5
- (md5
- ,md5InitialContext
- ,md5Update
- ,md5Finalize
- ) where
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import Data.ByteString.Internal
-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 Data.Binary
-import Data.Binary.Get
-import Data.Binary.Put
-import Numeric
-
-blockSize = 512 -- Block size in bits
-blockSizeBytes = blockSize `div` 8
-blockSizeBytesI64 = (fromIntegral blockSizeBytes) :: Int64
-blockSizeBits = (fromIntegral blockSize) :: Word64
-
-data MD5Partial = MD5Par !Word32 !Word32 !Word32 !Word32
-data MD5Context = MD5Ctx { mdPartial :: !MD5Partial,
- mdLeftOver :: ByteString,
- mdTotalLen :: !Word64
- }
-
-md5InitialContext = MD5Ctx (MD5Par h0 h1 h2 h3) B.empty 0
-h0 = 0x67452301
-h1 = 0xEFCDAB89
-h2 = 0x98BADCFE
-h3 = 0x10325476
-
--- | Will read the lazy ByteString and return the md5 digest.
--- Some application might want to wrap this function for type safty.
-md5 :: L.ByteString -> MD5Context
-md5 bs = md5Finalize $ md5Update md5InitialContext bs
-
-md5Finalize :: MD5Context -> MD5Context
-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 md5Update ctx (L.fromChunks (rem:padBS))
-
- where
- l = B.length rem
- lenZeroPad = if (l+1) <= blockSizeBytes - 8
- then (blockSizeBytes - 8) - (l+1)
- else (2*blockSizeBytes - 8) - (l+1)
-{-# INLINE md5Finalize #-}
-
-md5Update :: MD5Context -> L.ByteString -> MD5Context
-md5Update !ctx bsLazy =
- let blks = block bsLazy
- in foldl' performMD5Update ctx blks
-{-# INLINE md5Update #-}
-
-block :: L.ByteString -> [ByteString]
-block bs =
- if rest /= L.empty
- then conv top : block rest
- else [conv top]
- where
- conv = B.concat . L.toChunks
- (top,rest) = L.splitAt blockSizeBytesI64 bs
-{-# INLINE block #-}
-
--- 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 =
- let MD5Par a' b' c' d' = applyMD5Rounds par bs
- in if B.length bs == blockSizeBytes
- then MD5Ctx {
- mdPartial = MD5Par (a' + a) (b' + b) (c' + c) (d' + d),
- mdLeftOver = B.empty,
- mdTotalLen = len + blockSizeBits
- }
- else ctx { mdLeftOver = bs }
-
-applyMD5Rounds :: MD5Partial -> ByteString -> MD5Partial
-applyMD5Rounds par@(MD5Par a b c d) w =
- let -- Round 1
- !r0 = ff a b c d (w!!0) 7 3614090360
- !r1 = ff d r0 b c (w!!1) 12 3905402710
- !r2 = ff c r1 r0 b (w!!2) 17 606105819
- !r3 = ff b r2 r1 r0 (w!!3) 22 3250441966
- !r4 = ff r0 r3 r2 r1 (w!!4) 7 4118548399
- !r5 = ff r1 r4 r3 r2 (w!!5) 12 1200080426
- !r6 = ff r2 r5 r4 r3 (w!!6) 17 2821735955
- !r7 = ff r3 r6 r5 r4 (w!!7) 22 4249261313
- !r8 = ff r4 r7 r6 r5 (w!!8) 7 1770035416
- !r9 = ff r5 r8 r7 r6 (w!!9) 12 2336552879
- !r10 = ff r6 r9 r8 r7 (w!!10) 17 4294925233
- !r11 = ff r7 r10 r9 r8 (w!!11) 22 2304563134
- !r12 = ff r8 r11 r10 r9 (w!!12) 7 1804603682
- !r13 = ff r9 r12 r11 r10 (w!!13) 12 4254626195
- !r14 = ff r10 r13 r12 r11 (w!!14) 17 2792965006
- !r15 = ff r11 r14 r13 r12 (w!!15) 22 1236535329
- -- Round 2
- !r16 = gg r12 r15 r14 r13 (w!!1) 5 4129170786
- !r17 = gg r13 r16 r15 r14 (w!!6) 9 3225465664
- !r18 = gg r14 r17 r16 r15 (w!!11) 14 643717713
- !r19 = gg r15 r18 r17 r16 (w!!0) 20 3921069994
- !r20 = gg r16 r19 r18 r17 (w!!5) 5 3593408605
- !r21 = gg r17 r20 r19 r18 (w!!10) 9 38016083
- !r22 = gg r18 r21 r20 r19 (w!!15) 14 3634488961
- !r23 = gg r19 r22 r21 r20 (w!!4) 20 3889429448
- !r24 = gg r20 r23 r22 r21 (w!!9) 5 568446438
- !r25 = gg r21 r24 r23 r22 (w!!14) 9 3275163606
- !r26 = gg r22 r25 r24 r23 (w!!3) 14 4107603335
- !r27 = gg r23 r26 r25 r24 (w!!8) 20 1163531501
- !r28 = gg r24 r27 r26 r25 (w!!13) 5 2850285829
- !r29 = gg r25 r28 r27 r26 (w!!2) 9 4243563512
- !r30 = gg r26 r29 r28 r27 (w!!7) 14 1735328473
- !r31 = gg r27 r30 r29 r28 (w!!12) 20 2368359562
- -- Round 3
- !r32 = hh r28 r31 r30 r29 (w!!5) 4 4294588738
- !r33 = hh r29 r32 r31 r30 (w!!8) 11 2272392833
- !r34 = hh r30 r33 r32 r31 (w!!11) 16 1839030562
- !r35 = hh r31 r34 r33 r32 (w!!14) 23 4259657740
- !r36 = hh r32 r35 r34 r33 (w!!1) 4 2763975236
- !r37 = hh r33 r36 r35 r34 (w!!4) 11 1272893353
- !r38 = hh r34 r37 r36 r35 (w!!7) 16 4139469664
- !r39 = hh r35 r38 r37 r36 (w!!10) 23 3200236656
- !r40 = hh r36 r39 r38 r37 (w!!13) 4 681279174
- !r41 = hh r37 r40 r39 r38 (w!!0) 11 3936430074
- !r42 = hh r38 r41 r40 r39 (w!!3) 16 3572445317
- !r43 = hh r39 r42 r41 r40 (w!!6) 23 76029189
- !r44 = hh r40 r43 r42 r41 (w!!9) 4 3654602809
- !r45 = hh r41 r44 r43 r42 (w!!12) 11 3873151461
- !r46 = hh r42 r45 r44 r43 (w!!15) 16 530742520
- !r47 = hh r43 r46 r45 r44 (w!!2) 23 3299628645
- -- Round 4
- !r48 = ii r44 r47 r46 r45 (w!!0) 6 4096336452
- !r49 = ii r45 r48 r47 r46 (w!!7) 10 1126891415
- !r50 = ii r46 r49 r48 r47 (w!!14) 15 2878612391
- !r51 = ii r47 r50 r49 r48 (w!!5) 21 4237533241
- !r52 = ii r48 r51 r50 r49 (w!!12) 6 1700485571
- !r53 = ii r49 r52 r51 r50 (w!!3) 10 2399980690
- !r54 = ii r50 r53 r52 r51 (w!!10) 15 4293915773
- !r55 = ii r51 r54 r53 r52 (w!!1) 21 2240044497
- !r56 = ii r52 r55 r54 r53 (w!!8) 6 1873313359
- !r57 = ii r53 r56 r55 r54 (w!!15) 10 4264355552
- !r58 = ii r54 r57 r56 r55 (w!!6) 15 2734768916
- !r59 = ii r55 r58 r57 r56 (w!!13) 21 1309151649
- !r60 = ii r56 r59 r58 r57 (w!!4) 6 4149444226
- !r61 = ii r57 r60 r59 r58 (w!!11) 10 3174756917
- !r62 = ii r58 r61 r60 r59 (w!!2) 15 718787259
- !r63 = ii r59 r62 r61 r60 (w!!9) 21 3951481745
- in MD5Par r60 r63 r62 r61
- where
- f !x !y !z = (x .&. y) .|. ((complement x) .&. z)
- {-# INLINE f #-}
- g !x !y !z = (x .&. z) .|. (y .&. (complement z))
- {-# INLINE g #-}
- h !x !y !z = (x `xor` y `xor` z)
- {-# INLINE h #-}
- i !x !y !z = y `xor` (x .|. (complement z))
- {-# INLINE i #-}
- ff a b c d x s ac =
- 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 =
- 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 =
- 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 =
- let !a' = i b c d + x + ac + a
- !a'' = rotateL a' s
- in a'' + b
- {-# INLINE ii #-}
- (!!) word32s pos = getNthWord pos word32s
- {-# INLINE (!!) #-}
- getNthWord n bs@(PS ptr off len) =
- inlinePerformIO $ withForeignPtr ptr $ \ptr' -> do
- let p = castPtr $ plusPtr ptr' off
- peekElemOff p n
- {-# INLINE getNthWord #-}
-{-# INLINE applyMD5Rounds #-}
-
------ Some quick and dirty instances follow -----
-
-instance Show MD5Context where
- show (MD5Ctx (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)
-
-instance Binary MD5Context where
- put (MD5Ctx p r l) = put p >> putWord8 (fromIntegral (B.length r)) >>
- putByteString r >> putWord64be l
- get = do p <- get
- s <- getWord8
- r <- getByteString (fromIntegral s)
- l <- getWord64be
- 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
- return $ MD5Par a b c d
View
172 src/MD5/Rolled.hs
@@ -1,172 +0,0 @@
-{-# OPTIONS_GHC -fbang-patterns -funbox-strict-fields -fvia-c -optc-funroll-all-loops -optc-O3 #-}
---
--- Module : Crypto.MD5
--- License : BSD3
--- Maintainer : Thomas.DuBuisson@gmail.com
--- Stability : experimental
--- Portability : portable, requires bang patterns and ByteString
--- Tested with : GHC-6.8.0
---
-
-module MD5.Rolled
- (md5
- ,md5InitialContext
- ,md5Update
- ,md5Finalize
- ,MD5Context
- ,applyMD5Rounds
- ) where
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import Data.ByteString.Internal
-import Data.Bits
-import Data.List as T
-import Data.Int (Int64)
-import Data.Word
-import Foreign.Storable
-import Foreign.Ptr
-import Foreign.ForeignPtr
-import Numeric
-import System.Environment
-import System.IO
-import Data.Binary
-import Data.Binary.Get
-import Data.Binary.Put
-
-blockSize = 512 -- Block size in bits
-blockSizeBytes = blockSize `div` 8
-blockSizeBytesW64 = fromIntegral blockSizeBytes
-blockSizeBits = (fromIntegral blockSize) :: Word64
-
-sinConst :: [Word32]
-sinConst = [floor(abs(sin(i + 1)) * (2 ^ 32)) | i <- [0..63]]
-
-roundShift :: [Int]
-roundShift = [7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22,
- 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20,
- 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23,
- 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21 ]
-
-data MD5Partial = MD5Par !Word32 !Word32 !Word32 !Word32
-data MD5Context = MD5Ctx { mdPartial :: MD5Partial,
- mdLeftOver :: ByteString,
- mdTotalLen :: Word64
- }
-
-md5InitialContext = MD5Ctx (MD5Par h0 h1 h2 h3) B.empty 0
-h0 = 0x67452301
-h1 = 0xEFCDAB89
-h2 = 0x98BADCFE
-h3 = 0x10325476
-
--- | Will read the lazy ByteString and return the md5 digest.
--- Some application might want to wrap this function for type safty.
-md5 :: L.ByteString -> L.ByteString
-md5 bs = md5Finalize $ md5Update md5InitialContext bs
-
-md5Finalize :: MD5Context -> L.ByteString
-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' )
- (MD5Ctx (MD5Par a' b' c' d') _ _) = md5Update ctx (L.fromChunks (rem:padBS))
- in runPut ( do
- putWord32le a'
- putWord32le b'
- putWord32le c'
- putWord32le d' )
-
- where
- l = B.length rem
- lenZeroPad = if (l+1) <= blockSizeBytes - 8
- then (blockSizeBytes - 8) - (l+1)
- else (2*blockSizeBytes - 8) - (l+1)
-
-md5Update :: MD5Context -> L.ByteString -> MD5Context
-md5Update ctx bsLazy =
- let blks = block bsLazy
- in foldl' performMD5Update ctx blks
-
-block :: L.ByteString -> [ByteString]
-block bs =
- case L.toChunks bs of
- [] -> []
- otherwise -> (B.concat . L.toChunks) top : block rest
- where
- (top,rest) = L.splitAt blockSizeBytesW64 bs
-{-# INLINE block #-}
-
--- 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 =
- let MD5Par a' b' c' d' = applyMD5Rounds par bs
- in if B.length bs == blockSizeBytes
- then MD5Ctx {
- mdPartial = MD5Par (a' + a) (b' + b) (c' + c) (d' + d),
- mdLeftOver = B.empty,
- mdTotalLen = len + blockSizeBits
- }
- else ctx { mdLeftOver = bs }
-
-applyMD5Rounds :: MD5Partial -> ByteString -> MD5Partial
-applyMD5Rounds par@(MD5Par a b c d) w =
- foldl' (md5Round w) par [0..63]
-
-md5Round :: ByteString -> MD5Partial -> Int -> MD5Partial
-md5Round w par@(MD5Par a b c d) !r
- | r <= 15 = let j = r
- b' = ff a b c d (w!!j) rs sc
- in MD5Par d b' b c
- | r <= 31 = let j = (5*r + 1) `mod` 16
- b' = gg a b c d (w!!j) rs sc
- in MD5Par d b' b c
- | r <= 47 = let j = (3*r + 5) `mod` 16
- b' = hh a b c d (w!!j) rs sc
- in MD5Par d b' b c
- | otherwise = let j = (7*r) `mod` 16
- b' = ii a b c d (w!!j) rs sc
- in MD5Par d b' b c
- where
- rs = roundShift T.!! r
- sc = sinConst T.!! r
- f !x !y !z = (x .&. y) .|. ((complement x) .&. z)
- {-# INLINE f #-}
- g !x !y !z = (x .&. z) .|. (y .&. (complement z))
- {-# INLINE g #-}
- h !x !y !z = (x `xor` y `xor` z)
- {-# INLINE h #-}
- i !x !y !z = y `xor` (x .|. (complement z))
- {-# INLINE i #-}
- 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 = {-# 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 = {-# 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 = {-# SCC "ii" #-}
- let !a' = i b c d + x + ac + a
- !a'' = rotateL a' s
- in a'' + b
- {-# INLINE ii #-}
- (!!) word32s pos = getNthWord pos word32s
- {-# INLINE (!!) #-}
--- getNthWord n bs = runGet (skip (n*4) >> getWord32le) (L.fromChunks [bs])
- getNthWord n bs@(PS ptr off len) =
- inlinePerformIO $ withForeignPtr ptr $ \ptr' -> do
- let p = castPtr $ plusPtr ptr' off
- peekElemOff p n
- {-# INLINE getNthWord #-}
-{-# INLINE applyMD5Rounds #-}
Please sign in to comment.
Something went wrong with that request. Please try again.