> module Main where

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

> count_results :: (Int, Int) -> [IO(Int, Int)] -> IO(Int, Int)
> count_results ii [] = return ii
> count_results (ok1, fail1) (x:xs)
>  = do (ok2, fail2) <- x
>       count_results (ok1 + ok2, fail1 + fail2) xs

> main :: IO()
> main = do putStr "\n"
>           putStr "MD5 test suite\n"
>           putStr "==============\n\n"
>           (ok, failed) <- count_results (0,0) tests
>           putStr "Total OK: "
>           putStr $ show ok
>           putStr "\n"
>           putStr "Total Failed: "
>           putStr $ show failed
>           putStr "\n\n"

> tests :: [IO(Int, Int)]
> tests = [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(Int, Int)
> test_0bit = test "0 bit"
>                  (Just "")
>                  []
>                  ([], 0)
>                  (3649838548,78774415,2550759657,2118318316)
>                  "d41d8cd98f00b204e9800998ecf8427e"
>                  281949768489412648962353822266799178366

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

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

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

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

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

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

> test_21bit :: IO(Int, Int)
> test_21bit = test "21 bit"
>                   Nothing
>                   bs
>                   (string_to_word32s $ bools_to_string bs, fromIntegral $ length bs)
>                   (3016030143,592975423,115126882,2320915544)
>                   "bff7c4b33f16582362b2dc06585c568a"
>                   255169034072625008137368488973981996682
>  where bs = take 21 $ cycle [True, False, True, False, True]

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

> test :: String -> Maybe String -> [Bool] -> ([Word32], Zord64) -> ABCD -> String -> Integer -> IO(Int, Int)
> test text m_s bs ws_z ans_abcd ans_s ans_i =
>  do putStr $ "Doing " ++ text                        ++ " test:\n"
>     putStr $ "------" ++ replicate (length text) '-' ++ "------\n"
>     (ok1, failed1) <- case m_s of
>                           Nothing -> return (0, 0)
>                           Just s -> test_all False "String" s ans_abcd ans_s ans_i
>     (ok2, failed2) <- test_all True "[Bool]" bs ans_abcd ans_s ans_i
>     (ok3, failed3) <- test_all True "W32,64" ws_z ans_abcd ans_s ans_i
>     return (ok1 + ok2 + ok3, failed1 + failed2 + failed3)

> test_all :: (MD5 a) => Bool -> String -> a -> ABCD -> String -> Integer -> IO(Int, Int)
> test_all do_non_8 text m abcd s i =
>  do (ok1, failed1) <- test_normal text m abcd s i
>     (ok2, failed2) <- test_monad text "Mall:" monad_test_all m abcd s i
>     (ok3, failed3) <- if do_non_8
>                       then do (ok3a, failed3a) <- test_monad text "M1:"  (monad_test_bits 1)  m abcd s i
>                               (ok3b, failed3b) <- test_monad text "M3:"  (monad_test_bits 3)  m abcd s i
>                               return (ok3a + ok3b, failed3a + failed3b)
>                       else return (0, 0)
>     (ok4, failed4) <- test_monad text "M8:"  (monad_test_bits 8)  m abcd s i
>     (ok5, failed5) <- test_monad text "M24:" (monad_test_bits 24) m abcd s i
>     putStr "\n"
>     return (ok1 + ok2 + ok3 + ok4 + ok5, failed1 + failed2 + failed3 + failed4 + failed5)

> test_normal :: (MD5 a) => String -> a -> ABCD -> String -> Integer -> IO(Int, Int)
> test_normal text m abcd s i =
>  do putStr $ text ++ ":" ++ replicate (11 - length text) ' '
>     putStr " md5 "
>     let (str1, ok1, failed1) = do_test abcd $ md5 m
>     putStr str1
>     putStr " md5s "
>     let (str2, ok2, failed2) = do_test s $ md5s m
>     putStr str2
>     putStr " md5i "
>     let (str3, ok3, failed3) = do_test i $ md5i m
>     putStr str3
>     putStr "\n"
>     return (ok1 + ok2 + ok3, failed1 + failed2 + failed3)

> test_monad :: (MD5 a) => String -> String -> (a -> IO (a, a)) -> a -> ABCD -> String -> Integer -> IO(Int, Int)
> 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 "
>     (str1, ok1, failed1) <- (liftM (do_test abcd) $ md5M f m)
>     putStr str1
>     putStr " md5s "
>     (str2, ok2, failed2) <- (liftM (do_test s) $ md5sM f m)
>     putStr str2
>     putStr " md5i "
>     (str3, ok3, failed3) <- (liftM (do_test i) $ md5iM f m)
>     putStr str3
>     putStr "\n"
>     return (ok1 + ok2 + ok3, failed1 + failed2 + failed3)

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

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

> monad_test_bits :: (MD5 a) => Int -> a -> IO (a, a)
> monad_test_bits b m = return (m', c)
>  where (c, m') = getDrop_bits b m

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

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

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

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