> module Main where

> import MD5
> import Maybe
> import Monad
> import Word
> import Bits
> import Char

> f :: [Bool] -> String
> f [] = ""
> f bs = (chr.sum $ zipWith (\b p -> if b then 2^p else 0) xs ([7,6..0] :: [Int])):f ys
>  where (xs, ys) = takeDrop 8 bs

> main :: IO()
> main = do putStr "\n"
>           putStr "MD5 test suite\n"
>           putStr "==============\n\n"
>           test_0bit
>           test_1bit
>           test_7bit
>           test_8bit
>           test_9bit
>           test_16bit
>           test_17bit
>           test_21bit
>           test_23bit
>           test_24bit
>           test_25bit
>           test_31bit
>           test_32bit
>           test_33bit
>           test_440bit
>           test_447bit
>           test_448bit
>           test_449bit
>           test_456bit
>           test_504bit
>           test_511bit
>           test_512bit
>           test_513bit
>           test_520bit

> test_0bit :: IO()
> test_0bit = test "0 bit"
>                  (Just "")
>                  []
>                  (Just ([], 0))
>                  (3649838548,78774415,2550759657,2118318316)
>                  "d41d8cd98f00b204e9800998ecf8427e"
>                  281949768489412648962353822266799178366

> test_1bit :: IO()
> test_1bit = test "1 bit"
>                  Nothing
>                  [True]
>                  (Just ([128], 1))
>                  (272066174,3209175982,751495693,2921214329)
>                  "7e663710ae2348bf0deaca2c79311eae"
>                  168013458602541801121410793648038157998

