{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

#if !MIN_VERSION_base(4,18,0)
{-# LANGUAGE PatternSynonyms #-}
#endif

#include <openssl/opensslv.h>

-- |
-- Module: Data.Hash.Internal.OpenSSL
-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com>
-- License: MIT
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--
-- Bindings for OpenSSL EVP Message Digest Routines.
--
-- Requires OpenSSL version >= 1.1.0
--
module Data.Hash.Internal.OpenSSL
(

-- * EVP digest routines

  Algorithm(..)
, Ctx(..)
, Digest(..)
, resetCtx
, initCtx
, updateCtx
, finalCtx
, fetchAlgorithm

-- * Algorithms

, OpenSslDigest(..)
, OpenSslException(..)

-- ** SHA2
--
-- $sha2

, Sha2_224(..)
, Sha2_256(..)
, Sha2_384(..)
, Sha2_512(..)
, Sha2_512_224(..)
, Sha2_512_256(..)

-- ** SHA3
--
-- $sha3

, Sha3_224(..)
, Sha3_256(..)
, Sha3_384(..)
, Sha3_512(..)
, Shake128(..)
, type Shake128_256
, Shake256(..)
, type Shake256_512

-- ** Keccak
--
-- $keccak

, Keccak224(..)
, Keccak256(..)
, Keccak384(..)
, Keccak512(..)

-- *** Unsafe finalize functions
, finalizeKeccak256Ptr
, finalizeKeccak512Ptr

-- ** Blake2
--
-- $blake2

, Blake2b512(..)
, Blake2s256(..)
) where

import Control.Exception
import Control.Monad

import Data.ByteString.Short qualified as BS
import Data.Typeable
import Data.Void
import Data.Word

#if MIN_VERSION_base(4,18,0)
import Foreign.C.ConstPtr (ConstPtr(..))
import Foreign.C.String (withCString)
#else
import Foreign.C.String(CString, withCString)
#endif
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Ptr

import GHC.Exts
import GHC.IO
import GHC.TypeNats

-- internal modules

import Data.Hash.Class.Mutable
import Data.Hash.Internal.Utils

-- -------------------------------------------------------------------------- --
-- Check OpenSSL Version
--
-- OpenSSL Release History (cf. https://openssl.org/policies/releasestrat.html)
--
-- - OpenSSL 1.1: Support ended 2023-09-11.
-- - OpenSSL 3.0: Support ends 2026-09-07 (LTS).
-- - OpenSSL 3.1: Support ends 2025-03-14.
-- - OpenSSL 3.2: Native Keccak support added.

#if OPENSSL_VERSION_NUMBER < 0x10100000L
#error "Unsupported OpenSSL version. Please install OpenSSL >= 1.1.0"
#endif

-- -------------------------------------------------------------------------- --
--
-- Example for idiomatic use of OpenSSL message digests cf.
-- https://www.openssl.org/docs/man3.1/man7/crypto.html
--

-- -------------------------------------------------------------------------- --
-- Exceptions

newtype OpenSslException = OpenSslException String
    deriving (Int -> OpenSslException -> ShowS
[OpenSslException] -> ShowS
OpenSslException -> String
(Int -> OpenSslException -> ShowS)
-> (OpenSslException -> String)
-> ([OpenSslException] -> ShowS)
-> Show OpenSslException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenSslException -> ShowS
showsPrec :: Int -> OpenSslException -> ShowS
$cshow :: OpenSslException -> String
show :: OpenSslException -> String
$cshowList :: [OpenSslException] -> ShowS
showList :: [OpenSslException] -> ShowS
Show)

instance Exception OpenSslException

-- -------------------------------------------------------------------------- --
-- Utils for ConstPtr

#if MIN_VERSION_base(4,18,0)
type ConstCString = ConstPtr CChar
#else
type ConstPtr a = Ptr a
type ConstCString = CString

pattern ConstPtr :: forall p. p -> p
pattern ConstPtr a = a
#endif

withConstCString :: String -> (ConstCString -> IO a) -> IO a
withConstCString :: forall a. String -> (ConstCString -> IO a) -> IO a
withConstCString String
str ConstCString -> IO a
inner = String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> ConstCString -> IO a
inner (CString -> ConstCString
forall a. Ptr a -> ConstPtr a
ConstPtr CString
cstr)

constPtr :: Addr# -> ConstPtr a
constPtr :: forall a. Addr# -> ConstPtr a
constPtr Addr#
a = Ptr a -> ConstPtr a
forall a. Ptr a -> ConstPtr a
ConstPtr (Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
a)

nullConstPtr :: ConstPtr a
nullConstPtr :: forall a. ConstPtr a
nullConstPtr = Ptr a -> ConstPtr a
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr a
forall a. Ptr a
nullPtr

-- -------------------------------------------------------------------------- --
-- OpenSSL Message Digest Algorithms

-- | An algorithm implementation from an OpenSSL algorithm provider.
--
-- It must be freed after use. Internally, implementations are cached and
-- reference counted. Re-initialization after the last reference is freed is
-- somewhat expensive.
--
-- It is assumed that this always points to a valid algorithm implementation.
--
newtype Algorithm a = Algorithm (ForeignPtr Void)

instance Typeable a => Show (Algorithm a) where
    show :: Algorithm a -> String
show Algorithm a
_ = TypeRep -> String
forall a. Show a => a -> String
show (Maybe a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall a. Maybe a
Nothing @a))

class OpenSslDigest a where
    algorithm :: Algorithm a

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
-- | Fetches the digest implementation for the given algorithm from any provider
-- offering it, within the criteria given by the properties.
--
-- cf. https://www.openssl.org/docs/man3.0/man3/EVP_MD_fetch.html for details.
--
-- The obtained algorithm implementation is reference counted and must be freed
-- afer use.
--
-- The arguments are the OpenSSL context which is usually NULL, the algorithm
-- identifier, and the search criteria.
--
foreign import ccall unsafe "openssl/evp.h EVP_MD_fetch"
    c_evp_md_fetch :: Ptr Void {- nullPtr -} -> ConstCString -> ConstCString -> IO (Ptr a)

foreign import ccall unsafe "openssl/evp.h &EVP_MD_free"
    c_evp_md_free :: FunPtr (Ptr a -> IO ())

-- | Return an 'Algorithm' with given identifier from the default provider.
--
-- The result is guaranteed to be a valid algorithm. Otherwise an
-- 'OpenSslException' is thrown.
--
-- Cf. https://www.openssl.org/docs/manmaster/man7/OSSL_PROVIDER-default.html
-- for a list of available algorithms.
--
fetchAlgorithm :: String -> IO (Algorithm a)
fetchAlgorithm name = do
    withConstCString name $ \namePtr -> mask_ $ do
        ptr <- c_evp_md_fetch nullPtr namePtr (constPtr "provider=default"#)
        when (ptr == nullPtr) $ throw $ OpenSslException $ "fetching algorithm failed: " <> name
        Algorithm <$> newForeignPtr c_evp_md_free ptr
#else

foreign import ccall unsafe "openssl/evp.h EVP_get_digestbyname"
    c_EVP_get_digestbyname :: ConstCString -> IO (ConstPtr a)

-- | Look up the 'Algorithm' with given identifier. This is a less efficient
-- legacy way to obtain algorithm implementations. The returned algorithms
-- do not need to be freed.
--
-- The result is guaranteed to be a valid algorithm. Otherwise an
-- 'OpenSslException' is thrown.
--
fetchAlgorithm :: String -> IO (Algorithm a)
fetchAlgorithm :: forall a. String -> IO (Algorithm a)
fetchAlgorithm String
name = do
    String -> (ConstCString -> IO (Algorithm a)) -> IO (Algorithm a)
forall a. String -> (ConstCString -> IO a) -> IO a
withConstCString String
name ((ConstCString -> IO (Algorithm a)) -> IO (Algorithm a))
-> (ConstCString -> IO (Algorithm a)) -> IO (Algorithm a)
forall a b. (a -> b) -> a -> b
$ \ConstCString
namePtr -> IO (Algorithm a) -> IO (Algorithm a)
forall a. IO a -> IO a
mask_ (IO (Algorithm a) -> IO (Algorithm a))
-> IO (Algorithm a) -> IO (Algorithm a)
forall a b. (a -> b) -> a -> b
$ do
        ConstPtr Ptr Void
ptr <- ConstCString -> IO (ConstPtr Void)
forall a. ConstCString -> IO (ConstPtr a)
c_EVP_get_digestbyname ConstCString
namePtr
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Void
ptr Ptr Void -> Ptr Void -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Void
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException (String -> OpenSslException) -> String -> OpenSslException
forall a b. (a -> b) -> a -> b
$ String
"fetching algorithm failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name
        ForeignPtr Void -> Algorithm a
forall a. ForeignPtr Void -> Algorithm a
Algorithm (ForeignPtr Void -> Algorithm a)
-> IO (ForeignPtr Void) -> IO (Algorithm a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Void -> IO (ForeignPtr Void)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Void
ptr
#endif

-- -------------------------------------------------------------------------- --
-- Message Digest Context

-- | Generic OpenSSL message digest type.
--
-- This can be used with @DerivingVia@ to derive hash instances for concrete
-- message digest algorithms.
--
newtype Digest a = Digest BS.ShortByteString
    deriving (Digest a -> Digest a -> Bool
(Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool) -> Eq (Digest a)
forall a. Digest a -> Digest a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Digest a -> Digest a -> Bool
== :: Digest a -> Digest a -> Bool
$c/= :: forall a. Digest a -> Digest a -> Bool
/= :: Digest a -> Digest a -> Bool
Eq, Eq (Digest a)
Eq (Digest a) =>
(Digest a -> Digest a -> Ordering)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Digest a)
-> (Digest a -> Digest a -> Digest a)
-> Ord (Digest a)
Digest a -> Digest a -> Bool
Digest a -> Digest a -> Ordering
Digest a -> Digest a -> Digest a
forall a. Eq (Digest a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Digest a -> Digest a -> Bool
forall a. Digest a -> Digest a -> Ordering
forall a. Digest a -> Digest a -> Digest a
$ccompare :: forall a. Digest a -> Digest a -> Ordering
compare :: Digest a -> Digest a -> Ordering
$c< :: forall a. Digest a -> Digest a -> Bool
< :: Digest a -> Digest a -> Bool
$c<= :: forall a. Digest a -> Digest a -> Bool
<= :: Digest a -> Digest a -> Bool
$c> :: forall a. Digest a -> Digest a -> Bool
> :: Digest a -> Digest a -> Bool
$c>= :: forall a. Digest a -> Digest a -> Bool
>= :: Digest a -> Digest a -> Bool
$cmax :: forall a. Digest a -> Digest a -> Digest a
max :: Digest a -> Digest a -> Digest a
$cmin :: forall a. Digest a -> Digest a -> Digest a
min :: Digest a -> Digest a -> Digest a
Ord)
    deriving (Int -> Digest a -> ShowS
[Digest a] -> ShowS
Digest a -> String
(Int -> Digest a -> ShowS)
-> (Digest a -> String) -> ([Digest a] -> ShowS) -> Show (Digest a)
forall a. Int -> Digest a -> ShowS
forall a. [Digest a] -> ShowS
forall a. Digest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Digest a -> ShowS
showsPrec :: Int -> Digest a -> ShowS
$cshow :: forall a. Digest a -> String
show :: Digest a -> String
$cshowList :: forall a. [Digest a] -> ShowS
showList :: [Digest a] -> ShowS
Show, String -> Digest a
(String -> Digest a) -> IsString (Digest a)
forall a. String -> Digest a
forall a. (String -> a) -> IsString a
$cfromString :: forall a. String -> Digest a
fromString :: String -> Digest a
IsString) via B16ShortByteString

-- | OpenSSL Message Digest Context
--
newtype Ctx a = Ctx (ForeignPtr Void)

-- | Initialize new MD context. The obtained context must be freed after use.
--
foreign import ccall unsafe "openssl/evp.h EVP_MD_CTX_new"
    c_evp_ctx_new :: IO (Ptr a)

foreign import ccall unsafe "openssl/evp.h &EVP_MD_CTX_free"
    c_evp_ctx_free_ptr :: FunPtr (Ptr a -> IO ())

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
foreign import ccall unsafe "openssl/evp.h EVP_DigestInit_ex2"
#else
foreign import ccall unsafe "openssl/evp.h EVP_DigestInit_ex"
#endif
    c_evp_digest_init :: Ptr ctx -> ConstPtr alg -> Ptr Void {- nullPtr -} -> IO CInt

foreign import ccall unsafe "openssl/evp.h EVP_DigestUpdate"
    c_evp_digest_update :: Ptr ctx -> ConstPtr d -> CSize -> IO CInt

foreign import ccall unsafe "openssl/evp.h EVP_DigestFinal_ex"
    c_evp_digest_final :: Ptr ctx -> Ptr CUChar -> Ptr CUInt -> IO CInt

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
foreign import ccall unsafe "openssl/evp.h EVP_MD_CTX_get0_md"
#else
foreign import ccall unsafe "openssl/evp.h EVP_MD_CTX_md"
#endif
    c_evp_md_ctx_get0_md :: ConstPtr ctx -> ConstPtr a

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
foreign import ccall unsafe "openssl/evp.h EVP_MD_get_size"
#else
foreign import ccall unsafe "openssl/evp.h EVP_MD_size"
#endif
    c_evp_md_get_size :: ConstPtr a -> CInt

newCtx :: IO (Ctx a)
newCtx :: forall a. IO (Ctx a)
newCtx = IO (Ctx a) -> IO (Ctx a)
forall a. IO a -> IO a
mask_ (IO (Ctx a) -> IO (Ctx a)) -> IO (Ctx a) -> IO (Ctx a)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Void
ptr <- IO (Ptr Void)
forall a. IO (Ptr a)
c_evp_ctx_new
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Void
ptr Ptr Void -> Ptr Void -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Void
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"failed to create new context"
    ForeignPtr Void -> Ctx a
forall a. ForeignPtr Void -> Ctx a
Ctx (ForeignPtr Void -> Ctx a) -> IO (ForeignPtr Void) -> IO (Ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr Void -> Ptr Void -> IO (ForeignPtr Void)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Void
forall a. FunPtr (Ptr a -> IO ())
c_evp_ctx_free_ptr Ptr Void
ptr
{-# INLINE newCtx #-}

-- | Allocates and initializes a new context. The context may be reused by
-- calling 'resetCtx' on it.
--
initCtx :: Algorithm a -> IO (Ctx a)
initCtx :: forall a. Algorithm a -> IO (Ctx a)
initCtx (Algorithm ForeignPtr Void
alg) = do
    c :: Ctx a
c@(Ctx ForeignPtr Void
ctx) <- IO (Ctx a)
forall a. IO (Ctx a)
newCtx
    CInt
r <- ForeignPtr Void -> (Ptr Void -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO CInt) -> IO CInt)
-> (Ptr Void -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ctxPtr ->
        ForeignPtr Void -> (Ptr Void -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
alg ((Ptr Void -> IO CInt) -> IO CInt)
-> (Ptr Void -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Void
algPtr ->
            Ptr Void -> ConstPtr Void -> Ptr Void -> IO CInt
forall ctx alg. Ptr ctx -> ConstPtr alg -> Ptr Void -> IO CInt
c_evp_digest_init Ptr Void
ctxPtr (Ptr Void -> ConstPtr Void
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Void
algPtr) Ptr Void
forall a. Ptr a
nullPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest initialization failed"
    Ctx a -> IO (Ctx a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ctx a
c
{-# INLINE initCtx #-}

-- | Resets a context an initialize context.
--
resetCtx :: Ctx a -> IO ()
resetCtx :: forall a. Ctx a -> IO ()
resetCtx (Ctx ForeignPtr Void
ctx) = do
    CInt
r <- ForeignPtr Void -> (Ptr Void -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO CInt) -> IO CInt)
-> (Ptr Void -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ptr ->
        Ptr Void -> ConstPtr Any -> Ptr Void -> IO CInt
forall ctx alg. Ptr ctx -> ConstPtr alg -> Ptr Void -> IO CInt
c_evp_digest_init Ptr Void
ptr ConstPtr Any
forall a. ConstPtr a
nullConstPtr Ptr Void
forall a. Ptr a
nullPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest re-initialization failed"
{-# INLINE resetCtx #-}

-- | Feed more data into an context.
--
updateCtx :: Ctx a -> Ptr Word8 -> Int -> IO ()
updateCtx :: forall a. Ctx a -> Ptr Word8 -> Int -> IO ()
updateCtx (Ctx ForeignPtr Void
ctx) Ptr Word8
d Int
c = ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ptr -> do
    CInt
r <- Ptr Void -> ConstPtr Word8 -> CSize -> IO CInt
forall ctx d. Ptr ctx -> ConstPtr d -> CSize -> IO CInt
c_evp_digest_update Ptr Void
ptr (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
d) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest update failed"
{-# INLINE updateCtx #-}

-- | Finalize a hash and return the digest.
--
finalCtx :: Ctx a -> IO (Digest a)
finalCtx :: forall a. Ctx a -> IO (Digest a)
finalCtx (Ctx ForeignPtr Void
ctx) = ForeignPtr Void -> (Ptr Void -> IO (Digest a)) -> IO (Digest a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO (Digest a)) -> IO (Digest a))
-> (Ptr Void -> IO (Digest a)) -> IO (Digest a)
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ptr -> do
    let s :: Int
s = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ ConstPtr Any -> CInt
forall a. ConstPtr a -> CInt
c_evp_md_get_size (ConstPtr Void -> ConstPtr Any
forall ctx a. ConstPtr ctx -> ConstPtr a
c_evp_md_ctx_get0_md (Ptr Void -> ConstPtr Void
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Void
ptr))
    Int -> (Ptr CUChar -> IO (Digest a)) -> IO (Digest a)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
s ((Ptr CUChar -> IO (Digest a)) -> IO (Digest a))
-> (Ptr CUChar -> IO (Digest a)) -> IO (Digest a)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
dptr -> do
        CInt
r <- Ptr Void -> Ptr CUChar -> Ptr CUInt -> IO CInt
forall ctx. Ptr ctx -> Ptr CUChar -> Ptr CUInt -> IO CInt
c_evp_digest_final Ptr Void
ptr Ptr CUChar
dptr Ptr CUInt
forall a. Ptr a
nullPtr
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest finalization failed"
        ShortByteString -> Digest a
forall a. ShortByteString -> Digest a
Digest (ShortByteString -> Digest a)
-> IO ShortByteString -> IO (Digest a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ShortByteString
BS.packCStringLen (Ptr CUChar -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
dptr, Int
s)
{-# INLINE finalCtx #-}

-- -------------------------------------------------------------------------- --
-- Hash Instances for Digest

instance OpenSslDigest a => Hash (Digest a) where
    initialize :: IO (Context (Digest a))
initialize = Algorithm a -> IO (Ctx a)
forall a. Algorithm a -> IO (Ctx a)
initCtx (forall a. OpenSslDigest a => Algorithm a
algorithm @a)
    {-# INLINE initialize #-}

instance IncrementalHash (Digest a) where
    type Context (Digest a) = Ctx a
    update :: Context (Digest a) -> Ptr Word8 -> Int -> IO ()
update = Context (Digest a) -> Ptr Word8 -> Int -> IO ()
Ctx a -> Ptr Word8 -> Int -> IO ()
forall a. Ctx a -> Ptr Word8 -> Int -> IO ()
updateCtx
    finalize :: Context (Digest a) -> IO (Digest a)
finalize = Context (Digest a) -> IO (Digest a)
Ctx a -> IO (Digest a)
forall a. Ctx a -> IO (Digest a)
finalCtx
    {-# INLINE update #-}
    {-# INLINE finalize #-}

instance ResetableHash (Digest a) where
    reset :: Context (Digest a) -> IO ()
reset = Context (Digest a) -> IO ()
Ctx a -> IO ()
forall a. Ctx a -> IO ()
resetCtx
    {-# INLINE reset #-}

-- -------------------------------------------------------------------------- --
-- Hashes based on extendable-output functions (XOF)

newtype XOF_Digest (n :: Natural) a = XOF_Digest BS.ShortByteString
    deriving (XOF_Digest n a -> XOF_Digest n a -> Bool
(XOF_Digest n a -> XOF_Digest n a -> Bool)
-> (XOF_Digest n a -> XOF_Digest n a -> Bool)
-> Eq (XOF_Digest n a)
forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
== :: XOF_Digest n a -> XOF_Digest n a -> Bool
$c/= :: forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
/= :: XOF_Digest n a -> XOF_Digest n a -> Bool
Eq, Eq (XOF_Digest n a)
Eq (XOF_Digest n a) =>
(XOF_Digest n a -> XOF_Digest n a -> Ordering)
-> (XOF_Digest n a -> XOF_Digest n a -> Bool)
-> (XOF_Digest n a -> XOF_Digest n a -> Bool)
-> (XOF_Digest n a -> XOF_Digest n a -> Bool)
-> (XOF_Digest n a -> XOF_Digest n a -> Bool)
-> (XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a)
-> (XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a)
-> Ord (XOF_Digest n a)
XOF_Digest n a -> XOF_Digest n a -> Bool
XOF_Digest n a -> XOF_Digest n a -> Ordering
XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a
forall (n :: Natural) a. Eq (XOF_Digest n a)
forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
forall (n :: Natural) a.
XOF_Digest n a -> XOF_Digest n a -> Ordering
forall (n :: Natural) a.
XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: forall (n :: Natural) a.
XOF_Digest n a -> XOF_Digest n a -> Ordering
compare :: XOF_Digest n a -> XOF_Digest n a -> Ordering
$c< :: forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
< :: XOF_Digest n a -> XOF_Digest n a -> Bool
$c<= :: forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
<= :: XOF_Digest n a -> XOF_Digest n a -> Bool
$c> :: forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
> :: XOF_Digest n a -> XOF_Digest n a -> Bool
$c>= :: forall (n :: Natural) a. XOF_Digest n a -> XOF_Digest n a -> Bool
>= :: XOF_Digest n a -> XOF_Digest n a -> Bool
$cmax :: forall (n :: Natural) a.
XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a
max :: XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a
$cmin :: forall (n :: Natural) a.
XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a
min :: XOF_Digest n a -> XOF_Digest n a -> XOF_Digest n a
Ord)
    deriving (IO (Context (XOF_Digest n a))
IncrementalHash (XOF_Digest n a)
IncrementalHash (XOF_Digest n a) =>
IO (Context (XOF_Digest n a)) -> Hash (XOF_Digest n a)
forall (n :: Natural) a.
(KnownNat n, OpenSslDigest a) =>
IO (Context (XOF_Digest n a))
forall (n :: Natural) a.
(KnownNat n, OpenSslDigest a) =>
IncrementalHash (XOF_Digest n a)
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: forall (n :: Natural) a.
(KnownNat n, OpenSslDigest a) =>
IO (Context (XOF_Digest n a))
initialize :: IO (Context (XOF_Digest n a))
Hash, IncrementalHash (XOF_Digest n a)
IncrementalHash (XOF_Digest n a) =>
(Context (XOF_Digest n a) -> IO ())
-> ResetableHash (XOF_Digest n a)
Context (XOF_Digest n a) -> IO ()
forall (n :: Natural) a.
KnownNat n =>
IncrementalHash (XOF_Digest n a)
forall (n :: Natural) a.
KnownNat n =>
Context (XOF_Digest n a) -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: forall (n :: Natural) a.
KnownNat n =>
Context (XOF_Digest n a) -> IO ()
reset :: Context (XOF_Digest n a) -> IO ()
ResetableHash) via (Digest a)
    deriving (Int -> XOF_Digest n a -> ShowS
[XOF_Digest n a] -> ShowS
XOF_Digest n a -> String
(Int -> XOF_Digest n a -> ShowS)
-> (XOF_Digest n a -> String)
-> ([XOF_Digest n a] -> ShowS)
-> Show (XOF_Digest n a)
forall (n :: Natural) a. Int -> XOF_Digest n a -> ShowS
forall (n :: Natural) a. [XOF_Digest n a] -> ShowS
forall (n :: Natural) a. XOF_Digest n a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (n :: Natural) a. Int -> XOF_Digest n a -> ShowS
showsPrec :: Int -> XOF_Digest n a -> ShowS
$cshow :: forall (n :: Natural) a. XOF_Digest n a -> String
show :: XOF_Digest n a -> String
$cshowList :: forall (n :: Natural) a. [XOF_Digest n a] -> ShowS
showList :: [XOF_Digest n a] -> ShowS
Show, String -> XOF_Digest n a
(String -> XOF_Digest n a) -> IsString (XOF_Digest n a)
forall (n :: Natural) a. String -> XOF_Digest n a
forall a. (String -> a) -> IsString a
$cfromString :: forall (n :: Natural) a. String -> XOF_Digest n a
fromString :: String -> XOF_Digest n a
IsString) via B16ShortByteString

foreign import ccall unsafe "openssl/evp.h EVP_DigestFinalXOF"
    c_EVP_DigestFinalXOF :: Ptr ctx -> Ptr CUChar -> CSize -> IO CInt

-- | Finalize an XOF based hash and return the digest.
--
xof_finalCtx :: forall n a . KnownNat n => Ctx a -> IO (XOF_Digest n a)
xof_finalCtx :: forall (n :: Natural) a. KnownNat n => Ctx a -> IO (XOF_Digest n a)
xof_finalCtx (Ctx ForeignPtr Void
ctx) = ForeignPtr Void
-> (Ptr Void -> IO (XOF_Digest n a)) -> IO (XOF_Digest n a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO (XOF_Digest n a)) -> IO (XOF_Digest n a))
-> (Ptr Void -> IO (XOF_Digest n a)) -> IO (XOF_Digest n a)
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ptr -> do
    Int -> (Ptr CUChar -> IO (XOF_Digest n a)) -> IO (XOF_Digest n a)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
s ((Ptr CUChar -> IO (XOF_Digest n a)) -> IO (XOF_Digest n a))
-> (Ptr CUChar -> IO (XOF_Digest n a)) -> IO (XOF_Digest n a)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
dptr -> do
        CInt
r <- Ptr Void -> Ptr CUChar -> CSize -> IO CInt
forall ctx. Ptr ctx -> Ptr CUChar -> CSize -> IO CInt
c_EVP_DigestFinalXOF Ptr Void
ptr Ptr CUChar
dptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest finalization failed"
        ShortByteString -> XOF_Digest n a
forall (n :: Natural) a. ShortByteString -> XOF_Digest n a
XOF_Digest (ShortByteString -> XOF_Digest n a)
-> IO ShortByteString -> IO (XOF_Digest n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ShortByteString
BS.packCStringLen (Ptr CUChar -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
dptr, Int
s)
  where
    s :: Int
s = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). KnownNat n => Proxy# n -> Natural
natVal' @n Proxy# n
forall {k} (a :: k). Proxy# a
proxy#
{-# INLINE xof_finalCtx #-}

instance KnownNat n => IncrementalHash (XOF_Digest n a) where
    type Context (XOF_Digest n a) = Ctx a
    update :: Context (XOF_Digest n a) -> Ptr Word8 -> Int -> IO ()
update = Context (XOF_Digest n a) -> Ptr Word8 -> Int -> IO ()
Ctx a -> Ptr Word8 -> Int -> IO ()
forall a. Ctx a -> Ptr Word8 -> Int -> IO ()
updateCtx
    finalize :: Context (XOF_Digest n a) -> IO (XOF_Digest n a)
finalize = Context (XOF_Digest n a) -> IO (XOF_Digest n a)
Ctx a -> IO (XOF_Digest n a)
forall (n :: Natural) a. KnownNat n => Ctx a -> IO (XOF_Digest n a)
xof_finalCtx
    {-# INLINE update #-}
    {-# INLINE finalize #-}

#if OPENSSL_VERSION_NUMBER < 0x30200000L
-- -------------------------------------------------------------------------- --
-- Legacy Keccak Implementation

newtype LegacyKeccak_Digest a = LegacyKeccak_Digest BS.ShortByteString
    deriving (LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
(LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool)
-> (LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool)
-> Eq (LegacyKeccak_Digest a)
forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
== :: LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
$c/= :: forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
/= :: LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
Eq, Eq (LegacyKeccak_Digest a)
Eq (LegacyKeccak_Digest a) =>
(LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Ordering)
-> (LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool)
-> (LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool)
-> (LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool)
-> (LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool)
-> (LegacyKeccak_Digest a
    -> LegacyKeccak_Digest a -> LegacyKeccak_Digest a)
-> (LegacyKeccak_Digest a
    -> LegacyKeccak_Digest a -> LegacyKeccak_Digest a)
-> Ord (LegacyKeccak_Digest a)
LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Ordering
LegacyKeccak_Digest a
-> LegacyKeccak_Digest a -> LegacyKeccak_Digest a
forall a. Eq (LegacyKeccak_Digest a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
forall a.
LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Ordering
forall a.
LegacyKeccak_Digest a
-> LegacyKeccak_Digest a -> LegacyKeccak_Digest a
$ccompare :: forall a.
LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Ordering
compare :: LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Ordering
$c< :: forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
< :: LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
$c<= :: forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
<= :: LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
$c> :: forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
> :: LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
$c>= :: forall a. LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
>= :: LegacyKeccak_Digest a -> LegacyKeccak_Digest a -> Bool
$cmax :: forall a.
LegacyKeccak_Digest a
-> LegacyKeccak_Digest a -> LegacyKeccak_Digest a
max :: LegacyKeccak_Digest a
-> LegacyKeccak_Digest a -> LegacyKeccak_Digest a
$cmin :: forall a.
LegacyKeccak_Digest a
-> LegacyKeccak_Digest a -> LegacyKeccak_Digest a
min :: LegacyKeccak_Digest a
-> LegacyKeccak_Digest a -> LegacyKeccak_Digest a
Ord)
    deriving (Context (LegacyKeccak_Digest a) -> IO (LegacyKeccak_Digest a)
Context (LegacyKeccak_Digest a) -> Ptr Word8 -> Int -> IO ()
(Context (LegacyKeccak_Digest a) -> Ptr Word8 -> Int -> IO ())
-> (Context (LegacyKeccak_Digest a) -> IO (LegacyKeccak_Digest a))
-> IncrementalHash (LegacyKeccak_Digest a)
forall a.
Context (LegacyKeccak_Digest a) -> IO (LegacyKeccak_Digest a)
forall a.
Context (LegacyKeccak_Digest a) -> Ptr Word8 -> Int -> IO ()
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: forall a.
Context (LegacyKeccak_Digest a) -> Ptr Word8 -> Int -> IO ()
update :: Context (LegacyKeccak_Digest a) -> Ptr Word8 -> Int -> IO ()
$cfinalize :: forall a.
Context (LegacyKeccak_Digest a) -> IO (LegacyKeccak_Digest a)
finalize :: Context (LegacyKeccak_Digest a) -> IO (LegacyKeccak_Digest a)
IncrementalHash) via (Digest a)
    deriving (Int -> LegacyKeccak_Digest a -> ShowS
[LegacyKeccak_Digest a] -> ShowS
LegacyKeccak_Digest a -> String
(Int -> LegacyKeccak_Digest a -> ShowS)
-> (LegacyKeccak_Digest a -> String)
-> ([LegacyKeccak_Digest a] -> ShowS)
-> Show (LegacyKeccak_Digest a)
forall a. Int -> LegacyKeccak_Digest a -> ShowS
forall a. [LegacyKeccak_Digest a] -> ShowS
forall a. LegacyKeccak_Digest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> LegacyKeccak_Digest a -> ShowS
showsPrec :: Int -> LegacyKeccak_Digest a -> ShowS
$cshow :: forall a. LegacyKeccak_Digest a -> String
show :: LegacyKeccak_Digest a -> String
$cshowList :: forall a. [LegacyKeccak_Digest a] -> ShowS
showList :: [LegacyKeccak_Digest a] -> ShowS
Show, String -> LegacyKeccak_Digest a
(String -> LegacyKeccak_Digest a)
-> IsString (LegacyKeccak_Digest a)
forall a. String -> LegacyKeccak_Digest a
forall a. (String -> a) -> IsString a
$cfromString :: forall a. String -> LegacyKeccak_Digest a
fromString :: String -> LegacyKeccak_Digest a
IsString) via B16ShortByteString

foreign import ccall unsafe "keccak.h keccak_EVP_DigestInit_ex"
    c_keccak_EVP_DigestInit_ex :: Ptr ctx -> ConstPtr a -> IO CInt

legacyKeccak_initCtx :: Algorithm a -> IO (Ctx a)
legacyKeccak_initCtx :: forall a. Algorithm a -> IO (Ctx a)
legacyKeccak_initCtx (Algorithm ForeignPtr Void
alg) = do
    c :: Ctx a
c@(Ctx ForeignPtr Void
ctx) <- IO (Ctx a)
forall a. IO (Ctx a)
newCtx
    CInt
r <- ForeignPtr Void -> (Ptr Void -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO CInt) -> IO CInt)
-> (Ptr Void -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ctxPtr ->
        ForeignPtr Void -> (Ptr Void -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
alg ((Ptr Void -> IO CInt) -> IO CInt)
-> (Ptr Void -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Void
algPtr ->
            Ptr Void -> ConstPtr Void -> IO CInt
forall ctx a. Ptr ctx -> ConstPtr a -> IO CInt
c_keccak_EVP_DigestInit_ex Ptr Void
ctxPtr (Ptr Void -> ConstPtr Void
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Void
algPtr)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest initialization failed"
    Ctx a -> IO (Ctx a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ctx a
c
{-# INLINE legacyKeccak_initCtx #-}

legacyKeccak_resetCtx :: Ctx a -> IO ()
legacyKeccak_resetCtx :: forall a. Ctx a -> IO ()
legacyKeccak_resetCtx (Ctx ForeignPtr Void
ctx) = do
    CInt
r <- ForeignPtr Void -> (Ptr Void -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO CInt) -> IO CInt)
-> (Ptr Void -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Void
ptr ->
        Ptr Void -> ConstPtr Any -> IO CInt
forall ctx a. Ptr ctx -> ConstPtr a -> IO CInt
c_keccak_EVP_DigestInit_ex Ptr Void
ptr ConstPtr Any
forall a. ConstPtr a
nullConstPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest re-initialization failed"
{-# INLINE legacyKeccak_resetCtx #-}

instance OpenSslDigest a => Hash (LegacyKeccak_Digest a) where
    initialize :: IO (Context (LegacyKeccak_Digest a))
initialize = Algorithm a -> IO (Ctx a)
forall a. Algorithm a -> IO (Ctx a)
legacyKeccak_initCtx (forall a. OpenSslDigest a => Algorithm a
algorithm @a)
    {-# INLINE initialize #-}

instance ResetableHash (LegacyKeccak_Digest a) where
    reset :: Context (LegacyKeccak_Digest a) -> IO ()
reset = Context (LegacyKeccak_Digest a) -> IO ()
Ctx a -> IO ()
forall a. Ctx a -> IO ()
legacyKeccak_resetCtx
    {-# INLINE reset #-}
#endif

-- -------------------------------------------------------------------------- --
-- Concrete Digests
-- -------------------------------------------------------------------------- --

-- -------------------------------------------------------------------------- --
-- SHA-2

-- $sha2
--
-- SHA-2 (Secure Hash Algorithm 2) is a family of cryptographic hash functions
-- standardized in NIST FIPS 180-4, first published in 2001. These functions
-- conform to NIST FIPS 180-4.
--
-- The following hash functions from the SHA-2 family are supported in
-- openssl-3.0 (cf. https://www.openssl.org/docs/man3.0/man3/EVP_sha224.html)
--
-- SHA2-224, SHA2-256, SHA2-512/224, SHA2-512/256, SHA2-384, SHA2-512


-- OpenSSL < 3.0 uses legacy algorithm names. This should be replaced in the
-- code when the support for older versions of OpenSSL is removed.

sha2_224 :: Algorithm Sha2_224
sha2_224 :: Algorithm Sha2_224
sha2_224 = IO (Algorithm Sha2_224) -> Algorithm Sha2_224
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha2_224) -> Algorithm Sha2_224)
-> IO (Algorithm Sha2_224) -> Algorithm Sha2_224
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha2_224)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA224"
{-# NOINLINE sha2_224 #-}

sha2_256 :: Algorithm Sha2_256
sha2_256 :: Algorithm Sha2_256
sha2_256 = IO (Algorithm Sha2_256) -> Algorithm Sha2_256
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha2_256) -> Algorithm Sha2_256)
-> IO (Algorithm Sha2_256) -> Algorithm Sha2_256
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha2_256)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA256"
{-# NOINLINE sha2_256 #-}

sha2_384 :: Algorithm Sha2_384
sha2_384 :: Algorithm Sha2_384
sha2_384 = IO (Algorithm Sha2_384) -> Algorithm Sha2_384
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha2_384) -> Algorithm Sha2_384)
-> IO (Algorithm Sha2_384) -> Algorithm Sha2_384
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha2_384)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA384"
{-# NOINLINE sha2_384 #-}

sha2_512 :: Algorithm Sha2_512
sha2_512 :: Algorithm Sha2_512
sha2_512 = IO (Algorithm Sha2_512) -> Algorithm Sha2_512
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha2_512) -> Algorithm Sha2_512)
-> IO (Algorithm Sha2_512) -> Algorithm Sha2_512
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha2_512)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA512"
{-# NOINLINE sha2_512 #-}

sha2_512_224 :: Algorithm Sha2_512_224
sha2_512_224 :: Algorithm Sha2_512_224
sha2_512_224 = IO (Algorithm Sha2_512_224) -> Algorithm Sha2_512_224
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha2_512_224) -> Algorithm Sha2_512_224)
-> IO (Algorithm Sha2_512_224) -> Algorithm Sha2_512_224
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha2_512_224)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA512-224"
{-# NOINLINE sha2_512_224 #-}

sha2_512_256 :: Algorithm Sha2_512_256
sha2_512_256 :: Algorithm Sha2_512_256
sha2_512_256 = IO (Algorithm Sha2_512_256) -> Algorithm Sha2_512_256
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha2_512_256) -> Algorithm Sha2_512_256)
-> IO (Algorithm Sha2_512_256) -> Algorithm Sha2_512_256
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha2_512_256)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA512-256"
{-# NOINLINE sha2_512_256 #-}

newtype Sha2_224 = Sha2_224 BS.ShortByteString
    deriving (Sha2_224 -> Sha2_224 -> Bool
(Sha2_224 -> Sha2_224 -> Bool)
-> (Sha2_224 -> Sha2_224 -> Bool) -> Eq Sha2_224
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha2_224 -> Sha2_224 -> Bool
== :: Sha2_224 -> Sha2_224 -> Bool
$c/= :: Sha2_224 -> Sha2_224 -> Bool
/= :: Sha2_224 -> Sha2_224 -> Bool
Eq, Eq Sha2_224
Eq Sha2_224 =>
(Sha2_224 -> Sha2_224 -> Ordering)
-> (Sha2_224 -> Sha2_224 -> Bool)
-> (Sha2_224 -> Sha2_224 -> Bool)
-> (Sha2_224 -> Sha2_224 -> Bool)
-> (Sha2_224 -> Sha2_224 -> Bool)
-> (Sha2_224 -> Sha2_224 -> Sha2_224)
-> (Sha2_224 -> Sha2_224 -> Sha2_224)
-> Ord Sha2_224
Sha2_224 -> Sha2_224 -> Bool
Sha2_224 -> Sha2_224 -> Ordering
Sha2_224 -> Sha2_224 -> Sha2_224
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha2_224 -> Sha2_224 -> Ordering
compare :: Sha2_224 -> Sha2_224 -> Ordering
$c< :: Sha2_224 -> Sha2_224 -> Bool
< :: Sha2_224 -> Sha2_224 -> Bool
$c<= :: Sha2_224 -> Sha2_224 -> Bool
<= :: Sha2_224 -> Sha2_224 -> Bool
$c> :: Sha2_224 -> Sha2_224 -> Bool
> :: Sha2_224 -> Sha2_224 -> Bool
$c>= :: Sha2_224 -> Sha2_224 -> Bool
>= :: Sha2_224 -> Sha2_224 -> Bool
$cmax :: Sha2_224 -> Sha2_224 -> Sha2_224
max :: Sha2_224 -> Sha2_224 -> Sha2_224
$cmin :: Sha2_224 -> Sha2_224 -> Sha2_224
min :: Sha2_224 -> Sha2_224 -> Sha2_224
Ord)
    deriving (Int -> Sha2_224 -> ShowS
[Sha2_224] -> ShowS
Sha2_224 -> String
(Int -> Sha2_224 -> ShowS)
-> (Sha2_224 -> String) -> ([Sha2_224] -> ShowS) -> Show Sha2_224
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha2_224 -> ShowS
showsPrec :: Int -> Sha2_224 -> ShowS
$cshow :: Sha2_224 -> String
show :: Sha2_224 -> String
$cshowList :: [Sha2_224] -> ShowS
showList :: [Sha2_224] -> ShowS
Show, String -> Sha2_224
(String -> Sha2_224) -> IsString Sha2_224
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha2_224
fromString :: String -> Sha2_224
IsString) via B16ShortByteString
    deriving (Context Sha2_224 -> IO Sha2_224
Context Sha2_224 -> Ptr Word8 -> Int -> IO ()
(Context Sha2_224 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha2_224 -> IO Sha2_224) -> IncrementalHash Sha2_224
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha2_224 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha2_224 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha2_224 -> IO Sha2_224
finalize :: Context Sha2_224 -> IO Sha2_224
IncrementalHash, IO (Context Sha2_224)
IncrementalHash Sha2_224
IncrementalHash Sha2_224 => IO (Context Sha2_224) -> Hash Sha2_224
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha2_224)
initialize :: IO (Context Sha2_224)
Hash, IncrementalHash Sha2_224
IncrementalHash Sha2_224 =>
(Context Sha2_224 -> IO ()) -> ResetableHash Sha2_224
Context Sha2_224 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha2_224 -> IO ()
reset :: Context Sha2_224 -> IO ()
ResetableHash) via (Digest Sha2_224)
instance OpenSslDigest Sha2_224 where algorithm :: Algorithm Sha2_224
algorithm = Algorithm Sha2_224
sha2_224

newtype Sha2_256 = Sha2_256 BS.ShortByteString
    deriving (Sha2_256 -> Sha2_256 -> Bool
(Sha2_256 -> Sha2_256 -> Bool)
-> (Sha2_256 -> Sha2_256 -> Bool) -> Eq Sha2_256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha2_256 -> Sha2_256 -> Bool
== :: Sha2_256 -> Sha2_256 -> Bool
$c/= :: Sha2_256 -> Sha2_256 -> Bool
/= :: Sha2_256 -> Sha2_256 -> Bool
Eq, Eq Sha2_256
Eq Sha2_256 =>
(Sha2_256 -> Sha2_256 -> Ordering)
-> (Sha2_256 -> Sha2_256 -> Bool)
-> (Sha2_256 -> Sha2_256 -> Bool)
-> (Sha2_256 -> Sha2_256 -> Bool)
-> (Sha2_256 -> Sha2_256 -> Bool)
-> (Sha2_256 -> Sha2_256 -> Sha2_256)
-> (Sha2_256 -> Sha2_256 -> Sha2_256)
-> Ord Sha2_256
Sha2_256 -> Sha2_256 -> Bool
Sha2_256 -> Sha2_256 -> Ordering
Sha2_256 -> Sha2_256 -> Sha2_256
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha2_256 -> Sha2_256 -> Ordering
compare :: Sha2_256 -> Sha2_256 -> Ordering
$c< :: Sha2_256 -> Sha2_256 -> Bool
< :: Sha2_256 -> Sha2_256 -> Bool
$c<= :: Sha2_256 -> Sha2_256 -> Bool
<= :: Sha2_256 -> Sha2_256 -> Bool
$c> :: Sha2_256 -> Sha2_256 -> Bool
> :: Sha2_256 -> Sha2_256 -> Bool
$c>= :: Sha2_256 -> Sha2_256 -> Bool
>= :: Sha2_256 -> Sha2_256 -> Bool
$cmax :: Sha2_256 -> Sha2_256 -> Sha2_256
max :: Sha2_256 -> Sha2_256 -> Sha2_256
$cmin :: Sha2_256 -> Sha2_256 -> Sha2_256
min :: Sha2_256 -> Sha2_256 -> Sha2_256
Ord)
    deriving (Int -> Sha2_256 -> ShowS
[Sha2_256] -> ShowS
Sha2_256 -> String
(Int -> Sha2_256 -> ShowS)
-> (Sha2_256 -> String) -> ([Sha2_256] -> ShowS) -> Show Sha2_256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha2_256 -> ShowS
showsPrec :: Int -> Sha2_256 -> ShowS
$cshow :: Sha2_256 -> String
show :: Sha2_256 -> String
$cshowList :: [Sha2_256] -> ShowS
showList :: [Sha2_256] -> ShowS
Show, String -> Sha2_256
(String -> Sha2_256) -> IsString Sha2_256
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha2_256
fromString :: String -> Sha2_256
IsString) via B16ShortByteString
    deriving (Context Sha2_256 -> IO Sha2_256
Context Sha2_256 -> Ptr Word8 -> Int -> IO ()
(Context Sha2_256 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha2_256 -> IO Sha2_256) -> IncrementalHash Sha2_256
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha2_256 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha2_256 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha2_256 -> IO Sha2_256
finalize :: Context Sha2_256 -> IO Sha2_256
IncrementalHash, IO (Context Sha2_256)
IncrementalHash Sha2_256
IncrementalHash Sha2_256 => IO (Context Sha2_256) -> Hash Sha2_256
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha2_256)
initialize :: IO (Context Sha2_256)
Hash, IncrementalHash Sha2_256
IncrementalHash Sha2_256 =>
(Context Sha2_256 -> IO ()) -> ResetableHash Sha2_256
Context Sha2_256 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha2_256 -> IO ()
reset :: Context Sha2_256 -> IO ()
ResetableHash) via (Digest Sha2_256)
instance OpenSslDigest Sha2_256 where algorithm :: Algorithm Sha2_256
algorithm = Algorithm Sha2_256
sha2_256

newtype Sha2_384 = Sha2_384 BS.ShortByteString
    deriving (Sha2_384 -> Sha2_384 -> Bool
(Sha2_384 -> Sha2_384 -> Bool)
-> (Sha2_384 -> Sha2_384 -> Bool) -> Eq Sha2_384
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha2_384 -> Sha2_384 -> Bool
== :: Sha2_384 -> Sha2_384 -> Bool
$c/= :: Sha2_384 -> Sha2_384 -> Bool
/= :: Sha2_384 -> Sha2_384 -> Bool
Eq, Eq Sha2_384
Eq Sha2_384 =>
(Sha2_384 -> Sha2_384 -> Ordering)
-> (Sha2_384 -> Sha2_384 -> Bool)
-> (Sha2_384 -> Sha2_384 -> Bool)
-> (Sha2_384 -> Sha2_384 -> Bool)
-> (Sha2_384 -> Sha2_384 -> Bool)
-> (Sha2_384 -> Sha2_384 -> Sha2_384)
-> (Sha2_384 -> Sha2_384 -> Sha2_384)
-> Ord Sha2_384
Sha2_384 -> Sha2_384 -> Bool
Sha2_384 -> Sha2_384 -> Ordering
Sha2_384 -> Sha2_384 -> Sha2_384
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha2_384 -> Sha2_384 -> Ordering
compare :: Sha2_384 -> Sha2_384 -> Ordering
$c< :: Sha2_384 -> Sha2_384 -> Bool
< :: Sha2_384 -> Sha2_384 -> Bool
$c<= :: Sha2_384 -> Sha2_384 -> Bool
<= :: Sha2_384 -> Sha2_384 -> Bool
$c> :: Sha2_384 -> Sha2_384 -> Bool
> :: Sha2_384 -> Sha2_384 -> Bool
$c>= :: Sha2_384 -> Sha2_384 -> Bool
>= :: Sha2_384 -> Sha2_384 -> Bool
$cmax :: Sha2_384 -> Sha2_384 -> Sha2_384
max :: Sha2_384 -> Sha2_384 -> Sha2_384
$cmin :: Sha2_384 -> Sha2_384 -> Sha2_384
min :: Sha2_384 -> Sha2_384 -> Sha2_384
Ord)
    deriving (Int -> Sha2_384 -> ShowS
[Sha2_384] -> ShowS
Sha2_384 -> String
(Int -> Sha2_384 -> ShowS)
-> (Sha2_384 -> String) -> ([Sha2_384] -> ShowS) -> Show Sha2_384
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha2_384 -> ShowS
showsPrec :: Int -> Sha2_384 -> ShowS
$cshow :: Sha2_384 -> String
show :: Sha2_384 -> String
$cshowList :: [Sha2_384] -> ShowS
showList :: [Sha2_384] -> ShowS
Show, String -> Sha2_384
(String -> Sha2_384) -> IsString Sha2_384
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha2_384
fromString :: String -> Sha2_384
IsString) via B16ShortByteString
    deriving (Context Sha2_384 -> IO Sha2_384
Context Sha2_384 -> Ptr Word8 -> Int -> IO ()
(Context Sha2_384 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha2_384 -> IO Sha2_384) -> IncrementalHash Sha2_384
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha2_384 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha2_384 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha2_384 -> IO Sha2_384
finalize :: Context Sha2_384 -> IO Sha2_384
IncrementalHash, IO (Context Sha2_384)
IncrementalHash Sha2_384
IncrementalHash Sha2_384 => IO (Context Sha2_384) -> Hash Sha2_384
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha2_384)
initialize :: IO (Context Sha2_384)
Hash, IncrementalHash Sha2_384
IncrementalHash Sha2_384 =>
(Context Sha2_384 -> IO ()) -> ResetableHash Sha2_384
Context Sha2_384 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha2_384 -> IO ()
reset :: Context Sha2_384 -> IO ()
ResetableHash) via (Digest Sha2_384)
instance OpenSslDigest Sha2_384 where algorithm :: Algorithm Sha2_384
algorithm = Algorithm Sha2_384
sha2_384

newtype Sha2_512 = Sha2_512 BS.ShortByteString
    deriving (Sha2_512 -> Sha2_512 -> Bool
(Sha2_512 -> Sha2_512 -> Bool)
-> (Sha2_512 -> Sha2_512 -> Bool) -> Eq Sha2_512
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha2_512 -> Sha2_512 -> Bool
== :: Sha2_512 -> Sha2_512 -> Bool
$c/= :: Sha2_512 -> Sha2_512 -> Bool
/= :: Sha2_512 -> Sha2_512 -> Bool
Eq, Eq Sha2_512
Eq Sha2_512 =>
(Sha2_512 -> Sha2_512 -> Ordering)
-> (Sha2_512 -> Sha2_512 -> Bool)
-> (Sha2_512 -> Sha2_512 -> Bool)
-> (Sha2_512 -> Sha2_512 -> Bool)
-> (Sha2_512 -> Sha2_512 -> Bool)
-> (Sha2_512 -> Sha2_512 -> Sha2_512)
-> (Sha2_512 -> Sha2_512 -> Sha2_512)
-> Ord Sha2_512
Sha2_512 -> Sha2_512 -> Bool
Sha2_512 -> Sha2_512 -> Ordering
Sha2_512 -> Sha2_512 -> Sha2_512
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha2_512 -> Sha2_512 -> Ordering
compare :: Sha2_512 -> Sha2_512 -> Ordering
$c< :: Sha2_512 -> Sha2_512 -> Bool
< :: Sha2_512 -> Sha2_512 -> Bool
$c<= :: Sha2_512 -> Sha2_512 -> Bool
<= :: Sha2_512 -> Sha2_512 -> Bool
$c> :: Sha2_512 -> Sha2_512 -> Bool
> :: Sha2_512 -> Sha2_512 -> Bool
$c>= :: Sha2_512 -> Sha2_512 -> Bool
>= :: Sha2_512 -> Sha2_512 -> Bool
$cmax :: Sha2_512 -> Sha2_512 -> Sha2_512
max :: Sha2_512 -> Sha2_512 -> Sha2_512
$cmin :: Sha2_512 -> Sha2_512 -> Sha2_512
min :: Sha2_512 -> Sha2_512 -> Sha2_512
Ord)
    deriving (Int -> Sha2_512 -> ShowS
[Sha2_512] -> ShowS
Sha2_512 -> String
(Int -> Sha2_512 -> ShowS)
-> (Sha2_512 -> String) -> ([Sha2_512] -> ShowS) -> Show Sha2_512
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha2_512 -> ShowS
showsPrec :: Int -> Sha2_512 -> ShowS
$cshow :: Sha2_512 -> String
show :: Sha2_512 -> String
$cshowList :: [Sha2_512] -> ShowS
showList :: [Sha2_512] -> ShowS
Show, String -> Sha2_512
(String -> Sha2_512) -> IsString Sha2_512
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha2_512
fromString :: String -> Sha2_512
IsString) via B16ShortByteString
    deriving (Context Sha2_512 -> IO Sha2_512
Context Sha2_512 -> Ptr Word8 -> Int -> IO ()
(Context Sha2_512 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha2_512 -> IO Sha2_512) -> IncrementalHash Sha2_512
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha2_512 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha2_512 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha2_512 -> IO Sha2_512
finalize :: Context Sha2_512 -> IO Sha2_512
IncrementalHash, IO (Context Sha2_512)
IncrementalHash Sha2_512
IncrementalHash Sha2_512 => IO (Context Sha2_512) -> Hash Sha2_512
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha2_512)
initialize :: IO (Context Sha2_512)
Hash, IncrementalHash Sha2_512
IncrementalHash Sha2_512 =>
(Context Sha2_512 -> IO ()) -> ResetableHash Sha2_512
Context Sha2_512 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha2_512 -> IO ()
reset :: Context Sha2_512 -> IO ()
ResetableHash) via (Digest Sha2_512)
instance OpenSslDigest Sha2_512 where algorithm :: Algorithm Sha2_512
algorithm = Algorithm Sha2_512
sha2_512

newtype Sha2_512_224 = Sha2_512_224 BS.ShortByteString
    deriving (Sha2_512_224 -> Sha2_512_224 -> Bool
(Sha2_512_224 -> Sha2_512_224 -> Bool)
-> (Sha2_512_224 -> Sha2_512_224 -> Bool) -> Eq Sha2_512_224
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha2_512_224 -> Sha2_512_224 -> Bool
== :: Sha2_512_224 -> Sha2_512_224 -> Bool
$c/= :: Sha2_512_224 -> Sha2_512_224 -> Bool
/= :: Sha2_512_224 -> Sha2_512_224 -> Bool
Eq, Eq Sha2_512_224
Eq Sha2_512_224 =>
(Sha2_512_224 -> Sha2_512_224 -> Ordering)
-> (Sha2_512_224 -> Sha2_512_224 -> Bool)
-> (Sha2_512_224 -> Sha2_512_224 -> Bool)
-> (Sha2_512_224 -> Sha2_512_224 -> Bool)
-> (Sha2_512_224 -> Sha2_512_224 -> Bool)
-> (Sha2_512_224 -> Sha2_512_224 -> Sha2_512_224)
-> (Sha2_512_224 -> Sha2_512_224 -> Sha2_512_224)
-> Ord Sha2_512_224
Sha2_512_224 -> Sha2_512_224 -> Bool
Sha2_512_224 -> Sha2_512_224 -> Ordering
Sha2_512_224 -> Sha2_512_224 -> Sha2_512_224
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha2_512_224 -> Sha2_512_224 -> Ordering
compare :: Sha2_512_224 -> Sha2_512_224 -> Ordering
$c< :: Sha2_512_224 -> Sha2_512_224 -> Bool
< :: Sha2_512_224 -> Sha2_512_224 -> Bool
$c<= :: Sha2_512_224 -> Sha2_512_224 -> Bool
<= :: Sha2_512_224 -> Sha2_512_224 -> Bool
$c> :: Sha2_512_224 -> Sha2_512_224 -> Bool
> :: Sha2_512_224 -> Sha2_512_224 -> Bool
$c>= :: Sha2_512_224 -> Sha2_512_224 -> Bool
>= :: Sha2_512_224 -> Sha2_512_224 -> Bool
$cmax :: Sha2_512_224 -> Sha2_512_224 -> Sha2_512_224
max :: Sha2_512_224 -> Sha2_512_224 -> Sha2_512_224
$cmin :: Sha2_512_224 -> Sha2_512_224 -> Sha2_512_224
min :: Sha2_512_224 -> Sha2_512_224 -> Sha2_512_224
Ord)
    deriving (Int -> Sha2_512_224 -> ShowS
[Sha2_512_224] -> ShowS
Sha2_512_224 -> String
(Int -> Sha2_512_224 -> ShowS)
-> (Sha2_512_224 -> String)
-> ([Sha2_512_224] -> ShowS)
-> Show Sha2_512_224
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha2_512_224 -> ShowS
showsPrec :: Int -> Sha2_512_224 -> ShowS
$cshow :: Sha2_512_224 -> String
show :: Sha2_512_224 -> String
$cshowList :: [Sha2_512_224] -> ShowS
showList :: [Sha2_512_224] -> ShowS
Show, String -> Sha2_512_224
(String -> Sha2_512_224) -> IsString Sha2_512_224
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha2_512_224
fromString :: String -> Sha2_512_224
IsString) via B16ShortByteString
    deriving (Context Sha2_512_224 -> IO Sha2_512_224
Context Sha2_512_224 -> Ptr Word8 -> Int -> IO ()
(Context Sha2_512_224 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha2_512_224 -> IO Sha2_512_224)
-> IncrementalHash Sha2_512_224
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha2_512_224 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha2_512_224 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha2_512_224 -> IO Sha2_512_224
finalize :: Context Sha2_512_224 -> IO Sha2_512_224
IncrementalHash, IO (Context Sha2_512_224)
IncrementalHash Sha2_512_224
IncrementalHash Sha2_512_224 =>
IO (Context Sha2_512_224) -> Hash Sha2_512_224
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha2_512_224)
initialize :: IO (Context Sha2_512_224)
Hash, IncrementalHash Sha2_512_224
IncrementalHash Sha2_512_224 =>
(Context Sha2_512_224 -> IO ()) -> ResetableHash Sha2_512_224
Context Sha2_512_224 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha2_512_224 -> IO ()
reset :: Context Sha2_512_224 -> IO ()
ResetableHash) via (Digest Sha2_512_224)
instance OpenSslDigest Sha2_512_224 where algorithm :: Algorithm Sha2_512_224
algorithm = Algorithm Sha2_512_224
sha2_512_224

newtype Sha2_512_256 = Sha2_512_256 BS.ShortByteString
    deriving (Sha2_512_256 -> Sha2_512_256 -> Bool
(Sha2_512_256 -> Sha2_512_256 -> Bool)
-> (Sha2_512_256 -> Sha2_512_256 -> Bool) -> Eq Sha2_512_256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha2_512_256 -> Sha2_512_256 -> Bool
== :: Sha2_512_256 -> Sha2_512_256 -> Bool
$c/= :: Sha2_512_256 -> Sha2_512_256 -> Bool
/= :: Sha2_512_256 -> Sha2_512_256 -> Bool
Eq, Eq Sha2_512_256
Eq Sha2_512_256 =>
(Sha2_512_256 -> Sha2_512_256 -> Ordering)
-> (Sha2_512_256 -> Sha2_512_256 -> Bool)
-> (Sha2_512_256 -> Sha2_512_256 -> Bool)
-> (Sha2_512_256 -> Sha2_512_256 -> Bool)
-> (Sha2_512_256 -> Sha2_512_256 -> Bool)
-> (Sha2_512_256 -> Sha2_512_256 -> Sha2_512_256)
-> (Sha2_512_256 -> Sha2_512_256 -> Sha2_512_256)
-> Ord Sha2_512_256
Sha2_512_256 -> Sha2_512_256 -> Bool
Sha2_512_256 -> Sha2_512_256 -> Ordering
Sha2_512_256 -> Sha2_512_256 -> Sha2_512_256
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha2_512_256 -> Sha2_512_256 -> Ordering
compare :: Sha2_512_256 -> Sha2_512_256 -> Ordering
$c< :: Sha2_512_256 -> Sha2_512_256 -> Bool
< :: Sha2_512_256 -> Sha2_512_256 -> Bool
$c<= :: Sha2_512_256 -> Sha2_512_256 -> Bool
<= :: Sha2_512_256 -> Sha2_512_256 -> Bool
$c> :: Sha2_512_256 -> Sha2_512_256 -> Bool
> :: Sha2_512_256 -> Sha2_512_256 -> Bool
$c>= :: Sha2_512_256 -> Sha2_512_256 -> Bool
>= :: Sha2_512_256 -> Sha2_512_256 -> Bool
$cmax :: Sha2_512_256 -> Sha2_512_256 -> Sha2_512_256
max :: Sha2_512_256 -> Sha2_512_256 -> Sha2_512_256
$cmin :: Sha2_512_256 -> Sha2_512_256 -> Sha2_512_256
min :: Sha2_512_256 -> Sha2_512_256 -> Sha2_512_256
Ord)
    deriving (Int -> Sha2_512_256 -> ShowS
[Sha2_512_256] -> ShowS
Sha2_512_256 -> String
(Int -> Sha2_512_256 -> ShowS)
-> (Sha2_512_256 -> String)
-> ([Sha2_512_256] -> ShowS)
-> Show Sha2_512_256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha2_512_256 -> ShowS
showsPrec :: Int -> Sha2_512_256 -> ShowS
$cshow :: Sha2_512_256 -> String
show :: Sha2_512_256 -> String
$cshowList :: [Sha2_512_256] -> ShowS
showList :: [Sha2_512_256] -> ShowS
Show, String -> Sha2_512_256
(String -> Sha2_512_256) -> IsString Sha2_512_256
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha2_512_256
fromString :: String -> Sha2_512_256
IsString) via B16ShortByteString
    deriving (Context Sha2_512_256 -> IO Sha2_512_256
Context Sha2_512_256 -> Ptr Word8 -> Int -> IO ()
(Context Sha2_512_256 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha2_512_256 -> IO Sha2_512_256)
-> IncrementalHash Sha2_512_256
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha2_512_256 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha2_512_256 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha2_512_256 -> IO Sha2_512_256
finalize :: Context Sha2_512_256 -> IO Sha2_512_256
IncrementalHash, IO (Context Sha2_512_256)
IncrementalHash Sha2_512_256
IncrementalHash Sha2_512_256 =>
IO (Context Sha2_512_256) -> Hash Sha2_512_256
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha2_512_256)
initialize :: IO (Context Sha2_512_256)
Hash, IncrementalHash Sha2_512_256
IncrementalHash Sha2_512_256 =>
(Context Sha2_512_256 -> IO ()) -> ResetableHash Sha2_512_256
Context Sha2_512_256 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha2_512_256 -> IO ()
reset :: Context Sha2_512_256 -> IO ()
ResetableHash) via (Digest Sha2_512_256)
instance OpenSslDigest Sha2_512_256 where algorithm :: Algorithm Sha2_512_256
algorithm = Algorithm Sha2_512_256
sha2_512_256

-- -------------------------------------------------------------------------- --
-- SHA-3

-- $sha3
--
-- SHA-3 (Secure Hash Algorithm 3) is a family of cryptographic hash functions
-- standardized in NIST FIPS 202, first published in 2015. It is based on the
-- Keccak algorithm. These functions conform to NIST FIPS 202.
--
-- The following hash functions from the SHA-3 family are supported in
-- openssl-3.0 (cf. https://www.openssl.org/docs/man3.0/man3/EVP_sha3_224.html)
--
-- SHA3-3_224, SHA3-3_256, SHA3-3_384, SHA3-3_512, SHAKE128, SHAKE256

sha3_224 :: Algorithm Sha3_224
sha3_224 :: Algorithm Sha3_224
sha3_224 = IO (Algorithm Sha3_224) -> Algorithm Sha3_224
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha3_224) -> Algorithm Sha3_224)
-> IO (Algorithm Sha3_224) -> Algorithm Sha3_224
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha3_224)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA3-224"
{-# NOINLINE sha3_224 #-}

sha3_256 :: Algorithm Sha3_256
sha3_256 :: Algorithm Sha3_256
sha3_256 = IO (Algorithm Sha3_256) -> Algorithm Sha3_256
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha3_256) -> Algorithm Sha3_256)
-> IO (Algorithm Sha3_256) -> Algorithm Sha3_256
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha3_256)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA3-256"
{-# NOINLINE sha3_256 #-}

sha3_384 :: Algorithm Sha3_384
sha3_384 :: Algorithm Sha3_384
sha3_384 = IO (Algorithm Sha3_384) -> Algorithm Sha3_384
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha3_384) -> Algorithm Sha3_384)
-> IO (Algorithm Sha3_384) -> Algorithm Sha3_384
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha3_384)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA3-384"
{-# NOINLINE sha3_384 #-}

sha3_512 :: Algorithm Sha3_512
sha3_512 :: Algorithm Sha3_512
sha3_512 = IO (Algorithm Sha3_512) -> Algorithm Sha3_512
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Sha3_512) -> Algorithm Sha3_512)
-> IO (Algorithm Sha3_512) -> Algorithm Sha3_512
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Sha3_512)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHA3-512"
{-# NOINLINE sha3_512 #-}

shake128 :: Algorithm (Shake128 n)
shake128 :: forall (n :: Natural). Algorithm (Shake128 n)
shake128 = IO (Algorithm (Shake128 n)) -> Algorithm (Shake128 n)
forall a. IO a -> a
unsafePerformIO (IO (Algorithm (Shake128 n)) -> Algorithm (Shake128 n))
-> IO (Algorithm (Shake128 n)) -> Algorithm (Shake128 n)
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm (Shake128 n))
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHAKE128"
{-# NOINLINE shake128 #-}

shake256 :: Algorithm (Shake256 n)
shake256 :: forall (n :: Natural). Algorithm (Shake256 n)
shake256 = IO (Algorithm (Shake256 n)) -> Algorithm (Shake256 n)
forall a. IO a -> a
unsafePerformIO (IO (Algorithm (Shake256 n)) -> Algorithm (Shake256 n))
-> IO (Algorithm (Shake256 n)) -> Algorithm (Shake256 n)
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm (Shake256 n))
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"SHAKE256"
{-# NOINLINE shake256 #-}

newtype Sha3_224 = Sha3_224 BS.ShortByteString
    deriving (Sha3_224 -> Sha3_224 -> Bool
(Sha3_224 -> Sha3_224 -> Bool)
-> (Sha3_224 -> Sha3_224 -> Bool) -> Eq Sha3_224
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha3_224 -> Sha3_224 -> Bool
== :: Sha3_224 -> Sha3_224 -> Bool
$c/= :: Sha3_224 -> Sha3_224 -> Bool
/= :: Sha3_224 -> Sha3_224 -> Bool
Eq, Eq Sha3_224
Eq Sha3_224 =>
(Sha3_224 -> Sha3_224 -> Ordering)
-> (Sha3_224 -> Sha3_224 -> Bool)
-> (Sha3_224 -> Sha3_224 -> Bool)
-> (Sha3_224 -> Sha3_224 -> Bool)
-> (Sha3_224 -> Sha3_224 -> Bool)
-> (Sha3_224 -> Sha3_224 -> Sha3_224)
-> (Sha3_224 -> Sha3_224 -> Sha3_224)
-> Ord Sha3_224
Sha3_224 -> Sha3_224 -> Bool
Sha3_224 -> Sha3_224 -> Ordering
Sha3_224 -> Sha3_224 -> Sha3_224
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha3_224 -> Sha3_224 -> Ordering
compare :: Sha3_224 -> Sha3_224 -> Ordering
$c< :: Sha3_224 -> Sha3_224 -> Bool
< :: Sha3_224 -> Sha3_224 -> Bool
$c<= :: Sha3_224 -> Sha3_224 -> Bool
<= :: Sha3_224 -> Sha3_224 -> Bool
$c> :: Sha3_224 -> Sha3_224 -> Bool
> :: Sha3_224 -> Sha3_224 -> Bool
$c>= :: Sha3_224 -> Sha3_224 -> Bool
>= :: Sha3_224 -> Sha3_224 -> Bool
$cmax :: Sha3_224 -> Sha3_224 -> Sha3_224
max :: Sha3_224 -> Sha3_224 -> Sha3_224
$cmin :: Sha3_224 -> Sha3_224 -> Sha3_224
min :: Sha3_224 -> Sha3_224 -> Sha3_224
Ord)
    deriving (Int -> Sha3_224 -> ShowS
[Sha3_224] -> ShowS
Sha3_224 -> String
(Int -> Sha3_224 -> ShowS)
-> (Sha3_224 -> String) -> ([Sha3_224] -> ShowS) -> Show Sha3_224
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha3_224 -> ShowS
showsPrec :: Int -> Sha3_224 -> ShowS
$cshow :: Sha3_224 -> String
show :: Sha3_224 -> String
$cshowList :: [Sha3_224] -> ShowS
showList :: [Sha3_224] -> ShowS
Show, String -> Sha3_224
(String -> Sha3_224) -> IsString Sha3_224
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha3_224
fromString :: String -> Sha3_224
IsString) via B16ShortByteString
    deriving (Context Sha3_224 -> IO Sha3_224
Context Sha3_224 -> Ptr Word8 -> Int -> IO ()
(Context Sha3_224 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha3_224 -> IO Sha3_224) -> IncrementalHash Sha3_224
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha3_224 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha3_224 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha3_224 -> IO Sha3_224
finalize :: Context Sha3_224 -> IO Sha3_224
IncrementalHash, IO (Context Sha3_224)
IncrementalHash Sha3_224
IncrementalHash Sha3_224 => IO (Context Sha3_224) -> Hash Sha3_224
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha3_224)
initialize :: IO (Context Sha3_224)
Hash, IncrementalHash Sha3_224
IncrementalHash Sha3_224 =>
(Context Sha3_224 -> IO ()) -> ResetableHash Sha3_224
Context Sha3_224 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha3_224 -> IO ()
reset :: Context Sha3_224 -> IO ()
ResetableHash) via (Digest Sha3_224)
instance OpenSslDigest Sha3_224 where algorithm :: Algorithm Sha3_224
algorithm = Algorithm Sha3_224
sha3_224

newtype Sha3_256 = Sha3_256 BS.ShortByteString
    deriving (Sha3_256 -> Sha3_256 -> Bool
(Sha3_256 -> Sha3_256 -> Bool)
-> (Sha3_256 -> Sha3_256 -> Bool) -> Eq Sha3_256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha3_256 -> Sha3_256 -> Bool
== :: Sha3_256 -> Sha3_256 -> Bool
$c/= :: Sha3_256 -> Sha3_256 -> Bool
/= :: Sha3_256 -> Sha3_256 -> Bool
Eq, Eq Sha3_256
Eq Sha3_256 =>
(Sha3_256 -> Sha3_256 -> Ordering)
-> (Sha3_256 -> Sha3_256 -> Bool)
-> (Sha3_256 -> Sha3_256 -> Bool)
-> (Sha3_256 -> Sha3_256 -> Bool)
-> (Sha3_256 -> Sha3_256 -> Bool)
-> (Sha3_256 -> Sha3_256 -> Sha3_256)
-> (Sha3_256 -> Sha3_256 -> Sha3_256)
-> Ord Sha3_256
Sha3_256 -> Sha3_256 -> Bool
Sha3_256 -> Sha3_256 -> Ordering
Sha3_256 -> Sha3_256 -> Sha3_256
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha3_256 -> Sha3_256 -> Ordering
compare :: Sha3_256 -> Sha3_256 -> Ordering
$c< :: Sha3_256 -> Sha3_256 -> Bool
< :: Sha3_256 -> Sha3_256 -> Bool
$c<= :: Sha3_256 -> Sha3_256 -> Bool
<= :: Sha3_256 -> Sha3_256 -> Bool
$c> :: Sha3_256 -> Sha3_256 -> Bool
> :: Sha3_256 -> Sha3_256 -> Bool
$c>= :: Sha3_256 -> Sha3_256 -> Bool
>= :: Sha3_256 -> Sha3_256 -> Bool
$cmax :: Sha3_256 -> Sha3_256 -> Sha3_256
max :: Sha3_256 -> Sha3_256 -> Sha3_256
$cmin :: Sha3_256 -> Sha3_256 -> Sha3_256
min :: Sha3_256 -> Sha3_256 -> Sha3_256
Ord)
    deriving (Int -> Sha3_256 -> ShowS
[Sha3_256] -> ShowS
Sha3_256 -> String
(Int -> Sha3_256 -> ShowS)
-> (Sha3_256 -> String) -> ([Sha3_256] -> ShowS) -> Show Sha3_256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha3_256 -> ShowS
showsPrec :: Int -> Sha3_256 -> ShowS
$cshow :: Sha3_256 -> String
show :: Sha3_256 -> String
$cshowList :: [Sha3_256] -> ShowS
showList :: [Sha3_256] -> ShowS
Show, String -> Sha3_256
(String -> Sha3_256) -> IsString Sha3_256
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha3_256
fromString :: String -> Sha3_256
IsString) via B16ShortByteString
    deriving (Context Sha3_256 -> IO Sha3_256
Context Sha3_256 -> Ptr Word8 -> Int -> IO ()
(Context Sha3_256 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha3_256 -> IO Sha3_256) -> IncrementalHash Sha3_256
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha3_256 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha3_256 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha3_256 -> IO Sha3_256
finalize :: Context Sha3_256 -> IO Sha3_256
IncrementalHash, IO (Context Sha3_256)
IncrementalHash Sha3_256
IncrementalHash Sha3_256 => IO (Context Sha3_256) -> Hash Sha3_256
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha3_256)
initialize :: IO (Context Sha3_256)
Hash, IncrementalHash Sha3_256
IncrementalHash Sha3_256 =>
(Context Sha3_256 -> IO ()) -> ResetableHash Sha3_256
Context Sha3_256 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha3_256 -> IO ()
reset :: Context Sha3_256 -> IO ()
ResetableHash) via (Digest Sha3_256)
instance OpenSslDigest Sha3_256 where algorithm :: Algorithm Sha3_256
algorithm = Algorithm Sha3_256
sha3_256

newtype Sha3_384 = Sha3_384 BS.ShortByteString
    deriving (Sha3_384 -> Sha3_384 -> Bool
(Sha3_384 -> Sha3_384 -> Bool)
-> (Sha3_384 -> Sha3_384 -> Bool) -> Eq Sha3_384
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha3_384 -> Sha3_384 -> Bool
== :: Sha3_384 -> Sha3_384 -> Bool
$c/= :: Sha3_384 -> Sha3_384 -> Bool
/= :: Sha3_384 -> Sha3_384 -> Bool
Eq, Eq Sha3_384
Eq Sha3_384 =>
(Sha3_384 -> Sha3_384 -> Ordering)
-> (Sha3_384 -> Sha3_384 -> Bool)
-> (Sha3_384 -> Sha3_384 -> Bool)
-> (Sha3_384 -> Sha3_384 -> Bool)
-> (Sha3_384 -> Sha3_384 -> Bool)
-> (Sha3_384 -> Sha3_384 -> Sha3_384)
-> (Sha3_384 -> Sha3_384 -> Sha3_384)
-> Ord Sha3_384
Sha3_384 -> Sha3_384 -> Bool
Sha3_384 -> Sha3_384 -> Ordering
Sha3_384 -> Sha3_384 -> Sha3_384
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha3_384 -> Sha3_384 -> Ordering
compare :: Sha3_384 -> Sha3_384 -> Ordering
$c< :: Sha3_384 -> Sha3_384 -> Bool
< :: Sha3_384 -> Sha3_384 -> Bool
$c<= :: Sha3_384 -> Sha3_384 -> Bool
<= :: Sha3_384 -> Sha3_384 -> Bool
$c> :: Sha3_384 -> Sha3_384 -> Bool
> :: Sha3_384 -> Sha3_384 -> Bool
$c>= :: Sha3_384 -> Sha3_384 -> Bool
>= :: Sha3_384 -> Sha3_384 -> Bool
$cmax :: Sha3_384 -> Sha3_384 -> Sha3_384
max :: Sha3_384 -> Sha3_384 -> Sha3_384
$cmin :: Sha3_384 -> Sha3_384 -> Sha3_384
min :: Sha3_384 -> Sha3_384 -> Sha3_384
Ord)
    deriving (Int -> Sha3_384 -> ShowS
[Sha3_384] -> ShowS
Sha3_384 -> String
(Int -> Sha3_384 -> ShowS)
-> (Sha3_384 -> String) -> ([Sha3_384] -> ShowS) -> Show Sha3_384
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha3_384 -> ShowS
showsPrec :: Int -> Sha3_384 -> ShowS
$cshow :: Sha3_384 -> String
show :: Sha3_384 -> String
$cshowList :: [Sha3_384] -> ShowS
showList :: [Sha3_384] -> ShowS
Show, String -> Sha3_384
(String -> Sha3_384) -> IsString Sha3_384
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha3_384
fromString :: String -> Sha3_384
IsString) via B16ShortByteString
    deriving (Context Sha3_384 -> IO Sha3_384
Context Sha3_384 -> Ptr Word8 -> Int -> IO ()
(Context Sha3_384 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha3_384 -> IO Sha3_384) -> IncrementalHash Sha3_384
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha3_384 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha3_384 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha3_384 -> IO Sha3_384
finalize :: Context Sha3_384 -> IO Sha3_384
IncrementalHash, IO (Context Sha3_384)
IncrementalHash Sha3_384
IncrementalHash Sha3_384 => IO (Context Sha3_384) -> Hash Sha3_384
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha3_384)
initialize :: IO (Context Sha3_384)
Hash, IncrementalHash Sha3_384
IncrementalHash Sha3_384 =>
(Context Sha3_384 -> IO ()) -> ResetableHash Sha3_384
Context Sha3_384 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha3_384 -> IO ()
reset :: Context Sha3_384 -> IO ()
ResetableHash) via (Digest Sha3_384)
instance OpenSslDigest Sha3_384 where algorithm :: Algorithm Sha3_384
algorithm = Algorithm Sha3_384
sha3_384

