{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedTuples #-}

module Crypto.Hash.SHA1
    (
      SHA1
    ) where

import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as LC
import           Data.ByteString (ByteString)
import           Data.ByteString.Builder
import           Control.Monad.ST
import           Data.Int
import           Data.Word
import           Data.Bits
import           Data.Monoid
import           Data.Array.Unboxed
import           Data.Array.Unsafe
import           Data.Array.ST
import           Data.List(foldl')

import           Crypto.Hash.ADT

encodeInt64Helper :: Int64 -> [Word8]
encodeInt64Helper :: Int64 -> [Word8]
encodeInt64Helper Int64
x_ = [Word8
w7, Word8
w6, Word8
w5, Word8
w4, Word8
w3, Word8
w2, Word8
w1, Word8
w0]
  where x :: Int64
x = Int64
x_ Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
8
        w7 :: Word8
w7 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
56) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w6 :: Word8
w6 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w5 :: Word8
w5 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
40) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w4 :: Word8
w4 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w3 :: Word8
w3 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w2 :: Word8
w2 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w1 :: Word8
w1 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR`  Int
8) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff
        w0 :: Word8
w0 = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR`  Int
0) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xff

encodeInt64 :: Int64 -> ByteString
encodeInt64 :: Int64 -> ByteString
encodeInt64 = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (Int64 -> [Word8]) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> [Word8]
encodeInt64Helper

sha1BlockSize :: Int
sha1BlockSize :: Int
sha1BlockSize = Int
64

lastChunk :: Int64 -> ByteString -> [ByteString]
lastChunk :: Int64 -> ByteString -> [ByteString]
lastChunk Int64
msglen ByteString
s
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
sha1BlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)     = [ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString -> ByteString
B.cons Word8
0x80 (Int -> Word8 -> ByteString
B.replicate (Int
sha1BlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Word8
0x0)  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
encodedLen]
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sha1BlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) = ByteString -> [ByteString]
helper (ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString -> ByteString
B.cons Word8
0x80 (Int -> Word8 -> ByteString
B.replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sha1BlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Word8
0x0) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
encodedLen)
  where
    len :: Int
len        = ByteString -> Int
B.length ByteString
s
    encodedLen :: ByteString
encodedLen = Int64 -> ByteString
encodeInt64 Int64
msglen
    helper :: ByteString -> [ByteString]
helper ByteString
bs   = [ByteString
s1, ByteString
s2]
      where (ByteString
s1, ByteString
s2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
64 ByteString
bs

data SHA1 = SHA1  {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
          deriving SHA1 -> SHA1 -> Bool
(SHA1 -> SHA1 -> Bool) -> (SHA1 -> SHA1 -> Bool) -> Eq SHA1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SHA1 -> SHA1 -> Bool
== :: SHA1 -> SHA1 -> Bool
$c/= :: SHA1 -> SHA1 -> Bool
/= :: SHA1 -> SHA1 -> Bool
Eq

initHash :: SHA1
initHash :: SHA1
initHash = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> SHA1
SHA1 Word32
0x67452301 Word32
0xEFCDAB89 Word32
0x98BADCFE Word32
0x10325476 Word32
0xC3D2E1F0

instance Show SHA1 where
  show :: SHA1 -> String
show = ByteString -> String
LC.unpack (ByteString -> String) -> (SHA1 -> ByteString) -> SHA1 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (SHA1 -> Builder) -> SHA1 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Builder) -> [Word32] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word32 -> Builder
word32HexFixed ([Word32] -> Builder) -> (SHA1 -> [Word32]) -> SHA1 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA1 -> [Word32]
toList
    where toList :: SHA1 -> [Word32]
toList (SHA1 Word32
a Word32
b Word32
c Word32
d Word32
e) = Word32
aWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:Word32
bWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:Word32
cWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:Word32
dWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:[Word32
e]

sha1BlockUpdate :: SHA1 -> UArray Int Word64 -> SHA1
sha1BlockUpdate :: SHA1 -> UArray Int Word64 -> SHA1
sha1BlockUpdate SHA1
hv = (SHA1 -> (Int, Word64) -> SHA1) -> SHA1 -> [(Int, Word64)] -> SHA1
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SHA1 -> (Int, Word64) -> SHA1
forall {b}. (Integral b, Bits b) => SHA1 -> (Int, b) -> SHA1
acc SHA1
hv ([(Int, Word64)] -> SHA1)
-> (UArray Int Word64 -> [(Int, Word64)])
-> UArray Int Word64
-> SHA1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UArray Int Word64 -> [(Int, Word64)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs
  where acc :: SHA1 -> (Int, b) -> SHA1
acc (SHA1 Word32
a Word32
b Word32
c Word32
d Word32
e) (!Int
i, !b
w) = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> SHA1
SHA1 Word32
temp2 Word32
temp1 (Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
30) (Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
30) Word32
c
          where getK :: Int -> Word32
getK Int
i
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Word32
0x5a827999
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20 = Word32
0x6ed9eba1
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30 = Word32
0x8f1bbcdc
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
40 = Word32
0xca62c1d6
                getK :: Int -> Word32
                {-# INLINE getK #-}
                getF1 :: Int -> Word32
getF1 Int
i
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
d))
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20 = Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
d
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30 = (Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
c) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c))
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
40 = Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
d
                getF1 :: Int -> Word32
                {-# INLINE getF1 #-}
                getF2 :: Int -> Word32
getF2 Int
i
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. ((Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
30) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c))
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20 = Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
30) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30 = (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
30)) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
30)))
                  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
