module Network.HTTP.MD5Aux 
   (md5,  md5s,  md5i,
    MD5(..), ABCD(..), 
    Zord64, Str(..), BoolList(..), WordList(..)) where

import Data.Char (ord, chr)
import Data.Bits (rotateL, shiftL, shiftR, (.&.), (.|.), xor, complement)
import Data.Word (Word32, Word64)

rotL :: Word32 -> Int -> Word32
rotL :: Word32 -> Int -> Word32
rotL x :: Word32
x = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
rotateL Word32
x

type Zord64 = Word64

-- ===================== TYPES AND CLASS DEFINTIONS ========================


type XYZ = (Word32, Word32, Word32)
type Rotation = Int
newtype ABCD = ABCD (Word32, Word32, Word32, Word32) deriving (ABCD -> ABCD -> Bool
(ABCD -> ABCD -> Bool) -> (ABCD -> ABCD -> Bool) -> Eq ABCD
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABCD -> ABCD -> Bool
$c/= :: ABCD -> ABCD -> Bool
== :: ABCD -> ABCD -> Bool
$c== :: ABCD -> ABCD -> Bool
Eq, Int -> ABCD -> ShowS
[ABCD] -> ShowS
ABCD -> String
(Int -> ABCD -> ShowS)
-> (ABCD -> String) -> ([ABCD] -> ShowS) -> Show ABCD
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ABCD] -> ShowS
$cshowList :: [ABCD] -> ShowS
show :: ABCD -> String
$cshow :: ABCD -> String
showsPrec :: Int -> ABCD -> ShowS
$cshowsPrec :: Int -> ABCD -> ShowS
Show)
newtype Str = Str String
newtype BoolList = BoolList [Bool]
newtype WordList = WordList ([Word32], Word64)

-- Anything we want to work out the MD5 of must be an instance of class MD5

class MD5 a where
 get_next :: a -> ([Word32], Int, a) -- get the next blocks worth
 --                     \      \   \------ the rest of the input
 --                      \      \--------- the number of bits returned
 --                       \--------------- the bits returned in 32bit words
 len_pad :: Word64 -> a -> a         -- append the padding and length
 finished :: a -> Bool               -- Have we run out of input yet?


-- Mainly exists because it's fairly easy to do MD5s on input where the
-- length is not a multiple of 8

instance MD5 BoolList where
 get_next :: BoolList -> ([Word32], Int, BoolList)
get_next (BoolList s :: [Bool]
s) = ([Bool] -> [Word32]
bools_to_word32s [Bool]
ys, [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
ys, [Bool] -> BoolList
BoolList [Bool]
zs)
  where (ys :: [Bool]
ys, zs :: [Bool]
zs) = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt 512 [Bool]
s
 len_pad :: Word64 -> BoolList -> BoolList
len_pad l :: Word64
l (BoolList bs :: [Bool]
bs)
  = [Bool] -> BoolList
BoolList ([Bool]
bs [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool
True]
                 [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ (447 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
l) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 511) Bool
False
                 [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Word64
l Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL 1 Int
x) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 | Int
x <- ([Int] -> [Int]
forall a. [a] -> [a]
mangle [0..63])]
             )
  where mangle :: [a] -> [a]
mangle [] = []
        mangle xs :: [a]
xs = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
mangle [a]
zs
         where (ys :: [a]
ys, zs :: [a]
zs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt 8 [a]
xs
 finished :: BoolList -> Bool
finished (BoolList s :: [Bool]
s) = [Bool]
s [Bool] -> [Bool] -> Bool
forall a. Eq a => a -> a -> Bool
== []


-- The string instance is fairly straightforward

instance MD5 Str where
 get_next :: Str -> ([Word32], Int, Str)
get_next (Str s :: String
s) = (String -> [Word32]
string_to_word32s String
ys, 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ys, String -> Str
Str String
zs)
  where (ys :: String
ys, zs :: String
zs) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt 64 String
s
 len_pad :: Word64 -> Str -> Str
len_pad c64 :: Word64
c64 (Str s :: String
s) = String -> Str
Str (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
padding String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l)
  where padding :: String
padding = '\128'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
zeros) '\000'
        zeros :: Word64
zeros = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR ((440 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
c64) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 511) 3
        l :: String
l = Int -> Word64 -> String
length_to_chars 8 Word64
c64
 finished :: Str -> Bool
