SHA-1 in haskell producing wrong hashes

Question

I wrote a program to perform SHA-1 in haskell, and while it does produce hashes, they do not match with the ones produced by other SHA-1 programs

Example: cat hashes to: b5be86bc8bccfc24b01b093228ebb96fc92fa804 but is supposed to hash to 9d989e8d27dc9e0ec3389fc855f142c3d40f0c50

My code is:

(old code omitted)

I have no idea what is wrong. Can someone tell me where I made a mistake?

Edit: I fixed the stuff that was pointed out, however it is still not working. It works correctly up until the inner loop. I cleaned up the code so the functions for the inner loop are available as f1, f2 and f3 cat now interestingly hashes to ebe6c9fa1afa0ef5a0ca80bab251fd41cc29127e.

Code:

import Data.Word
import Data.Bits
import Data.Char (ord, intToDigit)
import Data.Binary (encode, decode)
import Numeric (showHex, showIntAtBase)
import System.IO (stdin)
import Data.Sequence ((<|), (|>))
import qualified Data.Sequence as S
import qualified Data.ByteString.Lazy as B
type Quintuple32 = (Word32, Word32, Word32, Word32, Word32)

addQuintuple (a, b, c, d, e) (f, g, h, i, j) =
    (a + f, b + g, c + h, d + i, e + j)

shower :: Quintuple32 -> String
shower (a, b, c, d, e) = concatMap (`showHex` "") [a, b, c, d, e]

hash :: Int -> S.Seq Word32 -> Quintuple32 -> Quintuple32
hash i w h@(a, b, c, d, e)
    | i < 20 = hash (i + 1) w (newhash (f1 h + k1))
    | i < 40 = hash (i + 1) w (newhash (f2 h + k2))
    | i < 60 = hash (i + 1) w (newhash (f3 h + k3))
    | i < 80 = hash (i + 1) w (newhash (f2 h + k4))
    | otherwise = h
  where (k1, k2, k3, k4) = (0x5A827999, 0x6ED9EBA1, 0x8F1BBCDC, 0xCA62C1D6)
        newhash a' = (rotate a 5 + a' + e + (w `S.index` i), a, rotate b 30, c, d)

f1 :: Quintuple32 -> Word32
f1 (_, b, c, _, _) = (b .&. c) .|. (complement b .&. c)

f2 :: Quintuple32 -> Word32
f2 (_, b, c, d, _) = b `xor` c `xor` d

f3 :: Quintuple32 -> Word32
f3 (_, b, c, d, _) = (b .&. c) .|. (b .&. d) .|. (c .&. d)

starting :: Quintuple32
starting = (0x67452301
           , 0xEFCDAB89
           , 0x98BADCFE
           , 0x10325476
           , 0xC3D2E1F0)

hasher :: Quintuple32 -> S.Seq Word32 -> Quintuple32
hasher acc x = addQuintuple acc (hash 0 (extend x) acc)

process :: B.ByteString -> Quintuple32
process = foldl hasher starting . chunks . pad

extend :: S.Seq Word32 -> S.Seq Word32
extend = extend' 16

extend' :: Int -> S.Seq Word32 -> S.Seq Word32
extend' 80 a = a
extend' i a = extend' (i + 1) (a |> xored)
  where xored = rotate ((a `S.index` (i - 3)) `xor`
                        (a `S.index` (i - 8)) `xor`
                        (a `S.index` (i - 14)) `xor`
                        (a `S.index` (i - 16))) 1

toBytes :: String -> B.ByteString
toBytes = B.pack . map (fromIntegral . ord)

splitEvery n xs
    | B.null xs = S.empty
    | otherwise = B.take n xs <| splitEvery n (B.drop n xs)

chunks :: B.ByteString -> [S.Seq Word32]
chunks xs
    | B.null xs = []
    | otherwise = x : chunks (B.drop 64 xs)
  where x = fmap decode (splitEvery 4 (B.take 64 xs))

pad :: B.ByteString -> B.ByteString
pad xs = B.append (add0 $ add1 xs) length64
  where length64 = encode (fromIntegral (8 * B.length xs) :: Word64)

add1 :: B.ByteString -> B.ByteString
add1 = flip B.append (B.singleton 128)

add0 :: B.ByteString -> B.ByteString
add0 xs
    | modulo /= 448 = add0 $ B.append xs (B.singleton 0)
    | otherwise = xs
  where modulo = (B.length xs * 8) `rem` 512

Also, a small question: is something like (a, b) = (8, 9) an acceptable thing to do to set multiple variables?

Answer 1

Oh, another one of these!

Two errors jump out at me immediately:

pad :: B.ByteString -> B.ByteString
pad xs = B.append (add0 $ add1 xs) length64
  where length64 = encode (fromIntegral (B.length xs) :: Word64)

Notice the length you append is supposed to be the bit length, not the byte length.

add1 :: B.ByteString -> B.ByteString
add1 = flip B.append (B.singleton 255)

Notice 255 /= 0b10000000 and the pad is supposed to be the later.

In general you debug these by 1) going over the spec again and again. 2) Comparing to another implementation, such as Adam Wick's SHA package, and comparing for equality at as fine grained level as possible.

EDIT: There are two more bugs, basically transcription errors. Look around a bit and shout if you're still stuck.