    {-# LANGUAGE Safe #-}

    {-# OPTIONS_GHC -fno-warn-missing-methods #-}

    {- |
       Module     : Data.Hash.MD5
       Copyright  : Copyright (C) 2001 Ian Lynagh
       SPDX-License-Identifier: BSD-3-Clause OR GPL-2.0-or-later

       Maintainer : Ian Lynagh <igloo@earth.li>
       Stability  : provisional
       Portability: portable

    Generation of MD5sums

    Written by Ian Lynagh, igloo\@earth.li
    -}

    module Data.Hash.MD5
        ( md5
        , md5s
        , md5i
        , MD5(..)
        , ABCD(..)
        , Zord64
        , Str(..)
        , BoolList(..)
        , WordList(..)
        ) where

    import           Data.Bits
    import           Data.Char (chr, ord)
    import           Data.Word

    -- | Synonym for 'Word64' due to historic reasons
    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], Zord64)

    -- | 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 :: Zord64 -> 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 :: Zord64 -> BoolList -> BoolList
    len_pad l :: Zord64
    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 (Zord64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Zord64 -> Int) -> Zord64 -> Int
    forall a b. (a -> b) -> a -> b
    $ (447 Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    - Zord64
    l) Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. 511) Bool
    False
                     [Bool] -> [Bool] -> [Bool]
    forall a. [a] -> [a] -> [a]
    ++ [Zord64
    l Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. (Zord64 -> Int -> Zord64
    forall a. Bits a => a -> Int -> a
    shiftL 1 Int
    x) Zord64 -> Zord64 -> 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 :: Zord64 -> Str -> Str
    len_pad c64 :: Zord64
    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 (Zord64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Zord64
    zeros) '\000'
            zeros :: Zord64
    zeros = Zord64 -> Int -> Zord64
    forall a. Bits a => a -> Int -> a
    shiftR ((440 Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    - Zord64
    c64) Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. 511) 3
            l :: String
    l = Int -> Zord64 -> String
    length_to_chars 8 Zord64
    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 :: Zord64
    l)) = ([Word32]
    xs, Zord64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Zord64
    taken, ([Word32], Zord64) -> WordList
    WordList ([Word32]
    ys, Zord64
    l Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    - Zord64
    taken))
      where (xs :: [Word32]
    xs, ys :: [Word32]
    ys) = Int -> [Word32] -> ([Word32], [Word32])
    forall a. Int -> [a] -> ([a], [a])
    splitAt 16 [Word32]
    ws
            taken :: Zord64
    taken = if Zord64
    l Zord64 -> Zord64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > 511 then 512 else Zord64
    l Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. 511
     len_pad :: Zord64 -> WordList -> WordList
    len_pad c64 :: Zord64
    c64 (WordList (ws :: [Word32]
    ws, l :: Zord64
    l)) = ([Word32], Zord64) -> 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, Zord64
    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 :: Zord64
    offset = Zord64
    c64 Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. 31
            lastone' :: [Word32]
    lastone' = [if Zord64
    offset Zord64 -> Zord64 -> 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 (Zord64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Zord64 -> Int) -> Zord64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Zord64
    offset Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. 7))
                            (Zord64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Zord64 -> Int) -> Zord64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Zord64
    offset Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. (31 Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    - 7))
            nextish :: [Word32]
    nextish = if Zord64
    offset Zord64 -> Zord64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then [128] else []
            c64' :: Zord64
    c64' = Zord64
    c64 Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    + (32 Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    - Zord64
    offset)
            num_blanks :: Int
    num_blanks = (Zord64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Zord64 -> Int) -> Zord64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Zord64 -> Int -> Zord64
    forall a. Bits a => a -> Int -> a
    shiftR ((448 Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    - Zord64
    c64') Zord64 -> Zord64 -> Zord64
    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 = Zord64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Zord64 -> Word32) -> Zord64 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Zord64
    c64 Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. (Zord64 -> Int -> Zord64
    forall a. Bits a => a -> Int -> a
    shiftL 1 32 Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    - 1)
            topsize :: Word32
    topsize = Zord64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Zord64 -> Word32) -> Zord64 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Zord64 -> Int -> Zord64
    forall a. Bits a => a -> Int -> a
    shiftR Zord64
    c64 32
            size :: [Word32]
    size = [Word32
    lowsize, Word32
    topsize]
            newlen :: Zord64
    newlen = Zord64
    l Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. (Zord64 -> Zord64
    forall a. Bits a => a -> a
    complement 511)
                   Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    + if Zord64
    c64 Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. 511 Zord64 -> Zord64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 448 then 1024 else 512
     finished :: WordList -> Bool
    finished (WordList (_, z :: Zord64
    z)) = Zord64
    z Zord64 -> Zord64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0

    -- | __WARNING__: This instance only defines the '+' operation
    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)

    -- ======================== 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 -> Zord64 -> ABCD -> a -> ABCD
    forall a. MD5 a => Bool -> Zord64 -> 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 hex number from 'md5s'. -}
    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?
             -> Zord64 -- 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 -> Zord64 -> ABCD -> a -> ABCD
    md5_main padded :: Bool
    padded ilen :: Zord64
    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 -> Zord64 -> ABCD -> a -> ABCD
    forall a. MD5 a => Bool -> Zord64 -> ABCD -> a -> ABCD
    md5_main Bool
    padded' (Zord64
    ilen Zord64 -> Zord64 -> Zord64
    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' :: Zord64
    len' = Zord64
    ilen Zord64 -> Zord64 -> Zord64
    forall a. Num a => a -> a -> a
    + Int -> Zord64
    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
    $ Zord64 -> a -> a
    forall a. MD5 a => Zord64 -> a -> a
    len_pad Zord64
    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
    forall a. Bits a => a -> Int -> a
    rotateL 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 -> Zord64 -> String
    length_to_chars :: Int -> Zord64 -> String
    length_to_chars 0 _ = []
    length_to_chars p :: Int
    p n :: Zord64
    n = Char
    thisChar -> ShowS
    forall a. a -> [a] -> [a]
    :Int -> Zord64 -> String
    length_to_chars (Int
    pInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) (Zord64 -> Int -> Zord64
    forall a. Bits a => a -> Int -> a
    shiftR Zord64
    n 8)
     where this :: Char
    this = Int -> Char
    chr (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ Zord64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Zord64 -> Int) -> Zord64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Zord64
    n Zord64 -> Zord64 -> Zord64
    forall a. Bits a => a -> a -> a
    .&. 255