> import Bits > import Word > import Monad > type ABCD = (Word32, Word32, Word32, Word32) > main :: IO() > main = do abcd1 <- (foldl (f apply_f) (return abcd0) $ zip3 [0..15] (cycle [7, 12, 17, 22]) [0..15]) > abcd2 <- (foldl (f apply_g) (return abcd1) $ zip3 [(5 * x + 1) `mod` 16 | x <- [0..15]] (cycle [5, 9, 14, 20]) [16..31]) > abcd3 <- (foldl (f apply_h) (return abcd2) $ zip3 [(3 * x + 5) `mod` 16 | x <- [0..15]] (cycle [4, 11, 16, 23]) [32..47]) > abcd4 <- (foldl (f apply_i) (return abcd3) $ zip3 [(7 * x) `mod` 16 | x <- [0..15]] (cycle [6, 10, 15, 21]) [48..63]) > let (a, b, c, d) = abcd0 > let (a', b', c', d') = abcd4 > putStr $ abcd_to_string (a + a', b + b', c + c', d + d') ++ "\n\n" > where abcd0 = (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476) > f g io_abcd tuple = (>>=) io_abcd (g tuple) > apply_f :: (Int, Int, Int) -> ABCD -> IO ABCD > apply_f (i, r, j) (a, b, c, d) > = do let t1 = c `xor` d > e1 = "c xor d" > putStr $ "t1 = " ++ e1 ++ " = " ++ disp t1 ++ "\n" > let t2 = b .&. t1 > e2 = "b & (" ++ e1 ++ ")" > putStr $ "t2 = " ++ e2 ++ " = " ++ disp t2 ++ "\n" > let t3 = d `xor` t2 > e3 = "d xor (" ++ e2 ++ ") = F(b,c,d)" > putStr $ "t3 = " ++ e3 ++ " = " ++ disp t3 ++ "\n" > let x_i = bin_to_dec $ list_Xs!!i > putStr $ "X[i] = " ++ disp x_i ++ "\n" > let t4 = t3 + x_i > e4 = "F(b,c,d) + X[i]" > putStr $ "t4 = " ++ e4 ++ " = " ++ disp t4 ++ "\n" > let t5 = a + t4 > e5 = "a + " ++ e4 > putStr $ "t5 = " ++ e5 ++ " = " ++ disp t5 ++ "\n" > let t_j = list_Ts!!j > putStr $ "T[j] = " ++ disp t_j ++ "\n" > let t6 = t5 + t_j > e6 = e5 ++ " + T[j]" > putStr $ "t6 = " ++ e6 ++ " = " ++ disp t6 ++ "\n" > let (t7, t8) = divMod t6 (2^(32 - r)) > t9 = t7 + 2^r * t8 > e9 = "(" ++ e6 ++ ") <<< r" > putStr $ "t9 = " ++ e9 ++ " = " ++ disp t9 ++ "\n" > let a' = b + t9 > e10 = "b + (" ++ e9 ++ ")" > putStr $ "a = " ++ e10 ++ " = " ++ disp a' ++ "\n" > putStr "\n" > putStr $ "a = " ++ disp a' ++ " = " ++ show a' ++ "\n" > putStr $ "b = " ++ disp b ++ " = " ++ show b ++ "\n" > putStr $ "c = " ++ disp c ++ " = " ++ show c ++ "\n" > putStr $ "d = " ++ disp d ++ " = " ++ show d ++ "\n" > putStr "\n" > return (d, a', b, c) > apply_g :: (Int, Int, Int) -> ABCD -> IO ABCD > apply_g (i, r, j) (a, b, c, d) > = do let t1 = b `xor` c > e1 = "b xor c" > putStr $ "t1 = " ++ e1 ++ " = " ++ disp t1 ++ "\n" > let t2 = d .&. t1 > e2 = "d & (" ++ e1 ++ ")" > putStr $ "t2 = " ++ e2 ++ " = " ++ disp t2 ++ "\n" > let t3 = c `xor` t2 > e3 = "c xor (" ++ e2 ++ ") = G(b,c,d)" > putStr $ "t3 = " ++ e3 ++ " = " ++ disp t3 ++ "\n" > let x_i = bin_to_dec $ list_Xs!!i > putStr $ "X[i] = " ++ disp x_i ++ "\n" > let t4 = t3 + x_i > e4 = "G(b,c,d) + X[i]" > putStr $ "t4 = " ++ e4 ++ " = " ++ disp t4 ++ "\n" > let t5 = a + t4 > e5 = "a + " ++ e4 > putStr $ "t5 = " ++ e5 ++ " = " ++ disp t5 ++ "\n" > let t_j = list_Ts!!j > putStr $ "T[j] = " ++ disp t_j ++ "\n" > let t6 = t5 + t_j > e6 = e5 ++ " + T[j]" > putStr $ "t6 = " ++ e6 ++ " = " ++ disp t6 ++ "\n" > let (t7, t8) = divMod t6 (2^(32 - r)) > t9 = t7 + 2^r * t8 > e9 = "(" ++ e6 ++ ") <<< r" > putStr $ "t9 = " ++ e9 ++ " = " ++ disp t9 ++ "\n" > let a' = b + t9 > e10 = "b + (" ++ e9 ++ ")" > putStr $ "a = " ++ e10 ++ " = " ++ disp a' ++ "\n" > putStr "\n" > putStr $ "a = " ++ disp a' ++ " = " ++ show a' ++ "\n" > putStr $ "b = " ++ disp b ++ " = " ++ show b ++ "\n" > putStr $ "c = " ++ disp c ++ " = " ++ show c ++ "\n" > putStr $ "d = " ++ disp d ++ " = " ++ show d ++ "\n" > putStr "\n" > return (d, a', b, c) > apply_h :: (Int, Int, Int) -> ABCD -> IO ABCD > apply_h (i, r, j) (a, b, c, d) > = do let t1 = b `xor` c > e1 = "b xor c" > putStr $ "t1 = " ++ e1 ++ " = " ++ disp t1 ++ "\n" > let t2 = t1 `xor` d > e2 = e1 ++ " xor d = H(b,c,d)" > putStr $ "t2 = " ++ e2 ++ " = " ++ disp t2 ++ "\n" > let x_i = bin_to_dec $ list_Xs!!i > putStr $ "X[i] = " ++ disp x_i ++ "\n" > let t4 = t2 + x_i > e4 = "H(b,c,d) + X[i]" > putStr $ "t4 = " ++ e4 ++ " = " ++ disp t4 ++ "\n" > let t5 = a + t4 > e5 = "a + " ++ e4 > putStr $ "t5 = " ++ e5 ++ " = " ++ disp t5 ++ "\n" > let t_j = list_Ts!!j > putStr $ "T[j] = " ++ disp t_j ++ "\n" > let t6 = t5 + t_j > e6 = e5 ++ " + T[j]" > putStr $ "t6 = " ++ e6 ++ " = " ++ disp t6 ++ "\n" > let (t7, t8) = divMod t6 (2^(32 - r)) > t9 = t7 + 2^r * t8 > e9 = "(" ++ e6 ++ ") <<< r" > putStr $ "t9 = " ++ e9 ++ " = " ++ disp t9 ++ "\n" > let a' = b + t9 > e10 = "b + (" ++ e9 ++ ")" > putStr $ "a = " ++ e10 ++ " = " ++ disp a' ++ "\n" > putStr "\n" > putStr $ "a = " ++ disp a' ++ " = " ++ show a' ++ "\n" > putStr $ "b = " ++ disp b ++ " = " ++ show b ++ "\n" > putStr $ "c = " ++ disp c ++ " = " ++ show c ++ "\n" > putStr $ "d = " ++ disp d ++ " = " ++ show d ++ "\n" > putStr "\n" > return (d, a', b, c) > apply_i :: (Int, Int, Int) -> ABCD -> IO ABCD > apply_i (i, r, j) (a, b, c, d) > = do let t1 = complement d > e1 = "not d" > putStr $ "t1 = " ++ e1 ++ " = " ++ disp t1 ++ "\n" > let t2 = b .|. t1 > e2 = "b | (" ++ e1 ++ ")" > putStr $ "t2 = " ++ e2 ++ " = " ++ disp t2 ++ "\n" > let t3 = c `xor` t2 > e3 = "c xor (" ++ e2 ++ ") = I(b,c,d)" > putStr $ "t3 = " ++ e3 ++ " = " ++ disp t3 ++ "\n" > let x_i = bin_to_dec $ list_Xs!!i > putStr $ "X[i] = " ++ disp x_i ++ "\n" > let t4 = t3 + x_i > e4 = "I(b,c,d) + X[i]" > putStr $ "t4 = " ++ e4 ++ " = " ++ disp t4 ++ "\n" > let t5 = a + t4 > e5 = "a + " ++ e4 > putStr $ "t5 = " ++ e5 ++ " = " ++ disp t5 ++ "\n" > let t_j = list_Ts!!j > putStr $ "T[j] = " ++ disp t_j ++ "\n" > let t6 = t5 + t_j > e6 = e5 ++ " + T[j]" > putStr $ "t6 = " ++ e6 ++ " = " ++ disp t6 ++ "\n" > let (t7, t8) = divMod t6 (2^(32 - r)) > t9 = t7 + 2^r * t8 > e9 = "(" ++ e6 ++ ") <<< r" > putStr $ "t9 = " ++ e9 ++ " = " ++ disp t9 ++ "\n" > let a' = b + t9 > e10 = "b + (" ++ e9 ++ ")" > putStr $ "a = " ++ e10 ++ " = " ++ disp a' ++ "\n" > putStr "\n" > putStr $ "a = " ++ disp a' ++ " = " ++ show a' ++ "\n" > putStr $ "b = " ++ disp b ++ " = " ++ show b ++ "\n" > putStr $ "c = " ++ disp c ++ " = " ++ show c ++ "\n" > putStr $ "d = " ++ disp d ++ " = " ++ show d ++ "\n" > putStr "\n" > return (d, a', b, c) > disp :: Word32 -> String > disp x = concat $ [if x .&. shiftL 1 y > 0 then "1" else "0" | y <- [31,30..0]] > bin_to_dec :: Integer -> Word32 > bin_to_dec 0 = 0 > bin_to_dec x = this + 2 * rest > where this = if odd x then 1 else 0 > rest = bin_to_dec $ div x 10 > abcd_to_string :: ABCD -> String > abcd_to_string (a,b,c,d) = concat $ map display_32bits_as_hex [a,b,c,d] > display_32bits_as_hex :: Word32 -> String > display_32bits_as_hex w = map getc [y2,y1,y4,y3,y6,y5,y8,y7] > where [y1,y2,y3,y4,y5,y6,y7,y8] > = map (\x -> (shiftR w (4*x)) .&. 15) [0..7] > getc n = (['0'..'9'] ++ ['a'..'f']) !! (fromIntegral n) > list_Xs :: [Integer] > list_Xs = list_Xs_1 > list_Xs_0 :: [Integer] > -- padding > list_Xs_0 = [00000000000000000000000010000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000] > list_Xs_1 :: [Integer] > -- bit 1 true \ / padding bit 1 > list_Xs_1 = [00000000000000000000000011000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000001, -- length 1 > 00000000000000000000000000000000] > list_Xs_8 :: [Integer] > -- padding <- a -> > list_Xs_8 = [00000000000000001000000001100001, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000000000, > 00000000000000000000000000001000, -- length 8 > 00000000000000000000000000000000] > list_Ts :: [Word32] > list_Ts = [0xd76aa478, 0xe8c7b756, 0x242070db, 0xc1bdceee, > 0xf57c0faf, 0x4787c62a, 0xa8304613, 0xfd469501, > 0x698098d8, 0x8b44f7af, 0xffff5bb1, 0x895cd7be, > 0x6b901122, 0xfd987193, 0xa679438e, 0x49b40821, > 0xf61e2562, 0xc040b340, 0x265e5a51, 0xe9b6c7aa, > 0xd62f105d, 0x2441453, 0xd8a1e681, 0xe7d3fbc8, > 0x21e1cde6, 0xc33707d6, 0xf4d50d87, 0x455a14ed, > 0xa9e3e905, 0xfcefa3f8, 0x676f02d9, 0x8d2a4c8a, > 0xfffa3942, 0x8771f681, 0x6d9d6122, 0xfde5380c, > 0xa4beea44, 0x4bdecfa9, 0xf6bb4b60, 0xbebfbc70, > 0x289b7ec6, 0xeaa127fa, 0xd4ef3085, 0x4881d05, > 0xd9d4d039, 0xe6db99e5, 0x1fa27cf8, 0xc4ac5665, > 0xf4292244, 0x432aff97, 0xab9423a7, 0xfc93a039, > 0x655b59c3, 0x8f0ccc92, 0xffeff47d, 0x85845dd1, > 0x6fa87e4f, 0xfe2ce6e0, 0xa3014314, 0x4e0811a1, > 0xf7537e82, 0xbd3af235, 0x2ad7d2bb, 0xeb86d391]