newtype Sha3_512 = Sha3_512 BS.ShortByteString
    deriving (Sha3_512 -> Sha3_512 -> Bool
(Sha3_512 -> Sha3_512 -> Bool)
-> (Sha3_512 -> Sha3_512 -> Bool) -> Eq Sha3_512
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha3_512 -> Sha3_512 -> Bool
== :: Sha3_512 -> Sha3_512 -> Bool
$c/= :: Sha3_512 -> Sha3_512 -> Bool
/= :: Sha3_512 -> Sha3_512 -> Bool
Eq, Eq Sha3_512
Eq Sha3_512 =>
(Sha3_512 -> Sha3_512 -> Ordering)
-> (Sha3_512 -> Sha3_512 -> Bool)
-> (Sha3_512 -> Sha3_512 -> Bool)
-> (Sha3_512 -> Sha3_512 -> Bool)
-> (Sha3_512 -> Sha3_512 -> Bool)
-> (Sha3_512 -> Sha3_512 -> Sha3_512)
-> (Sha3_512 -> Sha3_512 -> Sha3_512)
-> Ord Sha3_512
Sha3_512 -> Sha3_512 -> Bool
Sha3_512 -> Sha3_512 -> Ordering
Sha3_512 -> Sha3_512 -> Sha3_512
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha3_512 -> Sha3_512 -> Ordering
compare :: Sha3_512 -> Sha3_512 -> Ordering
$c< :: Sha3_512 -> Sha3_512 -> Bool
< :: Sha3_512 -> Sha3_512 -> Bool
$c<= :: Sha3_512 -> Sha3_512 -> Bool
<= :: Sha3_512 -> Sha3_512 -> Bool
$c> :: Sha3_512 -> Sha3_512 -> Bool
> :: Sha3_512 -> Sha3_512 -> Bool
$c>= :: Sha3_512 -> Sha3_512 -> Bool
>= :: Sha3_512 -> Sha3_512 -> Bool
$cmax :: Sha3_512 -> Sha3_512 -> Sha3_512
max :: Sha3_512 -> Sha3_512 -> Sha3_512
$cmin :: Sha3_512 -> Sha3_512 -> Sha3_512
min :: Sha3_512 -> Sha3_512 -> Sha3_512
Ord)
    deriving (Int -> Sha3_512 -> ShowS
[Sha3_512] -> ShowS
Sha3_512 -> String
(Int -> Sha3_512 -> ShowS)
-> (Sha3_512 -> String) -> ([Sha3_512] -> ShowS) -> Show Sha3_512
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha3_512 -> ShowS
showsPrec :: Int -> Sha3_512 -> ShowS
$cshow :: Sha3_512 -> String
show :: Sha3_512 -> String
$cshowList :: [Sha3_512] -> ShowS
showList :: [Sha3_512] -> ShowS
Show, String -> Sha3_512
(String -> Sha3_512) -> IsString Sha3_512
forall a. (String -> a) -> IsString a
$cfromString :: String -> Sha3_512
fromString :: String -> Sha3_512
IsString) via B16ShortByteString
    deriving (Context Sha3_512 -> IO Sha3_512
Context Sha3_512 -> Ptr Word8 -> Int -> IO ()
(Context Sha3_512 -> Ptr Word8 -> Int -> IO ())
-> (Context Sha3_512 -> IO Sha3_512) -> IncrementalHash Sha3_512
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Sha3_512 -> Ptr Word8 -> Int -> IO ()
update :: Context Sha3_512 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Sha3_512 -> IO Sha3_512
finalize :: Context Sha3_512 -> IO Sha3_512
IncrementalHash, IO (Context Sha3_512)
IncrementalHash Sha3_512
IncrementalHash Sha3_512 => IO (Context Sha3_512) -> Hash Sha3_512
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Sha3_512)
initialize :: IO (Context Sha3_512)
Hash, IncrementalHash Sha3_512
IncrementalHash Sha3_512 =>
(Context Sha3_512 -> IO ()) -> ResetableHash Sha3_512
Context Sha3_512 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Sha3_512 -> IO ()
reset :: Context Sha3_512 -> IO ()
ResetableHash) via (Digest Sha3_512)
instance OpenSslDigest Sha3_512 where algorithm :: Algorithm Sha3_512
algorithm = Algorithm Sha3_512
sha3_512

