{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- Module : Data.Digest.Pure.MD5 -- License : BSD3 -- -- Stability : experimental -- Portability : portable, requires bang patterns and ByteString -- Tested with : GHC-6.8.1 -- -- This is taken from the pureMD5 package but stripped down to remove some dependencies. -- Ideally one would extend pureMD5 or move this to a seperate package. -- Original Author is : Thomas.DuBuisson@gmail.com -- ----------------------------------------------------------------------------- module Data.Digest.Pure.MD5 ( MD5Digest (..) , mixRaw , md5Init ) where import Data.Word import Data.Bits data MD5Digest = MD5Digest !Word32 !Word32 !Word32 !Word32 deriving (Ord, Eq) md5Init :: MD5Digest md5Init = MD5Digest h0 h1 h2 h3 where h0 = 0x67452301 h1 = 0xEFCDAB89 h2 = 0x98BADCFE h3 = 0x10325476 {-# INLINE applyMD5RoundsRaw #-} applyMD5RoundsRaw :: MD5Digest -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> MD5Digest applyMD5RoundsRaw (MD5Digest da db dc dd) !w0 !w1 !w2 !w3 !w4 !w5 !w6 !w7 !w8 !w9 !w10 !w11 !w12 !w13 !w14 !w15 = {-# SCC "applyMD5RoundsRaw" #-} let -- Round 1 !r0 = ff da dd dc dd w0 7 3614090360 !r1 = ff dd r0 db dc w1 12 3905402710 !r2 = ff dc r1 r0 db w2 17 606105819 !r3 = ff db r2 r1 r0 w3 22 3250441966 !r4 = ff r0 r3 r2 r1 w4 7 4118548399 !r5 = ff r1 r4 r3 r2 w5 12 1200080426 !r6 = ff r2 r5 r4 r3 w6 17 2821735955 !r7 = ff r3 r6 r5 r4 w7 22 4249261313 !r8 = ff r4 r7 r6 r5 w8 7 1770035416 !r9 = ff r5 r8 r7 r6 w9 12 2336552879 !r10 = ff r6 r9 r8 r7 w10 17 4294925233 !r11 = ff r7 r10 r9 r8 w11 22 2304563134 !r12 = ff r8 r11 r10 r9 w12 7 1804603682 !r13 = ff r9 r12 r11 r10 w13 12 4254626195 !r14 = ff r10 r13 r12 r11 w14 17 2792965006 !r15 = ff r11 r14 r13 r12 w15 22 1236535329 -- Round 2 !r16 = gg r12 r15 r14 r13 w1 5 4129170786 !r17 = gg r13 r16 r15 r14 w6 9 3225465664 !r18 = gg r14 r17 r16 r15 w11 14 643717713 !r19 = gg r15 r18 r17 r16 w0 20 3921069994 !r20 = gg r16 r19 r18 r17 w5 5 3593408605 !r21 = gg r17 r20 r19 r18 w10 9 38016083 !r22 = gg r18 r21 r20 r19 w15 14 3634488961 !r23 = gg r19 r22 r21 r20 w4 20 3889429448 !r24 = gg r20 r23 r22 r21 w9 5 568446438 !r25 = gg r21 r24 r23 r22 w14 9 3275163606 !r26 = gg r22 r25 r24 r23 w3 14 4107603335 !r27 = gg r23 r26 r25 r24 w8 20 1163531501 !r28 = gg r24 r27 r26 r25 w13 5 2850285829 !r29 = gg r25 r28 r27 r26 w2 9 4243563512 !r30 = gg r26 r29 r28 r27 w7 14 1735328473 !r31 = gg r27 r30 r29 r28 w12 20 2368359562 -- Round 3 !r32 = hh r28 r31 r30 r29 w5 4 4294588738 !r33 = hh r29 r32 r31 r30 w8 11 2272392833 !r34 = hh r30 r33 r32 r31 w11 16 1839030562 !r35 = hh r31 r34 r33 r32 w14 23 4259657740 !r36 = hh r32 r35 r34 r33 w1 4 2763975236 !r37 = hh r33 r36 r35 r34 w4 11 1272893353 !r38 = hh r34 r37 r36 r35 w7 16 4139469664 !r39 = hh r35 r38 r37 r36 w10 23 3200236656 !r40 = hh r36 r39 r38 r37 w13 4 681279174 !r41 = hh r37 r40 r39 r38 w0 11 3936430074 !r42 = hh r38 r41 r40 r39 w3 16 3572445317 !r43 = hh r39 r42 r41 r40 w6 23 76029189 !r44 = hh r40 r43 r42 r41 w9 4 3654602809 !r45 = hh r41 r44 r43 r42 w12 11 3873151461 !r46 = hh r42 r45 r44 r43 w15 16 530742520 !r47 = hh r43 r46 r45 r44 w2 23 3299628645 -- Round 4 !r48 = ii r44 r47 r46 r45 w0 6 4096336452 !r49 = ii r45 r48 r47 r46 w7 10 1126891415 !r50 = ii r46 r49 r48 r47 w14 15 2878612391 !r51 = ii r47 r50 r49 r48 w5 21 4237533241 !r52 = ii r48 r51 r50 r49 w12 6 1700485571 !r53 = ii r49 r52 r51 r50 w3 10 2399980690 !r54 = ii r50 r53 r52 r51 w10 15 4293915773 !r55 = ii r51 r54 r53 r52 w1 21 2240044497 !r56 = ii r52 r55 r54 r53 w8 6 1873313359 !r57 = ii r53 r56 r55 r54 w15 10 4264355552 !r58 = ii r54 r57 r56 r55 w6 15 2734768916 !r59 = ii r55 r58 r57 r56 w13 21 1309151649 !r60 = ii r56 r59 r58 r57 w4 6 4149444226 !r61 = ii r57 r60 r59 r58 w11 10 3174756917 !r62 = ii r58 r61 r60 r59 w2 15 718787259 !r63 = ii r59 r62 r61 r60 w9 21 3951481745 in MD5Digest 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 = {-# 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 #-} -- | mix one Digest and 16 words by applying the md5-rounds mixRaw :: MD5Digest -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> MD5Digest {- mix is the same as applyMD5RoundsRaw, except without INLINE pragma -} mixRaw = applyMD5RoundsRaw ----- Some quick and dirty instances follow ----- -- todo: this is not offical instance Show MD5Digest where show (MD5Digest a b c d) = "HashMD5_"++ toHex a ++ toHex b ++ toHex c ++ toHex d where toHex :: Integral a => a -> String toHex x = reverse $ take 8 $ hex x where hex x = (digits !! (fromIntegral (x `mod` 16))) : hex ( x `div` 16) digits = "0123456789ABCDEF"