{-# OPTIONS_GHC -funbox-strict-fields #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Digest.SHA1
-- Copyright   :  (c) Dominic Steinitz 2007
-- License     :  BSD-style (see the file ReadMe.tex)
--
-- 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 (Array, array, elems, (!))
import Codec.Utils (i2osp)
import Prelude hiding (toInteger)

rotL :: Bits b => Int -> b -> b
rotL :: forall b. Bits b => Int -> b -> b
rotL = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
rotateL

data Word160 = Word160 {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
                       {-# UNPACK #-} !Word32
               deriving (Word160 -> Word160 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word160 -> Word160 -> Bool
$c/= :: Word160 -> Word160 -> Bool
== :: Word160 -> Word160 -> Bool
$c== :: Word160 -> Word160 -> Bool
Eq, Int -> Word160 -> ShowS
[Word160] -> ShowS
Word160 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word160] -> ShowS
$cshowList :: [Word160] -> ShowS
show :: Word160 -> String
$cshow :: Word160 -> String
showsPrec :: Int -> Word160 -> ShowS
$cshowsPrec :: Int -> Word160 -> ShowS
Show)

toInteger :: Word160 -> Integer
toInteger :: Word160 -> Integer
toInteger (Word160 Word32
a Word32
b Word32
c Word32
d Word32
e) = let n :: Integer
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
e forall a. Num a => a -> a -> a
+
                                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
d forall a. Bits a => a -> Int -> a
`shiftL` Int
32) forall a. Num a => a -> a -> a
+
                                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
c forall a. Bits a => a -> Int -> a
`shiftL` Int
64) forall a. Num a => a -> a -> a
+
                                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
b forall a. Bits a => a -> Int -> a
`shiftL` Int
96) forall a. Num a => a -> a -> a
+
                                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a forall a. Bits a => a -> Int -> a
`shiftL` Int
128)
                                in Integer
n seq :: forall a b. a -> b -> b
`seq` Integer
n

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

-- 'f' as defined in FIPS 180-4 section 4.1.1 "SHA-1 Functions"
f :: Int -> Word32 -> Word32 -> Word32 -> Word32
f :: Int -> Word32 -> Word32 -> Word32 -> Word32
f Int
n Word32
x Word32
y Word32
z
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
19 = (Word32
x forall a. Bits a => a -> a -> a
.&. Word32
y) forall a. Bits a => a -> a -> a
.|. ((forall a. Bits a => a -> a
complement Word32
x) forall a. Bits a => a -> a -> a
.&. Word32
z)
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
39 = Word32
x forall a. Bits a => a -> a -> a
`xor` Word32
y forall a. Bits a => a -> a -> a
`xor` Word32
z
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
59 = (Word32
x forall a. Bits a => a -> a -> a
.&. Word32
y) forall a. Bits a => a -> a -> a
.|. (Word32
x forall a. Bits a => a -> a -> a
.&. Word32
z) forall a. Bits a => a -> a -> a
.|. (Word32
y forall a. Bits a => a -> a -> a
.&. Word32
z)
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
79 = Word32
x forall a. Bits a => a -> a -> a
`xor` Word32
y forall a. Bits a => a -> a -> a
`xor` Word32
z

-- 'k' as defined in FIPS 180-4 section 4.2.1 "SHA-1 Constants"
k :: Int -> Word32
k :: Int -> Word32
k Int
n
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
19 = Word32
0x5a827999
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
39 = Word32
0x6ed9eba1
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
59 = Word32
0x8f1bbcdc
   | Int
n forall a. Ord a => a -> a -> Bool
<= Int
79 = Word32
0xca62c1d6

data AccAndWord160 = AccAndWord160 !Int !Word160

-- FIPS-180-4 section 6.1.2 "SHA-1 Hash Computation"
oneBlock :: Word160 -> [Word32] {- Word512 -} -> Word160
oneBlock :: Word160 -> [Word32] -> Word160
oneBlock Word160
ss [Word32]
xs = Word160
tt
   where
      -- message schedule $W_t$
      w :: Array Int Word32
      w :: Array Int Word32
w = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,Int
79) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
15] [Word32]
xs forall a. [a] -> [a] -> [a]
++ [(Int
i, forall b. Bits b => Int -> b -> b
rotL Int
1 (Int -> Word32
xxor Int
i)) | Int
i <- [Int
16..Int
79] ]
        where
          xxor :: Int -> Word32
xxor Int
i = Array Int Word32
w forall i e. Ix i => Array i e -> i -> e
! (Int
iforall a. Num a => a -> a -> a
-Int
3) forall a. Bits a => a -> a -> a
`xor` Array Int Word32
w forall i e. Ix i => Array i e -> i -> e
! (Int
iforall a. Num a => a -> a -> a
-Int
8) forall a. Bits a => a -> a -> a
`xor` Array Int Word32
w forall i e. Ix i => Array i e -> i -> e
! (Int
iforall a. Num a => a -> a -> a
-Int
14) forall a. Bits a => a -> a -> a
`xor` Array Int Word32
w forall i e. Ix i => Array i e -> i -> e
! (Int
iforall a. Num a => a -> a -> a
-Int
16)

      -- step 3
      g :: AccAndWord160 -> Word32 -> AccAndWord160