newtype Shake128 (bits :: Natural) = Shake128 BS.ShortByteString
    deriving (Shake128 bits -> Shake128 bits -> Bool
(Shake128 bits -> Shake128 bits -> Bool)
-> (Shake128 bits -> Shake128 bits -> Bool) -> Eq (Shake128 bits)
forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
== :: Shake128 bits -> Shake128 bits -> Bool
$c/= :: forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
/= :: Shake128 bits -> Shake128 bits -> Bool
Eq, Eq (Shake128 bits)
Eq (Shake128 bits) =>
(Shake128 bits -> Shake128 bits -> Ordering)
-> (Shake128 bits -> Shake128 bits -> Bool)
-> (Shake128 bits -> Shake128 bits -> Bool)
-> (Shake128 bits -> Shake128 bits -> Bool)
-> (Shake128 bits -> Shake128 bits -> Bool)
-> (Shake128 bits -> Shake128 bits -> Shake128 bits)
-> (Shake128 bits -> Shake128 bits -> Shake128 bits)
-> Ord (Shake128 bits)
Shake128 bits -> Shake128 bits -> Bool
Shake128 bits -> Shake128 bits -> Ordering
Shake128 bits -> Shake128 bits -> Shake128 bits
forall (bits :: Natural). Eq (Shake128 bits)
forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
forall (bits :: Natural).
Shake128 bits -> Shake128 bits -> Ordering
forall (bits :: Natural).
Shake128 bits -> Shake128 bits -> Shake128 bits
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: forall (bits :: Natural).
Shake128 bits -> Shake128 bits -> Ordering
compare :: Shake128 bits -> Shake128 bits -> Ordering
$c< :: forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
< :: Shake128 bits -> Shake128 bits -> Bool
$c<= :: forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
<= :: Shake128 bits -> Shake128 bits -> Bool
$c> :: forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
> :: Shake128 bits -> Shake128 bits -> Bool
$c>= :: forall (bits :: Natural). Shake128 bits -> Shake128 bits -> Bool
>= :: Shake128 bits -> Shake128 bits -> Bool
$cmax :: forall (bits :: Natural).
Shake128 bits -> Shake128 bits -> Shake128 bits
max :: Shake128 bits -> Shake128 bits -> Shake128 bits
$cmin :: forall (bits :: Natural).
Shake128 bits -> Shake128 bits -> Shake128 bits
min :: Shake128 bits -> Shake128 bits -> Shake128 bits
Ord)
    deriving (Int -> Shake128 bits -> ShowS
[Shake128 bits] -> ShowS
Shake128 bits -> String
(Int -> Shake128 bits -> ShowS)
-> (Shake128 bits -> String)
-> ([Shake128 bits] -> ShowS)
-> Show (Shake128 bits)
forall (bits :: Natural). Int -> Shake128 bits -> ShowS
forall (bits :: Natural). [Shake128 bits] -> ShowS
forall (bits :: Natural). Shake128 bits -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (bits :: Natural). Int -> Shake128 bits -> ShowS
showsPrec :: Int -> Shake128 bits -> ShowS
$cshow :: forall (bits :: Natural). Shake128 bits -> String
show :: Shake128 bits -> String
$cshowList :: forall (bits :: Natural). [Shake128 bits] -> ShowS
showList :: [Shake128 bits] -> ShowS
Show, String -> Shake128 bits
(String -> Shake128 bits) -> IsString (Shake128 bits)
forall (bits :: Natural). String -> Shake128 bits
forall a. (String -> a) -> IsString a
$cfromString :: forall (bits :: Natural). String -> Shake128 bits
fromString :: String -> Shake128 bits
IsString) via B16ShortByteString
    deriving (Context (Shake128 bits) -> IO (Shake128 bits)
Context (Shake128 bits) -> Ptr Word8 -> Int -> IO ()
(Context (Shake128 bits) -> Ptr Word8 -> Int -> IO ())
-> (Context (Shake128 bits) -> IO (Shake128 bits))
-> IncrementalHash (Shake128 bits)
forall (bits :: Natural).
KnownNat bits =>
Context (Shake128 bits) -> IO (Shake128 bits)
forall (bits :: Natural).
KnownNat bits =>
Context (Shake128 bits) -> Ptr Word8 -> Int -> IO ()
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: forall (bits :: Natural).
KnownNat bits =>
Context (Shake128 bits) -> Ptr Word8 -> Int -> IO ()
update :: Context (Shake128 bits) -> Ptr Word8 -> Int -> IO ()
$cfinalize :: forall (bits :: Natural).
KnownNat bits =>
Context (Shake128 bits) -> IO (Shake128 bits)
finalize :: Context (Shake128 bits) -> IO (Shake128 bits)
IncrementalHash, IO (Context (Shake128 bits))
IncrementalHash (Shake128 bits)
IncrementalHash (Shake128 bits) =>
IO (Context (Shake128 bits)) -> Hash (Shake128 bits)
forall (bits :: Natural).
KnownNat bits =>
IO (Context (Shake128 bits))
forall (bits :: Natural).
KnownNat bits =>
IncrementalHash (Shake128 bits)
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: forall (bits :: Natural).
KnownNat bits =>
IO (Context (Shake128 bits))
initialize :: IO (Context (Shake128 bits))
Hash, IncrementalHash (Shake128 bits)
IncrementalHash (Shake128 bits) =>
(Context (Shake128 bits) -> IO ()) -> ResetableHash (Shake128 bits)
Context (Shake128 bits) -> IO ()
forall (bits :: Natural).
KnownNat bits =>
IncrementalHash (Shake128 bits)
forall (bits :: Natural).
KnownNat bits =>
Context (Shake128 bits) -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: forall (bits :: Natural).
KnownNat bits =>
Context (Shake128 bits) -> IO ()
reset :: Context (Shake128 bits) -> IO ()
ResetableHash) via (XOF_Digest bits (Shake128 bits))
instance OpenSslDigest (Shake128 n) where algorithm :: Algorithm (Shake128 n)
algorithm = Algorithm (Shake128 n)
forall (n :: Natural). Algorithm (Shake128 n)
shake128