finished (Str s :: String
s) = String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ""


-- YA instance that is believed will be useful

instance MD5 WordList where
 get_next :: WordList -> ([Word32], Int, WordList)
get_next (WordList (ws :: [Word32]
ws, l :: Word64
l)) = ([Word32]
xs, Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
taken, ([Word32], Word64) -> WordList
WordList ([Word32]
ys, Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
taken))
  where (xs :: [Word32]
xs, ys :: [Word32]
ys) = Int -> [Word32] -> ([Word32], [Word32])
forall a. Int -> [a] -> ([a], [a])
splitAt 16 [Word32]
ws
        taken :: Word64
taken = if Word64
l Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 511 then 512 else Word64
l Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 511
 len_pad :: Word64 -> WordList -> WordList
len_pad c64 :: Word64
c64 (WordList (ws :: [Word32]
ws, l :: Word64
l)) = ([Word32], Word64) -> WordList
WordList ([Word32]
beginning [Word32] -> [Word32] -> [Word32]
forall a. [a] -> [a] -> [a]
++ [Word32]
nextish [Word32] -> [Word32] -> [Word32]
forall a. [a] -> [a] -> [a]
++ [Word32]
blanks [Word32] -> [Word32] -> [Word32]
forall a. [a] -> [a] -> [a]
++ [Word32]
size, Word64
newlen)
  where beginning :: [Word32]
beginning = if [Word32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word32]
ws Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Word32]
start [Word32] -> [Word32] -> [Word32]
forall a. [a] -> [a] -> [a]
++ [Word32]
lastone' else []
        start :: [Word32]
start = [Word32] -> [Word32]
forall a. [a] -> [a]
init [Word32]
ws
        lastone :: Word32
lastone = [Word32] -> Word32
forall a. [a] -> a
last [Word32]
ws
        offset :: Word64
offset = Word64
c64 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 31
        lastone' :: [Word32]
lastone' = [if Word64
offset Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Word32
lastone Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
theone else Word32
lastone]
        theone :: Word32
theone = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR 128 (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
offset Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 7))
                        (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
offset Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (31 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- 7))
        nextish :: [Word32]
nextish = if Word64
offset Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [128] else []
        c64' :: Word64
c64' = Word64
c64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (32 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
offset)
        num_blanks :: Int