g (AccAndWord160 Int
n (Word160 Word32
a Word32
b Word32
c Word32
d Word32
e)) Word32
w =
         Int -> Word160 -> AccAndWord160
AccAndWord160 (Int
nforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word160
Word160 {- a' = -} ((forall b. Bits b => Int -> b -> b
rotL Int
5 Word32
a) forall a. Num a => a -> a -> a
+ (Int -> Word32 -> Word32 -> Word32 -> Word32
f Int
n Word32
b Word32
c Word32
d) forall a. Num a => a -> a -> a
+ Word32
e forall a. Num a => a -> a -> a
+ Word32
w forall a. Num a => a -> a -> a
+ (Int -> Word32
k Int
n))
                                       {- b' = -} Word32
a
                                       {- c' = -} (forall b. Bits b => Int -> b -> b
rotL Int
30 Word32
b)
                                       {- d' = -} Word32
c
                                       {- e' = -} Word32
d

      (AccAndWord160 Int
_ Word160
tt) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AccAndWord160 -> Word32 -> AccAndWord160
g (Int -> Word160 -> AccAndWord160
AccAndWord160 Int
0 Word160
ss) (forall i e. Array i e -> [e]
elems Array Int Word32
w)

-- initial hash value $H^{(0)}$ as defined in FIPS-180-4 section 5.3.1
ss :: Word160
ss :: Word160
ss = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word160
Word160 Word32
0x67452301 Word32
0xefcdab89 Word32
0x98badcfe Word32
0x10325476 Word32
0xc3d2e1f0

-- FIPS-180-4 section 5.1.1
pad :: [Word8] -> [Word8]
pad :: [Word8] -> [Word8]
pad = Int -> [Word8] -> [Word8]
pad' Int
0
   where pad' :: Int -> [Word8] -> [Word8]
pad' Int
l [] = [Word8
0x80] forall a. [a] -> [a] -> [a]
++ [Word8]
ps forall a. [a] -> [a] -> [a]
++ [Word8]
lb
          where pl :: Int
pl = (Int
64forall a. Num a => a -> a -> a
-(Int
lforall a. Num a => a -> a -> a
+Int
9)) forall a. Integral a => a -> a -> a
`mod` Int
64
                ps :: [Word8]
ps = forall a. Int -> a -> [a]
replicate Int
pl Word8
0x00
                lb :: [Word8]
lb = forall a. Integral a => Int -> a -> [Word8]
i2osp Int
8 (Int
8forall a. Num a => a -> a -> a
*Int
l)
         pad' Int
l (Word8
x:[Word8]
xs) = Word8
x forall a. a -> [a] -> [a]
: (Int -> [Word8] -> [Word8]
pad' forall a b. (a -> b) -> a -> b
$! Int
lforall a. Num a => a -> a -> a
+Int
1) [Word8]
xs -- otherwise (l+1) it will be deferred until replicate

blockWord8sIn512 :: [Word8] -> [[Word8]]
blockWord8sIn512 :: [Word8] -> [[Word8]]
blockWord8sIn512 =
   forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {a}. [a] -> Maybe ([a], [a])
g
   where
      g :: [a] -> Maybe ([a], [a])
g [] = forall a. Maybe a
Nothing
      g [a]
xs = forall a. a -> Maybe a
Just (forall a. Int -> [a] -> ([a], [a])
splitAt Int
64 [a]
xs)

fromBytes :: (Num a, Bits a) => [a] -> a
fromBytes :: forall a. (Num a, Bits a) => [a] -> a
fromBytes [a]
input =
    let dofb :: t -> [t] -> t
dofb t
accum [] = t
accum
        dofb t
accum (t
x:[t]
xs) = t -> [t] -> t
dofb ((forall a. Bits a => a -> Int -> a
shiftL t
accum Int
8) forall a. Bits a => a -> a -> a
.|. t
x) [t]
xs
        in
        forall {t}. Bits t => t -> [t] -> t
dofb a
0 [a]
input

blockWord8sIn32 :: [Word8] -> [[Word8]]
blockWord8sIn32 :: [Word8] -> [[Word8]]
blockWord8sIn32 =
   forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {a}. [a] -> Maybe ([a], [a])
g
   where
      g :: [a] -> Maybe ([a], [a])
g [] = forall a. Maybe a
Nothing
      g [a]
xs = forall a. a -> Maybe a
Just (forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [a]
xs)

getWord32s :: [Word8] -> [Word32]
getWord32s :: [Word8] -> [Word32]
getWord32s =
   forall a b. (a -> b) -> [a] -> [b]
map forall a. (Num a, Bits a) => [a] -> a
fromBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Word8] -> [[Word8]]
blockWord8sIn32

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

-- step 4 of FIPS-180-4 section 6.1.2 SHA-1 Hash Computation
hashOnce :: Word160 -> [Word32] -> Word160
hashOnce :: Word160 -> [Word32] -> Word160
hashOnce Word160
ss [Word32]
a = (Word32 -> Word32 -> Word32) -> Word160 -> Word160 -> Word160
lift2 forall a. Num a => a -> a -> a
(+) Word160
ss (Word160 -> [Word32] -> Word160
oneBlock Word160
ss [Word32]
a)

hash :: [Word8] -> Word160
hash :: [Word8] -> Word160
hash = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word160 -> [Word32] -> Word160
hashOnce Word160
ss forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [[Word32]]
blockWord32sIn512