newtype Shake256 (bits :: Natural) = Shake256 BS.ShortByteString
    deriving (Shake256 bits -> Shake256 bits -> Bool
(Shake256 bits -> Shake256 bits -> Bool)
-> (Shake256 bits -> Shake256 bits -> Bool) -> Eq (Shake256 bits)
forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
== :: Shake256 bits -> Shake256 bits -> Bool
$c/= :: forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
/= :: Shake256 bits -> Shake256 bits -> Bool
Eq, Eq (Shake256 bits)
Eq (Shake256 bits) =>
(Shake256 bits -> Shake256 bits -> Ordering)
-> (Shake256 bits -> Shake256 bits -> Bool)
-> (Shake256 bits -> Shake256 bits -> Bool)
-> (Shake256 bits -> Shake256 bits -> Bool)
-> (Shake256 bits -> Shake256 bits -> Bool)
-> (Shake256 bits -> Shake256 bits -> Shake256 bits)
-> (Shake256 bits -> Shake256 bits -> Shake256 bits)
-> Ord (Shake256 bits)
Shake256 bits -> Shake256 bits -> Bool
Shake256 bits -> Shake256 bits -> Ordering
Shake256 bits -> Shake256 bits -> Shake256 bits
forall (bits :: Natural). Eq (Shake256 bits)
forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
forall (bits :: Natural).
Shake256 bits -> Shake256 bits -> Ordering
forall (bits :: Natural).
Shake256 bits -> Shake256 bits -> Shake256 bits
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: forall (bits :: Natural).
Shake256 bits -> Shake256 bits -> Ordering
compare :: Shake256 bits -> Shake256 bits -> Ordering
$c< :: forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
< :: Shake256 bits -> Shake256 bits -> Bool
$c<= :: forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
<= :: Shake256 bits -> Shake256 bits -> Bool
$c> :: forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
> :: Shake256 bits -> Shake256 bits -> Bool
$c>= :: forall (bits :: Natural). Shake256 bits -> Shake256 bits -> Bool
>= :: Shake256 bits -> Shake256 bits -> Bool
$cmax :: forall (bits :: Natural).
Shake256 bits -> Shake256 bits -> Shake256 bits
max :: Shake256 bits -> Shake256 bits -> Shake256 bits
$cmin :: forall (bits :: Natural).
Shake256 bits -> Shake256 bits -> Shake256 bits
min :: Shake256 bits -> Shake256 bits -> Shake256 bits
Ord)
    deriving (Int -> Shake256 bits -> ShowS
[Shake256 bits] -> ShowS
Shake256 bits -> String
(Int -> Shake256 bits -> ShowS)
-> (Shake256 bits -> String)
-> ([Shake256 bits] -> ShowS)
-> Show (Shake256 bits)
forall (bits :: Natural). Int -> Shake256 bits -> ShowS
forall (bits :: Natural). [Shake256 bits] -> ShowS
forall (bits :: Natural). Shake256 bits -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (bits :: Natural). Int -> Shake256 bits -> ShowS
showsPrec :: Int -> Shake256 bits -> ShowS
$cshow :: forall (bits :: Natural). Shake256 bits -> String
show :: Shake256 bits -> String
$cshowList :: forall (bits :: Natural). [Shake256 bits] -> ShowS
showList :: [Shake256 bits] -> ShowS
Show, String -> Shake256 bits
(String -> Shake256 bits) -> IsString (Shake256 bits)
forall (bits :: Natural). String -> Shake256 bits
forall a. (String -> a) -> IsString a
$cfromString :: forall (bits :: Natural). String -> Shake256 bits
fromString :: String -> Shake256 bits
IsString) via B16ShortByteString
    deriving (Context (Shake256 bits) -> IO (Shake256 bits)
Context (Shake256 bits) -> Ptr Word8 -> Int -> IO ()
(Context (Shake256 bits) -> Ptr Word8 -> Int -> IO ())
-> (Context (Shake256 bits) -> IO (Shake256 bits))
-> IncrementalHash (Shake256 bits)
forall (bits :: Natural).
KnownNat bits =>
Context (Shake256 bits) -> IO (Shake256 bits)
forall (bits :: Natural).
KnownNat bits =>
Context (Shake256 bits) -> Ptr Word8 -> Int -> IO ()
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: forall (bits :: Natural).
KnownNat bits =>
Context (Shake256 bits) -> Ptr Word8 -> Int -> IO ()
update :: Context (Shake256 bits) -> Ptr Word8 -> Int -> IO ()
$cfinalize :: forall (bits :: Natural).
KnownNat bits =>
Context (Shake256 bits) -> IO (Shake256 bits)
finalize :: Context (Shake256 bits) -> IO (Shake256 bits)
IncrementalHash, IO (Context (Shake256 bits))
IncrementalHash (Shake256 bits)
IncrementalHash (Shake256 bits) =>
IO (Context (Shake256 bits)) -> Hash (Shake256 bits)
forall (bits :: Natural).
KnownNat bits =>
IO (Context (Shake256 bits))
forall (bits :: Natural).
KnownNat bits =>
IncrementalHash (Shake256 bits)
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: forall (bits :: Natural).
KnownNat bits =>
IO (Context (Shake256 bits))
initialize :: IO (Context (Shake256 bits))
Hash, IncrementalHash (Shake256 bits)
IncrementalHash (Shake256 bits) =>
(Context (Shake256 bits) -> IO ()) -> ResetableHash (Shake256 bits)
Context (Shake256 bits) -> IO ()
forall (bits :: Natural).
KnownNat bits =>
IncrementalHash (Shake256 bits)
forall (bits :: Natural).
KnownNat bits =>
Context (Shake256 bits) -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: forall (bits :: Natural).
KnownNat bits =>
Context (Shake256 bits) -> IO ()
reset :: Context (Shake256 bits) -> IO ()
ResetableHash) via (XOF_Digest bits (Shake256 bits))
instance OpenSslDigest (Shake256 n) where algorithm :: Algorithm (Shake256 n)
algorithm = Algorithm (Shake256 n)
forall (n :: Natural). Algorithm (Shake256 n)
shake256

