|
Packit |
acf257 |
module Network.HTTP.MD5Aux
|
|
Packit |
acf257 |
(md5, md5s, md5i,
|
|
Packit |
acf257 |
MD5(..), ABCD(..),
|
|
Packit |
acf257 |
Zord64, Str(..), BoolList(..), WordList(..)) where
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
import Data.Char (ord, chr)
|
|
Packit |
acf257 |
import Data.Bits (rotateL, shiftL, shiftR, (.&.), (.|.), xor, complement)
|
|
Packit |
acf257 |
import Data.Word (Word32, Word64)
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
rotL :: Word32 -> Int -> Word32
|
|
Packit |
acf257 |
rotL x = rotateL x
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
type Zord64 = Word64
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- ===================== TYPES AND CLASS DEFINTIONS ========================
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
type XYZ = (Word32, Word32, Word32)
|
|
Packit |
acf257 |
type Rotation = Int
|
|
Packit |
acf257 |
newtype ABCD = ABCD (Word32, Word32, Word32, Word32) deriving (Eq, Show)
|
|
Packit |
acf257 |
newtype Str = Str String
|
|
Packit |
acf257 |
newtype BoolList = BoolList [Bool]
|
|
Packit |
acf257 |
newtype WordList = WordList ([Word32], Word64)
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Anything we want to work out the MD5 of must be an instance of class MD5
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
class MD5 a where
|
|
Packit |
acf257 |
get_next :: a -> ([Word32], Int, a) -- get the next blocks worth
|
|
Packit |
acf257 |
-- \ \ \------ the rest of the input
|
|
Packit |
acf257 |
-- \ \--------- the number of bits returned
|
|
Packit |
acf257 |
-- \--------------- the bits returned in 32bit words
|
|
Packit |
acf257 |
len_pad :: Word64 -> a -> a -- append the padding and length
|
|
Packit |
acf257 |
finished :: a -> Bool -- Have we run out of input yet?
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Mainly exists because it's fairly easy to do MD5s on input where the
|
|
Packit |
acf257 |
-- length is not a multiple of 8
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
instance MD5 BoolList where
|
|
Packit |
acf257 |
get_next (BoolList s) = (bools_to_word32s ys, length ys, BoolList zs)
|
|
Packit |
acf257 |
where (ys, zs) = splitAt 512 s
|
|
Packit |
acf257 |
len_pad l (BoolList bs)
|
|
Packit |
acf257 |
= BoolList (bs ++ [True]
|
|
Packit |
acf257 |
++ replicate (fromIntegral $ (447 - l) .&. 511) False
|
|
Packit |
acf257 |
++ [l .&. (shiftL 1 x) > 0 | x <- (mangle [0..63])]
|
|
Packit |
acf257 |
)
|
|
Packit |
acf257 |
where mangle [] = []
|
|
Packit |
acf257 |
mangle xs = reverse ys ++ mangle zs
|
|
Packit |
acf257 |
where (ys, zs) = splitAt 8 xs
|
|
Packit |
acf257 |
finished (BoolList s) = s == []
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- The string instance is fairly straightforward
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
instance MD5 Str where
|
|
Packit |
acf257 |
get_next (Str s) = (string_to_word32s ys, 8 * length ys, Str zs)
|
|
Packit |
acf257 |
where (ys, zs) = splitAt 64 s
|
|
Packit |
acf257 |
len_pad c64 (Str s) = Str (s ++ padding ++ l)
|
|
Packit |
acf257 |
where padding = '\128':replicate (fromIntegral zeros) '\000'
|
|
Packit |
acf257 |
zeros = shiftR ((440 - c64) .&. 511) 3
|
|
Packit |
acf257 |
l = length_to_chars 8 c64
|
|
Packit |
acf257 |
finished (Str s) = s == ""
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- YA instance that is believed will be useful
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
instance MD5 WordList where
|
|
Packit |
acf257 |
get_next (WordList (ws, l)) = (xs, fromIntegral taken, WordList (ys, l - taken))
|
|
Packit |
acf257 |
where (xs, ys) = splitAt 16 ws
|
|
Packit |
acf257 |
taken = if l > 511 then 512 else l .&. 511
|
|
Packit |
acf257 |
len_pad c64 (WordList (ws, l)) = WordList (beginning ++ nextish ++ blanks ++ size, newlen)
|
|
Packit |
acf257 |
where beginning = if length ws > 0 then start ++ lastone' else []
|
|
Packit |
acf257 |
start = init ws
|
|
Packit |
acf257 |
lastone = last ws
|
|
Packit |
acf257 |
offset = c64 .&. 31
|
|
Packit |
acf257 |
lastone' = [if offset > 0 then lastone + theone else lastone]
|
|
Packit |
acf257 |
theone = shiftL (shiftR 128 (fromIntegral $ offset .&. 7))
|
|
Packit |
acf257 |
(fromIntegral $ offset .&. (31 - 7))
|
|
Packit |
acf257 |
nextish = if offset == 0 then [128] else []
|
|
Packit |
acf257 |
c64' = c64 + (32 - offset)
|
|
Packit |
acf257 |
num_blanks = (fromIntegral $ shiftR ((448 - c64') .&. 511) 5)
|
|
Packit |
acf257 |
blanks = replicate num_blanks 0
|
|
Packit |
acf257 |
lowsize = fromIntegral $ c64 .&. (shiftL 1 32 - 1)
|
|
Packit |
acf257 |
topsize = fromIntegral $ shiftR c64 32
|
|
Packit |
acf257 |
size = [lowsize, topsize]
|
|
Packit |
acf257 |
newlen = l .&. (complement 511)
|
|
Packit |
acf257 |
+ if c64 .&. 511 >= 448 then 1024 else 512
|
|
Packit |
acf257 |
finished (WordList (_, z)) = z == 0
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
instance Num ABCD where
|
|
Packit |
acf257 |
ABCD (a1, b1, c1, d1) + ABCD (a2, b2, c2, d2) = ABCD (a1 + a2, b1 + b2, c1 + c2, d1 + d2)
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
(-) = error "(-){ABCD}: no instance method defined"
|
|
Packit |
acf257 |
(*) = error "(*){ABCD}: no instance method defined"
|
|
Packit |
acf257 |
signum = error "signum{ABCD}: no instance method defined"
|
|
Packit |
acf257 |
fromInteger = error "fromInteger{ABCD}: no instance method defined"
|
|
Packit |
acf257 |
abs = error "abs{ABCD}: no instance method defined"
|
|
Packit |
acf257 |
-- ===================== EXPORTED FUNCTIONS ========================
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- The simplest function, gives you the MD5 of a string as 4-tuple of
|
|
Packit |
acf257 |
-- 32bit words.
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5 :: (MD5 a) => a -> ABCD
|
|
Packit |
acf257 |
md5 m = md5_main False 0 magic_numbers m
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Returns a hex number ala the md5sum program
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5s :: (MD5 a) => a -> String
|
|
Packit |
acf257 |
md5s = abcd_to_string . md5
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Returns an integer equivalent to the above hex number
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5i :: (MD5 a) => a -> Integer
|
|
Packit |
acf257 |
md5i = abcd_to_integer . md5
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- ===================== THE CORE ALGORITHM ========================
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Decides what to do. The first argument indicates if padding has been
|
|
Packit |
acf257 |
-- added. The second is the length mod 2^64 so far. Then we have the
|
|
Packit |
acf257 |
-- starting state, the rest of the string and the final state.
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_main :: (MD5 a) =>
|
|
Packit |
acf257 |
Bool -- Have we added padding yet?
|
|
Packit |
acf257 |
-> Word64 -- The length so far mod 2^64
|
|
Packit |
acf257 |
-> ABCD -- The initial state
|
|
Packit |
acf257 |
-> a -- The non-processed portion of the message
|
|
Packit |
acf257 |
-> ABCD -- The resulting state
|
|
Packit |
acf257 |
md5_main padded ilen abcd m
|
|
Packit |
acf257 |
= if finished m && padded
|
|
Packit |
acf257 |
then abcd
|
|
Packit |
acf257 |
else md5_main padded' (ilen + 512) (abcd + abcd') m''
|
|
Packit |
acf257 |
where (m16, l, m') = get_next m
|
|
Packit |
acf257 |
len' = ilen + fromIntegral l
|
|
Packit |
acf257 |
((m16', _, m''), padded') = if not padded && l < 512
|
|
Packit |
acf257 |
then (get_next $ len_pad len' m, True)
|
|
Packit |
acf257 |
else ((m16, l, m'), padded)
|
|
Packit |
acf257 |
abcd' = md5_do_block abcd m16'
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- md5_do_block processes a 512 bit block by calling md5_round 4 times to
|
|
Packit |
acf257 |
-- apply each round with the correct constants and permutations of the
|
|
Packit |
acf257 |
-- block
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_do_block :: ABCD -- Initial state
|
|
Packit |
acf257 |
-> [Word32] -- The block to be processed - 16 32bit words
|
|
Packit |
acf257 |
-> ABCD -- Resulting state
|
|
Packit |
acf257 |
md5_do_block abcd0 w = abcd4
|
|
Packit |
acf257 |
where (r1, r2, r3, r4) = rounds
|
|
Packit |
acf257 |
{-
|
|
Packit |
acf257 |
map (\x -> w !! x) [1,6,11,0,5,10,15,4,9,14,3,8,13,2,7,12]
|
|
Packit |
acf257 |
-- [(5 * x + 1) `mod` 16 | x <- [0..15]]
|
|
Packit |
acf257 |
map (\x -> w !! x) [5,8,11,14,1,4,7,10,13,0,3,6,9,12,15,2]
|
|
Packit |
acf257 |
-- [(3 * x + 5) `mod` 16 | x <- [0..15]]
|
|
Packit |
acf257 |
map (\x -> w !! x) [0,7,14,5,12,3,10,1,8,15,6,13,4,11,2,9]
|
|
Packit |
acf257 |
-- [(7 * x) `mod` 16 | x <- [0..15]]
|
|
Packit |
acf257 |
-}
|
|
Packit |
acf257 |
perm5 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]
|
|
Packit |
acf257 |
= [c1,c6,c11,c0,c5,c10,c15,c4,c9,c14,c3,c8,c13,c2,c7,c12]
|
|
Packit |
acf257 |
perm5 _ = error "broke at perm5"
|
|
Packit |
acf257 |
perm3 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]
|
|
Packit |
acf257 |
= [c5,c8,c11,c14,c1,c4,c7,c10,c13,c0,c3,c6,c9,c12,c15,c2]
|
|
Packit |
acf257 |
perm3 _ = error "broke at perm3"
|
|
Packit |
acf257 |
perm7 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]
|
|
Packit |
acf257 |
= [c0,c7,c14,c5,c12,c3,c10,c1,c8,c15,c6,c13,c4,c11,c2,c9]
|
|
Packit |
acf257 |
perm7 _ = error "broke at perm7"
|
|
Packit |
acf257 |
abcd1 = md5_round md5_f abcd0 w r1
|
|
Packit |
acf257 |
abcd2 = md5_round md5_g abcd1 (perm5 w) r2
|
|
Packit |
acf257 |
abcd3 = md5_round md5_h abcd2 (perm3 w) r3
|
|
Packit |
acf257 |
abcd4 = md5_round md5_i abcd3 (perm7 w) r4
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- md5_round does one of the rounds. It takes an auxiliary function and foldls
|
|
Packit |
acf257 |
-- (md5_inner_function f) to repeatedly apply it to the initial state with the
|
|
Packit |
acf257 |
-- correct constants
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_round :: (XYZ -> Word32) -- Auxiliary function (F, G, H or I
|
|
Packit |
acf257 |
-- for those of you with a copy of
|
|
Packit |
acf257 |
-- the prayer book^W^WRFC)
|
|
Packit |
acf257 |
-> ABCD -- Initial state
|
|
Packit |
acf257 |
-> [Word32] -- The 16 32bit words of input
|
|
Packit |
acf257 |
-> [(Rotation, Word32)] -- The list of 16 rotations and
|
|
Packit |
acf257 |
-- additive constants
|
|
Packit |
acf257 |
-> ABCD -- Resulting state
|
|
Packit |
acf257 |
md5_round f abcd s ns = foldl (md5_inner_function f) abcd ns'
|
|
Packit |
acf257 |
where ns' = zipWith (\x (y, z) -> (y, x + z)) s ns
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Apply one of the functions md5_[fghi] and put the new ABCD together
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_inner_function :: (XYZ -> Word32) -- Auxiliary function
|
|
Packit |
acf257 |
-> ABCD -- Initial state
|
|
Packit |
acf257 |
-> (Rotation, Word32) -- The rotation and additive
|
|
Packit |
acf257 |
-- constant (X[i] + T[j])
|
|
Packit |
acf257 |
-> ABCD -- Resulting state
|
|
Packit |
acf257 |
md5_inner_function f (ABCD (a, b, c, d)) (s, ki) = ABCD (d, a', b, c)
|
|
Packit |
acf257 |
where mid_a = a + f(b,c,d) + ki
|
|
Packit |
acf257 |
rot_a = rotL mid_a s
|
|
Packit |
acf257 |
a' = b + rot_a
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- The 4 auxiliary functions
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_f :: XYZ -> Word32
|
|
Packit |
acf257 |
md5_f (x, y, z) = z `xor` (x .&. (y `xor` z))
|
|
Packit |
acf257 |
{- optimised version of: (x .&. y) .|. ((complement x) .&. z) -}
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_g :: XYZ -> Word32
|
|
Packit |
acf257 |
md5_g (x, y, z) = md5_f (z, x, y)
|
|
Packit |
acf257 |
{- was: (x .&. z) .|. (y .&. (complement z)) -}
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_h :: XYZ -> Word32
|
|
Packit |
acf257 |
md5_h (x, y, z) = x `xor` y `xor` z
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
md5_i :: XYZ -> Word32
|
|
Packit |
acf257 |
md5_i (x, y, z) = y `xor` (x .|. (complement z))
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- The magic numbers from the RFC.
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
magic_numbers :: ABCD
|
|
Packit |
acf257 |
magic_numbers = ABCD (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476)
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- The 4 lists of (rotation, additive constant) tuples, one for each round
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
rounds :: ([(Rotation, Word32)],
|
|
Packit |
acf257 |
[(Rotation, Word32)],
|
|
Packit |
acf257 |
[(Rotation, Word32)],
|
|
Packit |
acf257 |
[(Rotation, Word32)])
|
|
Packit |
acf257 |
rounds = (r1, r2, r3, r4)
|
|
Packit |
acf257 |
where r1 = [(s11, 0xd76aa478), (s12, 0xe8c7b756), (s13, 0x242070db),
|
|
Packit |
acf257 |
(s14, 0xc1bdceee), (s11, 0xf57c0faf), (s12, 0x4787c62a),
|
|
Packit |
acf257 |
(s13, 0xa8304613), (s14, 0xfd469501), (s11, 0x698098d8),
|
|
Packit |
acf257 |
(s12, 0x8b44f7af), (s13, 0xffff5bb1), (s14, 0x895cd7be),
|
|
Packit |
acf257 |
(s11, 0x6b901122), (s12, 0xfd987193), (s13, 0xa679438e),
|
|
Packit |
acf257 |
(s14, 0x49b40821)]
|
|
Packit |
acf257 |
r2 = [(s21, 0xf61e2562), (s22, 0xc040b340), (s23, 0x265e5a51),
|
|
Packit |
acf257 |
(s24, 0xe9b6c7aa), (s21, 0xd62f105d), (s22, 0x2441453),
|
|
Packit |
acf257 |
(s23, 0xd8a1e681), (s24, 0xe7d3fbc8), (s21, 0x21e1cde6),
|
|
Packit |
acf257 |
(s22, 0xc33707d6), (s23, 0xf4d50d87), (s24, 0x455a14ed),
|
|
Packit |
acf257 |
(s21, 0xa9e3e905), (s22, 0xfcefa3f8), (s23, 0x676f02d9),
|
|
Packit |
acf257 |
(s24, 0x8d2a4c8a)]
|
|
Packit |
acf257 |
r3 = [(s31, 0xfffa3942), (s32, 0x8771f681), (s33, 0x6d9d6122),
|
|
Packit |
acf257 |
(s34, 0xfde5380c), (s31, 0xa4beea44), (s32, 0x4bdecfa9),
|
|
Packit |
acf257 |
(s33, 0xf6bb4b60), (s34, 0xbebfbc70), (s31, 0x289b7ec6),
|
|
Packit |
acf257 |
(s32, 0xeaa127fa), (s33, 0xd4ef3085), (s34, 0x4881d05),
|
|
Packit |
acf257 |
(s31, 0xd9d4d039), (s32, 0xe6db99e5), (s33, 0x1fa27cf8),
|
|
Packit |
acf257 |
(s34, 0xc4ac5665)]
|
|
Packit |
acf257 |
r4 = [(s41, 0xf4292244), (s42, 0x432aff97), (s43, 0xab9423a7),
|
|
Packit |
acf257 |
(s44, 0xfc93a039), (s41, 0x655b59c3), (s42, 0x8f0ccc92),
|
|
Packit |
acf257 |
(s43, 0xffeff47d), (s44, 0x85845dd1), (s41, 0x6fa87e4f),
|
|
Packit |
acf257 |
(s42, 0xfe2ce6e0), (s43, 0xa3014314), (s44, 0x4e0811a1),
|
|
Packit |
acf257 |
(s41, 0xf7537e82), (s42, 0xbd3af235), (s43, 0x2ad7d2bb),
|
|
Packit |
acf257 |
(s44, 0xeb86d391)]
|
|
Packit |
acf257 |
s11 = 7
|
|
Packit |
acf257 |
s12 = 12
|
|
Packit |
acf257 |
s13 = 17
|
|
Packit |
acf257 |
s14 = 22
|
|
Packit |
acf257 |
s21 = 5
|
|
Packit |
acf257 |
s22 = 9
|
|
Packit |
acf257 |
s23 = 14
|
|
Packit |
acf257 |
s24 = 20
|
|
Packit |
acf257 |
s31 = 4
|
|
Packit |
acf257 |
s32 = 11
|
|
Packit |
acf257 |
s33 = 16
|
|
Packit |
acf257 |
s34 = 23
|
|
Packit |
acf257 |
s41 = 6
|
|
Packit |
acf257 |
s42 = 10
|
|
Packit |
acf257 |
s43 = 15
|
|
Packit |
acf257 |
s44 = 21
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- ===================== CONVERSION FUNCTIONS ========================
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Turn the 4 32 bit words into a string representing the hex number they
|
|
Packit |
acf257 |
-- represent.
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
abcd_to_string :: ABCD -> String
|
|
Packit |
acf257 |
abcd_to_string (ABCD (a,b,c,d)) = concat $ map display_32bits_as_hex [a,b,c,d]
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Split the 32 bit word up, swap the chunks over and convert the numbers
|
|
Packit |
acf257 |
-- to their hex equivalents.
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
display_32bits_as_hex :: Word32 -> String
|
|
Packit |
acf257 |
display_32bits_as_hex w = swap_pairs cs
|
|
Packit |
acf257 |
where cs = map (\x -> getc $ (shiftR w (4*x)) .&. 15) [0..7]
|
|
Packit |
acf257 |
getc n = (['0'..'9'] ++ ['a'..'f']) !! (fromIntegral n)
|
|
Packit |
acf257 |
swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs
|
|
Packit |
acf257 |
swap_pairs _ = []
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Convert to an integer, performing endianness magic as we go
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
abcd_to_integer :: ABCD -> Integer
|
|
Packit |
acf257 |
abcd_to_integer (ABCD (a,b,c,d)) = rev_num a * 2^(96 :: Int)
|
|
Packit |
acf257 |
+ rev_num b * 2^(64 :: Int)
|
|
Packit |
acf257 |
+ rev_num c * 2^(32 :: Int)
|
|
Packit |
acf257 |
+ rev_num d
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
rev_num :: Word32 -> Integer
|
|
Packit |
acf257 |
rev_num i = toInteger j `mod` (2^(32 :: Int))
|
|
Packit |
acf257 |
-- NHC's fault ~~~~~~~~~~~~~~~~~~~~~
|
|
Packit |
acf257 |
where j = foldl (\so_far next -> shiftL so_far 8 + (shiftR i next .&. 255))
|
|
Packit |
acf257 |
0 [0,8,16,24]
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Used to convert a 64 byte string to 16 32bit words
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
string_to_word32s :: String -> [Word32]
|
|
Packit |
acf257 |
string_to_word32s "" = []
|
|
Packit |
acf257 |
string_to_word32s ss = this:string_to_word32s ss'
|
|
Packit |
acf257 |
where (s, ss') = splitAt 4 ss
|
|
Packit |
acf257 |
this = foldr (\c w -> shiftL w 8 + (fromIntegral.ord) c) 0 s
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Used to convert a list of 512 bools to 16 32bit words
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
bools_to_word32s :: [Bool] -> [Word32]
|
|
Packit |
acf257 |
bools_to_word32s [] = []
|
|
Packit |
acf257 |
bools_to_word32s bs = this:bools_to_word32s rest
|
|
Packit |
acf257 |
where (bs1, bs1') = splitAt 8 bs
|
|
Packit |
acf257 |
(bs2, bs2') = splitAt 8 bs1'
|
|
Packit |
acf257 |
(bs3, bs3') = splitAt 8 bs2'
|
|
Packit |
acf257 |
(bs4, rest) = splitAt 8 bs3'
|
|
Packit |
acf257 |
this = boolss_to_word32 [bs1, bs2, bs3, bs4]
|
|
Packit |
acf257 |
bools_to_word8 = foldl (\w b -> shiftL w 1 + if b then 1 else 0) 0
|
|
Packit |
acf257 |
boolss_to_word32 = foldr (\w8 w -> shiftL w 8 + bools_to_word8 w8) 0
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
-- Convert the size into a list of characters used by the len_pad function
|
|
Packit |
acf257 |
-- for strings
|
|
Packit |
acf257 |
|
|
Packit |
acf257 |
length_to_chars :: Int -> Word64 -> String
|
|
Packit |
acf257 |
length_to_chars 0 _ = []
|
|
Packit |
acf257 |
length_to_chars p n = this:length_to_chars (p-1) (shiftR n 8)
|
|
Packit |
acf257 |
where this = chr $ fromIntegral $ n .&. 255
|
|
Packit |
acf257 |
|