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

module Crypto.Hash.SHA256
    (
      SHA256
    , SHA224
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LBS
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

initHs :: [Word32]
initHs :: [Word32]
initHs = [
    Word32
0x6a09e667 , Word32
0xbb67ae85 , Word32
0x3c6ef372 , Word32
0xa54ff53a
  , Word32
0x510e527f , Word32
0x9b05688c , Word32
0x1f83d9ab , Word32
0x5be0cd19  ]

initKs :: [Word32]
initKs :: [Word32]
initKs = [
   Word32
0x428a2f98, Word32
0x71374491, Word32
0xb5c0fbcf, Word32
0xe9b5dba5, Word32
0x3956c25b, Word32
0x59f111f1, Word32
0x923f82a4, Word32
0xab1c5ed5,
   Word32
0xd807aa98, Word32
0x12835b01, Word32
0x243185be, Word32
0x550c7dc3, Word32
0x72be5d74, Word32
0x80deb1fe, Word32
0x9bdc06a7, Word32
0xc19bf174,
   Word32
0xe49b69c1, Word32
0xefbe4786, Word32
0x0fc19dc6, Word32
0x240ca1cc, Word32
0x2de92c6f, Word32
0x4a7484aa, Word32
0x5cb0a9dc, Word32
0x76f988da,
   Word32
0x983e5152, Word32
0xa831c66d, Word32
0xb00327c8, Word32
0xbf597fc7, Word32
0xc6e00bf3, Word32
0xd5a79147, Word32
0x06ca6351, Word32
0x14292967,
   Word32
0x27b70a85, Word32
0x2e1b2138, Word32
0x4d2c6dfc, Word32
0x53380d13, Word32
0x650a7354, Word32
0x766a0abb, Word32
0x81c2c92e, Word32
0x92722c85,
   Word32
0xa2bfe8a1, Word32
0xa81a664b, Word32
0xc24b8b70, Word32
0xc76c51a3, Word32
0xd192e819, Word32
0xd6990624, Word32
0xf40e3585, Word32
0x106aa070,
   Word32
0x19a4c116, Word32
0x1e376c08, Word32
0x2748774c, Word32
0x34b0bcb5, Word32
0x391c0cb3, Word32
0x4ed8aa4a, Word32
0x5b9cca4f, Word32
0x682e6ff3,
   Word32
0x748f82ee, Word32
0x78a5636f, Word32
0x84c87814, Word32
0x8cc70208, Word32
0x90befffa, Word32
0xa4506ceb, Word32
0xbef9a3f7, Word32
0xc67178f2 ]

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

sha256BlockSize :: Int
sha256BlockSize = 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
56  = [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
55 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
120 = 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
119 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 SHA256 = SHA256  {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
          deriving SHA256 -> SHA256 -> Bool
(SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool) -> Eq SHA256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SHA256 -> SHA256 -> Bool
== :: SHA256 -> SHA256 -> Bool
$c/= :: SHA256 -> SHA256 -> Bool
/= :: SHA256 -> SHA256 -> Bool
Eq

data SHA224 = SHA224  {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32
              {-# UNPACK #-} !Word32              

initHash :: SHA256
initHash :: SHA256
initHash = [Word32] -> SHA256
fromList [Word32]
initHs
  where fromList :: [Word32] -> SHA256
fromList (Word32
a:Word32
b:Word32
c:Word32
d:Word32
e:Word32
f:Word32
g:Word32
h:[Word32]
_) = Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> SHA256
SHA256 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h

initHash224 :: SHA256
initHash224 :: SHA256
initHash224 = [Word32] -> SHA256
fromList [Word32
0xc1059ed8, Word32
0x367cd507, Word32
0x3070dd17, Word32
0xf70e5939, Word32
0xffc00b31, Word32
0x68581511, Word32
0x64f98fa7, Word32
0xbefa4fa4]
  where fromList :: [Word32] -> SHA256
fromList (Word32
a:Word32
b:Word32
c:Word32
d:Word32
e:Word32
f:Word32
g:Word32
h:[Word32]
_) = Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> SHA256
SHA256 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h

instance Show SHA256 where
  show :: SHA256 -> String
show = ByteString -> String
LC.unpack (ByteString -> String)
-> (SHA256 -> ByteString) -> SHA256 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (SHA256 -> Builder) -> SHA256 -> 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) -> (SHA256 -> [Word32]) -> SHA256 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> [Word32]
toList
    where toList :: SHA256 -> [Word32]
toList (SHA256 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h) = 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
eWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:Word32
fWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:Word32
gWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:[Word32
h]

instance Show SHA224 where
  show :: SHA224 -> String
show = ByteString -> String
LC.unpack (ByteString -> String)
-> (SHA224 -> ByteString) -> SHA224 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (SHA224 -> Builder) -> SHA224 -> 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) -> (SHA224 -> [Word32]) -> SHA224 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA224 -> [Word32]
toList
    where toList :: SHA224 -> [Word32]
toList (SHA224 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h) = 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
eWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:Word32
fWord32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:[Word32
g]

instance Eq SHA224 where
  (SHA224 Word32
a1 Word32
b1 Word32
c1 Word32
d1 Word32
e1 Word32
f1 Word32
g1 Word32
_) == :: SHA224 -> SHA224 -> Bool
== (SHA224 Word32
a2 Word32
b2 Word32
c2 Word32
d2 Word32
e2 Word32
f2 Word32
g2 Word32
_) =
       Word32
a1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
a2 Bool -> Bool -> Bool
&& Word32
b1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
b2 Bool -> Bool -> Bool
&& Word32
c1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
c2 Bool -> Bool -> Bool
&& Word32
d1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
d2
    Bool -> Bool -> Bool
&& Word32
e1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
e2 Bool -> Bool -> Bool
&& Word32
f1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
f2 Bool -> Bool -> Bool
&& Word32
g1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
g2

{-# INLINABLE sha256BlockUpdate #-}
sha256BlockUpdate :: SHA256 -> Word32 -> SHA256
sha256BlockUpdate :: SHA256 -> Word32 -> SHA256
sha256BlockUpdate (SHA256 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h) Word32
w =
    let
      !s1 :: Word32
s1    = (Word32
e Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
6) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
e Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
11) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
e Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
25)
      !ch :: Word32
ch    = (Word32
e Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
f) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
e Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
g)
      !temp1 :: Word32
temp1 = Word32
h Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
s1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
ch Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
w
      !s0 :: Word32
s0    = (Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
2) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
13) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
22)
      !maj :: Word32
