    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 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
    $c== :: ABCD -> ABCD -> Bool
    == :: ABCD -> ABCD -> Bool
    $c/= :: ABCD -> ABCD -> Bool
    /= :: 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
    $cshowsPrec :: Int -> ABCD -> ShowS
    showsPrec :: Int -> ABCD -> ShowS
    $cshow :: ABCD -> String
    show :: ABCD -> String
    $cshowList :: [ABCD] -> ShowS
    showList :: [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 [Bool]
    s) = ([Bool] -> [Word32]
    bools_to_word32s [Bool]
    ys, [Bool] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Bool]
    ys, [Bool] -> BoolList
    BoolList [Bool]
    zs)
      where ([Bool]
    ys, [Bool]
    zs) = Int -> [Bool] -> ([Bool], [Bool])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    512 [Bool]
    s
     len_pad :: Word64 -> BoolList -> BoolList
    len_pad Word64
    l (BoolList [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
    $ (Word64
    447 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    l) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    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 Word64
    1 Int
    x) Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word64
    0 | Int
    x <- ([Int] -> [Int]
    forall {a}. [a] -> [a]
    mangle [Int
    0..Int
    63])]
                 )
      where mangle :: [a] -> [a]
    mangle [] = []
            mangle [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 ([a]
    ys, [a]
    zs) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    8 [a]
    xs
     finished :: BoolList -> Bool
    finished (BoolList [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 String
    s) = (String -> [Word32]
    string_to_word32s String
    ys, Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    ys, String -> Str
    Str String
    zs)
      where (String
    ys, String
    zs) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    64 String
    s
     len_pad :: Word64 -> Str -> Str
    len_pad Word64
    c64 (Str 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 = Char
    '\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) Char
    '\000'
            zeros :: Word64
    zeros = Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    shiftR ((Word64
    440 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    c64) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    511) Int
    3
            l :: String
    l = Int -> Word64 -> String
    length_to_chars Int
    8 Word64
    c64
     finished :: Str -> Bool
    finished (Str String
    s) = String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ""

    -- YA instance that is believed will be useful

    instance MD5 WordList where
     get_next :: WordList -> ([Word32], Int, WordList)
    get_next (WordList ([Word32]
    ws, 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 ([Word32]
    xs, [Word32]
    ys) = Int -> [Word32] -> ([Word32], [Word32])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    16 [Word32]
    ws
            taken :: Word64
    taken = if Word64
    l Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word64
    511 then Word64
    512 else Word64
    l Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    511
     len_pad :: Word64 -> WordList -> WordList
    len_pad Word64
    c64 (WordList ([Word32]
    ws, 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Word32]
    ws Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then [Word32]
    start [Word32] -> [Word32] -> [Word32]
    forall a. [a] -> [a] -> [a]
    ++ [Word32]
    lastone' else []
            start :: [Word32]
    start = [Word32] -> [Word32]
    forall a. HasCallStack => [a] -> [a]
    init [Word32]
    ws
            lastone :: Word32
    lastone = [Word32] -> Word32
    forall a. HasCallStack => [a] -> a
    last [Word32]
    ws
            offset :: Word64
    offset = Word64
    c64 Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    31
            lastone' :: [Word32]
    lastone' = [if Word64
    offset Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word64
    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 Word32
    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
    .&. Word64
    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
    .&. (Word64
    31 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    7))
            nextish :: [Word32]
    nextish = if Word64
    offset Word64 -> Word64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word64
    0 then [Word32
    128] else []
            c64' :: Word64
    c64' = Word64
    c64 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + (Word64
    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 ((Word64
    448 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    c64') Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    511) Int
    5)
            blanks :: [Word32]
    blanks = Int -> Word32 -> [Word32]
    forall a. Int -> a -> [a]
    replicate Int
    num_blanks Word32
    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 Word64
    1 Int
    32 Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    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 Int
    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 Word64
    511)
                   Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + if Word64
    c64 Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    511 Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word64
    448 then Word64
    1024 else Word64
    512
     finished :: WordList -> Bool
    finished (WordList ([Word32]
    _, Word64
    z)) = Word64
    z Word64 -> Word64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word64
    0

    instance Num ABCD where
     ABCD (Word32
    a1, Word32
    b1, Word32
    c1, Word32
    d1) + :: ABCD -> ABCD -> ABCD
    + ABCD (Word32
    a2, Word32
    b2, Word32
    c2, 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 String
    "(-){ABCD}: no instance method defined"
     * :: ABCD -> ABCD -> ABCD
    (*)         = String -> ABCD -> ABCD -> ABCD
    forall a. HasCallStack => String -> a
    error String
    "(*){ABCD}: no instance method defined"
     signum :: ABCD -> ABCD
    signum      = String -> ABCD -> ABCD
    forall a. HasCallStack => String -> a
    error String
    "signum{ABCD}: no instance method defined"
     fromInteger :: Integer -> ABCD
    fromInteger = String -> Integer -> ABCD
    forall a. HasCallStack => String -> a
    error String
    "fromInteger{ABCD}: no instance method defined"
     abs :: ABCD -> ABCD
    abs         = String -> ABCD -> ABCD
    forall a. HasCallStack => String -> a
    error String
    "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 :: forall a. MD5 a => a -> ABCD
    md5 a
    m = Bool -> Word64 -> ABCD -> a -> ABCD
    forall a. MD5 a => Bool -> Word64 -> ABCD -> a -> ABCD
    md5_main Bool
    False Word64
    0 ABCD
    magic_numbers a
    m

    -- Returns a hex number à la md5sum program

    md5s :: (MD5 a) => a -> String
    md5s :: forall a. MD5 a => 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 :: forall a. MD5 a => 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 :: forall a. MD5 a => Bool -> Word64 -> ABCD -> a -> ABCD
    md5_main Bool
    padded Word64
    ilen ABCD
    abcd 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
    + Word64
    512) (ABCD
    abcd ABCD -> ABCD -> ABCD
    forall a. Num a => a -> a -> a
    + ABCD
    abcd') a
    m''
     where ([Word32]
    m16, Int
    l, 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
           (([Word32]
    m16', Int
    _, a
    m''), Bool
    padded') = if Bool -> Bool
    not Bool
    padded Bool -> Bool -> Bool
    && Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    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 ABCD
    abcd0 [Word32]
    w = ABCD
    abcd4
     where ([(Int, Word32)]
    r1, [(Int, Word32)]
    r2, [(Int, Word32)]
    r3, [(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 [a
    c0,a
    c1,a
    c2,a
    c3,a
    c4,a
    c5,a
    c6,a
    c7,a
    c8,a
    c9,a
    c10,a
    c11,a
    c12,a
    c13,a
    c14,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 [a]
    _ = String -> [a]
    forall a. HasCallStack => String -> a
    error String
    "broke at perm5"
           perm3 :: [a] -> [a]
    perm3 [a
    c0,a
    c1,a
    c2,a
    c3,a
    c4,a
    c5,a
    c6,a
    c7,a
    c8,a
    c9,a
    c10,a
    c11,a
    c12,a
    c13,a
    c14,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 [a]
    _ = String -> [a]
    forall a. HasCallStack => String -> a
    error String
    "broke at perm3"
           perm7 :: [a] -> [a]
    perm7 [a
    c0,a
    c1,a
    c2,a
    c3,a
    c4,a
    c5,a
    c6,a
    c7,a
    c8,a
    c9,a
    c10,a
    c11,a
    c12,a
    c13,a
    c14,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 [a]
    _ = String -> [a]
    forall a. HasCallStack => String -> a
    error String
    "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 XYZ -> Word32
    f ABCD
    abcd [Word32]
    s [(Int, Word32)]
    ns = (ABCD -> (Int, Word32) -> ABCD) -> ABCD -> [(Int, Word32)] -> ABCD
    forall b a. (b -> a -> b) -> b -> [a] -> b
    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 (\Word32
    x (Int
    y, 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 XYZ -> Word32
    f (ABCD (Word32
    a, Word32
    b, Word32
    c, Word32
    d)) (Int
    s, 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 (Word32
    x, Word32
    y, 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 (Word32
    x, Word32
    y, 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 (Word32
    x, Word32
    y, 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 (Word32
    x, Word32
    y, 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 (Word32
    0x67452301, Word32
    0xefcdab89, Word32
    0x98badcfe, Word32
    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, Word32
    0xd76aa478), (Int
    s12, Word32
    0xe8c7b756), (Int
    s13, Word32
    0x242070db),
                 (Int
    s14, Word32
    0xc1bdceee), (Int
    s11, Word32
    0xf57c0faf), (Int
    s12, Word32
    0x4787c62a),
                 (Int
    s13, Word32
    0xa8304613), (Int
    s14, Word32
    0xfd469501), (Int
    s11, Word32
    0x698098d8),
                 (Int
    s12, Word32
    0x8b44f7af), (Int
    s13, Word32
    0xffff5bb1), (Int
    s14, Word32
    0x895cd7be),
                 (Int
    s11, Word32
    0x6b901122), (Int
    s12, Word32
    0xfd987193), (Int
    s13, Word32
    0xa679438e),
                 (Int
    s14, Word32
    0x49b40821)]
           r2 :: [(Int, Word32)]
    r2 = [(Int
    s21, Word32
    0xf61e2562), (Int
    s22, Word32
    0xc040b340), (Int
    s23, Word32
    0x265e5a51),
                 (Int
    s24, Word32
    0xe9b6c7aa), (Int
    s21, Word32
    0xd62f105d), (Int
    s22,  Word32
    0x2441453),
                 (Int
    s23, Word32
    0xd8a1e681), (Int
    s24, Word32
    0xe7d3fbc8), (Int
    s21, Word32
    0x21e1cde6),
                 (Int
    s22, Word32
    0xc33707d6), (Int
    s23, Word32
    0xf4d50d87), (Int
    s24, Word32
    0x455a14ed),
                 (Int
    s21, Word32
    0xa9e3e905), (Int
    s22, Word32
    0xfcefa3f8), (Int
    s23, Word32
    0x676f02d9),
                 (Int
    s24, Word32
    0x8d2a4c8a)]
           r3 :: [(Int, Word32)]
    r3 = [(Int
    s31, Word32
    0xfffa3942), (Int
    s32, Word32
    0x8771f681), (Int
    s33, Word32
    0x6d9d6122),
                 (Int
    s34, Word32
    0xfde5380c), (Int
    s31, Word32
    0xa4beea44), (Int
    s32, Word32
    0x4bdecfa9),
                 (Int
    s33, Word32
    0xf6bb4b60), (Int
    s34, Word32
    0xbebfbc70), (Int
    s31, Word32
    0x289b7ec6),
                 (Int
    s32, Word32
    0xeaa127fa), (Int
    s33, Word32
    0xd4ef3085), (Int
    s34,  Word32
    0x4881d05),
                 (Int
    s31, Word32
    0xd9d4d039), (Int
    s32, Word32
    0xe6db99e5), (Int
    s33, Word32
    0x1fa27cf8),
                 (Int
    s34, Word32
    0xc4ac5665)]
           r4 :: [(Int, Word32)]
    r4 = [(Int
    s41, Word32
    0xf4292244), (Int
    s42, Word32
    0x432aff97), (Int
    s43, Word32
    0xab9423a7),
                 (Int
    s44, Word32
    0xfc93a039), (Int
    s41, Word32
    0x655b59c3), (Int
    s42, Word32
    0x8f0ccc92),
                 (Int
    s43, Word32
    0xffeff47d), (Int
    s44, Word32
    0x85845dd1), (Int
    s41, Word32
    0x6fa87e4f),
                 (Int
    s42, Word32
    0xfe2ce6e0), (Int
    s43, Word32
    0xa3014314), (Int
    s44, Word32
    0x4e0811a1),
                 (Int
    s41, Word32
    0xf7537e82), (Int
    s42, Word32
    0xbd3af235), (Int
    s43, Word32
    0x2ad7d2bb),
                 (Int
    s44, Word32
    0xeb86d391)]
           s11 :: Int
    s11 = Int
    7
           s12 :: Int
    s12 = Int
    12
           s13 :: Int
    s13 = Int
    17
           s14 :: Int
    s14 = Int
    22
           s21 :: Int
    s21 = Int
    5
           s22 :: Int
    s22 = Int
    9
           s23 :: Int
    s23 = Int
    14
           s24 :: Int
    s24 = Int
    20
           s31 :: Int
    s31 = Int
    4
           s32 :: Int
    s32 = Int
    11
           s33 :: Int
    s33 = Int
    16
           s34 :: Int
    s34 = Int
    23
           s41 :: Int
    s41 = Int
    6
           s42 :: Int
    s42 = Int
    10
           s43 :: Int
    s43 = Int
    15
           s44 :: Int
    s44 = Int
    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 (Word32
    a,Word32
    b,Word32
    c,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 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 (\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 (Int
    4Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    x)) Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. Word32
    15) [Int
    0..Int
    7]
           getc :: a -> Char
    getc a
    n = ([Char
    '0'..Char
    '9'] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    'a'..Char
    'f']) String -> Int -> Char
    forall a. HasCallStack => [a] -> Int -> a
    !! (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    n)
           swap_pairs :: [a] -> [a]
    swap_pairs (a
    x1:a
    x2:[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 [a]
    _ = []

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

    abcd_to_integer :: ABCD -> Integer
    abcd_to_integer :: ABCD -> Integer
    abcd_to_integer (ABCD (Word32
    a,Word32
    b,Word32
    c,Word32
    d)) = Word32 -> Integer
    rev_num Word32
    a Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    2Integer -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    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
    * Integer
    2Integer -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    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
    * Integer
    2Integer -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    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 Word32
    i = Word32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger Word32
    j Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `mod` (Integer
    2Integer -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    32 :: Int))
     --         NHC's fault ~~~~~~~~~~~~~~~~~~~~~
     where j :: Word32
    j = (Word32 -> Int -> Word32) -> Word32 -> [Int] -> Word32
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Word32
    so_far Int
    next -> Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    shiftL Word32
    so_far Int
    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
    .&. Word32
    255))
                     Word32
    0 [Int
    0,Int
    8,Int
    16,Int
    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
    "" = []
    string_to_word32s String
    ss = Word32
    thisWord32 -> [Word32] -> [Word32]
    forall a. a -> [a] -> [a]
    :String -> [Word32]
    string_to_word32s String
    ss'
     where (String
    s, String
    ss') = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    4 String
    ss
           this :: Word32
    this = (Char -> Word32 -> Word32) -> Word32 -> String -> Word32
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Char
    c Word32
    w -> Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    shiftL Word32
    w Int
    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) Word32
    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 [Bool]
    bs = Word32
    thisWord32 -> [Word32] -> [Word32]
    forall a. a -> [a] -> [a]
    :[Bool] -> [Word32]
    bools_to_word32s [Bool]
    rest
     where ([Bool]
    bs1, [Bool]
    bs1') = Int -> [Bool] -> ([Bool], [Bool])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    8 [Bool]
    bs
           ([Bool]
    bs2, [Bool]
    bs2') = Int -> [Bool] -> ([Bool], [Bool])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    8 [Bool]
    bs1'
           ([Bool]
    bs3, [Bool]
    bs3') = Int -> [Bool] -> ([Bool], [Bool])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    8 [Bool]
    bs2'
           ([Bool]
    bs4, [Bool]
    rest) = Int -> [Bool] -> ([Bool], [Bool])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    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 b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Word32
    w Bool
    b -> Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    shiftL Word32
    w Int
    1 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + if Bool
    b then Word32
    1 else Word32
    0) Word32
    0
           boolss_to_word32 :: [[Bool]] -> Word32
    boolss_to_word32 = ([Bool] -> Word32 -> Word32) -> Word32 -> [[Bool]] -> Word32
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\[Bool]
    w8 Word32
    w -> Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    shiftL Word32
    w Int
    8 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + [Bool] -> Word32
    bools_to_word8 [Bool]
    w8) Word32
    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 Int
    0 Word64
    _ = []
    length_to_chars Int
    p 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
    -Int
    1) (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    shiftR Word64
    n Int
    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
    .&. Word64
    255