{-# OPTIONS_GHC -funbox-strict-fields #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Digest.SHA1
-- Copyright   :  (c) Dominic Steinitz 2007
-- License     :  BSD-style (see the file ReadMe.tex)
--
-- Maintainer  :  dominic.steinitz@blueyonder.co.uk
-- Stability   :  experimental
-- Portability :  portable
--
-- Take [Word8] and return Word160.
-- See <http://www.itl.nist.gov/fipspubs/fip180-1.htm> for the specification.
--
-----------------------------------------------------------------------------

module Data.Digest.SHA1(
   Word160(Word160),
   hash,
   lift2,
   toInteger
   ) where

import Data.Bits
import Data.List
import Data.Word
import Data.Array.IArray
import Codec.Utils
import Prelude hiding (toInteger)

rotL :: Bits b => Int -> b -> b
rotL = flip rotateL

data Word160 = Word160 {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
               deriving (Eq, Show)

toInteger :: Word160 -> Integer
toInteger (Word160 a b c d e) = let n = fromIntegral e +
                                        (fromIntegral d `shiftL` 32) +
                                        (fromIntegral c `shiftL` 64) +
                                        (fromIntegral b `shiftL` 96) +
                                        (fromIntegral a `shiftL` 128)
                                in n `seq` n

lift2 :: (Word32 -> Word32 -> Word32) -> Word160 -> Word160 -> Word160
lift2 f a@(Word160 x1 x2 x3 x4 x5) b@(Word160 y1 y2 y3 y4 y5) = 
   Word160 (f x1 y1) (f x2 y2) (f x3 y3) (f x4 y4) (f x5 y5)

f n x y z 
   | n <= 19 = (x .&. y) .|. ((complement x) .&. z)
   | n <= 39 = x `xor` y `xor` z
   | n <= 59 = (x .&. y) .|. (x .&. z) .|. (y .&. z)
   | n <= 79 = x `xor` y `xor` z

k n
   | n <= 19 = 0x5a827999
   | n <= 39 = 0x6ed9eba1
   | n <= 59 = 0x8f1bbcdc
   | n <= 79 = 0xca62c1d6

data AccAndWord160 = AccAndWord160 !Int !Word160

-- Word160 -> Word512 -> Word160 
oneBlock ss xs = tt
   where
      us :: Array Int Word32
      us = 
         accumArray (curry snd) 0 (0,79) (zip [0..15] xs ++ map (\(x,y) -> (x, rotL 1 y))[(i, xxor i) | i<-[16..79]])
            where
               xxor i = us ! (i-16) `xor` us ! (i-3) `xor` us ! (i-8) `xor` us ! (i-14)
      g (AccAndWord160 n (Word160 a b c d e)) w = 
         AccAndWord160 (n+1) (Word160 ((rotL 5 a) + (f n b c d) + e + w + (k n)) a (rotL 30 b) c d)
      (AccAndWord160 _ tt) = foldl' g (AccAndWord160 0 ss) (elems us)

ss :: Word160
ss = Word160 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0

pad = pad' 0
   where pad' l [] = [0x80] ++ ps ++ lb
          where pl = (64-(l+9)) `mod` 64
                ps = replicate pl 0x00
                lb = i2osp 8 (8*l)
         pad' l (x:xs) = x : (pad' $! l+1) xs -- otherwise (l+1) it will be deferred until replicate

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

fromBytes :: (Bits a) => [a] -> a
fromBytes input =
    let dofb accum [] = accum
        dofb accum (x:xs) = dofb ((shiftL accum 8) .|. x) xs
        in
        dofb 0 input

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

getWord32s :: [Word8] -> [Word32]
getWord32s =
   map fromBytes . map (map fromIntegral) .  blockWord8sIn32

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

hashOnce ss a = lift2 (+) ss (oneBlock ss a)

hash :: [Word8] -> Word160
hash = foldl' hashOnce ss . blockWord32sIn512