{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Trustworthy  #-}

-- |
-- Module      : Crypto.Hash.SHA256
-- License     : BSD-3
-- Maintainer  : Herbert Valerio Riedel <hvr@gnu.org>
-- Stability   : stable
--
-- A module containing <https://en.wikipedia.org/wiki/SHA-2 SHA-256> bindings
--
module Crypto.Hash.SHA256
    (

    -- * Incremental API
    --
    -- | This API is based on 4 different functions, similar to the
    -- lowlevel operations of a typical hash:
    --
    --  - 'init': create a new hash context
    --  - 'update': update non-destructively a new hash context with a strict bytestring
    --  - 'updates': same as update, except that it takes a list of strict bytestrings
    --  - 'finalize': finalize the context and returns a digest bytestring.
    --
    -- all those operations are completely pure, and instead of
    -- changing the context as usual in others language, it
    -- re-allocates a new context each time.
    --
    -- Example:
    --
    -- > import qualified Data.ByteString
    -- > import qualified Crypto.Hash.SHA256 as SHA256
    -- >
    -- > main = print digest
    -- >   where
    -- >     digest = SHA256.finalize ctx
    -- >     ctx    = foldl SHA256.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])
    -- >     ctx0   = SHA256.init

      Ctx(..)
    , init     -- :: Ctx
    , update   -- :: Ctx -> ByteString -> Ctx
    , updates  -- :: Ctx -> [ByteString] -> Ctx
    , finalize -- :: Ctx -> ByteString
    , finalizeAndLength -- :: Ctx -> (ByteString,Word64)
    , start     -- :: ByteString -> Ct
    , startlazy -- :: L.ByteString -> Ctx

    -- * Single Pass API
    --
    -- | This API use the incremental API under the hood to provide
    -- the common all-in-one operations to create digests out of a
    -- 'ByteString' and lazy 'L.ByteString'.
    --
    --  - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString'
    --  - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString'
    --  - 'hashlazyAndLength': create a digest ('init' + 'update' + 'finalizeAndLength') from a lazy 'L.ByteString'
    --
    -- Example:
    --
    -- > import qualified Data.ByteString
    -- > import qualified Crypto.Hash.SHA256 as SHA256
    -- >
    -- > main = print $ SHA256.hash (Data.ByteString.pack [0..255])
    --
    -- __NOTE__: The returned digest is a binary 'ByteString'. For
    -- converting to a base16/hex encoded digest the
    -- <https://hackage.haskell.org/package/base16-bytestring base16-bytestring>
    -- package is recommended.

    , hash     -- :: ByteString -> ByteString
    , hashlazy -- :: L.ByteString -> ByteString
    , hashlazyAndLength -- :: L.ByteString -> (ByteString,Int64)

    -- ** HMAC-SHA-256
    --
    -- | <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
    -- <https://en.wikipedia.org/wiki/HMAC HMAC>-SHA-256 digests

    , hmac     -- :: ByteString -> ByteString -> ByteString
    , hmaclazy -- :: ByteString -> L.ByteString -> ByteString
    , hmaclazyAndLength -- :: ByteString -> L.ByteString -> (ByteString,Word64)

    -- ** HKDF-SHA-256
    --
    -- | <https://tools.ietf.org/html/rfc5869 RFC5869>-compatible
    -- <https://en.wikipedia.org/wiki/HKDF HKDF>-SHA-256 key derivation function

    , hkdf
    ) where

import           Data.Bits                (xor)
import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as B
import           Data.ByteString.Internal (create,
                                           createAndTrim, mallocByteString,
                                           memcpy, toForeignPtr)
import qualified Data.ByteString.Lazy     as L
import           Data.ByteString.Unsafe   (unsafeUseAsCStringLen)
import           Data.Word
import           Foreign.C.Types
import           Foreign.ForeignPtr       (withForeignPtr)
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Prelude                  hiding (init)
import           System.IO.Unsafe         (unsafeDupablePerformIO)

