[Haskell-cafe] Space Leak Help

[Dominic Steinitz]

I have re-written SHA1 so that is more idiomatically haskell and it is easy to 
see how it implements the specification. The only problem is I now have a 
space leak. I can see where the leak is but I'm less sure what to do about 
getting rid of it.

Here's the offending function:

pad :: [Word8] -> [Word8]
pad xs =
   xs ++ [0x80] ++ ps ++ lb
   where
      l = length xs
      pl = (64-(l+9)) `mod` 64
      ps = replicate pl 0x00
      lb = i2osp 8 (8*l)

I've thought about zipping the xs with [1..] which will give me a length as I 
go. Is this the right way to go are there better techniques for dealing with 
this?

I've attached the full source below.

Dominic.

module Main(main) where

import Data.Char
import Data.Bits
import Data.List
import Data.Word
import System
import Codec.Utils

type Rotation = Int

rotL :: Rotation -> Word32 -> Word32
rotL s a = shiftL a s .|. shiftL a (s-32)

instance Num [Word32] where
   a + b = zipWith (+) a b

f n x y z 
   | (0 <= n)  && (n <= 19) = (x .&. y) .|. ((complement x) .&. z)
   | (20 <= n) && (n <= 39) = x `xor` y `xor` z
   | (40 <= n) && (n <= 59) = (x .&. y) .|. (x .&. z) .|. (y .&. z)
   | (60 <= n) && (n <= 79) = x `xor` y `xor` z
   | otherwise = error "invalid index for f"

k n
   | (0 <= n)  && (n <= 19) = 0x5a827999
   | (20 <= n) && (n <= 39) = 0x6ed9eba1
   | (40 <= n) && (n <= 59) = 0x8f1bbcdc
   | (60 <= n) && (n <= 79) = 0xca62c1d6
   | otherwise = error "invalid index for k"

-- Word120 -> Word512 -> Word120 
oneBlock ss xs = (as!!80):(bs!!80):(cs!!80):(ds!!80):(es!!80):[]
   where
      ws = xs ++ map (rotL 1) (zipWith4 xxxor wm3s wm8s wm14s wm16s)
         where 
            xxxor a b c d = a `xor` b `xor` c `xor` d
            wm3s  = drop (16-3)  ws
            wm8s  = drop (16-8)  ws
            wm14s = drop (16-14) ws
            wm16s = drop (16-16) ws
      as = (ss!!0):ts
      bs = (ss!!1):as
      cs = (ss!!2):(map (rotL 30) bs)
      ds = (ss!!3):cs 
      es = (ss!!4):ds
      ts = (map (rotL 5) as) + (zipWith4 f [0..] bs cs ds) + es + (map k 
[0..]) + ws

ss :: [Word32]
ss = [0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476, 0xc3d2e1f0]

pad :: [Word8] -> [Word8]
pad xs =
   xs ++ [0x80] ++ ps ++ lb
   where
      l = length xs
      pl = (64-(l+9)) `mod` 64
      ps = replicate pl 0x00
      lb = i2osp 8 (8*l)

blockWord8sIn512 :: [Word8] -> [[Word8]]
blockWord8sIn512 =
   unfoldr g
   where
      g [] = Nothing
      g xs = Just (splitAt 64 xs)

getWord32s :: [Word8] -> [Word32]
getWord32s s = 
   map f [0..15]
   where 
      f i = foldl (+) 0 $ map (\n -> toEnum (fromEnum (s!!(i*4+n))) `shiftL` 
(fromIntegral (8 * (3-n)))) [0..3]

blockWord32sIn512 :: [Word8] -> [[Word32]]
blockWord32sIn512 = (map getWord32s) . blockWord8sIn512 . pad

-- Word120 -> Word512 -> Word120
hashOnce ss a = ss + oneBlock ss a

hash = foldl' hashOnce ss . blockWord32sIn512

convert :: String -> [Word8]
convert = map (fromIntegral . ord)

short :: [Word8]
short = convert "abc"

message :: [Word8]
message = convert "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"

performance n =
   (convert . take n . repeat) 'a'

test n = mapM_ (putStrLn . show . hash) [short, message, performance n]

main =
   do progName <- getProgName
      args <- getArgs
      if length args /= 1
         then putStrLn ("Usage: " ++ progName ++ " <testSize>")
         else test (read (args!!0))