type Shake128_256 = Shake128 32
type Shake256_512 = Shake256 64

-- -------------------------------------------------------------------------- --
-- Keccak for OpenSSL >=3.2

-- $keccak
--
-- This is the latest version of Keccak-256 hash function that was submitted to
-- the SHA3 competition. It is different from the final NIST SHA3 hash.
--
-- The difference between NIST SHA3-256 and Keccak-256 is the use of a different
-- padding character for the input message. The former uses '0x06' and the
-- latter uses '0x01'.
--
-- This version of Keccak-256 is used by the Ethereum project.
--
-- The following hash functions from the SHA-3 family are supported in
-- openssl-3.2 (cf. https://www.openssl.org/docs/man3.2/man7/EVP_MD-KECCAK.html)
--
-- KECCAK-224, KECCAK-256, KECCAK-384, KECCAK-512
#if OPENSSL_VERSION_NUMBER < 0x30200000L
--
-- This implementation of Keccak-256 uses internal OpenSSL APIs. It may break
-- with new versions of OpenSSL. It may also be broken for existing versions of
-- OpenSSL. Portability of the code is unknown.
--
-- ONLY USE THIS CODE AFTER YOU HAVE VERIFIED THAT IT WORKS WITH OUR VERSION OF
-- OPENSSL.
--
-- For details see the file cbits/keccak.c.
#endif

#if OPENSSL_VERSION_NUMBER >= 0x30200000L
#define KECCAK(x) ("KECCAK-" <> show @Int x)
#define KECCAK_DIGEST Digest
#else
#define KECCAK(x) ("SHA3-" <> show @Int x)
#define KECCAK_DIGEST LegacyKeccak_Digest
#endif

keccak_224 :: Algorithm Keccak224
keccak_224 :: Algorithm Keccak224
keccak_224 = IO (Algorithm Keccak224) -> Algorithm Keccak224
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Keccak224) -> Algorithm Keccak224)
-> IO (Algorithm Keccak224) -> Algorithm Keccak224
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Keccak224)
forall a. String -> IO (Algorithm a)
fetchAlgorithm KECCAK(224)
{-# NOINLINE keccak_224 #-}

keccak_256 :: Algorithm Keccak256
keccak_256 :: Algorithm Keccak256
keccak_256 = IO (Algorithm Keccak256) -> Algorithm Keccak256
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Keccak256) -> Algorithm Keccak256)
-> IO (Algorithm Keccak256) -> Algorithm Keccak256
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Keccak256)
forall a. String -> IO (Algorithm a)
fetchAlgorithm KECCAK(256)
{-# NOINLINE keccak_256 #-}

keccak_384 :: Algorithm Keccak384
keccak_384 :: Algorithm Keccak384
keccak_384 = IO (Algorithm Keccak384) -> Algorithm Keccak384
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Keccak384) -> Algorithm Keccak384)
-> IO (Algorithm Keccak384) -> Algorithm Keccak384
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Keccak384)
forall a. String -> IO (Algorithm a)
fetchAlgorithm KECCAK(384)
{-# NOINLINE keccak_384 #-}

keccak_512 :: Algorithm Keccak512
keccak_512 :: Algorithm Keccak512
keccak_512 = IO (Algorithm Keccak512) -> Algorithm Keccak512
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Keccak512) -> Algorithm Keccak512)
-> IO (Algorithm Keccak512) -> Algorithm Keccak512
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Keccak512)
forall a. String -> IO (Algorithm a)
fetchAlgorithm KECCAK(512)
{-# NOINLINE keccak_512 #-}

newtype Keccak224 = Keccak224 BS.ShortByteString
    deriving (Keccak224 -> Keccak224 -> Bool
(Keccak224 -> Keccak224 -> Bool)
-> (Keccak224 -> Keccak224 -> Bool) -> Eq Keccak224
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keccak224 -> Keccak224 -> Bool
== :: Keccak224 -> Keccak224 -> Bool
$c/= :: Keccak224 -> Keccak224 -> Bool
/= :: Keccak224 -> Keccak224 -> Bool
Eq, Eq Keccak224
Eq Keccak224 =>
(Keccak224 -> Keccak224 -> Ordering)
-> (Keccak224 -> Keccak224 -> Bool)
-> (Keccak224 -> Keccak224 -> Bool)
-> (Keccak224 -> Keccak224 -> Bool)
-> (Keccak224 -> Keccak224 -> Bool)
-> (Keccak224 -> Keccak224 -> Keccak224)
-> (Keccak224 -> Keccak224 -> Keccak224)
-> Ord Keccak224
Keccak224 -> Keccak224 -> Bool
Keccak224 -> Keccak224 -> Ordering
Keccak224 -> Keccak224 -> Keccak224
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Keccak224 -> Keccak224 -> Ordering
compare :: Keccak224 -> Keccak224 -> Ordering
$c< :: Keccak224 -> Keccak224 -> Bool
< :: Keccak224 -> Keccak224 -> Bool
$c<= :: Keccak224 -> Keccak224 -> Bool
<= :: Keccak224 -> Keccak224 -> Bool
$c> :: Keccak224 -> Keccak224 -> Bool
> :: Keccak224 -> Keccak224 -> Bool
$c>= :: Keccak224 -> Keccak224 -> Bool
>= :: Keccak224 -> Keccak224 -> Bool
$cmax :: Keccak224 -> Keccak224 -> Keccak224
max :: Keccak224 -> Keccak224 -> Keccak224
$cmin :: Keccak224 -> Keccak224 -> Keccak224
min :: Keccak224 -> Keccak224 -> Keccak224
Ord)
    deriving (Int -> Keccak224 -> ShowS
[Keccak224] -> ShowS
Keccak224 -> String
(Int -> Keccak224 -> ShowS)
-> (Keccak224 -> String)
-> ([Keccak224] -> ShowS)
-> Show Keccak224
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Keccak224 -> ShowS
showsPrec :: Int -> Keccak224 -> ShowS
$cshow :: Keccak224 -> String
show :: Keccak224 -> String
$cshowList :: [Keccak224] -> ShowS
showList :: [Keccak224] -> ShowS
Show, String -> Keccak224
(String -> Keccak224) -> IsString Keccak224
forall a. (String -> a) -> IsString a
$cfromString :: String -> Keccak224
fromString :: String -> Keccak224
IsString) via B16ShortByteString
    deriving (Context Keccak224 -> IO Keccak224
Context Keccak224 -> Ptr Word8 -> Int -> IO ()
(Context Keccak224 -> Ptr Word8 -> Int -> IO ())
-> (Context Keccak224 -> IO Keccak224) -> IncrementalHash Keccak224
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Keccak224 -> Ptr Word8 -> Int -> IO ()
update :: Context Keccak224 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Keccak224 -> IO Keccak224
finalize :: Context Keccak224 -> IO Keccak224
IncrementalHash, IO (Context Keccak224)
IncrementalHash Keccak224
IncrementalHash Keccak224 =>
IO (Context Keccak224) -> Hash Keccak224
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Keccak224)
initialize :: IO (Context Keccak224)
Hash, IncrementalHash Keccak224
IncrementalHash Keccak224 =>
(Context Keccak224 -> IO ()) -> ResetableHash Keccak224
Context Keccak224 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Keccak224 -> IO ()
reset :: Context Keccak224 -> IO ()
ResetableHash) via (KECCAK_DIGEST Keccak224)
instance OpenSslDigest Keccak224 where algorithm :: Algorithm Keccak224
algorithm = Algorithm Keccak224
keccak_224