import           Compat                   (constructBS)
import           Crypto.Hash.SHA256.FFI

-- | perform IO for hashes that do allocation and ffi.
-- unsafeDupablePerformIO is used when possible as the
-- computation is pure and the output is directly linked
-- to the input. we also do not modify anything after it has
-- been returned to the user.
unsafeDoIO :: IO a -> a
unsafeDoIO :: IO a -> a
unsafeDoIO = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO

-- keep this synchronised with cbits/sha256.h
{-# INLINE digestSize #-}
digestSize :: Int
digestSize :: Int
digestSize = Int
32

{-# INLINE sizeCtx #-}
sizeCtx :: Int
sizeCtx :: Int
sizeCtx = Int
104

{-# INLINE withByteStringPtr #-}
withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
b Ptr Word8 -> IO a
f =
    ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr Word8 -> IO a
f (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
    where (ForeignPtr Word8
fptr, Int
off, Int
_) = ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr ByteString
b

{-# INLINE create' #-}
-- | Variant of 'create' which allows to return an argument
create' :: Int -> (Ptr Word8 -> IO a) -> IO (ByteString,a)
create' :: Int -> (Ptr Word8 -> IO a) -> IO (ByteString, a)
create' Int
l Ptr Word8 -> IO a
f = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
    a
x <- ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO a
f Ptr Word8
p
    let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> ByteString
constructBS ForeignPtr Word8
fp Int
l
    (ByteString, a) -> IO (ByteString, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, a) -> IO (ByteString, a))
-> (ByteString, a) -> IO (ByteString, a)
forall a b. (a -> b) -> a -> b
$! a
x a -> (ByteString, a) -> (ByteString, a)
`seq` ByteString
bs ByteString -> (ByteString, a) -> (ByteString, a)
`seq` (ByteString
bs,a
x)

copyCtx :: Ptr Ctx -> Ptr Ctx -> IO ()
copyCtx :: Ptr Ctx -> Ptr Ctx -> IO ()
copyCtx Ptr Ctx
dst Ptr Ctx
src = Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr Ctx -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Ctx
dst) (Ptr Ctx -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Ctx
src) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeCtx)

withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy (Ctx ByteString
ctxB) Ptr Ctx -> IO ()
f = ByteString -> Ctx
Ctx (ByteString -> Ctx) -> IO ByteString -> IO Ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO ByteString
createCtx
  where
    createCtx :: IO ByteString
createCtx = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
sizeCtx ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr ->
                ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
ctxB ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
srcPtr -> do
                    Ptr Ctx -> Ptr Ctx -> IO ()
copyCtx (Ptr Word8 -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr) (Ptr Word8 -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
srcPtr)
                    Ptr Ctx -> IO ()
f (Ptr Word8 -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr)

withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
withCtxThrow (Ctx ByteString
ctxB) Ptr Ctx -> IO a
f =
    Int -> (Ptr Any -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeCtx ((Ptr Any -> IO a) -> IO a) -> (Ptr Any -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Any
dstPtr ->
    ByteString -> (Ptr Word8 -> IO a) -> IO a
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
ctxB ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
srcPtr -> do
        Ptr Ctx -> Ptr Ctx -> IO ()
copyCtx (Ptr Any -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
dstPtr) (Ptr Word8 -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
srcPtr)
        Ptr Ctx -> IO a
f (Ptr Any -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
dstPtr)

withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Ptr Ctx -> IO ()
f = ByteString -> Ctx
Ctx (ByteString -> Ctx) -> IO ByteString -> IO Ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
sizeCtx (Ptr Ctx -> IO ()
f (Ptr Ctx -> IO ()) -> (Ptr Word8 -> Ptr Ctx) -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr)

withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow Ptr Ctx -> IO a
f = Int -> (Ptr Any -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeCtx (Ptr Ctx -> IO a
f (Ptr Ctx -> IO a) -> (Ptr Any -> Ptr Ctx) -> Ptr Any -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Any -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr)

-- 'safe' call overhead neglible for 4KiB and more
c_sha256_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()
c_sha256_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()
c_sha256_update Ptr Ctx
pctx Ptr Word8
pbuf CSize
sz
  | CSize
sz CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSize
4096 = Ptr Ctx -> Ptr Word8 -> CSize -> IO ()
c_sha256_update_unsafe Ptr Ctx
pctx Ptr Word8
pbuf CSize
sz
  | Bool
otherwise = Ptr Ctx -> Ptr Word8 -> CSize -> IO ()
c_sha256_update_safe   Ptr Ctx
pctx Ptr Word8
pbuf CSize
sz

-- 'safe' call overhead neglible for 4KiB and more
c_sha256_hash :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()
c_sha256_hash :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()
c_sha256_hash Ptr Word8
pbuf CSize
sz Ptr Word8
pout
  | CSize
sz CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSize
4096 = Ptr Word8 -> CSize -> Ptr Word8 -> IO ()
c_sha256_hash_unsafe Ptr Word8
pbuf CSize
sz Ptr Word8
pout
  | Bool
otherwise = Ptr Word8 -> CSize -> Ptr Word8 -> IO ()
c_sha256_hash_safe   Ptr Word8
pbuf CSize
sz Ptr Word8
pout

updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr ByteString
d =
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
d (\(Ptr CChar
cs, Int
len) -> Ptr Ctx -> Ptr Word8 -> CSize -> IO ()
c_sha256_update Ptr Ctx
ptr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cs) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

finalizeInternalIO :: Ptr Ctx -> IO ByteString
finalizeInternalIO :: Ptr Ctx -> IO ByteString
finalizeInternalIO Ptr Ctx
ptr = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
digestSize (Ptr Ctx -> Ptr Word8 -> IO ()
c_sha256_finalize Ptr Ctx
ptr)

finalizeInternalIO' :: Ptr Ctx -> IO (ByteString,Word64)
finalizeInternalIO' :: Ptr Ctx -> IO (ByteString, Word64)
finalizeInternalIO' Ptr Ctx
ptr = Int -> (Ptr Word8 -> IO Word64) -> IO (ByteString, Word64)
forall a. Int -> (Ptr Word8 -> IO a) -> IO (ByteString, a)
create' Int
digestSize (Ptr Ctx -> Ptr Word8 -> IO Word64
c_sha256_finalize_len Ptr Ctx
ptr)


{-# NOINLINE init #-}
-- | create a new hash context
init :: Ctx
init :: Ctx
init = IO Ctx -> Ctx
forall a. IO a -> a
unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
forall a b. (a -> b) -> a -> b
$ (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Ptr Ctx -> IO ()
c_sha256_init

validCtx :: Ctx -> Bool
validCtx :: Ctx -> Bool
validCtx (Ctx ByteString
b) = ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sizeCtx

{-# NOINLINE update #-}
-- | update a context with a bytestring
update :: Ctx -> ByteString -> Ctx
update :: Ctx -> ByteString -> Ctx
update Ctx
ctx ByteString
d
  | Ctx -> Bool
validCtx Ctx
ctx = IO Ctx -> Ctx
forall a. IO a -> a
unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
forall a b. (a -> b) -> a -> b
$ Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy Ctx
ctx ((Ptr Ctx -> IO ()) -> IO Ctx) -> (Ptr Ctx -> IO ()) -> IO Ctx
forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr ByteString
d
  | Bool
otherwise    = [Char] -> Ctx
forall a. HasCallStack => [Char] -> a
error [Char]
"SHA256.update: invalid Ctx"

{-# NOINLINE updates #-}
-- | updates a context with multiple bytestrings
updates :: Ctx -> [ByteString] -> Ctx
updates :: Ctx -> [ByteString] -> Ctx
updates Ctx
ctx [ByteString]
d
  | Ctx -> Bool
validCtx Ctx
ctx = IO Ctx -> Ctx
forall a. IO a -> a
unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
forall a b. (a -> b) -> a -> b
$ Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy Ctx
ctx ((Ptr Ctx -> IO ()) -> IO Ctx) -> (Ptr Ctx -> IO ()) -> IO Ctx
forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr) [ByteString]
d
  | Bool
otherwise    = [Char] -> Ctx
forall a. HasCallStack => [Char] -> a
error [Char]
"SHA256.updates: invalid Ctx"

{-# NOINLINE finalize #-}
-- | finalize the context into a digest bytestring (32 bytes)
finalize :: Ctx -> ByteString
finalize :: Ctx -> ByteString
finalize Ctx
ctx
  | Ctx -> Bool
validCtx Ctx
ctx = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDoIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Ctx -> (Ptr Ctx -> IO ByteString) -> IO ByteString
forall a. Ctx -> (Ptr Ctx -> IO a) -> IO a
withCtxThrow Ctx
ctx Ptr Ctx -> IO ByteString
finalizeInternalIO
  | Bool
otherwise    = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"SHA256.finalize: invalid Ctx"

{-# NOINLINE finalizeAndLength #-}
-- | Variant of 'finalize' also returning length of hashed content
--
-- @since 0.11.101.0
finalizeAndLength :: Ctx -> (ByteString,Word64)
finalizeAndLength :: Ctx -> (ByteString, Word64)
finalizeAndLength Ctx
ctx
  | Ctx -> Bool
validCtx Ctx
ctx = IO (ByteString, Word64) -> (ByteString, Word64)
forall a. IO a -> a
unsafeDoIO (IO (ByteString, Word64) -> (ByteString, Word64))
-> IO (ByteString, Word64) -> (ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ Ctx
-> (Ptr Ctx -> IO (ByteString, Word64)) -> IO (ByteString, Word64)
forall a. Ctx -> (Ptr Ctx -> IO a) -> IO a
withCtxThrow Ctx
ctx Ptr Ctx -> IO (ByteString, Word64)
finalizeInternalIO'
  | Bool
otherwise    = [Char] -> (ByteString, Word64)
forall a. HasCallStack => [Char] -> a
error [Char]
"SHA256.finalize: invalid Ctx"

{-# NOINLINE hash #-}
-- | hash a strict bytestring into a digest bytestring (32 bytes)
hash :: ByteString -> ByteString
-- hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> c_sha256_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr
hash :: ByteString -> ByteString
hash ByteString
d = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDoIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
d ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cs, Int
len) -> Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
digestSize (Ptr Word8 -> CSize -> Ptr Word8 -> IO ()
c_sha256_hash (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cs) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

{-# NOINLINE start #-}
-- | hash a strict bytestring into a Ctx
start :: ByteString -> Ctx
start :: ByteString -> Ctx
start ByteString
d = IO Ctx -> Ctx
forall a. IO a -> a
unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
forall a b. (a -> b) -> a -> b
$ (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew ((Ptr Ctx -> IO ()) -> IO Ctx) -> (Ptr Ctx -> IO ()) -> IO Ctx
forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> Ptr Ctx -> IO ()
c_sha256_init Ptr Ctx
ptr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr ByteString
d


{-# NOINLINE hashlazy #-}
-- | hash a lazy bytestring into a digest bytestring (32 bytes)
hashlazy :: L.ByteString -> ByteString
hashlazy :: ByteString -> ByteString
hashlazy ByteString
l = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDoIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Ptr Ctx -> IO ByteString) -> IO ByteString
forall a. (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow ((Ptr Ctx -> IO ByteString) -> IO ByteString)
-> (Ptr Ctx -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr ->
    Ptr Ctx -> IO ()
c_sha256_init Ptr Ctx
ptr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr) (ByteString -> [ByteString]
L.toChunks ByteString
l) IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Ctx -> IO ByteString
finalizeInternalIO Ptr Ctx
ptr

{-# NOINLINE startlazy #-}
-- | hash a lazy bytestring into a Ctx
startlazy :: L.ByteString -> Ctx
startlazy :: ByteString -> Ctx
startlazy ByteString
l = IO Ctx -> Ctx
forall a. IO a -> a
unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
forall a b. (a -> b) -> a -> b
$ (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew ((Ptr Ctx -> IO ()) -> IO Ctx) -> (Ptr Ctx -> IO ()) -> IO Ctx
forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr ->
    Ptr Ctx -> IO ()
c_sha256_init Ptr Ctx
ptr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr) (ByteString -> [ByteString]
L.toChunks ByteString
l)

{-# NOINLINE hashlazyAndLength #-}
-- | Variant of 'hashlazy' which simultaneously computes the hash and length of a lazy bytestring.
--
-- @since 0.11.101.0
hashlazyAndLength :: L.ByteString -> (ByteString,Word64)
hashlazyAndLength :: ByteString -> (ByteString, Word64)
hashlazyAndLength ByteString
l = IO (ByteString, Word64) -> (ByteString, Word64)
forall a. IO a -> a
unsafeDoIO (IO (ByteString, Word64) -> (ByteString, Word64))
-> IO (ByteString, Word64) -> (ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ (Ptr Ctx -> IO (ByteString, Word64)) -> IO (ByteString, Word64)
forall a. (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow ((Ptr Ctx -> IO (ByteString, Word64)) -> IO (ByteString, Word64))
-> (Ptr Ctx -> IO (ByteString, Word64)) -> IO (ByteString, Word64)
forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr ->
    Ptr Ctx -> IO ()
c_sha256_init Ptr Ctx
ptr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr) (ByteString -> [ByteString]
L.toChunks ByteString
l) IO () -> IO (ByteString, Word64) -> IO (ByteString, Word64)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Ctx -> IO (ByteString, Word64)
finalizeInternalIO' Ptr Ctx
ptr


-- | Compute 32-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
-- HMAC-SHA-256 digest for a strict bytestring message
--
-- @since 0.11.100.0
hmac :: ByteString -- ^ secret
     -> ByteString -- ^ message
     -> ByteString -- ^ digest (32 bytes)
hmac :: ByteString -> ByteString -> ByteString
hmac ByteString
secret ByteString
msg = ByteString -> ByteString
hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
opad (ByteString -> ByteString
hashlazy (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
ipad,ByteString
msg])
  where
    opad :: ByteString
opad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x5c) ByteString
k'
    ipad :: ByteString
ipad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x36) ByteString
k'

    k' :: ByteString
k'  = ByteString -> ByteString -> ByteString
B.append ByteString
kt ByteString
pad
    kt :: ByteString
kt  = if ByteString -> Int
B.length ByteString
secret Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 then ByteString -> ByteString
hash ByteString
secret else ByteString
secret
    pad :: ByteString
pad = Int -> Word8 -> ByteString
B.replicate (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
kt) Word8
0


-- | Compute 32-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
-- HMAC-SHA-256 digest for a lazy bytestring message
--
-- @since 0.11.100.0
hmaclazy :: ByteString   -- ^ secret
         -> L.ByteString -- ^ message
         -> ByteString   -- ^ digest (32 bytes)
hmaclazy :: ByteString -> ByteString -> ByteString
hmaclazy ByteString
secret ByteString
msg = ByteString -> ByteString
hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
opad (ByteString -> ByteString
hashlazy (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
L.append ByteString
ipad ByteString
msg)
  where
    opad :: ByteString
opad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x5c) ByteString
k'
    ipad :: ByteString
ipad = [ByteString] -> ByteString
L.fromChunks [(Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x36) ByteString
k']

    k' :: ByteString
k'  = ByteString -> ByteString -> ByteString
B.append ByteString
kt ByteString
pad
    kt :: ByteString
kt  = if ByteString -> Int
B.length ByteString
secret Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 then ByteString -> ByteString
hash ByteString
secret else ByteString
secret
    pad :: ByteString
pad = Int -> Word8 -> ByteString
B.replicate (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
kt) Word8
0


-- | Variant of 'hmaclazy' which also returns length of message
--
-- @since 0.11.101.0
hmaclazyAndLength :: ByteString   -- ^ secret
                  -> L.ByteString -- ^ message
                  -> (ByteString,Word64) -- ^ digest (32 bytes) and length of message
hmaclazyAndLength :: ByteString -> ByteString -> (ByteString, Word64)
hmaclazyAndLength ByteString
secret ByteString
msg =
    (ByteString -> ByteString
hash (ByteString -> ByteString -> ByteString
B.append ByteString
opad ByteString
htmp), Word64
sz' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ipadLen)
  where
    (ByteString
htmp, Word64
sz') = ByteString -> (ByteString, Word64)
hashlazyAndLength (ByteString -> ByteString -> ByteString
L.append ByteString
ipad ByteString
msg)

    opad :: ByteString
opad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x5c) ByteString
k'
    ipad :: ByteString
ipad = [ByteString] -> ByteString
L.fromChunks [(Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x36) ByteString
k']
    ipadLen :: Int
ipadLen = ByteString -> Int
B.length ByteString
k'

    k' :: ByteString
k'  = ByteString -> ByteString -> ByteString
B.append ByteString
kt ByteString
pad
    kt :: ByteString
kt  = if ByteString -> Int
B.length ByteString
secret Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 then ByteString -> ByteString
hash ByteString
secret else ByteString
secret
    pad :: ByteString
pad = Int -> Word8 -> ByteString
B.replicate (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
kt) Word8
0

{-# NOINLINE hkdf #-}
-- | <https://tools.ietf.org/html/rfc6234 RFC6234>-compatible
-- HKDF-SHA-256 key derivation function.
--
-- @since 0.11.101.0
hkdf :: ByteString -- ^ /IKM/ Input keying material
     -> ByteString -- ^ /salt/ Optional salt value, a non-secret random value (can be @""@)
     -> ByteString -- ^ /info/ Optional context and application specific information (can be @""@)
     -> Int        -- ^ /L/ length of output keying material in octets (at most 255*32 bytes)
     -> ByteString -- ^ /OKM/ Output keying material (/L/ bytes)
hkdf :: ByteString -> ByteString -> ByteString -> Int -> ByteString
hkdf ByteString
ikm ByteString
salt ByteString
info Int
l
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
B.empty
  | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
255Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
32 = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"hkdf: invalid L parameter"
  | Bool
otherwise = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDoIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim (Int
32Int -> Int -> Int
forall a. Num a => a -> a -> a
*Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
cnt) (Word8 -> ByteString -> Ptr Word8 -> IO Int
go Word8
0 ByteString
B.empty)
  where
    prk :: ByteString
prk = ByteString -> ByteString -> ByteString
hmac ByteString
salt ByteString
ikm
    cnt :: Word8
cnt = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
31) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32) :: Word8

    go :: Word8 -> ByteString -> Ptr Word8 -> IO Int
    go :: Word8 -> ByteString -> Ptr Word8 -> IO Int
go !Word8
i ByteString
t !Ptr Word8
p | Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cnt  = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
               | Bool
otherwise = do
                   let t' :: ByteString
t' = ByteString -> ByteString -> ByteString
hmaclazy ByteString
prk ([ByteString] -> ByteString
L.fromChunks [ByteString
t,ByteString
info,Word8 -> ByteString
B.singleton (Word8
iWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Word8
1)])
                   ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
t' ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tptr' -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p Ptr Word8
tptr' Int
32
                   Word8 -> ByteString -> Ptr Word8 -> IO Int
go (Word8
iWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Word8
1) ByteString
t' (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32)