num_blanks = (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR ((448 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
c64') Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 511) 5)
        blanks :: [Word32]
blanks = Int -> Word32 -> [Word32]
forall a. Int -> a -> [a]
replicate Int
num_blanks 0
        lowsize :: Word32
lowsize = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64
c64 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL 1 32 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- 1)
        topsize :: Word32
topsize = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
c64 32
        size :: [Word32]
size = [Word32
lowsize, Word32
topsize]
        newlen :: Word64
newlen = Word64
l Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64 -> Word64
forall a. Bits a => a -> a
complement 511)
               Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ if Word64
c64 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 511 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 448 then 1024 else 512
 finished :: WordList -> Bool
finished (WordList (_, z :: Word64
z)) = Word64
z Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0


instance Num ABCD where
 ABCD (a1 :: Word32
a1, b1 :: Word32
b1, c1 :: Word32
c1, d1 :: Word32
d1) + :: ABCD -> ABCD -> ABCD
+ ABCD (a2 :: Word32
a2, b2 :: Word32
b2, c2 :: Word32
c2, d2 :: Word32
d2) = (Word32, Word32, Word32, Word32) -> ABCD
ABCD (Word32
a1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
a2, Word32
b1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b2, Word32
c1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
c2, Word32
d1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d2)

 (-)         = String -> ABCD -> ABCD -> ABCD
forall a. HasCallStack => String -> a
error "(-){ABCD}: no instance method defined"
 * :: ABCD -> ABCD -> ABCD
(*)         = String -> ABCD -> ABCD -> ABCD
forall a. HasCallStack => String -> a
error "(*){ABCD}: no instance method defined"
 signum :: ABCD -> ABCD
signum      = String -> ABCD -> ABCD
forall a. HasCallStack => String -> a
error "signum{ABCD}: no instance method defined"
 fromInteger :: Integer -> ABCD
fromInteger = String -> Integer -> ABCD
forall a. HasCallStack => String -> a
error "fromInteger{ABCD}: no instance method defined"
 abs :: ABCD -> ABCD
abs         = String -> ABCD -> ABCD
forall a. HasCallStack => String -> a
error "abs{ABCD}: no instance method defined"
-- ===================== EXPORTED FUNCTIONS ========================


-- The simplest function, gives you the MD5 of a string as 4-tuple of
-- 32bit words.

md5 :: (MD5 a) => a -> ABCD
md5 :: a -> ABCD
md5 m :: a
m = Bool -> Word64 -> ABCD -> a -> ABCD
forall a. MD5 a => Bool -> Word64 -> ABCD -> a -> ABCD
md5_main Bool
False 0 ABCD
magic_numbers a
m


-- Returns a hex number ala the md5sum program

md5s :: (MD5 a) => a -> String
md5s :: a -> String
md5s = ABCD -> String
abcd_to_string (ABCD -> String) -> (a -> ABCD) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ABCD
forall a. MD5 a => a -> ABCD
md5


-- Returns an integer equivalent to the above hex number

md5i :: (MD5 a) => a -> Integer
md5i :: a -> Integer
md5i = ABCD -> Integer
abcd_to_integer (ABCD -> Integer) -> (a -> ABCD) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ABCD
forall a. MD5 a => a -> ABCD
md5


-- ===================== THE CORE ALGORITHM ========================


-- Decides what to do. The first argument indicates if padding has been
-- added. The second is the length mod 2^64 so far. Then we have the
-- starting state, the rest of the string and the final state.

md5_main :: (MD5 a) =>
            Bool   -- Have we added padding yet?
         -> Word64 -- The length so far mod 2^64
         -> ABCD   -- The initial state
         -> a      -- The non-processed portion of the message
         -> ABCD   -- The resulting state
md5_main :: Bool -> Word64 -> ABCD -> a -> ABCD
md5_main padded :: Bool
padded ilen :: Word64
ilen abcd :: ABCD
abcd m :: a
m
 = if a -> Bool
forall a. MD5 a => a -> Bool
finished a
m Bool -> Bool -> Bool
&& Bool
padded
   then ABCD
abcd
   else Bool -> Word64 -> ABCD -> a -> ABCD
forall a. MD5 a => Bool -> Word64 -> ABCD -> a -> ABCD
md5_main Bool
padded' (Word64
ilen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ 512) (ABCD
abcd ABCD -> ABCD -> ABCD
forall a. Num a => a -> a -> a
+ ABCD
abcd') a
m''
 where (m16 :: [Word32]
m16, l :: Int
l, m' :: a
m') = a -> ([Word32], Int, a)
forall a. MD5 a => a -> ([Word32], Int, a)
get_next a
m
       len' :: Word64
len' = Word64
ilen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
       ((m16' :: [Word32]
m16', _, m'' :: a
m''), padded' :: Bool
padded') = if Bool -> Bool
not Bool
padded Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 512
                                   then (a -> ([Word32], Int, a)
forall a. MD5 a => a -> ([Word32], Int, a)
get_next (a -> ([Word32], Int, a)) -> a -> ([Word32], Int, a)
forall a b. (a -> b) -> a -> b
$ Word64 -> a -> a
forall a. MD5 a => Word64 -> a -> a
len_pad Word64
len' a
m, Bool
True)
                                   else (([Word32]
m16, Int
l, a
m'), Bool
padded)
       abcd' :: ABCD
abcd' = ABCD -> [Word32] -> ABCD
md5_do_block ABCD
abcd [Word32]
m16'


-- md5_do_block processes a 512 bit block by calling md5_round 4 times to
-- apply each round with the correct constants and permutations of the
-- block

md5_do_block :: ABCD     -- Initial state
             -> [Word32] -- The block to be processed - 16 32bit words
             -> ABCD     -- Resulting state
md5_do_block :: ABCD -> [Word32] -> ABCD
md5_do_block abcd0 :: ABCD
abcd0 w :: [Word32]
w = ABCD
abcd4
 where (r1 :: [(Int, Word32)]
r1, r2 :: [(Int, Word32)]
r2, r3 :: [(Int, Word32)]
r3, r4 :: [(Int, Word32)]
r4) = ([(Int, Word32)], [(Int, Word32)], [(Int, Word32)],
 [(Int, Word32)])
rounds
       {-
       map (\x -> w !! x) [1,6,11,0,5,10,15,4,9,14,3,8,13,2,7,12]
                       -- [(5 * x + 1) `mod` 16 | x <- [0..15]]
       map (\x -> w !! x) [5,8,11,14,1,4,7,10,13,0,3,6,9,12,15,2]
                       -- [(3 * x + 5) `mod` 16 | x <- [0..15]]
       map (\x -> w !! x) [0,7,14,5,12,3,10,1,8,15,6,13,4,11,2,9]
                       -- [(7 * x) `mod` 16 | x <- [0..15]]
       -}
       perm5 :: [a] -> [a]
perm5 [c0 :: a
c0,c1 :: a
c1,c2 :: a
c2,c3 :: a
c3,c4 :: a
c4,c5 :: a
c5,c6 :: a
c6,c7 :: a
c7,c8 :: a
c8,c9 :: a
c9,c10 :: a
c10,c11 :: a
c11,c12 :: a
c12,c13 :: a
c13,c14 :: a
c14,c15 :: a
c15]
        = [a
c1,a
c6,a
c11,a
c0,a
c5,a
c10,a
c15,a
c4,a
c9,a
c14,a
c3,a
c8,a
c13,a
c2,a
c7,a
c12]
       perm5 _ = String -> [a]
forall a. HasCallStack => String -> a
error "broke at perm5"
       perm3 :: [a] -> [a]
perm3 [c0 :: a
c0,c1 :: a
c1,c2 :: a
c2,c3 :: a
c3,c4 :: a
c4,c5 :: a
c5,c6 :: a
c6,c7 :: a
c7,c8 :: a
c8,c9 :: a
c9,c10 :: a
c10,c11 :: a
c11,c12 :: a
c12,c13 :: a
c13,c14 :: a
c14,c15 :: a
c15]
        = [a
c5,a
c8,a
c11,a
c14,a
c1,a
c4,a
c7,a
c10,a
c13,a
c0,a
c3,a
c6,a
c9,a
c12,a
c15,a
c2]
       perm3 _ = String -> [a]
forall a. HasCallStack => String -> a
error "broke at perm3"
       perm7 :: [a] -> [a]
perm7 [c0 :: a
c0,c1 :: a
c1,c2 :: a
c2,c3 :: a
c3,c4 :: a
c4,c5 :: a
c5,c6 :: a
c6,c7 :: a
c7,c8 :: a
c8,c9 :: a
c9,c10 :: a
c10,c11 :: a
c11,c12 :: a
c12,c13 :: a
c13,c14 :: a
c14,c15 :: a
c15]
        = [a
c0,a
c7,a
c14,a
c5,a
c12,a
c3,a
c10,a
c1,a
c8,a
c15,a
c6,a
c13,a
c4,a
c11,a
c2,a
c9]
       perm7 _ = String -> [a]
forall a. HasCallStack => String -> a
error "broke at perm7"
       abcd1 :: ABCD
abcd1 = (XYZ -> Word32) -> ABCD -> [Word32] -> [(Int, Word32)] -> ABCD
md5_round XYZ -> Word32
md5_f ABCD
abcd0        [Word32]
w  [(Int, Word32)]
r1
       abcd2 :: ABCD
abcd2 = (XYZ -> Word32) -> ABCD -> [Word32] -> [(Int, Word32)] -> ABCD
md5_round XYZ -> Word32
md5_g ABCD
abcd1 ([Word32] -> [Word32]
forall a. [a] -> [a]
perm5 [Word32]
w) [(Int, Word32)]
r2
       abcd3 :: ABCD
abcd3 = (XYZ -> Word32) -> ABCD -> [Word32] -> [(Int, Word32)] -> ABCD
md5_round XYZ -> Word32
md5_h ABCD
abcd2 ([Word32] -> [Word32]
forall a. [a] -> [a]
perm3 [Word32]
w) [(Int, Word32)]
r3
       abcd4 :: ABCD
abcd4 = (XYZ -> Word32) -> ABCD -> [Word32] -> [(Int, Word32)] -> ABCD
md5_round XYZ -> Word32
md5_i ABCD
abcd3 ([Word32] -> [Word32]
forall a. [a] -> [a]
perm7 [Word32]
w) [(Int, Word32)]
r4


-- md5_round does one of the rounds. It takes an auxiliary function and foldls
-- (md5_inner_function f) to repeatedly apply it to the initial state with the
-- correct constants

md5_round :: (XYZ -> Word32)      -- Auxiliary function (F, G, H or I
                                  -- for those of you with a copy of
                                  -- the prayer book^W^WRFC)
          -> ABCD                 -- Initial state
          -> [Word32]             -- The 16 32bit words of input
          -> [(Rotation, Word32)] -- The list of 16 rotations and
                                  -- additive constants
          -> ABCD                 -- Resulting state
md5_round :: (XYZ -> Word32) -> ABCD -> [Word32] -> [(Int, Word32)] -> ABCD
md5_round f :: XYZ -> Word32
f abcd :: ABCD
abcd s :: [Word32]
s ns :: [(Int, Word32)]
ns = (ABCD -> (Int, Word32) -> ABCD) -> ABCD -> [(Int, Word32)] -> ABCD
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((XYZ -> Word32) -> ABCD -> (Int, Word32) -> ABCD
md5_inner_function XYZ -> Word32
f) ABCD
abcd [(Int, Word32)]
ns'
 where ns' :: [(Int, Word32)]
ns' = (Word32 -> (Int, Word32) -> (Int, Word32))
-> [Word32] -> [(Int, Word32)] -> [(Int, Word32)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\x :: Word32
x (y :: Int
y, z :: Word32
z) -> (Int
y, Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
z)) [Word32]
s [(Int, Word32)]
ns


-- Apply one of the functions md5_[fghi] and put the new ABCD together

md5_inner_function :: (XYZ -> Word32)    -- Auxiliary function
                   -> ABCD               -- Initial state
                   -> (Rotation, Word32) -- The rotation and additive
                                         -- constant (X[i] + T[j])
                   -> ABCD               -- Resulting state
md5_inner_function :: (XYZ -> Word32) -> ABCD -> (Int, Word32) -> ABCD
md5_inner_function f :: XYZ -> Word32
f (ABCD (a :: Word32
a, b :: Word32
b, c :: Word32
c, d :: Word32
d)) (s :: Int
s, ki :: Word32
ki) = (Word32, Word32, Word32, Word32) -> ABCD
ABCD (Word32
d, Word32
a', Word32
b, Word32
c)
 where mid_a :: Word32
mid_a = Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ XYZ -> Word32
f(Word32
b,Word32
c,Word32
d) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
ki
       rot_a :: Word32
rot_a = Word32 -> Int -> Word32
rotL Word32
mid_a Int
s
       a' :: Word32
a' = Word32
b Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
rot_a


-- The 4 auxiliary functions

md5_f :: XYZ -> Word32
md5_f :: XYZ -> Word32
md5_f (x :: Word32
x, y :: Word32
y, z :: Word32
z) = Word32
z Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
y Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
z))
{- optimised version of: (x .&. y) .|. ((complement x) .&. z) -}

md5_g :: XYZ -> Word32
md5_g :: XYZ -> Word32
md5_g (x :: Word32
x, y :: Word32
y, z :: Word32
z) = XYZ -> Word32
md5_f (Word32
z, Word32
x, Word32
y)
{- was: (x .&. z) .|. (y .&. (complement z)) -}

md5_h :: XYZ -> Word32
md5_h :: XYZ -> Word32
md5_h (x :: Word32
x, y :: Word32
y, z :: Word32
z) = Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
y Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
z

md5_i :: XYZ -> Word32
md5_i :: XYZ -> Word32
md5_i (x :: Word32
x, y :: Word32
y, z :: Word32
z) = Word32
y Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
z))


