{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns #-}
-- |
-- Module      : Crypto.Hash.SHA512t
-- License     : BSD-style
-- Maintainer  : Herbert Valerio Riedel <hvr@gnu.org>
-- Stability   : stable
-- Portability : unknown
--
-- A module containing <https://en.wikipedia.org/wiki/SHA-2 SHA-512/t> bindings
--
-- @since 0.11.102.0
module Crypto.Hash.SHA512t
    (

    -- * 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.SHA512t as SHA512t
    -- >
    -- > main = print digest
    -- >   where
    -- >     digest = SHA512t.finalize ctx
    -- >     ctx    = foldl SHA512t.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])
    -- >     ctx0   = SHA512t.init 224

      Ctx(..)
    , init     -- :: Int -> Ctx
    , update   -- :: Ctx -> ByteString -> Ctx
    , updates  -- :: Ctx -> [ByteString] -> Ctx
    , finalize -- :: Ctx -> ByteString
    , finalizeAndLength -- :: Ctx -> (ByteString,Word64)
    , start    -- :: Int -> ByteString -> Ctx
    , startlazy -- :: Int -> 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'
    --
    -- Example:
    --
    -- > import qualified Data.ByteString
    -- > import qualified Crypto.Hash.SHA512t as SHA512t
    -- >
    -- > main = print $ SHA512t.hash 224 (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     -- :: Int -> ByteString -> ByteString
    , hashlazy -- :: Int -> L.ByteString -> ByteString
    , hashlazyAndLength -- :: Int -> L.ByteString -> (ByteString,Word64)

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

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

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

import Compat (constructBS)
import Crypto.Hash.SHA512.FFI hiding (Ctx(..))
import qualified Crypto.Hash.SHA512.FFI as FFI (Ctx(..))

-- | SHA-512/t Context
--
-- This extends the non-truncated SHA-512 Context (see 'FFI.Ctx')
-- with the value of the /t/ parameter which must be within the
-- range @[1..511]@ excluding the value @384@ as per FIPS-180-4
-- section 5.3.6.
data Ctx = Ctx !Int !FFI.Ctx
  deriving (Ctx -> Ctx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ctx -> Ctx -> Bool
$c/= :: Ctx -> Ctx -> Bool
== :: Ctx -> Ctx -> Bool
$c== :: Ctx -> Ctx -> Bool
Eq)

-- | 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 :: forall a. IO a -> a
unsafeDoIO = forall a. IO a -> a
unsafeDupablePerformIO

{-# INLINE digestSize #-}
digestSize :: Int -> Int
digestSize :: Int -> Int
digestSize Int
t = (Int
tforall a. Num a => a -> a -> a
+Int
7) forall a. Integral a => a -> a -> a
`div` Int
8

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

{-# INLINE withByteStringPtr #-}
withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr :: forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
b Ptr Word8 -> IO a
f =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr Word8 -> IO a
f (Ptr Word8
ptr 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' :: forall a. Int -> (Ptr Word8 -> IO a) -> IO (ByteString, a)
create' Int
l Ptr Word8 -> IO a
f = do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
l
    a
x <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
x seq :: forall a b. a -> b -> b
`seq` ByteString
bs seq :: forall a b. a -> b -> b
`seq` (ByteString
bs,a
x)

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

withCtxCopy :: Ctx -> (Ptr FFI.Ctx -> IO ()) -> IO Ctx
withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy (Ctx Int
tbits (FFI.Ctx ByteString
ctxB)) Ptr Ctx -> IO ()
f = (Int -> Ctx -> Ctx
Ctx Int
tbits forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Ctx
FFI.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 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dstPtr ->
                forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
ctxB forall a b. (a -> b) -> a -> b
$ \Ptr Word8
srcPtr -> do
                    Ptr Ctx -> Ptr Ctx -> IO ()
copyCtx (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr) (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
srcPtr)
                    Ptr Ctx -> IO ()
f (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstPtr)

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

withCtxNew :: Int -> (Ptr FFI.Ctx -> IO ()) -> IO Ctx
withCtxNew :: Int -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Int
t Ptr Ctx -> IO ()
f = (Int -> Ctx -> Ctx
Ctx Int
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Ctx
FFI.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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)

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

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

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

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

finalizeInternalIO :: Int -> Ptr FFI.Ctx -> IO ByteString
finalizeInternalIO :: Int -> Ptr Ctx -> IO ByteString
finalizeInternalIO Int
t Ptr Ctx
ptr = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (Int -> Int
digestSize Int
t) (Ptr Ctx -> Word16 -> Ptr Word8 -> IO ()
c_sha512t_finalize Ptr Ctx
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t))

finalizeInternalIO' :: Int -> Ptr FFI.Ctx -> IO (ByteString,Word64)
finalizeInternalIO' :: Int -> Ptr Ctx -> IO (ByteString, Word64)
finalizeInternalIO' Int
t Ptr Ctx
ptr = forall a. Int -> (Ptr Word8 -> IO a) -> IO (ByteString, a)
create' (Int -> Int
digestSize Int
t) (Ptr Ctx -> Word16 -> Ptr Word8 -> IO Word64
c_sha512t_finalize_len Ptr Ctx
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t))

{-# NOINLINE init #-}
-- | create a new hash context
init :: Int -> Ctx
init :: Int -> Ctx
init Int
224 = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Int
224 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Ctx -> Word16 -> IO ()
c_sha512t_init Word16
224
init Int
256 = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Int
256 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Ctx -> Word16 -> IO ()
c_sha512t_init Word16
256
init Int
t   = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Int
t forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Ctx -> Word16 -> IO ()
c_sha512t_init Word16
t'
  where
    !t' :: Word16
t' = Int -> Word16
tFromInt Int
t -- will 'error' for invalid values

tFromInt :: Int -> Word16
tFromInt :: Int -> Word16
tFromInt Int
t
  | Int -> Bool
isValidT Int
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t
  | Bool
otherwise  = forall a. HasCallStack => [Char] -> a
error ([Char]
"invalid SHA512/t (with t=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
t forall a. [a] -> [a] -> [a]
++ [Char]
") requested")

-- see FIPS 180-4 section 5.3.6.
isValidT :: Int -> Bool
isValidT :: Int -> Bool
isValidT Int
t = Int
t forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
t forall a. Ord a => a -> a -> Bool
< Int
512 Bool -> Bool -> Bool
&& Int
t forall a. Eq a => a -> a -> Bool
/= Int
384

validCtx :: Ctx -> Bool
validCtx :: Ctx -> Bool
validCtx (Ctx Int
t (FFI.Ctx ByteString
b)) = Int -> Bool
isValidT Int
t Bool -> Bool -> Bool
&& ByteString -> Int
B.length ByteString
b 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 = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy Ctx
ctx forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr ByteString
d
  | Bool
otherwise    = forall a. HasCallStack => [Char] -> a
error [Char]
"SHA512t.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 = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy Ctx
ctx forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> 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    = forall a. HasCallStack => [Char] -> a
error [Char]
"SHA512t.updates: invalid Ctx"

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

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

{-# NOINLINE hash #-}
-- | hash a strict bytestring into a digest bytestring (/t/ bits)
hash :: Int -> ByteString -> ByteString
hash :: Int -> ByteString -> ByteString
hash Int
t ByteString
d = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
d forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cs, Int
len) ->
    Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (Int -> Int
digestSize Int
t) (Word16 -> Ptr Word8 -> CSize -> Ptr Word8 -> IO ()
c_sha512t_hash Word16
t' (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cs) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
  where
    !t' :: Word16
t' = Int -> Word16
tFromInt Int
t

{-# NOINLINE start #-}
-- | hash a strict bytestring into a Ctx
start :: Int -> ByteString -> Ctx
start :: Int -> ByteString -> Ctx
start Int
t ByteString
d = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Int
t forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> do
    Ptr Ctx -> Word16 -> IO ()
c_sha512t_init Ptr Ctx
ptr Word16
t' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Ctx -> ByteString -> IO ()
updateInternalIO Ptr Ctx
ptr ByteString
d
  where
    !t' :: Word16
t' = Int -> Word16
tFromInt Int
t

{-# NOINLINE hashlazy #-}
-- | hash a lazy bytestring into a digest bytestring (/t/ bits)
hashlazy :: Int -> L.ByteString -> ByteString
hashlazy :: Int -> ByteString -> ByteString
hashlazy Int
t ByteString
l = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ forall a. (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> do
    Ptr Ctx -> Word16 -> IO ()
c_sha512t_init Ptr Ctx
ptr Word16
t' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Ptr Ctx -> IO ByteString
finalizeInternalIO Int
t Ptr Ctx
ptr
  where
    !t' :: Word16
t' = Int -> Word16
tFromInt Int
t

{-# NOINLINE hashlazyAndLength #-}
-- | Variant of 'hashlazy' which simultaneously computes the hash and length of a lazy bytestring.
hashlazyAndLength :: Int -> L.ByteString -> (ByteString,Word64)
hashlazyAndLength :: Int -> ByteString -> (ByteString, Word64)
hashlazyAndLength Int
t ByteString
l = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ forall a. (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr ->
    Ptr Ctx -> Word16 -> IO ()
c_sha512t_init Ptr Ctx
ptr Word16
t' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Ptr Ctx -> IO (ByteString, Word64)
finalizeInternalIO' Int
t Ptr Ctx
ptr
  where
    !t' :: Word16
t' = Int -> Word16
tFromInt Int
t

{-# NOINLINE startlazy #-}
-- | hash a lazy bytestring into a Ctx
startlazy :: Int -> L.ByteString -> Ctx
startlazy :: Int -> ByteString -> Ctx
startlazy Int
t ByteString
l = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew Int
t forall a b. (a -> b) -> a -> b
$ \Ptr Ctx
ptr -> do
    Ptr Ctx -> Word16 -> IO ()
c_sha512t_init Ptr Ctx
ptr Word16
t' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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)
  where
    t' :: Word16
t' = Int -> Word16
tFromInt Int
t

{-# NOINLINE hmac #-}
-- | Compute /t/-bit <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
-- HMAC-SHA-512/t digest for a strict bytestring message
hmac :: Int        -- ^ digest length /t/ in bits
     -> ByteString -- ^ secret
     -> ByteString -- ^ message
     -> ByteString
hmac :: Int -> ByteString -> ByteString -> ByteString
hmac Int
t ByteString
secret ByteString
msg = Int -> ByteString -> ByteString
hash Int
t forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
opad (Int -> ByteString -> ByteString
hash Int
t forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
ipad ByteString
msg)
  where
    opad :: ByteString
opad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (forall a. Bits a => a -> a -> a
xor Word8
0x5c) ByteString
k'
    ipad :: ByteString
ipad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (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 forall a. Ord a => a -> a -> Bool
> Int
128 then Int -> ByteString -> ByteString
hash Int
t ByteString
secret else ByteString
secret
    pad :: ByteString
pad = Int -> Word8 -> ByteString
B.replicate (Int
128 forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
kt) Word8
0


{-# NOINLINE hmaclazy #-}
-- | Compute4 /t/-bit <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible
-- HMAC-SHA-512/t digest for a lazy bytestring message
hmaclazy :: Int          -- ^ digest length /t/ in bits
         -> ByteString   -- ^ secret
         -> L.ByteString -- ^ message
         -> ByteString
hmaclazy :: Int -> ByteString -> ByteString -> ByteString
hmaclazy Int
t ByteString
secret ByteString
msg = Int -> ByteString -> ByteString
hash Int
t forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
opad (Int -> ByteString -> ByteString
hashlazy Int
t 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 (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 (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 forall a. Ord a => a -> a -> Bool
> Int
128 then Int -> ByteString -> ByteString
hash Int
t ByteString
secret else ByteString
secret
    pad :: ByteString
pad = Int -> Word8 -> ByteString
B.replicate (Int
128 forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
kt) Word8
0

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

    opad :: ByteString
opad = (Word8 -> Word8) -> ByteString -> ByteString
B.map (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 (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 forall a. Ord a => a -> a -> Bool
> Int
128 then Int -> ByteString -> ByteString
hash Int
t ByteString
secret else ByteString
secret
    pad :: ByteString
pad = Int -> Word8 -> ByteString
B.replicate (Int
128 forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
kt) Word8
0