newtype Keccak256 = Keccak256 BS.ShortByteString
    deriving (Keccak256 -> Keccak256 -> Bool
(Keccak256 -> Keccak256 -> Bool)
-> (Keccak256 -> Keccak256 -> Bool) -> Eq Keccak256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keccak256 -> Keccak256 -> Bool
== :: Keccak256 -> Keccak256 -> Bool
$c/= :: Keccak256 -> Keccak256 -> Bool
/= :: Keccak256 -> Keccak256 -> Bool
Eq, Eq Keccak256
Eq Keccak256 =>
(Keccak256 -> Keccak256 -> Ordering)
-> (Keccak256 -> Keccak256 -> Bool)
-> (Keccak256 -> Keccak256 -> Bool)
-> (Keccak256 -> Keccak256 -> Bool)
-> (Keccak256 -> Keccak256 -> Bool)
-> (Keccak256 -> Keccak256 -> Keccak256)
-> (Keccak256 -> Keccak256 -> Keccak256)
-> Ord Keccak256
Keccak256 -> Keccak256 -> Bool
Keccak256 -> Keccak256 -> Ordering
Keccak256 -> Keccak256 -> Keccak256
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Keccak256 -> Keccak256 -> Ordering
compare :: Keccak256 -> Keccak256 -> Ordering
$c< :: Keccak256 -> Keccak256 -> Bool
< :: Keccak256 -> Keccak256 -> Bool
$c<= :: Keccak256 -> Keccak256 -> Bool
<= :: Keccak256 -> Keccak256 -> Bool
$c> :: Keccak256 -> Keccak256 -> Bool
> :: Keccak256 -> Keccak256 -> Bool
$c>= :: Keccak256 -> Keccak256 -> Bool
>= :: Keccak256 -> Keccak256 -> Bool
$cmax :: Keccak256 -> Keccak256 -> Keccak256
max :: Keccak256 -> Keccak256 -> Keccak256
$cmin :: Keccak256 -> Keccak256 -> Keccak256
min :: Keccak256 -> Keccak256 -> Keccak256
Ord)
    deriving (Int -> Keccak256 -> ShowS
[Keccak256] -> ShowS
Keccak256 -> String
(Int -> Keccak256 -> ShowS)
-> (Keccak256 -> String)
-> ([Keccak256] -> ShowS)
-> Show Keccak256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Keccak256 -> ShowS
showsPrec :: Int -> Keccak256 -> ShowS
$cshow :: Keccak256 -> String
show :: Keccak256 -> String
$cshowList :: [Keccak256] -> ShowS
showList :: [Keccak256] -> ShowS
Show, String -> Keccak256
(String -> Keccak256) -> IsString Keccak256
forall a. (String -> a) -> IsString a
$cfromString :: String -> Keccak256
fromString :: String -> Keccak256
IsString) via B16ShortByteString
    deriving (Context Keccak256 -> IO Keccak256
Context Keccak256 -> Ptr Word8 -> Int -> IO ()
(Context Keccak256 -> Ptr Word8 -> Int -> IO ())
-> (Context Keccak256 -> IO Keccak256) -> IncrementalHash Keccak256
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Keccak256 -> Ptr Word8 -> Int -> IO ()
update :: Context Keccak256 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Keccak256 -> IO Keccak256
finalize :: Context Keccak256 -> IO Keccak256
IncrementalHash, IO (Context Keccak256)
IncrementalHash Keccak256
IncrementalHash Keccak256 =>
IO (Context Keccak256) -> Hash Keccak256
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Keccak256)
initialize :: IO (Context Keccak256)
Hash, IncrementalHash Keccak256
IncrementalHash Keccak256 =>
(Context Keccak256 -> IO ()) -> ResetableHash Keccak256
Context Keccak256 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Keccak256 -> IO ()
reset :: Context Keccak256 -> IO ()
ResetableHash) via (KECCAK_DIGEST Keccak256)
instance OpenSslDigest Keccak256 where algorithm :: Algorithm Keccak256
algorithm = Algorithm Keccak256
keccak_256