maj   = (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
b) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
c) 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)
      !temp2 :: Word32
temp2 = Word32
s0 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
maj
    in Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> SHA256
SHA256 (Word32
temp1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
temp2) Word32
a Word32
b Word32
c (Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
temp1) Word32
e Word32
f Word32
g

{-# 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 Word32
prepareBlock :: ByteString -> UArray Int Word32
prepareBlock ByteString
s = (forall s. ST s (UArray Int Word32)) -> UArray Int Word32
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UArray Int Word32)) -> UArray Int Word32)
-> (forall s. ST s (UArray Int Word32)) -> UArray Int Word32
forall a b. (a -> b) -> a -> b
$ do
  iou <- (Int, Int) -> Word32 -> ST s (STUArray s Int Word32)
forall i. Ix i => (i, i) -> Word32 -> ST s (STUArray s i Word32)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
63) Word32
0 :: ST s (STUArray s Int Word32)
  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)
    write2 Int
k a
x = STUArray s Int Word32 -> Int -> Word32 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word32
iou (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k)     (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                 STUArray s Int Word32 -> Int -> Word32 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word32
iou (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k)   (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xffffffff))
    {-# INLINE write2 #-}
  write2 0 w1
  write2 1 w2
  write2 2 w3
  write2 3 w4
  write2 4 w5
  write2 5 w6
  write2 6 w7
  write2 7 w8
  let go Int
i = STUArray s Int Word32 -> Int -> m Word32
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word32
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
16) m Word32 -> (Word32 -> 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
>>= \Word32
x1 ->
        STUArray s Int Word32 -> Int -> m Word32
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word32
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
15) m Word32 -> (Word32 -> 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
>>= \Word32
x2 ->
        STUArray s Int Word32 -> Int -> m Word32
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word32
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7) m Word32 -> (Word32 -> 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
>>= \Word32
x3 ->
        STUArray s Int Word32 -> Int -> m Word32
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word32
iou (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) m Word32 -> (Word32 -> 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
>>= \Word32
x4 ->
        let !s0 :: Word32
s0 = (Word32
x2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR`  Int
7) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
x2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
18) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
x2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR`  Int
3)
            !s1 :: Word32
s1 = (Word32
x4 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
17) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
x4 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Int
19) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
x4 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
10)
        in STUArray s Int Word32 -> Int -> Word32 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word32