40 = Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
30) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
c
                getF2 :: Int -> Word32
                {-# INLINE getF2 #-}
                !f1 :: Word32
f1        = Int -> Word32
getF1 Int
i
                !f2 :: Word32
f2        = Int -> Word32
getF2 Int
i
                !k :: Word32
k         = Int -> Word32
getK Int
i
                !temp1 :: Word32
temp1     = (Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
5) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
f1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (b -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b
w b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
32))
                !temp2 :: Word32
temp2     = (Word32
temp1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Int
5) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
f2 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (b -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b
w b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
0xffffffff))
        {-# INLINE acc #-}

{-# INLINE readW64 #-}
readW64 :: ByteString -> Word64
readW64 :: ByteString -> Word64
readW64 = (Word64 -> Word8 -> Word64) -> Word64 -> ByteString -> Word64
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Word64 -> Word8 -> Word64
acc Word64
0 (ByteString -> Word64)
-> (ByteString -> ByteString) -> ByteString -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
8
  where acc :: Word64 -> Word8 -> Word64
acc Word64
x Word8
c = Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c
        acc :: Word64 -> Word8 -> Word64
        {-# INLINE acc #-}

prepareBlock :: ByteString -> UArray Int Word64
prepareBlock :: ByteString -> UArray Int Word64
prepareBlock ByteString
s = (forall s. ST s (UArray Int Word64)) -> UArray Int Word64
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UArray Int Word64)) -> UArray Int Word64)
-> (forall s. ST s (UArray Int Word64)) -> UArray Int Word64
forall a b. (a -> b) -> a -> b
$ do
  iou <- (Int, Int) -> Word64 -> ST s (STUArray s Int Word64)
forall i. Ix i => (i, i) -> Word64 -> ST s (STUArray s i Word64)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
39) Word64
0 :: ST s (STUArray s Int Word64)
  let
    !w1 = ByteString -> Word64
readW64 ByteString
s
    !w2 = ByteString -> Word64
readW64 (Int -> ByteString -> ByteString
B.drop Int
8 ByteString
s)
    !w3 = ByteString -> Word64
readW64 (Int -> ByteString -> ByteString
B.drop Int
16 ByteString
s)
    !w4 = ByteString -> Word64
readW64 (Int -> ByteString -> ByteString
B.drop Int
24 ByteString
s)
    !w5 = ByteString -> Word64
readW64 (Int -> ByteString -> ByteString
B.drop Int
32 ByteString
s)
    !w6 = ByteString -> Word64
readW64 (Int -> ByteString -> ByteString
B.drop Int
40 ByteString
s)
    !w7 = ByteString -> Word64
readW64 (Int -> ByteString -> ByteString
B.drop Int
48 ByteString
s)
    !w8 = ByteString -> Word64
readW64 (Int -> ByteString -> ByteString
B.drop Int
56 ByteString
s)
  writeArray iou 0 w1
  writeArray iou 1 w2
  writeArray iou 2 w3
  writeArray iou 3 w4
  writeArray iou 4 w5
  writeArray iou 5 w6
  writeArray iou 6 w7
  writeArray iou 7 w8
  let step1 Int
i = STUArray s Int Word64 -> Int -> m Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
x1 ->
        STUArray s Int Word64 -> Int -> m Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
7) m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
x2 ->
        STUArray s Int Word64 -> Int -> m Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4) m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
x3 ->
        STUArray s Int Word64 -> Int -> m Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
x4 ->
        STUArray s Int Word64 -> Int -> m Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
x5 ->
        let !wi :: Word64
