{-# 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 = 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 = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MD5 -> MD5 -> Bool
$c/= :: MD5 -> MD5 -> Bool
== :: MD5 -> MD5 -> Bool
$c== :: MD5 -> MD5 -> Bool
Eq           

instance Show MD5 where
  show :: MD5 -> String
show = ByteString -> String
LC.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Word32 -> Builder
word32HexFixed forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
byteSwap32) 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
aforall a. a -> [a] -> [a]
:Word32
bforall a. a -> [a] -> [a]
:Word32
cforall 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_ forall a. Num a => a -> a -> a
* Int64
8
        w7 :: Word8
w7 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR` Int
56) forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w6 :: Word8
w6 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR` Int
48) forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w5 :: Word8
w5 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR` Int
40) forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w4 :: Word8
w4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR` Int
32) forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w3 :: Word8
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR` Int
24) forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR`  Int
8) forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w0 :: Word8
w0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int64
x forall a. Bits a => a -> Int -> a
`shiftR`  Int
0) forall a. Bits a => a -> a -> a
.&. Int64
0xff

encodeInt64 :: Int64 -> ByteString
encodeInt64 :: Int64 -> ByteString
encodeInt64 = [Word8] -> ByteString
B.pack 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 forall a. Ord a => a -> a -> Bool
< (Int
md5BlockSize forall a. Num a => a -> a -> a
- Int
8)  = [ByteString
s forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString -> ByteString
B.cons Word8
0x80 (Int -> Word8 -> ByteString
B.replicate (Int
md5BlockSize forall a. Num a => a -> a -> a
- Int
9 forall a. Num a => a -> a -> a
- Int
len) Word8
0x0)  forall a. Semigroup a => a -> a -> a
<> ByteString
encodedLen]
  | Int
len forall a. Ord a => a -> a -> Bool
< (Int
2forall a. Num a => a -> a -> a
*Int
md5BlockSize forall a. Num a => a -> a -> a
- Int
8) = ByteString -> [ByteString]
helper (ByteString
s forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString -> ByteString
B.cons Word8
0x80 (Int -> Word8 -> ByteString
B.replicate (Int
2forall a. Num a => a -> a -> a
*Int
md5BlockSize forall a. Num a => a -> a -> a
-Int
9 forall a. Num a => a -> a -> a
- Int
len) Word8
0x0) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' 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 forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Num 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 = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
15) 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 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 = 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 forall a. Ord a => a -> a -> Bool
< Int
16  = ((Word32
d forall a. Bits a => a -> a -> a
`xor` (Word32
b forall a. Bits a => a -> a -> a
.&. (Word32
c forall a. Bits a => a -> a -> a
`xor` Word32
d))), Int
i)
          | Int
i forall a. Ord a => a -> a -> Bool
< Int
32  = ((Word32
c forall a. Bits a => a -> a -> a
`xor` (Word32
d forall a. Bits a => a -> a -> a
.&. (Word32
b forall a. Bits a => a -> a -> a
`xor` Word32
c))), (Int
5forall a. Num a => a -> a -> a
*Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Bits a => a -> a -> a
.&. Int
0xf)
          | Int
i forall a. Ord a => a -> a -> Bool
< Int
48  = (Word32
b forall a. Bits a => a -> a -> a
`xor` Word32
c forall a. Bits a => a -> a -> a
`xor` Word32
d, (Int
3forall a. Num a => a -> a -> a
*Int
iforall a. Num a => a -> a -> a
+Int
5) forall a. Bits a => a -> a -> a
.&. Int
0xf)
          | Int
i forall a. Ord a => a -> a -> Bool
< Int
64  = ((Word32
c forall a. Bits a => a -> a -> a
`xor` (Word32
b forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> a
complement Word32
d))), (Int
7forall a. Num a => a -> a -> a
*Int
i) forall a. Bits a => a -> a -> a
.&. Int
0xf)
        !b' :: Word32
b'      = Word32
b forall a. Num a => a -> a -> a
+ (Word32
aforall a. Num a => a -> a -> a
+Word32
fforall a. Num a => a -> a -> a
+(UArray Int Word32
initKsforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i)forall a. Num a => a -> a -> a
+(UArray Int Word32
uforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
g)) forall a. Bits a => a -> Int -> a
`rotateL` (UArray Int Int
initSsforall (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
aforall a. Num a => a -> a -> a
+Word32
a') (Word32
bforall a. Num a => a -> a -> a
+Word32
b') (Word32
cforall a. Num a => a -> a -> a
+Word32
c') (Word32
dforall 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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  forall a. Ord a => a -> a -> Bool
< Int
sizeToRead = forall a. Int64 -> Int -> ByteString -> a -> Context a
Context (Int64
n forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeRead) (Int
k forall a. Num a => a -> a -> a
+ Int
sizeRead) (ByteString
w forall a. Semigroup a => a -> a -> a
<> ByteString
s1) MD5
hv
  | Int
sizeRead forall a. Ord a => a -> a -> Bool
>= Int
sizeToRead = Context MD5 -> ByteString -> Context MD5
md5Update (forall a. Int64 -> Int -> ByteString -> a -> Context a
Context (Int64
n forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeToRead) Int
0 forall a. Monoid a => a
mempty (MD5 -> ByteString -> MD5
encodeChunk MD5
hv (ByteString
w forall a. Semigroup a => a -> a -> a
<> ByteString
s1))) ByteString
s'
  where
    !sizeToRead :: Int
sizeToRead  = Int
md5BlockSize 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) = 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 = forall a b. a -> b -> a
const Int
md5BlockSize
  hashDigestSize :: MD5 -> Int
hashDigestSize = 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