1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{-# 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
|