-- The magic numbers from the RFC.

magic_numbers :: ABCD
magic_numbers :: ABCD
magic_numbers = (Word32, Word32, Word32, Word32) -> ABCD
ABCD (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476)


-- The 4 lists of (rotation, additive constant) tuples, one for each round

rounds :: ([(Rotation, Word32)],
           [(Rotation, Word32)],
           [(Rotation, Word32)],
           [(Rotation, Word32)])
rounds :: ([(Int, Word32)], [(Int, Word32)], [(Int, Word32)],
 [(Int, Word32)])
rounds = ([(Int, Word32)]
r1, [(Int, Word32)]
r2, [(Int, Word32)]
r3, [(Int, Word32)]
r4)
 where r1 :: [(Int, Word32)]
r1 = [(Int
s11, 0xd76aa478), (Int
s12, 0xe8c7b756), (Int
s13, 0x242070db),
             (Int
s14, 0xc1bdceee), (Int
s11, 0xf57c0faf), (Int
s12, 0x4787c62a),
             (Int
s13, 0xa8304613), (Int
s14, 0xfd469501), (Int
s11, 0x698098d8),
             (Int
s12, 0x8b44f7af), (Int
s13, 0xffff5bb1), (Int
s14, 0x895cd7be),
             (Int
s11, 0x6b901122), (Int
s12, 0xfd987193), (Int
s13, 0xa679438e),
             (Int
s14, 0x49b40821)]
       r2 :: [(Int, Word32)]