iou Int
i (Word32
x1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
s0 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
s1)
      {-# INLINE go #-}
  mapM_ go [16..63]
  unsafeFreeze iou

{-# INLINE encodeChunk #-}
encodeChunk :: SHA256 -> ByteString -> SHA256
encodeChunk :: SHA256 -> ByteString -> SHA256
encodeChunk hv :: SHA256
hv@(SHA256 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h) ByteString
bs = Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> SHA256
SHA256 (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') (Word32
fWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
f') (Word32
gWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
g') (Word32
hWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
h')
  where
    SHA256 Word32
a' Word32
b' Word32
c' Word32
d' Word32
e' Word32
f' Word32
g' Word32
h' = (SHA256 -> Word32 -> SHA256) -> SHA256 -> [Word32] -> SHA256
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SHA256 -> Word32 -> SHA256
sha256BlockUpdate SHA256
hv ((Word32 -> Word32 -> Word32) -> [Word32] -> [Word32] -> [Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+) (UArray Int Word32 -> [Word32]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems (ByteString -> UArray Int Word32
prepareBlock ByteString
bs)) [Word32]
initKs)

{-# NOINLINE sha256Hash #-}
sha256Hash :: LBS.ByteString -> SHA256
sha256Hash :: ByteString -> SHA256
sha256Hash = Context SHA256 -> SHA256
sha256Final (Context SHA256 -> SHA256)
-> (ByteString -> Context SHA256) -> ByteString -> SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA256 -> ByteString -> Context SHA256)
-> Context SHA256 -> ByteString -> Context SHA256
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
LBS.foldlChunks Context SHA256 -> ByteString -> Context SHA256
sha256Update Context SHA256
sha256Init

sha256Init :: Context SHA256
sha256Init :: Context SHA256
sha256Init = Int64 -> Int -> ByteString -> SHA256 -> Context SHA256
forall a. Int64 -> Int -> ByteString -> a -> Context a
Context Int64
0 Int
0 ByteString
B.empty SHA256
initHash

{-# NOINLINE sha256Update #-}
sha256Update :: Context SHA256 -> ByteString -> Context SHA256
sha256Update :: Context SHA256 -> ByteString -> Context SHA256
sha256Update ctx :: Context SHA256
ctx@(Context Int64
n Int
k ByteString
w SHA256
hv) ByteString
s
  | ByteString -> Bool
B.null ByteString
s               = Context SHA256
ctx
  | Int
sizeRead  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeToRead = Int64 -> Int -> ByteString -> SHA256 -> Context SHA256
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) SHA256
hv
  | Int
sizeRead Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sizeToRead = Context SHA256 -> ByteString -> Context SHA256
sha256Update (Int64 -> Int -> ByteString -> SHA256 -> Context SHA256
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 (SHA256 -> ByteString -> SHA256
encodeChunk SHA256
hv (ByteString
w ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s1))) ByteString
s'
  where
    !sizeToRead :: Int
sizeToRead  = Int
sha256BlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k
    (!ByteString
s1, !ByteString
s')   = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
sizeToRead ByteString
s
    !sizeRead :: Int
sizeRead    = ByteString -> Int
B.length ByteString
s1

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

fromSHA224 :: SHA224 -> SHA256
fromSHA256 :: SHA256 -> SHA224
fromSHA224 :: SHA224 -> SHA256
fromSHA224 (SHA224 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h) = Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> SHA256
SHA256 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h
fromSHA256 :: SHA256 -> SHA224
fromSHA256 (SHA256 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h) = Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> SHA224
SHA224 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Word32
g Word32
h

sha224Init :: Context SHA224
sha224Init :: Context SHA224
sha224Init   = (SHA256 -> SHA224) -> Context SHA256 -> Context SHA224
forall a b. (a -> b) -> Context a -> Context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SHA256 -> SHA224
fromSHA256 (Int64 -> Int -> ByteString -> SHA256 -> Context SHA256
forall a. Int64 -> Int -> ByteString -> a -> Context a
Context Int64
0 Int
0 ByteString
B.empty SHA256
initHash224)
sha224Update :: Context SHA224 -> ByteString -> Context SHA224
sha224Update :: Context SHA224 -> ByteString -> Context SHA224
sha224Update = (Context SHA256 -> Context SHA224)
-> (ByteString -> Context SHA256) -> ByteString -> Context SHA224
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SHA256 -> SHA224) -> Context SHA256 -> Context SHA224
forall a b. (a -> b) -> Context a -> Context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SHA256 -> SHA224
fromSHA256) ((ByteString -> Context SHA256) -> ByteString -> Context SHA224)
-> (Context SHA224 -> ByteString -> Context SHA256)
-> Context SHA224
-> ByteString
-> Context SHA224
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context SHA256 -> ByteString -> Context SHA256
sha256Update (Context SHA256 -> ByteString -> Context SHA256)
-> (Context SHA224 -> Context SHA256)
-> Context SHA224
-> ByteString
-> Context SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SHA224 -> SHA256) -> Context SHA224 -> Context SHA256
forall a b. (a -> b) -> Context a -> Context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SHA224 -> SHA256
fromSHA224
sha224Final :: Context SHA224 -> SHA224
sha224Final :: Context SHA224 -> SHA224
sha224Final = SHA256 -> SHA224
fromSHA256 (SHA256 -> SHA224)
-> (Context SHA224 -> SHA256) -> Context SHA224 -> SHA224
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context SHA256 -> SHA256
sha256Final (Context SHA256 -> SHA256)
-> (Context SHA224 -> Context SHA256) -> Context SHA224 -> SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SHA224 -> SHA256) -> Context SHA224 -> Context SHA256
forall a b. (a -> b) -> Context a -> Context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SHA224 -> SHA256
fromSHA224