> test_7bit :: IO()
> test_7bit = test "7 bit"
>                  Nothing
>                  bs
>                  (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                  (3874223782,2323395709,238016611,1952053381)
>                  "a6f6ebe67d347c8a63d82f0e85f85974"
>                  221933936954978917418574952682441169268
>  where bs = take 7 $ cycle [True, False, True, False, True]

> test_8bit :: IO()
> test_8bit = test "8 bit"
>                  (Just "a")
>                  (c_to_bool 'a')
>                  (Just (get_word_32s "a", 8))
>                  (3111502092,2830561728,3801727793,1629910889)
>                  "0cc175b9c0f1b6a831c399e269772661"
>                  16955237001963240173058271559858726497

> test_9bit :: IO()
> test_9bit = test "9 bit"
>                  Nothing
>                  bs
>                  (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                  (3073956015,1560736200,2585607869,1030470636)
>                  "afd838b7c8f1065dbd3e1d9aecbb6b3d"
>                  233737585759683728280024948142665067325
>  where bs = take 9 $ cycle [True, False, True, False, True]

> test_16bit :: IO()
> test_16bit = test "16 bit"
>                   (Just "ab")
>                   (concat $ map c_to_bool "ab")
>                   (Just (get_word_32s "ab", 16))
>                   (1140096536,3436257889,735854639,2699817106)
>                   "187ef4436122d1cc2f40dc2b92f0eba0"
>                   32560655549305688865853317129809488800

> test_17bit :: IO()
> test_17bit = test "17 bit"
>                   Nothing
>                   bs
>                   (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                   (3600379153,3154230051,1518575401,1699697739)
>                   "116d99d623bb01bc299f835a4b544f65"
>                   23165956460478055474386295161267441509
>  where bs = take 17 $ cycle [True, False, True, False, True]

> test_21bit :: IO()
> test_21bit = test "21 bit"
>                   Nothing
>                   bs
>                   -- 10101101 + 01101011 * 256 + 01011000 * 256^2
>                   -- = 173 + 107 * 256 + 88 * 256^2 = 5794733
>                   -- (Just ([5794733], 21))
>                   (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                   (3016030143,592975423,115126882,2320915544)
>                   "bff7c4b33f16582362b2dc06585c568a"
>                   255169034072625008137368488973981996682
>  where bs = take 21 $ cycle [True, False, True, False, True]

> test_23bit :: IO()
> test_23bit = test "23 bit"
>                   Nothing
>                   bs
>                   (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                   (2817603430,1893037087,336283538,3113257946)
>                   "6637f1a71f74d57092470b14da8b90b9"
>                   135871733198833733130647634097814081721
>  where bs = take 23 $ cycle [True, False, True, False, True]

> test_24bit :: IO()
> test_24bit = test "24 bit"
>                   (Just "abc")
>                   (concat $ map c_to_bool "abc")
>                   (Just (get_word_32s "abc", 24))
>                   (2555380112,2958021180,2101319382,1920983336)
>                   "900150983cd24fb0d6963f7d28e17f72"
>                   191415658344158766168031473277922803570

> test_25bit :: IO()
> test_25bit = test "25 bit"
>                   Nothing
>                   bs
>                   (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                   (2146107602,447910356,3861996385,1949814853)
>                   "d200eb7fd491b21a616331e645d03774"
>                   279142655608852788157756064665745504116
>  where bs = take 25 $ cycle [True, False, True, False, True]

> test_31bit :: IO()
> test_31bit = test "31 bit"
>                    Nothing
>                    bs
>                    (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                    (3148654028,3251176583,3327096227,396272808)
>                    "cca5acbb8704c9c1a3754fc6a8a49e17"
>                    272022743553685567682651335045736078871
>  where bs = take 31 $ cycle [True, False, True, False, True]

> test_32bit :: IO()
> test_32bit = test "32 bit"
>                   (Just "abcd")
>                   (concat $ map c_to_bool "abcd")
>                   (Just (get_word_32s "abcd", 32))
>                   (1282538722,2481858375,3441750933,523468590)
>                   "e2fc714c4727ee9395f324cd2e7f331f"
>                   301716283811389038011477436469853762335

> test_33bit :: IO()
> test_33bit = test "33 bit"
>                    Nothing
>                    bs
>                    (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                    (1520634312,789137520,774383623,2149163117)
>                    "c809a35a7048092f0728282e6da01980"
>                    265895643026759416663301597970063956352
>  where bs = take 33 $ cycle [True, False, True, False, True]

> test_440bit :: IO()
> test_440bit = test "440 bit"
>                    (Just m_s)
>                    m_b
>                    (Just (get_word_32s m_s, fromIntegral $ 8 * length m_s))
>                    (2129780455,1829200469,2963858748,3872126999)
>                    "e7def17e5562076d3ce5a8b017f8cbe6"
>                    308209254998797990860977056692741655526
>  where m_s = take 55 $ cycle "abcdefg"
>        m_b = take 440 $ cycle $ concat $ map c_to_bool "abcdefg"

> test_447bit :: IO()
> test_447bit = test "447 bit"
>                    Nothing
>                    bs
>                    (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                    (146018617,419045834,2338281671,4179882525)
>                    "3911b408ca21fa18c7585f8b1df223f9"
>                    75857916336446301824658930015268905977
>  where bs = take 447 $ cycle [True, False, True, False, True]

> test_448bit :: IO()
> test_448bit = test "448 bit"
>                    (Just m_s)
>                    m_b
>                    (Just (get_word_32s m_s, fromIntegral $ 8 * length m_s))
>                    (272111924,677845269,2833319824,3656850596)
>                    "34193810151967289007e1a8a41cf7d9"
>                    69250800291397296307218994760733489113
>  where m_s = take 56 $ cycle "abcdefg"
>        m_b = take 448 $ cycle $ concat $ map c_to_bool "abcdefg"

> test_449bit :: IO()
> test_449bit = test "449 bit"
>                    Nothing
>                    bs
>                    (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                    (3601628369,1310326814,2751960693,1362514509)
>                    "d17cacd61e001a4e759607a44d523651"
>                    278456001468069016726202533662103320145
>  where bs = take 449 $ cycle [True, False, True, False, True]


> test_456bit :: IO()
> test_456bit = test "456 bit"
>                    (Just m_s)
>                    m_b
>                    (Just (get_word_32s m_s, fromIntegral $ 8 * length m_s))
>                    (279449730,856127161,3308518469,3347659648)
>                    "8210a810b976073345fc33c5803b89c7"
>                    172886124971637048494467684822136097223
>  where m_s = take 57 $ cycle "abcdefg"
>        m_b = take 456 $ cycle $ concat $ map c_to_bool "abcdefg"

> test_504bit :: IO()
> test_504bit = test "504 bit"
>                    (Just m_s)
>                    m_b
>                    (Just (get_word_32s m_s, fromIntegral $ 8 * length m_s))
>                    (2956572680,1313635985,3566901056,574489456)
>                    "08b839b0917e4c4e40979ad470033e22"
>                    11590376674781757343337222324479016482
>  where m_s = take 63 $ cycle "abcdefg"
>        m_b = take 504 $ cycle $ concat $ map c_to_bool "abcdefg"

> test_511bit :: IO()
> test_511bit = test "511 bit"
>                    Nothing
>                    bs
>                    (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                    (2264330280,2921290735,2761951796,3504581562)
>                    "28f0f686ef5b1fae340aa0a4baabe3d0"
>                    54420271240858347973075956822623118288
>  where bs = take 511 $ cycle [True, False, True, False, True]

> test_512bit :: IO()
> test_512bit = test "512 bit"
>                    (Just m_s)
>                    m_b
>                    (Just (get_word_32s m_s, fromIntegral $ 8 * length m_s))
>                    (2109724156,489761275,3318408917,910478853)
>                    "fcd5bf7dfb29311dd5e6cac505ce4436"
>                    336075298090151865378817828545312474166
>  where m_s = take 64 $ cycle "abcdefg"
>        m_b = take 512 $ cycle $ concat $ map c_to_bool "abcdefg"

> test_513bit :: IO()
> test_513bit = test "513 bit"
>                    Nothing
>                    bs
>                    (Just (get_word_32s $ f bs, fromIntegral $ length bs))
>                    (4120376527,4030448340,1842259211,293161983)
>                    "cff497f5d4c23bf00ba5ce6dff4b7911"
>                    276420197681555687768256992541883988241
>  where bs = take 513 $ cycle [True, False, True, False, True]

> test_520bit :: IO()
> test_520bit = test "520 bit"
>                    (Just m_s)
>                    m_b
>                    (Just (get_word_32s m_s, fromIntegral $ 8 * length m_s))
>                    (2047994787,3293532858,2497755399,2821287797)
>                    "a3eb117aba524fc407b9e094756f29a8"
>                    217884707599159781021720901460062841256
>  where m_s = take 65 $ cycle "abcdefg"
>        m_b = take 520 $ cycle $ concat $ map c_to_bool "abcdefg"

> test :: String -> Maybe String -> [Bool] -> Maybe ([Word32], Zord64) -> ABCD -> String -> Integer -> IO()
> test text m_s bs m_ws_z ans_abcd ans_s ans_i =
>  do putStr $ "Doing " ++ text                        ++ " test:\n"
>     putStr $ "------" ++ replicate (length text) '-' ++ "------\n"
>     case m_s of
>         Nothing -> return ()
>         Just s -> test_all "String" s ans_abcd ans_s ans_i
>     test_all "[Bool]" bs ans_abcd ans_s ans_i
>     case m_ws_z of
>         Nothing -> return ()
>         Just ws_z -> test_all "W32,64" ws_z ans_abcd ans_s ans_i

> test_all :: (MD5 a) => String -> a -> ABCD -> String -> Integer -> IO()
> test_all text m abcd s i =
>  do test_normal text m abcd s i
>     test_monad text "Mall:" monad_test_all m abcd s i
>     test_monad text "M8:" monad_test_8bit m abcd s i
>     test_monad text "M24:" monad_test_24bit m abcd s i
>     putStr "\n"

> test_normal :: (MD5 a) => String -> a -> ABCD -> String -> Integer -> IO()
> test_normal text m abcd s i =
>  do putStr $ text ++ ":" ++ replicate (11 - length text) ' '
>     putStr " md5 "
>     putStr $ do_test abcd $ md5 m
>     putStr " md5s "
>     putStr $ do_test s $ md5s m
>     putStr " md5i "
>     putStr $ do_test i $ md5i m
>     putStr "\n"

> test_monad :: (MD5 a) => String -> String -> (a -> IO (a, a)) -> a -> ABCD -> String -> Integer -> IO()
> test_monad text_desc text_type f m abcd s i =
>  do putStr $ text_desc ++ text_type ++ replicate (12 - length text_desc - length text_type) ' '
>     putStr " md5 "
>     (liftM (do_test abcd) $ md5M f m) >>= putStr
>     putStr " md5s "
>     (liftM (do_test s) $ md5sM f m) >>= putStr
>     putStr " md5i "
>     (liftM (do_test i) $ md5iM f m) >>= putStr
>     putStr "\n"

> do_test :: (Eq a) => a -> a -> String
> do_test a b = if a == b then "\027[32mOK\027[0m.    "
>                         else "\027[31mFAILED\027[0m."

> monad_test_all :: (MD5 a) => a -> IO (a, a)
> monad_test_all m = return (anull, m)

> monad_test_8bit :: (MD5 a) => a -> IO (a, a)
> monad_test_8bit m = return (m', c)
>  where (c, m') = getDrop_bits 8 m

> monad_test_24bit :: (MD5 a) => a -> IO (a, a)
> monad_test_24bit m = return (m', c)
>  where (c, m') = getDrop_bits 24 m

> c_to_bool :: Char -> [Bool]
> c_to_bool 'a' = [False, True, True, False, False, False, False, True]
> c_to_bool 'b' = [False, True, True, False, False, False, True, False]
> c_to_bool 'c' = [False, True, True, False, False, False, True, True]
> c_to_bool 'd' = [False, True, True, False, False, True, False, False]
> c_to_bool 'e' = [False, True, True, False, False, True, False, True]
> c_to_bool 'f' = [False, True, True, False, False, True, True, False]
> c_to_bool 'g' = [False, True, True, False, False, True, True, True]
> c_to_bool _ = undefined

> takeDrop :: Int -> [a] -> ([a], [a])
> takeDrop _ [] = ([], [])
> takeDrop 0 xs = ([], xs)
> takeDrop n (x:xs) = (x:ys, zs)
>  where (ys, zs) = takeDrop (n-1) xs

> get_word_32s :: String -> [Word32]
> get_word_32s "" = []
> get_word_32s ss = this:get_word_32s ss'
>  where (s, ss') = takeDrop 4 ss
>        this = foldr (\c i -> shiftL i 8 + (fromIntegral.ord) c) 0 s