r2 = [(Int
s21, 0xf61e2562), (Int
s22, 0xc040b340), (Int
s23, 0x265e5a51),
             (Int
s24, 0xe9b6c7aa), (Int
s21, 0xd62f105d), (Int
s22,  0x2441453),
             (Int
s23, 0xd8a1e681), (Int
s24, 0xe7d3fbc8), (Int
s21, 0x21e1cde6),
             (Int
s22, 0xc33707d6), (Int
s23, 0xf4d50d87), (Int
s24, 0x455a14ed),
             (Int
s21, 0xa9e3e905), (Int
s22, 0xfcefa3f8), (Int
s23, 0x676f02d9),
             (Int
s24, 0x8d2a4c8a)]
       r3 :: [(Int, Word32)]
r3 = [(Int
s31, 0xfffa3942), (Int
s32, 0x8771f681), (Int
s33, 0x6d9d6122),
             (Int
s34, 0xfde5380c), (Int
s31, 0xa4beea44), (Int
s32, 0x4bdecfa9),
             (Int
s33, 0xf6bb4b60), (Int
s34, 0xbebfbc70), (Int
s31, 0x289b7ec6),
             (Int
s32, 0xeaa127fa), (Int
s33, 0xd4ef3085), (Int
s34,  0x4881d05),
             (Int
s31, 0xd9d4d039), (Int
s32, 0xe6db99e5), (Int
s33, 0x1fa27cf8),
             (Int
s34, 0xc4ac5665)]
       r4 :: [(Int, Word32)]