newtype Keccak384 = Keccak384 BS.ShortByteString
    deriving (Keccak384 -> Keccak384 -> Bool
(Keccak384 -> Keccak384 -> Bool)
-> (Keccak384 -> Keccak384 -> Bool) -> Eq Keccak384
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keccak384 -> Keccak384 -> Bool
== :: Keccak384 -> Keccak384 -> Bool
$c/= :: Keccak384 -> Keccak384 -> Bool
/= :: Keccak384 -> Keccak384 -> Bool
Eq, Eq Keccak384
Eq Keccak384 =>
(Keccak384 -> Keccak384 -> Ordering)
-> (Keccak384 -> Keccak384 -> Bool)
-> (Keccak384 -> Keccak384 -> Bool)
-> (Keccak384 -> Keccak384 -> Bool)
-> (Keccak384 -> Keccak384 -> Bool)
-> (Keccak384 -> Keccak384 -> Keccak384)
-> (Keccak384 -> Keccak384 -> Keccak384)
-> Ord Keccak384
Keccak384 -> Keccak384 -> Bool
Keccak384 -> Keccak384 -> Ordering
Keccak384 -> Keccak384 -> Keccak384
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Keccak384 -> Keccak384 -> Ordering
compare :: Keccak384 -> Keccak384 -> Ordering
$c< :: Keccak384 -> Keccak384 -> Bool
< :: Keccak384 -> Keccak384 -> Bool
$c<= :: Keccak384 -> Keccak384 -> Bool
<= :: Keccak384 -> Keccak384 -> Bool
$c> :: Keccak384 -> Keccak384 -> Bool
> :: Keccak384 -> Keccak384 -> Bool
$c>= :: Keccak384 -> Keccak384 -> Bool
>= :: Keccak384 -> Keccak384 -> Bool
$cmax :: Keccak384 -> Keccak384 -> Keccak384
max :: Keccak384 -> Keccak384 -> Keccak384
$cmin :: Keccak384 -> Keccak384 -> Keccak384
min :: Keccak384 -> Keccak384 -> Keccak384
Ord)
    deriving (Int -> Keccak384 -> ShowS
[Keccak384] -> ShowS
Keccak384 -> String
(Int -> Keccak384 -> ShowS)
-> (Keccak384 -> String)
-> ([Keccak384] -> ShowS)
-> Show Keccak384
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Keccak384 -> ShowS
showsPrec :: Int -> Keccak384 -> ShowS
$cshow :: Keccak384 -> String
show :: Keccak384 -> String
$cshowList :: [Keccak384] -> ShowS
showList :: [Keccak384] -> ShowS
Show, String -> Keccak384
(String -> Keccak384) -> IsString Keccak384
forall a. (String -> a) -> IsString a
$cfromString :: String -> Keccak384
fromString :: String -> Keccak384
IsString) via B16ShortByteString
    deriving (Context Keccak384 -> IO Keccak384
Context Keccak384 -> Ptr Word8 -> Int -> IO ()
(Context Keccak384 -> Ptr Word8 -> Int -> IO ())
-> (Context Keccak384 -> IO Keccak384) -> IncrementalHash Keccak384
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Keccak384 -> Ptr Word8 -> Int -> IO ()
update :: Context Keccak384 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Keccak384 -> IO Keccak384
finalize :: Context Keccak384 -> IO Keccak384
IncrementalHash, IO (Context Keccak384)
IncrementalHash Keccak384
IncrementalHash Keccak384 =>
IO (Context Keccak384) -> Hash Keccak384
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Keccak384)
initialize :: IO (Context Keccak384)
Hash, IncrementalHash Keccak384
IncrementalHash Keccak384 =>
(Context Keccak384 -> IO ()) -> ResetableHash Keccak384
Context Keccak384 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Keccak384 -> IO ()
reset :: Context Keccak384 -> IO ()
ResetableHash) via (KECCAK_DIGEST Keccak384)
instance OpenSslDigest Keccak384 where algorithm :: Algorithm Keccak384
algorithm = Algorithm Keccak384
keccak_384

