{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Safe #-} module Crypto.Hash.MD5 ( MD5 ) where import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Builder import Data.Array.Unboxed import Data.Int import Data.Word import Data.Bits import Data.Monoid import Data.List(foldl') import Crypto.Hash.ADT initSs :: UArray Int Int initSs :: UArray Int Int initSs = (Int, Int) -> [Int] -> UArray Int Int forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => (i, i) -> [e] -> a i e listArray (Int 0, Int 63) [ Int 7, Int 12, Int 17, Int 22, Int 7, Int 12, Int 17, Int 22, Int 7, Int 12, Int 17, Int 22, Int 7, Int 12, Int 17, Int 22 , Int 5, Int 9, Int 14, Int 20, Int 5, Int 9, Int 14, Int 20, Int 5, Int 9, Int 14, Int 20, Int 5, Int 9, Int 14, Int 20 , Int 4, Int 11, Int 16, Int 23, Int 4, Int 11, Int 16, Int 23, Int 4, Int 11, Int 16, Int 23, Int 4, Int 11, Int 16, Int 23 , Int 6, Int 10, Int 15, Int 21, Int 6, Int 10, Int 15, Int 21, Int 6, Int 10, Int 15, Int 21, Int 6, Int 10, Int 15, Int 21 ] initKs :: UArray Int Word32 initKs :: UArray Int Word32 initKs = (Int, Int) -> [Word32] -> UArray Int Word32 forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => (i, i) -> [e] -> a i e listArray (Int 0, Int 63) [ Word32 0xd76aa478, Word32 0xe8c7b756, Word32 0x242070db, Word32 0xc1bdceee , Word32 0xf57c0faf, Word32 0x4787c62a, Word32 0xa8304613, Word32 0xfd469501 , Word32 0x698098d8, Word32 0x8b44f7af, Word32 0xffff5bb1, Word32 0x895cd7be , Word32 0x6b901122, Word32 0xfd987193, Word32 0xa679438e, Word32 0x49b40821 , Word32 0xf61e2562, Word32 0xc040b340, Word32 0x265e5a51, Word32 0xe9b6c7aa , Word32 0xd62f105d, Word32 0x02441453, Word32 0xd8a1e681, Word32 0xe7d3fbc8 , Word32 0x21e1cde6, Word32 0xc33707d6, Word32 0xf4d50d87, Word32 0x455a14ed , Word32 0xa9e3e905, Word32 0xfcefa3f8, Word32 0x676f02d9, Word32 0x8d2a4c8a , Word32 0xfffa3942, Word32 0x8771f681, Word32 0x6d9d6122, Word32 0xfde5380c , Word32 0xa4beea44, Word32 0x4bdecfa9, Word32 0xf6bb4b60, Word32 0xbebfbc70 , Word32 0x289b7ec6, Word32 0xeaa127fa, Word32 0xd4ef3085, Word32 0x04881d05 , Word32 0xd9d4d039, Word32 0xe6db99e5, Word32 0x1fa27cf8, Word32 0xc4ac5665 , Word32 0xf4292244, Word32 0x432aff97, Word32 0xab9423a7, Word32 0xfc93a039 , Word32 0x655b59c3, Word32 0x8f0ccc92, Word32 0xffeff47d, Word32 0x85845dd1 , Word32 0x6fa87e4f, Word32 0xfe2ce6e0, Word32 0xa3014314, Word32 0x4e0811a1 , Word32 0xf7537e82, Word32 0xbd3af235, Word32 0x2ad7d2bb, Word32 0xeb86d391 ] data MD5 = MD5 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 deriving MD5 -> MD5 -> Bool (MD5 -> MD5 -> Bool) -> (MD5 -> MD5 -> Bool) -> Eq MD5 forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: MD5 -> MD5 -> Bool == :: MD5 -> MD5 -> Bool $c/= :: MD5 -> MD5 -> Bool /= :: MD5 -> MD5 -> Bool Eq instance Show MD5 where show :: MD5 -> String show = ByteString -> String LC.unpack (ByteString -> String) -> (MD5 -> ByteString) -> MD5 -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Builder -> ByteString toLazyByteString (Builder -> ByteString) -> (MD5 -> Builder) -> MD5 -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . (Word32 -> Builder) -> [Word32] -> Builder forall m a. Monoid m => (a -> m) -> [a] -> m forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap (Word32 -> Builder word32HexFixed (Word32 -> Builder) -> (Word32 -> Word32) -> Word32 -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . Word32 -> Word32 byteSwap32) ([Word32] -> Builder) -> (MD5 -> [Word32]) -> MD5 -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . MD5 -> [Word32] toList where toList :: MD5 -> [Word32] toList (MD5 Word32 a Word32 b Word32 c Word32 d) = Word32 aWord32 -> [Word32] -> [Word32] forall a. a -> [a] -> [a] :Word32 bWord32 -> [Word32] -> [Word32] forall a. a -> [a] -> [a] :Word32 cWord32 -> [Word32] -> [Word32] forall a. a -> [a] -> [a] :[Word32 d] initHash :: MD5 initHash :: MD5 initHash = Word32 -> Word32 -> Word32 -> Word32 -> MD5 MD5 Word32 0x67452301 Word32 0xefcdab89 Word32 0x98badcfe Word32 0x10325476 encodeInt64Helper :: Int64 -> [Word8] encodeInt64Helper :: Int64 -> [Word8] encodeInt64Helper Int64 x_ = [Word8 w0, Word8 w1, Word8 w2, Word8 w3, Word8 w4, Word8 w5, Word8 w6, Word8 w7] where x :: Int64 x = Int64 x_ Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a * Int64 8 w7 :: Word8 w7 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 56) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff w6 :: Word8 w6 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 48) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff w5 :: Word8 w5 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 40) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff w4 :: Word8 w4 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 32) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff w3 :: Word8 w3 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 24) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff w2 :: Word8 w2 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 16) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff w1 :: Word8 w1 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 8) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff w0 :: Word8 w0 = Int64 -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int64 -> Word8) -> Int64 -> Word8 forall a b. (a -> b) -> a -> b $ (Int64 x Int64 -> Int -> Int64 forall a. Bits a => a -> Int -> a `shiftR` Int 0) Int64 -> Int64 -> Int64 forall a. Bits a => a -> a -> a .&. Int64 0xff encodeInt64 :: Int64 -> ByteString encodeInt64 :: Int64 -> ByteString encodeInt64 = [Word8] -> ByteString B.pack ([Word8] -> ByteString) -> (Int64 -> [Word8]) -> Int64 -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . Int64 -> [Word8] encodeInt64Helper md5BlockSize :: Int md5BlockSize :: Int md5BlockSize = Int 64 md5DigestSize :: Int md5DigestSize :: Int md5DigestSize = Int 16 lastChunk :: Int64 -> ByteString -> [ByteString] lastChunk :: Int64 -> ByteString -> [ByteString] lastChunk Int64 msglen ByteString s | Int len Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < (Int md5BlockSize Int -> Int -> Int forall a. Num a => a -> a -> a - Int 8) = [ByteString s ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> Word8 -> ByteString -> ByteString B.cons Word8 0x80 (Int -> Word8 -> ByteString B.replicate (Int md5BlockSize Int -> Int -> Int forall a. Num a => a -> a -> a - Int 9 Int -> Int -> Int forall a. Num a => a -> a -> a - Int len) Word8 0x0) ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> ByteString encodedLen] | Int len Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < (Int 2Int -> Int -> Int forall a. Num a => a -> a -> a *Int md5BlockSize Int -> Int -> Int forall a. Num a => a -> a -> a - Int 8) = ByteString -> [ByteString] helper (ByteString s ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> Word8 -> ByteString -> ByteString B.cons Word8 0x80 (Int -> Word8 -> ByteString B.replicate (Int 2Int -> Int -> Int forall a. Num a => a -> a -> a *Int md5BlockSize Int -> Int -> Int forall a. Num a => a -> a -> a -Int 9 Int -> Int -> Int forall a. Num a => a -> a -> a - Int len) Word8 0x0) ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> ByteString encodedLen) where len :: Int len = ByteString -> Int B.length ByteString s encodedLen :: ByteString encodedLen = Int64 -> ByteString encodeInt64 Int64 msglen helper :: ByteString -> [ByteString] helper ByteString bs = [ByteString s1, ByteString s2] where (!ByteString s1, !ByteString s2) = Int -> ByteString -> (ByteString, ByteString) B.splitAt Int 64 ByteString bs readW32 :: ByteString -> Word32 readW32 :: ByteString -> Word32 readW32 = Word32 -> Word32 byteSwap32 (Word32 -> Word32) -> (ByteString -> Word32) -> ByteString -> Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . (Word32 -> Word8 -> Word32) -> Word32 -> ByteString -> Word32 forall a. (a -> Word8 -> a) -> a -> ByteString -> a B.foldl' Word32 -> Word8 -> Word32 forall {a} {a}. (Bits a, Integral a, Num a) => a -> a -> a acc Word32 0 where acc :: a -> a -> a acc a x a c = a x a -> Int -> a forall a. Bits a => a -> Int -> a `shiftL` Int 8 a -> a -> a forall a. Num a => a -> a -> a + a -> a forall a b. (Integral a, Num b) => a -> b fromIntegral a c {-# INLINE acc #-} {-# INLINE readW32 #-} prepareBlock :: ByteString -> UArray Int Word32 prepareBlock :: ByteString -> UArray Int Word32 prepareBlock = (Int, Int) -> [Word32] -> UArray Int Word32 forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => (i, i) -> [e] -> a i e listArray (Int 0, Int 15) ([Word32] -> UArray Int Word32) -> (ByteString -> [Word32]) -> ByteString -> UArray Int Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> [Word32] go where go :: ByteString -> [Word32] go ByteString s | ByteString -> Bool B.null ByteString s = [] | Bool otherwise = let !s1 :: ByteString s1 = Int -> ByteString -> ByteString B.take Int 4 ByteString s !s' :: ByteString s' = Int -> ByteString -> ByteString B.drop Int 4 ByteString s in ByteString -> Word32 readW32 ByteString s1 Word32 -> [Word32] -> [Word32] forall a. a -> [a] -> [a] : ByteString -> [Word32] go ByteString s' {-# INLINE go #-} md5BlockUpdate :: MD5 -> UArray Int Word32 -> MD5 md5BlockUpdate :: MD5 -> UArray Int Word32 -> MD5 md5BlockUpdate MD5 h UArray Int Word32 u = (MD5 -> Int -> MD5) -> MD5 -> [Int] -> MD5 forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' MD5 -> Int -> MD5 blkUpdate MD5 h [Int 0..Int 63] where blkUpdate :: MD5 -> Int -> MD5 blkUpdate (MD5 Word32 a Word32 b Word32 c Word32 d) Int i = Word32 -> Word32 -> Word32 -> Word32 -> MD5 MD5 Word32 d Word32 b' Word32 b Word32 c where !(!Word32 f, !Int g) | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 16 = ((Word32 d Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a `xor` (Word32 b Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. (Word32 c Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a `xor` Word32 d))), Int i) | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 32 = ((Word32 c Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a `xor` (Word32 d Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. (Word32 b Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a `xor` Word32 c))), (Int 5Int -> Int -> Int forall a. Num a => a -> a -> a *Int iInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1) Int -> Int -> Int forall a. Bits a => a -> a -> a .&. Int 0xf) | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 48 = (Word32 b Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a `xor` Word32 c Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a `xor` Word32 d, (Int 3Int -> Int -> Int forall a. Num a => a -> a -> a *Int iInt -> Int -> Int forall a. Num a => a -> a -> a +Int 5) Int -> Int -> Int forall a. Bits a => a -> a -> a .&. Int 0xf) | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 64 = ((Word32 c Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a `xor` (Word32 b Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .|. (Word32 -> Word32 forall a. Bits a => a -> a complement Word32 d))), (Int 7Int -> Int -> Int forall a. Num a => a -> a -> a *Int i) Int -> Int -> Int forall a. Bits a => a -> a -> a .&. Int 0xf) !b' :: Word32 b' = Word32 b Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a + (Word32 aWord32 -> Word32 -> Word32 forall a. Num a => a -> a -> a +Word32 fWord32 -> Word32 -> Word32 forall a. Num a => a -> a -> a +(UArray Int Word32 initKsUArray Int Word32 -> Int -> Word32 forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> i -> e !Int i)Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a +(UArray Int Word32 uUArray Int Word32 -> Int -> Word32 forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> i -> e !Int g)) Word32 -> Int -> Word32 forall a. Bits a => a -> Int -> a `rotateL` (UArray Int Int initSsUArray Int Int -> Int -> Int forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> i -> e !Int i) blkUpdate :: MD5 -> Int -> MD5 {-# INLINE blkUpdate #-} {-# INLINE encodeChunk #-} encodeChunk :: MD5 -> ByteString -> MD5 encodeChunk :: MD5 -> ByteString -> MD5 encodeChunk hv :: MD5 hv@(MD5 Word32 a Word32 b Word32 c Word32 d) ByteString bs = Word32 -> Word32 -> Word32 -> Word32 -> MD5 MD5 (Word32 aWord32 -> Word32 -> Word32 forall a. Num a => a -> a -> a +Word32 a') (Word32 bWord32 -> Word32 -> Word32 forall a. Num a => a -> a -> a +Word32 b') (Word32 cWord32 -> Word32 -> Word32 forall a. Num a => a -> a -> a +Word32 c') (Word32 dWord32 -> Word32 -> Word32 forall a. Num a => a -> a -> a +Word32 d') where MD5 Word32 a' Word32 b' Word32 c' Word32 d' = MD5 -> UArray Int Word32 -> MD5 md5BlockUpdate MD5 hv (ByteString -> UArray Int Word32 prepareBlock ByteString bs) {-# NOINLINE md5Hash #-} md5Hash :: LBS.ByteString -> MD5 md5Hash :: ByteString -> MD5 md5Hash = Context MD5 -> MD5 md5Final (Context MD5 -> MD5) -> (ByteString -> Context MD5) -> ByteString -> MD5 forall b c a. (b -> c) -> (a -> b) -> a -> c . (Context MD5 -> ByteString -> Context MD5) -> Context MD5 -> ByteString -> Context MD5 forall a. (a -> ByteString -> a) -> a -> ByteString -> a LBS.foldlChunks Context MD5 -> ByteString -> Context MD5 md5Update Context MD5 md5Init md5Init :: Context MD5 md5Init :: Context MD5 md5Init = Int64 -> Int -> ByteString -> MD5 -> Context MD5 forall a. Int64 -> Int -> ByteString -> a -> Context a Context Int64 0 Int 0 ByteString B.empty MD5 initHash md5Update :: Context MD5 -> ByteString -> Context MD5 md5Update :: Context MD5 -> ByteString -> Context MD5 md5Update ctx :: Context MD5 ctx@(Context Int64 n Int k ByteString w MD5 hv) ByteString s | ByteString -> Bool B.null ByteString s = Context MD5 ctx | Int sizeRead Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int sizeToRead = Int64 -> Int -> ByteString -> MD5 -> Context MD5 forall a. Int64 -> Int -> ByteString -> a -> Context a Context (Int64 n Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a + Int -> Int64 forall a b. (Integral a, Num b) => a -> b fromIntegral Int sizeRead) (Int k Int -> Int -> Int forall a. Num a => a -> a -> a + Int sizeRead) (ByteString w ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> ByteString s1) MD5 hv | Int sizeRead Int -> Int -> Bool forall a. Ord a => a -> a -> Bool >= Int sizeToRead = Context MD5 -> ByteString -> Context MD5 md5Update (Int64 -> Int -> ByteString -> MD5 -> Context MD5 forall a. Int64 -> Int -> ByteString -> a -> Context a Context (Int64 n Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a + Int -> Int64 forall a b. (Integral a, Num b) => a -> b fromIntegral Int sizeToRead) Int 0 ByteString forall a. Monoid a => a mempty (MD5 -> ByteString -> MD5 encodeChunk MD5 hv (ByteString w ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> ByteString s1))) ByteString s' where !sizeToRead :: Int sizeToRead = Int md5BlockSize Int -> Int -> Int forall a. Num a => a -> a -> a - Int k !s1 :: ByteString s1 = Int -> ByteString -> ByteString B.take Int sizeToRead ByteString s !s' :: ByteString s' = Int -> ByteString -> ByteString B.drop Int sizeToRead ByteString s !sizeRead :: Int sizeRead = ByteString -> Int B.length ByteString s1 {-# NOINLINE md5Final #-} md5Final :: Context MD5 -> MD5 md5Final :: Context MD5 -> MD5 md5Final (Context Int64 n Int _ ByteString w MD5 hv) = (MD5 -> ByteString -> MD5) -> MD5 -> [ByteString] -> MD5 forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' MD5 -> ByteString -> MD5 encodeChunk MD5 hv (Int64 -> ByteString -> [ByteString] lastChunk Int64 n ByteString w) instance HashAlgorithm MD5 where hashBlockSize :: MD5 -> Int hashBlockSize = Int -> MD5 -> Int forall a b. a -> b -> a const Int md5BlockSize hashDigestSize :: MD5 -> Int hashDigestSize = Int -> MD5 -> Int forall a b. a -> b -> a const Int md5DigestSize hashInit :: Context MD5 hashInit = Context MD5 md5Init hashUpdate :: Context MD5 -> ByteString -> Context MD5 hashUpdate = Context MD5 -> ByteString -> Context MD5 md5Update hashFinal :: Context MD5 -> MD5 hashFinal = Context MD5 -> MD5 md5Final