r4 = [(Int
s41, 0xf4292244), (Int
s42, 0x432aff97), (Int
s43, 0xab9423a7),
             (Int
s44, 0xfc93a039), (Int
s41, 0x655b59c3), (Int
s42, 0x8f0ccc92),
             (Int
s43, 0xffeff47d), (Int
s44, 0x85845dd1), (Int
s41, 0x6fa87e4f),
             (Int
s42, 0xfe2ce6e0), (Int
s43, 0xa3014314), (Int
s44, 0x4e0811a1),
             (Int
s41, 0xf7537e82), (Int
s42, 0xbd3af235), (Int
s43, 0x2ad7d2bb),
             (Int
s44, 0xeb86d391)]
       s11 :: Int
s11 = 7
       s12 :: Int
s12 = 12
       s13 :: Int
s13 = 17
       s14 :: Int
s14 = 22
       s21 :: Int
s21 = 5
       s22 :: Int
s22 = 9
       s23 :: Int
s23 = 14
       s24 :: Int
s24 = 20
       s31 :: Int
s31 = 4
       s32 :: Int
s32 = 11
       s33 :: Int
s33 = 16
       s34 :: Int
s34 = 23
       s41 :: Int
s41 = 6
       s42 :: Int
s42 = 10
       s43 :: Int
s43 = 15
       s44 :: Int
s44 = 21


-- ===================== CONVERSION FUNCTIONS ========================


-- Turn the 4 32 bit words into a string representing the hex number they
-- represent.

abcd_to_string :: ABCD -> String
abcd_to_string :: ABCD -> String
abcd_to_string (ABCD (a :: Word32
a,b :: Word32
b,c :: Word32
c,d :: Word32
d)) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Word32 -> String) -> [Word32] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> String
display_32bits_as_hex [Word32
a,Word32
b,Word32
c,Word32
d]


-- Split the 32 bit word up, swap the chunks over and convert the numbers
-- to their hex equivalents.

display_32bits_as_hex :: Word32 -> String
display_32bits_as_hex :: Word32 -> String
display_32bits_as_hex w :: Word32
w = ShowS
forall a. [a] -> [a]
swap_pairs String
cs
 where cs :: String