newtype Keccak512 = Keccak512 BS.ShortByteString
    deriving (Keccak512 -> Keccak512 -> Bool
(Keccak512 -> Keccak512 -> Bool)
-> (Keccak512 -> Keccak512 -> Bool) -> Eq Keccak512
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keccak512 -> Keccak512 -> Bool
== :: Keccak512 -> Keccak512 -> Bool
$c/= :: Keccak512 -> Keccak512 -> Bool
/= :: Keccak512 -> Keccak512 -> Bool
Eq, Eq Keccak512
Eq Keccak512 =>
(Keccak512 -> Keccak512 -> Ordering)
-> (Keccak512 -> Keccak512 -> Bool)
-> (Keccak512 -> Keccak512 -> Bool)
-> (Keccak512 -> Keccak512 -> Bool)
-> (Keccak512 -> Keccak512 -> Bool)
-> (Keccak512 -> Keccak512 -> Keccak512)
-> (Keccak512 -> Keccak512 -> Keccak512)
-> Ord Keccak512
Keccak512 -> Keccak512 -> Bool
Keccak512 -> Keccak512 -> Ordering
Keccak512 -> Keccak512 -> Keccak512
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Keccak512 -> Keccak512 -> Ordering
compare :: Keccak512 -> Keccak512 -> Ordering
$c< :: Keccak512 -> Keccak512 -> Bool
< :: Keccak512 -> Keccak512 -> Bool
$c<= :: Keccak512 -> Keccak512 -> Bool
<= :: Keccak512 -> Keccak512 -> Bool
$c> :: Keccak512 -> Keccak512 -> Bool
> :: Keccak512 -> Keccak512 -> Bool
$c>= :: Keccak512 -> Keccak512 -> Bool
>= :: Keccak512 -> Keccak512 -> Bool
$cmax :: Keccak512 -> Keccak512 -> Keccak512
max :: Keccak512 -> Keccak512 -> Keccak512
$cmin :: Keccak512 -> Keccak512 -> Keccak512
min :: Keccak512 -> Keccak512 -> Keccak512
Ord)
    deriving (Int -> Keccak512 -> ShowS
[Keccak512] -> ShowS
Keccak512 -> String
(Int -> Keccak512 -> ShowS)
-> (Keccak512 -> String)
-> ([Keccak512] -> ShowS)
-> Show Keccak512
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Keccak512 -> ShowS
showsPrec :: Int -> Keccak512 -> ShowS
$cshow :: Keccak512 -> String
show :: Keccak512 -> String
$cshowList :: [Keccak512] -> ShowS
showList :: [Keccak512] -> ShowS
Show, String -> Keccak512
(String -> Keccak512) -> IsString Keccak512
forall a. (String -> a) -> IsString a
$cfromString :: String -> Keccak512
fromString :: String -> Keccak512
IsString) via B16ShortByteString
    deriving (Context Keccak512 -> IO Keccak512
Context Keccak512 -> Ptr Word8 -> Int -> IO ()
(Context Keccak512 -> Ptr Word8 -> Int -> IO ())
-> (Context Keccak512 -> IO Keccak512) -> IncrementalHash Keccak512
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Keccak512 -> Ptr Word8 -> Int -> IO ()
update :: Context Keccak512 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Keccak512 -> IO Keccak512
finalize :: Context Keccak512 -> IO Keccak512
IncrementalHash, IO (Context Keccak512)
IncrementalHash Keccak512
IncrementalHash Keccak512 =>
IO (Context Keccak512) -> Hash Keccak512
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Keccak512)
initialize :: IO (Context Keccak512)
Hash, IncrementalHash Keccak512
IncrementalHash Keccak512 =>
(Context Keccak512 -> IO ()) -> ResetableHash Keccak512
Context Keccak512 -> IO ()
forall a.
IncrementalHash a =>
(Context a -> IO ()) -> ResetableHash a
$creset :: Context Keccak512 -> IO ()
reset :: Context Keccak512 -> IO ()
ResetableHash) via (KECCAK_DIGEST Keccak512)
instance OpenSslDigest Keccak512 where algorithm :: Algorithm Keccak512
algorithm = Algorithm Keccak512
keccak_512

-- | Low-Level function that writes the final digest directly into the provided
-- pointer. The pointer must point to at least 64 bytes of allocated memory.
-- This is not checked and a violation of this condition may result in a
-- segmentation fault.
--
finalizeKeccak256Ptr :: Ctx Keccak256 -> Ptr Word8 -> IO ()
finalizeKeccak256Ptr :: Ctx Keccak256 -> Ptr Word8 -> IO ()
finalizeKeccak256Ptr (Ctx ForeignPtr Void
ctx) Ptr Word8
dptr =
    ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
cptr -> do
        CInt
r <- Ptr Void -> Ptr CUChar -> Ptr CUInt -> IO CInt
forall ctx. Ptr ctx -> Ptr CUChar -> Ptr CUInt -> IO CInt
c_evp_digest_final Ptr Void
cptr (Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr) Ptr CUInt
forall a. Ptr a
nullPtr
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest finalization failed"
{-# INLINE finalizeKeccak256Ptr #-}

-- | Low-Level function that writes the final digest directly into the provided
-- pointer. The pointer must point to at least 64 bytes of allocated memory.
-- This is not checked and a violation of this condition may result in a
-- segmentation fault.
--
finalizeKeccak512Ptr :: Ctx Keccak512 -> Ptr Word8 -> IO ()
finalizeKeccak512Ptr :: Ctx Keccak512 -> Ptr Word8 -> IO ()
finalizeKeccak512Ptr (Ctx ForeignPtr Void
ctx) Ptr Word8
dptr = do
    ForeignPtr Void -> (Ptr Void -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Void
ctx ((Ptr Void -> IO ()) -> IO ()) -> (Ptr Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Void
cptr -> do
        CInt
r <- Ptr Void -> Ptr CUChar -> Ptr CUInt -> IO CInt
forall ctx. Ptr ctx -> Ptr CUChar -> Ptr CUInt -> IO CInt
c_evp_digest_final Ptr Void
cptr (Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr) Ptr CUInt
forall a. Ptr a
nullPtr
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ OpenSslException -> IO ()
forall a e. Exception e => e -> a
throw (OpenSslException -> IO ()) -> OpenSslException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpenSslException
OpenSslException String
"digest finalization failed"
{-# INLINE finalizeKeccak512Ptr #-}

-- -------------------------------------------------------------------------- --
-- Blake

-- $blake2
--
-- BLAKE2 is an improved version of BLAKE, which was submitted to the NIST SHA-3
-- algorithm competition. The BLAKE2s and BLAKE2b algorithms are described in
-- RFC 7693.
--
-- The following hash functions from the BLAKE2 family are supported in
-- openssl-3.0 (cf.
-- https://www.openssl.org/docs/man3.0/man3/EVP_blake2b512.html)
--
-- BLAKE2B-512, BLACKE2S-256
--
-- While the BLAKE2b and BLAKE2s algorithms supports a variable length digest,
-- this implementation outputs a digest of a fixed length (the maximum length
-- supported), which is 512-bits for BLAKE2b and 256-bits for BLAKE2s.

blake2b512 :: Algorithm Blake2b512
blake2b512 :: Algorithm Blake2b512
blake2b512 = IO (Algorithm Blake2b512) -> Algorithm Blake2b512
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Blake2b512) -> Algorithm Blake2b512)
-> IO (Algorithm Blake2b512) -> Algorithm Blake2b512
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Blake2b512)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"BLAKE2b512"
{-# NOINLINE blake2b512 #-}

blake2s256 :: Algorithm Blake2s256
blake2s256 :: Algorithm Blake2s256
blake2s256 = IO (Algorithm Blake2s256) -> Algorithm Blake2s256
forall a. IO a -> a
unsafePerformIO (IO (Algorithm Blake2s256) -> Algorithm Blake2s256)
-> IO (Algorithm Blake2s256) -> Algorithm Blake2s256
forall a b. (a -> b) -> a -> b
$ String -> IO (Algorithm Blake2s256)
forall a. String -> IO (Algorithm a)
fetchAlgorithm String
"BLAKE2s256"
{-# NOINLINE blake2s256 #-}

newtype Blake2b512 = Blake2b512 BS.ShortByteString
    deriving (Blake2b512 -> Blake2b512 -> Bool
(Blake2b512 -> Blake2b512 -> Bool)
-> (Blake2b512 -> Blake2b512 -> Bool) -> Eq Blake2b512
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Blake2b512 -> Blake2b512 -> Bool
== :: Blake2b512 -> Blake2b512 -> Bool
$c/= :: Blake2b512 -> Blake2b512 -> Bool
/= :: Blake2b512 -> Blake2b512 -> Bool
Eq, Eq Blake2b512
Eq Blake2b512 =>
(Blake2b512 -> Blake2b512 -> Ordering)
-> (Blake2b512 -> Blake2b512 -> Bool)
-> (Blake2b512 -> Blake2b512 -> Bool)
-> (Blake2b512 -> Blake2b512 -> Bool)
-> (Blake2b512 -> Blake2b512 -> Bool)
-> (Blake2b512 -> Blake2b512 -> Blake2b512)
-> (Blake2b512 -> Blake2b512 -> Blake2b512)
-> Ord Blake2b512
Blake2b512 -> Blake2b512 -> Bool
Blake2b512 -> Blake2b512 -> Ordering
Blake2b512 -> Blake2b512 -> Blake2b512
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Blake2b512 -> Blake2b512 -> Ordering
compare :: Blake2b512 -> Blake2b512 -> Ordering
$c< :: Blake2b512 -> Blake2b512 -> Bool
< :: Blake2b512 -> Blake2b512 -> Bool
$c<= :: Blake2b512 -> Blake2b512 -> Bool
<= :: Blake2b512 -> Blake2b512 -> Bool
$c> :: Blake2b512 -> Blake2b512 -> Bool
> :: Blake2b512 -> Blake2b512 -> Bool
$c>= :: Blake2b512 -> Blake2b512 -> Bool
>= :: Blake2b512 -> Blake2b512 -> Bool
$cmax :: Blake2b512 -> Blake2b512 -> Blake2b512
max :: Blake2b512 -> Blake2b512 -> Blake2b512
$cmin :: Blake2b512 -> Blake2b512 -> Blake2b512
min :: Blake2b512 -> Blake2b512 -> Blake2b512
Ord)
    deriving (Int -> Blake2b512 -> ShowS
[Blake2b512] -> ShowS
Blake2b512 -> String
(Int -> Blake2b512 -> ShowS)
-> (Blake2b512 -> String)
-> ([Blake2b512] -> ShowS)
-> Show Blake2b512
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Blake2b512 -> ShowS
showsPrec :: Int -> Blake2b512 -> ShowS
$cshow :: Blake2b512 -> String
show :: Blake2b512 -> String
$cshowList :: [Blake2b512] -> ShowS
showList :: [Blake2b512] -> ShowS
Show, String -> Blake2b512
(String -> Blake2b512) -> IsString Blake2b512
forall a. (String -> a) -> IsString a
$cfromString :: String -> Blake2b512
fromString :: String -> Blake2b512
IsString) via B16ShortByteString
    deriving (Context Blake2b512 -> IO Blake2b512
Context Blake2b512 -> Ptr Word8 -> Int -> IO ()
(Context Blake2b512 -> Ptr Word8 -> Int -> IO ())
-> (Context Blake2b512 -> IO Blake2b512)
-> IncrementalHash Blake2b512
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Blake2b512 -> Ptr Word8 -> Int -> IO ()
update :: Context Blake2b512 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Blake2b512 -> IO Blake2b512
finalize :: Context Blake2b512 -> IO Blake2b512
IncrementalHash, IO (Context Blake2b512)
IncrementalHash Blake2b512
IncrementalHash Blake2b512 =>
IO (Context Blake2b512) -> Hash Blake2b512
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Blake2b512)
initialize :: IO (Context Blake2b512)
Hash) via (Digest Blake2b512)
instance OpenSslDigest Blake2b512 where algorithm :: Algorithm Blake2b512
algorithm = Algorithm Blake2b512
blake2b512

newtype Blake2s256 = Blake2s256 BS.ShortByteString
    deriving (Blake2s256 -> Blake2s256 -> Bool
(Blake2s256 -> Blake2s256 -> Bool)
-> (Blake2s256 -> Blake2s256 -> Bool) -> Eq Blake2s256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Blake2s256 -> Blake2s256 -> Bool
== :: Blake2s256 -> Blake2s256 -> Bool
$c/= :: Blake2s256 -> Blake2s256 -> Bool
/= :: Blake2s256 -> Blake2s256 -> Bool
Eq, Eq Blake2s256
Eq Blake2s256 =>
(Blake2s256 -> Blake2s256 -> Ordering)
-> (Blake2s256 -> Blake2s256 -> Bool)
-> (Blake2s256 -> Blake2s256 -> Bool)
-> (Blake2s256 -> Blake2s256 -> Bool)
-> (Blake2s256 -> Blake2s256 -> Bool)
-> (Blake2s256 -> Blake2s256 -> Blake2s256)
-> (Blake2s256 -> Blake2s256 -> Blake2s256)
-> Ord Blake2s256
Blake2s256 -> Blake2s256 -> Bool
Blake2s256 -> Blake2s256 -> Ordering
Blake2s256 -> Blake2s256 -> Blake2s256
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Blake2s256 -> Blake2s256 -> Ordering
compare :: Blake2s256 -> Blake2s256 -> Ordering
$c< :: Blake2s256 -> Blake2s256 -> Bool
< :: Blake2s256 -> Blake2s256 -> Bool
$c<= :: Blake2s256 -> Blake2s256 -> Bool
<= :: Blake2s256 -> Blake2s256 -> Bool
$c> :: Blake2s256 -> Blake2s256 -> Bool
> :: Blake2s256 -> Blake2s256 -> Bool
$c>= :: Blake2s256 -> Blake2s256 -> Bool
>= :: Blake2s256 -> Blake2s256 -> Bool
$cmax :: Blake2s256 -> Blake2s256 -> Blake2s256
max :: Blake2s256 -> Blake2s256 -> Blake2s256
$cmin :: Blake2s256 -> Blake2s256 -> Blake2s256
min :: Blake2s256 -> Blake2s256 -> Blake2s256
Ord)
    deriving (Int -> Blake2s256 -> ShowS
[Blake2s256] -> ShowS
Blake2s256 -> String
(Int -> Blake2s256 -> ShowS)
-> (Blake2s256 -> String)
-> ([Blake2s256] -> ShowS)
-> Show Blake2s256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Blake2s256 -> ShowS
showsPrec :: Int -> Blake2s256 -> ShowS
$cshow :: Blake2s256 -> String
show :: Blake2s256 -> String
$cshowList :: [Blake2s256] -> ShowS
showList :: [Blake2s256] -> ShowS
Show, String -> Blake2s256
(String -> Blake2s256) -> IsString Blake2s256
forall a. (String -> a) -> IsString a
$cfromString :: String -> Blake2s256
fromString :: String -> Blake2s256
IsString) via B16ShortByteString
    deriving (Context Blake2s256 -> IO Blake2s256
Context Blake2s256 -> Ptr Word8 -> Int -> IO ()
(Context Blake2s256 -> Ptr Word8 -> Int -> IO ())
-> (Context Blake2s256 -> IO Blake2s256)
-> IncrementalHash Blake2s256
forall a.
(Context a -> Ptr Word8 -> Int -> IO ())
-> (Context a -> IO a) -> IncrementalHash a
$cupdate :: Context Blake2s256 -> Ptr Word8 -> Int -> IO ()
update :: Context Blake2s256 -> Ptr Word8 -> Int -> IO ()
$cfinalize :: Context Blake2s256 -> IO Blake2s256
finalize :: Context Blake2s256 -> IO Blake2s256
IncrementalHash, IO (Context Blake2s256)
IncrementalHash Blake2s256
IncrementalHash Blake2s256 =>
IO (Context Blake2s256) -> Hash Blake2s256
forall a. IncrementalHash a => IO (Context a) -> Hash a
$cinitialize :: IO (Context Blake2s256)
initialize :: IO (Context Blake2s256)
Hash) via (Digest Blake2s256)
instance OpenSslDigest Blake2s256 where algorithm :: Algorithm Blake2s256
algorithm = Algorithm Blake2s256
blake2s256