{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
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
type Zord64 = Word64
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)
class MD5 a where
get_next :: a -> ([Word32], Int, a)
len_pad :: Zord64 -> a -> a
finished :: a -> Bool
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
== []
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
== ""
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
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)
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
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
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
md5_main :: (MD5 a) =>
Bool
-> Zord64
-> ABCD
-> a
-> ABCD
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 :: ABCD
-> [Word32]
-> ABCD
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
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 :: (XYZ -> Word32)
-> ABCD
-> [Word32]
-> [(Rotation, Word32)]
-> ABCD
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
md5_inner_function :: (XYZ -> Word32)
-> ABCD
-> (Rotation, Word32)
-> ABCD
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
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))
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)
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))
magic_numbers :: ABCD
magic_numbers :: ABCD
magic_numbers = (Word32, Word32, Word32, Word32) -> ABCD
ABCD (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476)
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
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]
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 _ = []
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))
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]
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
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
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