wi = (Word64
x1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
x2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
x3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` ( ((Word64
x4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
x5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) )) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Int
1
            !i1 :: Word64
i1 = (Word64
wi Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x1
            !i2 :: Word64
i2 = Word64
wi Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x1
            !wj :: Word64
wj = (Word64
wi Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xfffffffefffffffe) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
i1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
i2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
        in STUArray s Int Word64 -> Int -> Word64 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word64
iou Int
i Word64
wj
      {-# INLINE step1 #-}
  mapM_ step1 [8..39]
  unsafeFreeze iou

{-# INLINE encodeChunk #-}
encodeChunk :: SHA1 -> ByteString -> SHA1
encodeChunk :: SHA1 -> ByteString -> SHA1
encodeChunk hv :: SHA1
hv@(SHA1 Word32
a Word32
b Word32
c Word32
d Word32
e) ByteString
bs = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> SHA1
SHA1 (Word32
aWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
a') (Word32
bWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
b') (Word32
cWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
c') (Word32
dWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
d') (Word32
eWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
e')
  where
    SHA1 Word32
a' Word32
b' Word32
c' Word32
d' Word32
e' = SHA1 -> UArray Int Word64 -> SHA1
sha1BlockUpdate SHA1
hv (ByteString -> UArray Int Word64
prepareBlock ByteString
bs)

sha1Init :: Context SHA1
sha1Init :: Context SHA1
sha1Init = Int64 -> Int -> ByteString -> SHA1 -> Context SHA1
forall a. Int64 -> Int -> ByteString -> a -> Context a
Context Int64
0 Int
0 ByteString
B.empty SHA1
initHash

{-# NOINLINE sha1Update #-}
sha1Update :: Context SHA1 -> ByteString -> Context SHA1
sha1Update :: Context SHA1 -> ByteString -> Context SHA1
sha1Update ctx :: Context SHA1
ctx@(Context Int64
n Int
k ByteString
w SHA1
hv) ByteString
s
  | ByteString -> Bool
B.null ByteString
s               = Context SHA1
ctx
  | Int
sizeRead  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeToRead = Int64 -> Int -> ByteString -> SHA1 -> Context SHA1
forall a. Int64 -> Int -> ByteString -> a -> Context a
Context (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeRead) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeRead) (ByteString
w ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s1) SHA1
hv
  | Int
sizeRead Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sizeToRead = Context SHA1 -> ByteString -> Context SHA1
sha1Update (Int64 -> Int -> ByteString -> SHA1 -> Context SHA1
forall a. Int64 -> Int -> ByteString -> a -> Context a
Context (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeToRead) Int
0 ByteString
forall a. Monoid a => a
mempty (SHA1 -> ByteString -> SHA1
encodeChunk SHA1
hv (ByteString
w ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s1))) ByteString
s'
  where
    !sizeToRead :: Int
sizeToRead  = Int
sha1BlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k
    !s1 :: ByteString
s1          = Int -> ByteString -> ByteString
B.take Int
sizeToRead ByteString
s
    !s' :: ByteString
s'          = Int -> ByteString -> ByteString
B.drop Int
sizeToRead ByteString
s
    !sizeRead :: Int
sizeRead    = ByteString -> Int
B.length ByteString
s1

{-# NOINLINE sha1Final #-}
sha1Final :: Context SHA1 -> SHA1
sha1Final :: Context SHA1 -> SHA1
sha1Final (Context Int64
n Int
_ ByteString
w SHA1
hv) = (SHA1 -> ByteString -> SHA1) -> SHA1 -> [ByteString] -> SHA1
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SHA1 -> ByteString -> SHA1
encodeChunk SHA1
hv (Int64 -> ByteString -> [ByteString]
lastChunk Int64
n ByteString
w)

{-# NOINLINE sha1Hash #-}
sha1Hash :: LBS.ByteString -> SHA1
sha1Hash :: ByteString -> SHA1
sha1Hash = Context SHA1 -> SHA1
sha1Final (Context SHA1 -> SHA1)
-> (ByteString -> Context SHA1) -> ByteString -> SHA1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA1 -> ByteString -> Context SHA1)
-> Context SHA1 -> ByteString -> Context SHA1
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
LBS.foldlChunks Context SHA1 -> ByteString -> Context SHA1
sha1Update Context SHA1
sha1Init

instance HashAlgorithm SHA1 where
  hashBlockSize :: SHA1 -> Int
hashBlockSize = Int -> SHA1 -> Int
forall a b. a -> b -> a
const Int
sha1BlockSize
  hashDigestSize :: SHA1 -> Int
hashDigestSize = Int -> SHA1 -> Int
forall a b. a -> b -> a
const Int
20
  hashInit :: Context SHA1
hashInit = Context SHA1
sha1Init
  hashUpdate :: Context SHA1 -> ByteString -> Context SHA1
hashUpdate = Context SHA1 -> ByteString -> Context SHA1
sha1Update
  hashFinal :: Context SHA1 -> SHA1
hashFinal = Context SHA1 -> SHA1
sha1Final