--{-# NOINLINE sha224Hash #-}
sha224Hash :: LBS.ByteString -> SHA224
sha224Hash :: ByteString -> SHA224
sha224Hash = Context SHA224 -> SHA224
sha224Final (Context SHA224 -> SHA224)
-> (ByteString -> Context SHA224) -> ByteString -> SHA224
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context SHA224 -> ByteString -> Context SHA224)
-> Context SHA224 -> ByteString -> Context SHA224
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
LBS.foldlChunks Context SHA224 -> ByteString -> Context SHA224
sha224Update Context SHA224
sha224Init

instance HashAlgorithm SHA256 where
  hashBlockSize :: SHA256 -> Int
hashBlockSize = Int -> SHA256 -> Int
forall a b. a -> b -> a
const Int
64
  hashDigestSize :: SHA256 -> Int
hashDigestSize = Int -> SHA256 -> Int
forall a b. a -> b -> a
const Int
32
  hashInit :: Context SHA256
hashInit = Context SHA256
sha256Init
  hashUpdate :: Context SHA256 -> ByteString -> Context SHA256
hashUpdate = Context SHA256 -> ByteString -> Context SHA256
sha256Update
  hashFinal :: Context SHA256 -> SHA256
hashFinal = Context SHA256 -> SHA256
sha256Final

instance HashAlgorithm SHA224 where
  hashBlockSize :: SHA224 -> Int
hashBlockSize = Int -> SHA224 -> Int
forall a b. a -> b -> a
const Int
64
  hashDigestSize :: SHA224 -> Int
hashDigestSize = Int -> SHA224 -> Int
forall a b. a -> b -> a
const Int
28
  hashInit :: Context SHA224
hashInit = Context SHA224
sha224Init
  hashUpdate :: Context SHA224 -> ByteString -> Context SHA224
hashUpdate = Context SHA224 -> ByteString -> Context SHA224
sha224Update
  hashFinal :: Context SHA224 -> SHA224
hashFinal = Context SHA224 -> SHA224
sha224Final