cs = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Int
x -> Word32 -> Char
forall a. Integral a => a -> Char
getc (Word32 -> Char) -> Word32 -> Char
forall a b. (a -> b) -> a -> b
$ (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w (4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x)) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 15) [0..7]
       getc :: a -> Char
getc n :: a
n = (['0'..'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ ['a'..'f']) String -> Int -> Char
forall a. [a] -> Int -> a
!! (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
       swap_pairs :: [a] -> [a]
swap_pairs (x1 :: a
x1:x2 :: a
x2:xs :: [a]
xs) = a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
swap_pairs [a]
xs
       swap_pairs _ = []

-- Convert to an integer, performing endianness magic as we go

abcd_to_integer :: ABCD -> Integer
abcd_to_integer :: ABCD -> Integer
abcd_to_integer (ABCD (a :: Word32
a,b :: Word32
b,c :: Word32
c,d :: Word32
d)) = Word32 -> Integer
rev_num Word32
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(96 :: Int)
                                 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
rev_num Word32
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(64 :: Int)
                                 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
rev_num Word32
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(32 :: Int)
                                 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
rev_num Word32
d

rev_num :: Word32 -> Integer
rev_num :: Word32 -> Integer
rev_num i :: Word32
i = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
j Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(32 :: Int))
 --         NHC's fault ~~~~~~~~~~~~~~~~~~~~~
 where j :: Word32
j = (Word32 -> Int -> Word32) -> Word32 -> [Int] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\so_far :: Word32
so_far next :: Int
next -> Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
so_far 8 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
i Int
next Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 255))
                 0 [0,8,16,24]

-- Used to convert a 64 byte string to 16 32bit words

string_to_word32s :: String -> [Word32]
string_to_word32s :: String -> [Word32]
string_to_word32s "" = []
string_to_word32s ss :: String
ss = Word32
thisWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:String -> [Word32]
string_to_word32s String
ss'
 where (s :: String
s, ss' :: String
ss') = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt 4 String
ss
       this :: Word32
this = (Char -> Word32 -> Word32) -> Word32 -> String -> Word32
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\c :: Char
c w :: Word32
w -> Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
w 8 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
ord) Char
c) 0 String
s


-- Used to convert a list of 512 bools to 16 32bit words

bools_to_word32s :: [Bool] -> [Word32]
bools_to_word32s :: [Bool] -> [Word32]
bools_to_word32s [] = []
bools_to_word32s bs :: [Bool]
bs = Word32
thisWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:[Bool] -> [Word32]
bools_to_word32s [Bool]
rest
 where (bs1 :: [Bool]
bs1, bs1' :: [Bool]
bs1') = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt 8 [Bool]
bs
       (bs2 :: [Bool]
bs2, bs2' :: [Bool]
bs2') = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt 8 [Bool]
bs1'
       (bs3 :: [Bool]
bs3, bs3' :: [Bool]
bs3') = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt 8 [Bool]
bs2'
       (bs4 :: [Bool]
bs4, rest :: [Bool]
rest) = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt 8 [Bool]
bs3'
       this :: Word32
this = [[Bool]] -> Word32
boolss_to_word32 [[Bool]
bs1, [Bool]
bs2, [Bool]
bs3, [Bool]
bs4]
       bools_to_word8 :: [Bool] -> Word32
bools_to_word8 = (Word32 -> Bool -> Word32) -> Word32 -> [Bool] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\w :: Word32
w b :: Bool
b -> Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
w 1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ if Bool
b then 1 else 0) 0
       boolss_to_word32 :: [[Bool]] -> Word32
boolss_to_word32 = ([Bool] -> Word32 -> Word32) -> Word32 -> [[Bool]] -> Word32
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\w8 :: [Bool]
w8 w :: Word32
w -> Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
w 8 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ [Bool] -> Word32
bools_to_word8 [Bool]
w8) 0


-- Convert the size into a list of characters used by the len_pad function
-- for strings

length_to_chars :: Int -> Word64 -> String
length_to_chars :: Int -> Word64 -> String
length_to_chars 0 _ = []
length_to_chars p :: Int
p n :: Word64
n = Char
thisChar -> ShowS
forall a. a -> [a] -> [a]
:Int -> Word64 -> String
length_to_chars (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
n 8)
         where this :: Char
this = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255