hashes 0.2.3 → 0.3.0

raw patch · 22 files changed

+841/−450 lines, 22 filesdep ~sha-validationPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: sha-validation

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−0
• README.md +7/−4
• bench/Main.hs +1/−1
• cbits/keccak-example.c +0/−49
• cbits/keccak.c +39/−105
• cbits/keccak.h +12/−18
• hashes.cabal +11/−8
• src/Data/Hash/Blake2.hs +1/−1
• src/Data/Hash/Class/Mutable.hs +51/−6
• src/Data/Hash/Class/Mutable/Salted.hs +48/−5
• src/Data/Hash/Internal/OpenSSL.hs +355/−237
• src/Data/Hash/Internal/Utils.hs +27/−2
• src/Data/Hash/Keccak.hs +1/−1
• src/Data/Hash/SHA2.hs +1/−1
• src/Data/Hash/SHA3.hs +5/−1
• src/Data/Hash/SipHash.hs +1/−1
• test/Cryptonite.hs +2/−2
• test/Main.hs +5/−1
• test/Test/Data/Hash/Keccak.hs +115/−0
• test/Test/Data/Hash/SHA2.hs +97/−0
• test/Test/Data/Hash/SHA3.hs +39/−5
• test/Test/Data/Hash/SipHash.hs +2/−2

@@ -1,5 +1,26 @@ # Revision history for the hashes package +## 0.3.0 -- 2024-07-12++Breaking Changes:++*   Add type type parameter to support different output sizes for `Shake128` and+    `Shake256`.+*   Hash functions in `Data.Hash.Class.Mutable` and+    `Data.Hash.Class.Mutable.Salted` now run in `IO`, which is generally more+    efficient than a pure computation within `unsafePerformIO`. The modules also+    provide pure variants of the hash functions that can be used when the+    performance overhead of `unsafePerformIO` does not matter.+*   Drop support for OpenSSL < 1.1.++Other Changes:++*   Add support for Keccak224, Keccak384, Shake128/256,and Shake256/512.+*   Improved test coverage for OpenSSL based hashes.+*   Avoid deprecated API calls in the implementation of OpenSSL based hashes.+*   Add an IsString instance for OpenSSL based digests that uses hex encoding.+*   Improve heuristics for locating libcrypt on macOS.+ ## 0.2.3 -- 2022-11-22  *   Support reset and reuse of context for OpenSSL digests.

@@ -18,7 +18,7 @@ `-f+with-openssl`, which is the default.  A version of OpenSSL of at least version 1.1 must be available on the system at-a location for Cabal/GHC can find it.+a location where Cabal/GHC can find it.  *   SHA2     *   SHA2-224@@ -32,14 +32,17 @@     *   SHA3_256     *   SHA3_384     *   SHA3_512-    *   SHAKE-128-    *   SHAKE-256+    *   SHAKE-128_256+    *   SHAKE-256_512+    *   SHAKE-128 (custom output size)+    *   SHAKE-256 (custom output size) *   BLAKE2     *   BLAKE2s256     *   BLAKE2b512 *   KECCAK+    *   KECCAK-224     *   KECCAK-256+    *   KECCAK-384     *   KECCAK-512-    See comment in [Data.Hash.Keccak](https://github.com/larskuhtz/hs-hashes/blob/main/src/Data/Hash/Keccak.hs) before using these Keccak implementations.  

@@ -161,7 +161,7 @@  #if defined(WITH_OPENSSL) ossl :: forall a . Coercible a BS.ShortByteString => H.Hash a => B.ByteString -> BS.ShortByteString-ossl b = coerce $! SHA3.hashByteString @a b+ossl b = coerce $! SHA3.hashByteString_ @a b {-# INLINE ossl #-} #endif 

@@ -1,49 +0,0 @@-#include <string.h>-#include "keccak.h"--/* *************************************************************************** */-/* Generic Tools */--#define CHECKED(f)             \-    if (! (f)) {               \-        ok = 0; goto finally; \-    }--/* *************************************************************************** */-/* Digests */--typedef unsigned char MD_VALUE[32];-typedef char MD_VALUE_HEX[32*2+1];--void digestToHex(char *result, const unsigned char *md_value) {-    int i;-    for (i = 0; i < 32; i++) {-        sprintf(&result[2*i], "%02x", (uint8_t) (md_value[i]));-    }-}--const char *msg = "testing";-const char *expected = "5f16f4c7f149ac4f9510d9cf8cf384038ad348b3bcdc01915f95de12df9d1b02";--/* *************************************************************************** */-/* Main */--int main()-{-    int ok = 1;-    MD_VALUE md_value;-    MD_VALUE_HEX result;-    KECCAK256_CTX *ctx = NULL;--    CHECKED(ctx = keccak256_newctx());-    CHECKED(keccak256_init(ctx));-    CHECKED(keccak256_update(ctx, msg, strlen(msg)));-    CHECKED(keccak256_final(ctx, md_value));-    digestToHex(result, md_value);-    printf("Keccak-256 digest: %s\n", result);-    printf("expected         : %s\n", expected);--finally:-    if (ctx) keccak256_freectx(ctx);-    return ! ok;-}

@@ -1,35 +1,32 @@+/*+ * Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com>+ * License: MIT+ * Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+ */+ #include <openssl/evp.h> #include "keccak.h"  /* *************************************************************************** */-/* OpenSSL Master */--/*-int main()-{-    int ok = 1;-    unsigned int md_len = 0;-    MD_VALUE md_value;-    MD_VALUE_HEX result;-    EVP_MD *md;-    EVP_MD_CTX *ctx;--    CHECKED(md = EVP_get_digestbyname("KECCAK-256"));-    CHECKED(ctx = EVP_MD_CTX_new());-    CHECKED(EVP_DigestInit(ctx, md));-    CHECKED(EVP_DigestUpdate(ctx, msg, strlen(msg)));-    CHECKED(EVP_DigestFinal(ctx, md_value, &md_len));--    // Print Digest-    digestToHex(result, md_value);-    printf("Keccak-256 digest: %s\n", result);-    printf("expected         : %s\n", expected);--finally:-    if (ctx) EVP_MD_CTX_free(ctx);-    return ! ok;-}-*/+/* Legacy support for Keccak for OpenSSL prior to version 3.2+ *+ * Support for Keccak-224, Keccak-256, Keccak-384, and Keccak-512 was added+ * in OpenSSL version 3.2.+ *+ * 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.+ *+ * This file also adds supports for those digests for OpenSSL versions 1.1+ * onward.+ *+ * Keccak differs from NIST standardized SHA3 by using a different padding+ * value. This implementation uses low-level internals of the SHA3+ * implementation for overwriting the padding byte.+ */  /* *************************************************************************** */ /* OpenSSL 1.1 and OpenSSL 3.0 */@@ -77,101 +74,38 @@  #define PAD_BYTE_OFFSET (25 * sizeof(uint64_t) + 3 * sizeof(size_t) + 1600/8 - 32) -/* OPENSSL 3.1 */-#if OPENSSL_VERSION_NUMBER >= 0x31000000L-#define SET_PAD_BYTE+/* OPENSSL 3.2 */+#if OPENSSL_VERSION_NUMBER >= 0x30200000L -/* OPENSSL 3.0 */+/* Keccak is supported directly in OpenSSL >= 2.3. No legacy implementation is+ * provided in this case.+ */++/* OPENSSL 3.0 (use with algorithm name "SHA3") */ #elif OPENSSL_VERSION_NUMBER >= 0x30000000L #define GET_CTX(ctx) (*(((uint8_t **) ctx) + 7)) #define SET_PAD_BYTE (((uint8_t *) GET_CTX(ctx))[PAD_BYTE_OFFSET] = 0x01) -/* OPENSSL 1.1 */+/* OPENSSL 1.1 (use with algorithm name "SHA3") */ #elif OPENSSL_VERSION_NUMBER >= 0x10100000L #define GET_CTX(ctx) ((uint8_t *) EVP_MD_CTX_md_data(ctx)) #define SET_PAD_BYTE (GET_CTX(ctx)[PAD_BYTE_OFFSET] = 0x01) +#else+#error "Unsupported OpenSSL version. Please install OpenSSL >= 1.1.0"+ #endif  /* *************************************************************************** */ /* Implementation */ --KECCAK256_CTX *keccak256_newctx()-{-    return EVP_MD_CTX_new();-}--KECCAK512_CTX *keccak512_newctx()-{-    return EVP_MD_CTX_new();-}--int keccak256_init(KECCAK256_CTX *ctx) {+#if OPENSSL_VERSION_NUMBER < 0x30200000L+int keccak_EVP_DigestInit_ex(EVP_MD_CTX *ctx, EVP_MD *md) {     int ok = 1;-    const EVP_MD *md = NULL;-    CHECKED(md = EVP_get_digestbyname("SHA3-256"));     CHECKED(EVP_DigestInit_ex(ctx, md, NULL));     SET_PAD_BYTE; finally:     return ok; }--int keccak512_init(KECCAK512_CTX *ctx) {-    int ok = 1;-    const EVP_MD *md = NULL;-    CHECKED(md = EVP_get_digestbyname("SHA3-512"));-    CHECKED(EVP_DigestInit_ex(ctx, md, NULL));-    SET_PAD_BYTE;-finally:-    return ok;-}--int keccak256_reset(KECCAK512_CTX *ctx) {-    int ok = 1;-    CHECKED(EVP_DigestInit_ex(ctx, NULL, NULL));-    SET_PAD_BYTE;-finally:-    return ok;-}--int keccak512_reset(KECCAK512_CTX *ctx) {-    int ok = 1;-    CHECKED(EVP_DigestInit_ex(ctx, NULL, NULL));-    SET_PAD_BYTE;-finally:-    return ok;-}--int keccak256_update(KECCAK256_CTX *ctx, const void *p, size_t l)-{-    return EVP_DigestUpdate(ctx, p, l);-}--int keccak512_update(KECCAK512_CTX *ctx, const void *p, size_t l)-{-    return EVP_DigestUpdate(ctx, p, l);-}--int keccak256_final(KECCAK256_CTX *ctx, unsigned char *md)-{-    unsigned int l;-    return EVP_DigestFinal_ex(ctx, md, &l);-}--int keccak512_final(KECCAK512_CTX *ctx, unsigned char *md)-{-    unsigned int l;-    return EVP_DigestFinal_ex(ctx, md, &l);-}--void keccak256_freectx(KECCAK256_CTX *ctx)-{-    return EVP_MD_CTX_free(ctx);-}--void keccak512_freectx(KECCAK512_CTX *ctx)-{-    return EVP_MD_CTX_free(ctx);-}+#endif 

@@ -1,3 +1,9 @@+/*+ * Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com>+ * License: MIT+ * Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+ */+ #include <openssl/evp.h>  /* *************************************************************************** */@@ -11,22 +17,10 @@ /* *************************************************************************** */ /* Keccak */ -typedef EVP_MD_CTX KECCAK256_CTX;-typedef EVP_MD_CTX KECCAK512_CTX;--// KECCAK-256-KECCAK256_CTX *keccak256_newctx();-int keccak256_init(KECCAK256_CTX *ctx);-int keccak256_reset(KECCAK256_CTX *ctx);-int keccak256_update(KECCAK256_CTX *ctx, const void *p, size_t l);-int keccak256_final(KECCAK256_CTX *ctx, unsigned char *md);-void keccak256_freectx(KECCAK256_CTX *ctx);--// KECCAK-512-KECCAK512_CTX *keccak512_newctx();-int keccak512_init(KECCAK512_CTX *ctx);-int keccak512_reset(KECCAK512_CTX *ctx);-int keccak512_update(KECCAK512_CTX *ctx, const void *p, size_t l);-int keccak512_final(KECCAK512_CTX *ctx, unsigned char *md);-void keccak512_freectx(KECCAK512_CTX *ctx);+/* Keccak is supported directly in OpenSSL >= 2.3. No legacy implementation is+ * provided in this case.+ */ +#if OPENSSL_VERSION_NUMBER < 0x30200000L+int keccak_EVP_DigestInit_ex(EVP_MD_CTX *ctx, EVP_MD *md);+#endif

@@ -1,6 +1,6 @@-cabal-version: 2.4+cabal-version: 3.0 name: hashes-version: 0.2.3+version: 0.3.0 synopsis: Hash functions Description: Efficient implementations of hash functions homepage: https://github.com/larskuhtz/hs-hashes@@ -9,18 +9,19 @@ license-file: LICENSE author: Lars Kuhtz maintainer: lakuhtz@gmail.com-copyright: Copyright (c) 2019-2021 Lars Kuhtz <lakuhtz@gmail.com>+copyright: Copyright (c) 2019-2024 Lars Kuhtz <lakuhtz@gmail.com> category: Data tested-with:+    GHC==9.10+    GHC==9.6+    GHC==9.4     GHC==9.2-    GHC==9.0.1-    GHC==8.10.7-extra-source-files:+extra-doc-files:     README.md     CHANGELOG.md+extra-source-files:     cbits/keccak.h     cbits/keccak.c-    cbits/keccak-example.c  source-repository head     type: git@@ -114,9 +115,11 @@      if flag(with-openssl)         build-depends:-            , sha-validation >=0.1+            , sha-validation >=0.1.0.1         other-modules:+            Test.Data.Hash.SHA2             Test.Data.Hash.SHA3+            Test.Data.Hash.Keccak      if flag(test-cryptonite)         build-depends:

@@ -1,6 +1,6 @@ -- | -- Module: Data.Hash.Blake2--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental

@@ -5,7 +5,7 @@  -- | -- Module: Data.Hash.Class.Mutable--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental@@ -16,6 +16,7 @@ ( Hash(..) , IncrementalHash(..) +-- * Hash functions , hashPtr , hashStorable , hashByteString@@ -23,6 +24,22 @@ , hashShortByteString , hashByteArray +-- ** Pure variants of hash functions+--+-- The following pure variants of the hash functions are implemented with+-- 'unsafePerformIO'. This is generally less efficient than running them+-- directly in 'IO'. Often the performance difference does not matter. However,+-- when many hashes are computed one should prefer the variants that run in+-- 'IO'. When a 'ResetableHash' instance is available it provides the most+-- efficient way to compute many hashes in a tight loop.++, hashPtr_+, hashStorable_+, hashByteString_+, hashByteStringLazy_+, hashShortByteString_+, hashByteArray_+ -- * Incremental Hashing , updateByteString , updateByteStringLazy@@ -43,8 +60,9 @@ import Foreign.Storable  import GHC.Exts-import GHC.IO +import System.IO.Unsafe+ -- internal modules  import Data.Hash.Class.Mutable.Internal@@ -65,15 +83,15 @@     finalize ctx {-# INLINE hashPtr #-} -hashByteString :: forall a . Hash a => B.ByteString -> a-hashByteString b = unsafeDupablePerformIO $ do+hashByteString :: forall a . Hash a => B.ByteString -> IO a+hashByteString b = do     ctx <- initialize @a     updateByteString @a ctx b     finalize ctx {-# INLINE hashByteString #-} -hashByteStringLazy :: forall a . Hash a => BL.ByteString -> a-hashByteStringLazy b = unsafeDupablePerformIO $ do+hashByteStringLazy :: forall a . Hash a => BL.ByteString -> IO a+hashByteStringLazy b = do     ctx <- initialize @a     updateByteStringLazy @a ctx b     finalize ctx@@ -99,4 +117,31 @@     updateByteArray @a ctx b     finalize ctx {-# INLINE hashByteArray #-}++-- --------------------------------------------------------------------------+-- Pure variants of hashes++hashPtr_ :: forall a . Hash a => Ptr Word8 -> Int -> a+hashPtr_ a = unsafePerformIO . hashPtr a+{-# INLINE hashPtr_ #-}++hashByteString_ :: forall a . Hash a => B.ByteString -> a+hashByteString_ = unsafePerformIO . hashByteString+{-# INLINE hashByteString_ #-}++hashByteStringLazy_ :: forall a . Hash a => BL.ByteString -> a+hashByteStringLazy_ = unsafePerformIO . hashByteStringLazy+{-# INLINE hashByteStringLazy_ #-}++hashShortByteString_ :: forall a . Hash a => BS.ShortByteString -> a+hashShortByteString_ = unsafePerformIO . hashShortByteString+{-# INLINE hashShortByteString_ #-}++hashStorable_ :: forall a b . Hash a => Storable b => b -> a+hashStorable_ = unsafePerformIO . hashStorable+{-# INLINE hashStorable_ #-}++hashByteArray_ :: forall a . Hash a => ByteArray# -> a+hashByteArray_ a = unsafePerformIO $ hashByteArray a+{-# INLINE hashByteArray_ #-} 

@@ -6,7 +6,7 @@  -- | -- Module: Data.Hash.Class.Mutable.Salted--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental@@ -23,6 +23,22 @@ , hashShortByteString , hashByteArray +-- ** Pure variants of hash functions+--+-- The following pure variants of the hash functions are implemented with+-- 'unsafePerformIO'. This is generally less efficient than running them+-- directly in 'IO'. Often the performance difference does not matter. However,+-- when many hashes are computed one should prefer the variants that run in+-- 'IO'. When a 'ResetableHash' instance is available it provides the most+-- efficient way to compute many hashes in a tight loop.++, hashPtr_+, hashStorable_+, hashByteString_+, hashByteStringLazy_+, hashShortByteString_+, hashByteArray_+ -- * Incremental Hashing , updateByteString , updateByteStringLazy@@ -64,15 +80,15 @@     finalize ctx {-# INLINE hashPtr #-} -hashByteString :: forall a . Hash a => Salt a -> B.ByteString -> a-hashByteString k b = unsafeDupablePerformIO $ do+hashByteString :: forall a . Hash a => Salt a -> B.ByteString -> IO a+hashByteString k b = do         ctx <- initialize @a k         updateByteString @a ctx b         finalize ctx {-# INLINE hashByteString #-} -hashByteStringLazy :: forall a . Hash a => Salt a -> BL.ByteString -> a-hashByteStringLazy k b = unsafeDupablePerformIO $ do+hashByteStringLazy :: forall a . Hash a => Salt a -> BL.ByteString -> IO a+hashByteStringLazy k b = do         ctx <- initialize @a k         updateByteStringLazy @a ctx b         finalize ctx@@ -98,4 +114,31 @@         updateByteArray @a ctx b         finalize ctx {-# INLINE hashByteArray #-}++-- -------------------------------------------------------------------------- --+-- Pure variants++hashPtr_ :: forall a . Hash a => Salt a -> Ptr Word8 -> Int -> a+hashPtr_ s ptr = unsafePerformIO . hashPtr s ptr+{-# INLINE hashPtr_ #-}++hashByteString_ :: forall a . Hash a => Salt a -> B.ByteString -> a+hashByteString_ s = unsafePerformIO . hashByteString s+{-# INLINE hashByteString_ #-}++hashByteStringLazy_ :: forall a . Hash a => Salt a -> BL.ByteString -> a+hashByteStringLazy_ s = unsafePerformIO . hashByteStringLazy s+{-# INLINE hashByteStringLazy_ #-}++hashShortByteString_ :: forall a . Hash a => Salt a -> BS.ShortByteString -> a+hashShortByteString_ s = unsafePerformIO . hashShortByteString s+{-# INLINE hashShortByteString_ #-}++hashStorable_ :: forall a b . Hash a => Storable b => Salt a -> b -> a+hashStorable_ s = unsafePerformIO . hashStorable s+{-# INLINE hashStorable_ #-}++hashByteArray_ :: forall a . Hash a => Salt a -> ByteArray# -> a+hashByteArray_ s a = unsafePerformIO $ hashByteArray s a+{-# INLINE hashByteArray_ #-} 

@@ -1,8 +1,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -13,13 +17,15 @@  -- | -- Module: Data.Hash.Internal.OpenSSL--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- 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+-- Bindings for OpenSSL EVP Message Digest Routines. --+-- Requires OpenSSL version >= 1.1.0+-- module Data.Hash.Internal.OpenSSL ( @@ -32,6 +38,7 @@ , initCtx , updateCtx , finalCtx+, fetchAlgorithm  -- * Algorithms @@ -58,13 +65,17 @@ , Sha3_384(..) , Sha3_512(..) , Shake128(..)+, type Shake128_256 , Shake256(..)+, type Shake256_512  -- ** Keccak -- -- $keccak +, Keccak224(..) , Keccak256(..)+, Keccak384(..) , Keccak512(..)  -- *** Unsafe finalize functions@@ -82,52 +93,146 @@ import Control.Exception import Control.Monad -import qualified Data.ByteString.Short as BS+import Data.ByteString.Short qualified as BS+import Data.Typeable import Data.Void import Data.Word +import Foreign.C.String (CString, withCString) 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  -- -------------------------------------------------------------------------- ----- OpenSSL Message Digests+--+-- 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 (Show)  instance Exception OpenSslException -newtype Algorithm = Algorithm (Ptr Void)-newtype Ctx a = Ctx (ForeignPtr Void)+-- -------------------------------------------------------------------------- --+-- 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 _ = show (typeRep (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 -} -> CString -> CString -> 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+    withCString name $ \namePtr -> mask_ $ do+        ptr <- c_evp_md_fetch nullPtr namePtr (Ptr "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 :: CString -> IO (Ptr 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 name = do+    withCString name $ \namePtr -> mask_ $ do+        ptr <- c_EVP_get_digestbyname namePtr+        when (ptr == nullPtr) $ throw $ OpenSslException $ "fetching algorithm failed: " <> name+        Algorithm <$> newForeignPtr_ 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 (Eq, Ord)-    deriving (Show) via B16ShortByteString+    deriving (Show, IsString) via B16ShortByteString -#if OPENSSL_VERSION_NUMBER >= 0x10100000L+-- | 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"-#else-foreign import ccall unsafe "openssl/evp.h EVP_MD_CTX_create"-#endif     c_evp_ctx_new :: IO (Ptr a) -#if OPENSSL_VERSION_NUMBER >= 0x10100000L foreign import ccall unsafe "openssl/evp.h &EVP_MD_CTX_free"-#else-foreign import ccall unsafe "openssl/evp.h &EVP_MD_CTX_destroy"-#endif     c_evp_ctx_free_ptr :: FunPtr (Ptr a -> IO ())  #if OPENSSL_VERSION_NUMBER >= 0x30000000L@@ -141,35 +246,40 @@     c_evp_digest_update :: Ptr ctx -> Ptr d -> Int -> IO Bool  foreign import ccall unsafe "openssl/evp.h EVP_DigestFinal_ex"-    c_evp_digest_final :: Ptr ctx -> Ptr d -> Int -> IO Bool+    c_evp_digest_final :: Ptr ctx -> Ptr d -> Ptr Int -> IO Bool  #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_ctx_get0_md :: Ptr ctx -> IO Algorithm+    c_evp_md_ctx_get0_md :: Ptr ctx -> Ptr 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_get_size :: Algorithm -> IO Int+    c_evp_md_get_size :: Ptr a -> Int +newCtx :: IO (Ctx a)+newCtx = mask_ $ do+    ptr <- c_evp_ctx_new+    when (ptr == nullPtr) $ throw $ OpenSslException "failed to create new context"+    Ctx <$> newForeignPtr c_evp_ctx_free_ptr ptr+{-# INLINE newCtx #-}+ -- | Allocates and initializes a new context. The context may be reused by -- calling 'resetCtx' on it. ---initCtx :: Algorithm -> IO (Ctx a)+initCtx :: Algorithm a -> IO (Ctx a) initCtx (Algorithm alg) = do-    ctx <- mask_ $ do-        ptr <- c_evp_ctx_new-        when (ptr == nullPtr) $ throw $ OpenSslException "failed to create new context"-        newForeignPtr c_evp_ctx_free_ptr ptr-    r <- withForeignPtr ctx $ \ptr ->-        c_evp_digest_init ptr alg nullPtr+    c@(Ctx ctx) <- newCtx+    r <- withForeignPtr ctx $ \ctxPtr ->+        withForeignPtr alg $ \algPtr ->+            c_evp_digest_init ctxPtr algPtr nullPtr     unless r $ throw $ OpenSslException "digest initialization failed"-    return $ Ctx ctx+    return c {-# INLINE initCtx #-}  -- | Resets a context an initialize context.@@ -193,36 +303,101 @@ -- finalCtx :: Ctx a -> IO (Digest a) finalCtx (Ctx ctx) = withForeignPtr ctx $ \ptr -> do-    s <- c_evp_ctx_get0_md ptr >>= c_evp_get_size+    let s = c_evp_md_get_size (c_evp_md_ctx_get0_md ptr)     allocaBytes s $ \dptr -> do-        r <- c_evp_digest_final ptr dptr 0+        r <- c_evp_digest_final ptr dptr nullPtr         unless r $ throw $ OpenSslException "digest finalization failed"         Digest <$> BS.packCStringLen (dptr, s) {-# INLINE finalCtx #-}  -- -------------------------------------------------------------------------- ----- Support for DerivingVia+-- Hash Instances for Digest -class OpenSslDigest a where-    algorithm :: Algorithm+instance OpenSslDigest a => Hash (Digest a) where+    initialize = initCtx (algorithm @a)+    {-# INLINE initialize #-} -instance OpenSslDigest a => IncrementalHash (Digest a) where+instance IncrementalHash (Digest a) where     type Context (Digest a) = Ctx a     update = updateCtx     finalize = finalCtx     {-# INLINE update #-}     {-# INLINE finalize #-} -instance OpenSslDigest a => Hash (Digest a) where-    initialize = initCtx (algorithm @a)+instance ResetableHash (Digest a) where+    reset = resetCtx+    {-# INLINE reset #-}++-- -------------------------------------------------------------------------- --+-- Hashes based on extendable-output functions (XOF)++newtype XOF_Digest (n :: Natural) a = XOF_Digest BS.ShortByteString+    deriving (Eq, Ord)+    deriving (Hash, ResetableHash) via (Digest a)+    deriving (Show, IsString) via B16ShortByteString++foreign import ccall unsafe "openssl/evp.h EVP_DigestFinalXOF"+    c_EVP_DigestFinalXOF :: Ptr ctx -> Ptr d -> Int -> IO Bool++-- | 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 (Ctx ctx) = withForeignPtr ctx $ \ptr -> do+    allocaBytes s $ \dptr -> do+        r <- c_EVP_DigestFinalXOF ptr dptr s+        unless r $ throw $ OpenSslException "digest finalization failed"+        XOF_Digest <$> BS.packCStringLen (dptr, s)+  where+    s = fromIntegral $ natVal' @n proxy#+{-# INLINE xof_finalCtx #-}++instance KnownNat n => IncrementalHash (XOF_Digest n a) where+    type Context (XOF_Digest n a) = Ctx a+    update = updateCtx+    finalize = xof_finalCtx+    {-# INLINE update #-}+    {-# INLINE finalize #-}++#if OPENSSL_VERSION_NUMBER < 0x30200000L+-- -------------------------------------------------------------------------- --+-- Legacy Keccak Implementation++newtype LegacyKeccak_Digest a = LegacyKeccak_Digest BS.ShortByteString+    deriving (Eq, Ord)+    deriving (IncrementalHash) via (Digest a)+    deriving (Show, IsString) via B16ShortByteString++foreign import ccall unsafe "keccak.h keccak_EVP_DigestInit_ex"+    c_keccak_EVP_DigestInit_ex :: Ptr ctx -> Ptr a -> IO Bool++legacyKeccak_initCtx :: Algorithm a -> IO (Ctx a)+legacyKeccak_initCtx (Algorithm alg) = do+    c@(Ctx ctx) <- newCtx+    r <- withForeignPtr ctx $ \ctxPtr ->+        withForeignPtr alg $ \algPtr ->+            c_keccak_EVP_DigestInit_ex ctxPtr algPtr+    unless r $ throw $ OpenSslException "digest initialization failed"+    return c+{-# INLINE legacyKeccak_initCtx #-}++legacyKeccak_resetCtx :: Ctx a -> IO ()+legacyKeccak_resetCtx (Ctx ctx) = do+    r <- withForeignPtr ctx $ \ptr ->+        c_keccak_EVP_DigestInit_ex ptr nullPtr+    unless r $ throw $ OpenSslException "digest re-initialization failed"+{-# INLINE legacyKeccak_resetCtx #-}++instance OpenSslDigest a => Hash (LegacyKeccak_Digest a) where+    initialize = legacyKeccak_initCtx (algorithm @a)     {-# INLINE initialize #-} -instance OpenSslDigest a => ResetableHash (Digest a) where-    reset = resetCtx+instance ResetableHash (LegacyKeccak_Digest a) where+    reset = legacyKeccak_resetCtx     {-# INLINE reset #-}+#endif  -- -------------------------------------------------------------------------- ----- Digests+-- Concrete Digests -- -------------------------------------------------------------------------- --  -- -------------------------------------------------------------------------- --@@ -237,63 +412,71 @@ -- 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) ----- EVP_sha224, EVP_sha256, EVP_sha512_224, EVP_sha512_256, EVP_sha384,--- EVP_sha512---+-- SHA2-224, SHA2-256, SHA2-512/224, SHA2-512/256, SHA2-384, SHA2-512 -foreign import ccall unsafe "openssl/evp.h EVP_sha224"-    c_evp_sha2_224 :: Algorithm -foreign import ccall unsafe "openssl/evp.h EVP_sha256"-    c_evp_sha2_256 :: Algorithm+-- OpenSSL < 3.0 uses legacy algorithm names. This should be replaced in the+-- code when the support for older versions of OpenSSL is removed. -foreign import ccall unsafe "openssl/evp.h EVP_sha384"-    c_evp_sha2_384 :: Algorithm+sha2_224 :: Algorithm Sha2_224+sha2_224 = unsafePerformIO $ fetchAlgorithm "SHA224"+{-# NOINLINE sha2_224 #-} -foreign import ccall unsafe "openssl/evp.h EVP_sha512"-    c_evp_sha2_512 :: Algorithm+sha2_256 :: Algorithm Sha2_256+sha2_256 = unsafePerformIO $ fetchAlgorithm "SHA256"+{-# NOINLINE sha2_256 #-} -foreign import ccall unsafe "openssl/evp.h EVP_sha512_224"-    c_evp_sha2_512_224 :: Algorithm+sha2_384 :: Algorithm Sha2_384+sha2_384 = unsafePerformIO $ fetchAlgorithm "SHA384"+{-# NOINLINE sha2_384 #-} -foreign import ccall unsafe "openssl/evp.h EVP_sha512_256"-    c_evp_sha2_512_256 :: Algorithm+sha2_512 :: Algorithm Sha2_512+sha2_512 = unsafePerformIO $ fetchAlgorithm "SHA512"+{-# NOINLINE sha2_512 #-} +sha2_512_224 :: Algorithm Sha2_512_224+sha2_512_224 = unsafePerformIO $ fetchAlgorithm "SHA512-224"+{-# NOINLINE sha2_512_224 #-}++sha2_512_256 :: Algorithm Sha2_512_256+sha2_512_256 = unsafePerformIO $ fetchAlgorithm "SHA512-256"+{-# NOINLINE sha2_512_256 #-}+ newtype Sha2_224 = Sha2_224 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha2_224)-instance OpenSslDigest Sha2_224 where algorithm = c_evp_sha2_224+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha2_224)+instance OpenSslDigest Sha2_224 where algorithm = sha2_224  newtype Sha2_256 = Sha2_256 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha2_256)-instance OpenSslDigest Sha2_256 where algorithm = c_evp_sha2_256+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha2_256)+instance OpenSslDigest Sha2_256 where algorithm = sha2_256  newtype Sha2_384 = Sha2_384 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha2_384)-instance OpenSslDigest Sha2_384 where algorithm = c_evp_sha2_384+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha2_384)+instance OpenSslDigest Sha2_384 where algorithm = sha2_384  newtype Sha2_512 = Sha2_512 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha2_512)-instance OpenSslDigest Sha2_512 where algorithm = c_evp_sha2_512+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha2_512)+instance OpenSslDigest Sha2_512 where algorithm = sha2_512  newtype Sha2_512_224 = Sha2_512_224 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha2_512_224)-instance OpenSslDigest Sha2_512_224 where algorithm = c_evp_sha2_512_224+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha2_512_224)+instance OpenSslDigest Sha2_512_224 where algorithm = sha2_512_224  newtype Sha2_512_256 = Sha2_512_256 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha2_512_256)-instance OpenSslDigest Sha2_512_256 where algorithm = c_evp_sha2_512_256+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha2_512_256)+instance OpenSslDigest Sha2_512_256 where algorithm = sha2_512_256  -- -------------------------------------------------------------------------- -- -- SHA-3@@ -307,65 +490,73 @@ -- 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) ----- EVP_sha3_224, EVP_sha3_256, EVP_sha3_384, EVP_sha3_512, EVP_shake128,--- EVP_shake256+-- SHA3-3_224, SHA3-3_256, SHA3-3_384, SHA3-3_512, SHAKE128, SHAKE256 -foreign import ccall unsafe "openssl/evp.h EVP_sha3_224"-    c_evp_sha3_224 :: Algorithm+sha3_224 :: Algorithm Sha3_224+sha3_224 = unsafePerformIO $ fetchAlgorithm "SHA3-224"+{-# NOINLINE sha3_224 #-} -foreign import ccall unsafe "openssl/evp.h EVP_sha3_256"-    c_evp_sha3_256 :: Algorithm+sha3_256 :: Algorithm Sha3_256+sha3_256 = unsafePerformIO $ fetchAlgorithm "SHA3-256"+{-# NOINLINE sha3_256 #-} -foreign import ccall unsafe "openssl/evp.h EVP_sha3_384"-    c_evp_sha3_384 :: Algorithm+sha3_384 :: Algorithm Sha3_384+sha3_384 = unsafePerformIO $ fetchAlgorithm "SHA3-384"+{-# NOINLINE sha3_384 #-} -foreign import ccall unsafe "openssl/evp.h EVP_sha3_512"-    c_evp_sha3_512 :: Algorithm+sha3_512 :: Algorithm Sha3_512+sha3_512 = unsafePerformIO $ fetchAlgorithm "SHA3-512"+{-# NOINLINE sha3_512 #-} -foreign import ccall unsafe "openssl/evp.h EVP_shake128"-    c_evp_shake128 :: Algorithm+shake128 :: Algorithm (Shake128 n)+shake128 = unsafePerformIO $ fetchAlgorithm "SHAKE128"+{-# NOINLINE shake128 #-} -foreign import ccall unsafe "openssl/evp.h EVP_shake256"-    c_evp_shake256 :: Algorithm+shake256 :: Algorithm (Shake256 n)+shake256 = unsafePerformIO $ fetchAlgorithm "SHAKE256"+{-# NOINLINE shake256 #-}  newtype Sha3_224 = Sha3_224 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha3_224)-instance OpenSslDigest Sha3_224 where algorithm = c_evp_sha3_224+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha3_224)+instance OpenSslDigest Sha3_224 where algorithm = sha3_224  newtype Sha3_256 = Sha3_256 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha3_256)-instance OpenSslDigest Sha3_256 where algorithm = c_evp_sha3_256+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha3_256)+instance OpenSslDigest Sha3_256 where algorithm = sha3_256  newtype Sha3_384 = Sha3_384 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha3_384)-instance OpenSslDigest Sha3_384 where algorithm = c_evp_sha3_384+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha3_384)+instance OpenSslDigest Sha3_384 where algorithm = sha3_384  newtype Sha3_512 = Sha3_512 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Sha3_512)-instance OpenSslDigest Sha3_512 where algorithm = c_evp_sha3_512+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (Digest Sha3_512)+instance OpenSslDigest Sha3_512 where algorithm = sha3_512 -newtype Shake128 = Shake128 BS.ShortByteString+newtype Shake128 (bits :: Natural) = Shake128 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Shake128)-instance OpenSslDigest Shake128 where algorithm = c_evp_shake128+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (XOF_Digest bits (Shake128 bits))+instance OpenSslDigest (Shake128 n) where algorithm = shake128 -newtype Shake256 = Shake256 BS.ShortByteString+newtype Shake256 (bits :: Natural) = Shake256 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString-    deriving (IncrementalHash, Hash) via (Digest Shake256)-instance OpenSslDigest Shake256 where algorithm = c_evp_shake256+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (XOF_Digest bits (Shake256 bits))+instance OpenSslDigest (Shake256 n) where algorithm = shake256 +type Shake128_256 = Shake128 32+type Shake256_512 = Shake256 64+ -- -------------------------------------------------------------------------- ----- Keccak+-- Keccak for OpenSSL >=3.2  -- $keccak --@@ -378,6 +569,12 @@ -- -- 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.@@ -386,57 +583,55 @@ -- OPENSSL. -- -- For details see the file cbits/keccak.c.---- KECCAK-256--newtype Keccak256 = Keccak256 BS.ShortByteString-    deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString+#endif -foreign import ccall unsafe "keccak.h keccak256_newctx"-    c_keccak256_newctx :: IO (Ptr ctx)+#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 -foreign import ccall unsafe "keccak.h keccak256_init"-    c_keccak256_init :: Ptr ctx -> IO Bool+keccak_224 :: Algorithm Keccak224+keccak_224 = unsafePerformIO $ fetchAlgorithm KECCAK(224)+{-# NOINLINE keccak_224 #-} -foreign import ccall unsafe "keccak.h keccak256_reset"-    c_keccak256_reset :: Ptr ctx -> IO Bool+keccak_256 :: Algorithm Keccak256+keccak_256 = unsafePerformIO $ fetchAlgorithm KECCAK(256)+{-# NOINLINE keccak_256 #-} -foreign import ccall unsafe "keccak.h keccak256_update"-    c_keccak256_update :: Ptr ctx -> Ptr Word8 -> Int -> IO Bool+keccak_384 :: Algorithm Keccak384+keccak_384 = unsafePerformIO $ fetchAlgorithm KECCAK(384)+{-# NOINLINE keccak_384 #-} -foreign import ccall unsafe "keccak.h keccak256_final"-    c_keccak256_final :: Ptr ctx -> Ptr Word8 -> IO Bool+keccak_512 :: Algorithm Keccak512+keccak_512 = unsafePerformIO $ fetchAlgorithm KECCAK(512)+{-# NOINLINE keccak_512 #-} -foreign import ccall unsafe "keccak.h &keccak256_freectx"-    c_keccak256_freectx_ptr :: FunPtr (Ptr ctx -> IO ())+newtype Keccak224 = Keccak224 BS.ShortByteString+    deriving (Eq, Ord)+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (KECCAK_DIGEST Keccak224)+instance OpenSslDigest Keccak224 where algorithm = keccak_224 -instance IncrementalHash Keccak256 where-    type Context Keccak256 = Ctx Keccak256-    update (Ctx ctx) ptr n = withForeignPtr ctx $ \cptr -> do-        r <- c_keccak256_update cptr ptr n-        unless r $ throw $ OpenSslException "digest update failed"-    finalize (Ctx ctx) = withForeignPtr ctx $ \cptr -> do-        allocaBytes 32 $ \dptr -> do-            r <- c_keccak256_final cptr dptr-            unless r $ throw $ OpenSslException "digest finalization failed"-            Keccak256 <$> BS.packCStringLen (castPtr dptr, 32)-    {-# INLINE update #-}-    {-# INLINE finalize #-}+newtype Keccak256 = Keccak256 BS.ShortByteString+    deriving (Eq, Ord)+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (KECCAK_DIGEST Keccak256)+instance OpenSslDigest Keccak256 where algorithm = keccak_256 -newKeccak256Ctx :: IO (Ctx Keccak256)-newKeccak256Ctx = fmap Ctx $ mask_ $ do-    ptr <- c_keccak256_newctx-    when (ptr == nullPtr) $ throw $ OpenSslException "failed to initialize context"-    newForeignPtr c_keccak256_freectx_ptr ptr-{-# INLINE newKeccak256Ctx #-}+newtype Keccak384 = Keccak384 BS.ShortByteString+    deriving (Eq, Ord)+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (KECCAK_DIGEST Keccak384)+instance OpenSslDigest Keccak384 where algorithm = keccak_384 -resetKeccak256Ctx :: Ctx Keccak256 -> IO ()-resetKeccak256Ctx (Ctx ctx) = do-    r <- withForeignPtr ctx $ \ptr ->-        c_keccak256_reset ptr-    unless r $ throw $ OpenSslException "digest re-initialization failed"-{-# INLINE resetKeccak256Ctx #-}+newtype Keccak512 = Keccak512 BS.ShortByteString+    deriving (Eq, Ord)+    deriving (Show, IsString) via B16ShortByteString+    deriving (IncrementalHash, Hash, ResetableHash) via (KECCAK_DIGEST Keccak512)+instance OpenSslDigest Keccak512 where algorithm = 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.@@ -446,74 +641,10 @@ finalizeKeccak256Ptr :: Ctx Keccak256 -> Ptr Word8 -> IO () finalizeKeccak256Ptr (Ctx ctx) dptr =     withForeignPtr ctx $ \cptr -> do-        r <- c_keccak256_final cptr dptr+        r <- c_evp_digest_final cptr dptr nullPtr         unless r $ throw $ OpenSslException "digest finalization failed" {-# INLINE finalizeKeccak256Ptr #-} -instance Hash Keccak256 where-    initialize = do-        Ctx ctx <- newKeccak256Ctx-        r <- withForeignPtr ctx $ \ptr ->-            c_keccak256_init ptr-        unless r $ throw $ OpenSslException "digest initialization failed"-        return $ Ctx ctx-    {-# INLINE initialize #-}--instance ResetableHash Keccak256 where-    reset = resetKeccak256Ctx-    {-# INLINE reset #-}---- KECCAK-512--newtype Keccak512 = Keccak512 BS.ShortByteString-    deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString--foreign import ccall unsafe "keccak.h keccak512_newctx"-    c_keccak512_newctx :: IO (Ptr ctx)--foreign import ccall unsafe "keccak.h keccak512_init"-    c_keccak512_init :: Ptr ctx -> IO Bool--foreign import ccall unsafe "keccak.h keccak512_reset"-    c_keccak512_reset :: Ptr ctx -> IO Bool--foreign import ccall unsafe "keccak.h keccak512_update"-    c_keccak512_update :: Ptr ctx -> Ptr Word8 -> Int -> IO Bool--foreign import ccall unsafe "keccak.h keccak512_final"-    c_keccak512_final :: Ptr ctx -> Ptr Word8 -> IO Bool--foreign import ccall unsafe "keccak.h &keccak512_freectx"-    c_keccak512_freectx_ptr :: FunPtr (Ptr ctx -> IO ())--instance IncrementalHash Keccak512 where-    type Context Keccak512 = Ctx Keccak512-    update (Ctx ctx) ptr n = withForeignPtr ctx $ \cptr -> do-        r <- c_keccak512_update cptr ptr n-        unless r $ throw $ OpenSslException "digest update failed"-    finalize (Ctx ctx) = withForeignPtr ctx $ \cptr -> do-        allocaBytes 64 $ \dptr -> do-            r <- c_keccak512_final cptr dptr-            unless r $ throw $ OpenSslException "digest finalization failed"-            Keccak512 <$> BS.packCStringLen (castPtr dptr, 64)-    {-# INLINE update #-}-    {-# INLINE finalize #-}--newKeccak512Ctx :: IO (Ctx Keccak512)-newKeccak512Ctx = fmap Ctx $ mask_ $ do-    ptr <- c_keccak512_newctx-    when (ptr == nullPtr) $ throw $ OpenSslException "failed to initialize context"-    newForeignPtr c_keccak512_freectx_ptr ptr-{-# INLINE newKeccak512Ctx #-}--resetKeccak512Ctx :: Ctx Keccak512 -> IO ()-resetKeccak512Ctx (Ctx ctx) = do-    r <- withForeignPtr ctx $ \ptr ->-        c_keccak512_reset ptr-    unless r $ throw $ OpenSslException "digest re-initialization failed"-{-# INLINE resetKeccak512Ctx #-}- -- | 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@@ -522,23 +653,10 @@ finalizeKeccak512Ptr :: Ctx Keccak512 -> Ptr Word8 -> IO () finalizeKeccak512Ptr (Ctx ctx) dptr = do     withForeignPtr ctx $ \cptr -> do-        r <- c_keccak512_final cptr dptr+        r <- c_evp_digest_final cptr dptr nullPtr         unless r $ throw $ OpenSslException "digest finalization failed" {-# INLINE finalizeKeccak512Ptr #-} -instance Hash Keccak512 where-    initialize = do-        Ctx ctx <- newKeccak512Ctx-        r <- withForeignPtr ctx $ \ptr ->-            c_keccak512_init ptr-        unless r $ throw $ OpenSslException "digest initialization failed"-        return $ Ctx ctx-    {-# INLINE initialize #-}--instance ResetableHash Keccak512 where-    reset = resetKeccak512Ctx-    {-# INLINE reset #-}- -- -------------------------------------------------------------------------- -- -- Blake @@ -552,29 +670,29 @@ -- openssl-3.0 (cf. -- https://www.openssl.org/docs/man3.0/man3/EVP_blake2b512.html) ----- EVP_blake2b512, EVP_blake2s256+-- 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.------ -foreign import ccall unsafe "openssl/evp.h EVP_blake2b512"-    c_evp_blake2b512 :: Algorithm+blake2b512 :: Algorithm Blake2b512+blake2b512 = unsafePerformIO $ fetchAlgorithm "BLAKE2b512"+{-# NOINLINE blake2b512 #-} -foreign import ccall unsafe "openssl/evp.h EVP_blake2s256"-    c_evp_blake2s256 :: Algorithm+blake2s256 :: Algorithm Blake2s256+blake2s256 = unsafePerformIO $ fetchAlgorithm "BLAKE2s256"+{-# NOINLINE blake2s256 #-}  newtype Blake2b512 = Blake2b512 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString+    deriving (Show, IsString) via B16ShortByteString     deriving (IncrementalHash, Hash) via (Digest Blake2b512)-instance OpenSslDigest Blake2b512 where algorithm = c_evp_blake2b512+instance OpenSslDigest Blake2b512 where algorithm = blake2b512  newtype Blake2s256 = Blake2s256 BS.ShortByteString     deriving (Eq, Ord)-    deriving (Show) via B16ShortByteString+    deriving (Show, IsString) via B16ShortByteString     deriving (IncrementalHash, Hash) via (Digest Blake2s256)-instance OpenSslDigest Blake2s256 where algorithm = c_evp_blake2s256+instance OpenSslDigest Blake2s256 where algorithm = blake2s256 

@@ -1,18 +1,26 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}  -- | -- Module: Data.Hash.Internal.Utils--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental -- module Data.Hash.Internal.Utils ( B16ShortByteString(..)+, b16 ) where +import Data.Bits+import Data.Char+import Data.String+import Data.ByteString qualified as B import qualified Data.ByteString.Short as BS  import Text.Printf@@ -20,8 +28,25 @@ -- -------------------------------------------------------------------------- -- -- Utils -newtype B16ShortByteString = B16ShortByteString BS.ShortByteString+newtype B16ShortByteString = B16ShortByteString+    { _unB16ShortByteString :: BS.ShortByteString } +b16 :: B16ShortByteString -> B.ByteString+b16 (B16ShortByteString b) = BS.fromShort b+ instance Show B16ShortByteString where     show (B16ShortByteString b) = concatMap (printf "%0.2x") $ BS.unpack b++-- This is rather inefficient. It is intended for string literals, debugging,+-- and testing.+--+instance IsString B16ShortByteString where+    fromString l+        | odd (length l) =+            error "Data.Hash.Internal.Utils.B16ShortByteString.fromString: odd input length"+        | otherwise = B16ShortByteString $ BS.pack $ go l+      where+        go [] = mempty+        go [_] = error "Data.Hash.Internal.Utils.B16ShortByteString.fromString: odd input length"+        go (a:b:t) = fromIntegral (shiftL (digitToInt a) 4 + digitToInt b) : go t 

@@ -3,7 +3,7 @@  -- | -- Module: Data.Hash.Keccak--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental

@@ -1,6 +1,6 @@ -- | -- Module: Data.Hash.SHA2--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental

@@ -1,6 +1,8 @@+{-# LANGUAGE ExplicitNamespaces #-}+ -- | -- Module: Data.Hash.SHA3--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental@@ -20,7 +22,9 @@ , Sha3_384(..) , Sha3_512(..) , Shake128(..)+, type Shake128_256 , Shake256(..)+, type Shake256_512  , module Data.Hash.Class.Mutable ) where

@@ -14,7 +14,7 @@  -- | -- Module: Data.Hash.SipHash--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental

@@ -9,7 +9,7 @@  -- | -- Module: Cryptonite--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental@@ -73,7 +73,7 @@   where     bytes = B.pack b     cryptonite = BS.toShort $ BA.convert $ C.hash @_ @calg bytes-    internal = coerce $ M.hashByteString @alg bytes+    internal = coerce $ M.hashByteString_ @alg bytes #endif  -- -------------------------------------------------------------------------- --

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} -- | -- Module: Main--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental@@ -16,7 +16,9 @@ import qualified Test.Data.Hash.Class.Pure  #if defined(WITH_OPENSSL)+import qualified Test.Data.Hash.SHA2 import qualified Test.Data.Hash.SHA3+import qualified Test.Data.Hash.Keccak #endif  #if defined(TEST_CRYPTONITE)@@ -35,7 +37,9 @@     describe "Test.Data.Hash.Class.Pure" Test.Data.Hash.Class.Pure.tests  #if defined(WITH_OPENSSL)+    describe "Test.Data.Hash.SHA2" Test.Data.Hash.SHA2.tests     describe "Test.Data.Hash.SHA3" Test.Data.Hash.SHA3.tests+    describe "Test.Data.Hash.Keccak" Test.Data.Hash.Keccak.tests #endif  #if defined(TEST_CRYPTONITE)

@@ -0,0 +1,115 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Test.Data.Hash.Keccak+-- Copyright: Copyright © 2024 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+module Test.Data.Hash.Keccak+( tests+) where++import Data.ByteString qualified as B+import Data.ByteString.Short qualified as BS+import Data.Coerce+import Data.String++import Test.QuickCheck+import Test.Syd++-- internal modules++import Data.Hash.Internal.Utils+import Data.Hash.Keccak+import Data.Hash.SHA2+import Data.Hash.SHA3++-- -------------------------------------------------------------------------- --++tests :: Spec+tests = describe "Keccak Test Vectors" $ do+    describe "Keccak256" $ do+        examples256+        badExamples256+        correctKeccakVersion++-- -------------------------------------------------------------------------- --+-- Trivial Tests++examples256 :: Spec+examples256 = describe "example hashes" $ do+    succeed @Keccak256 "" "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470"+    succeed @Keccak256 "1234" "56570de287d73cd1cb6092bb8fdee6173974955fdef345ae579ee9f475ea7432"+    succeed @Keccak256 helloWorld "47173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fad"++badExamples256 :: Spec+badExamples256 = describe "bad example hashes fail" $ do+    failTest @Keccak256 "" "c5d2460186f7233c927e7db2dcc603c0e500b653ca82273b7bfad8045d85a470"+    failTest @Keccak256 "00" "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470"+    failTest @Keccak256 "1234" "56570de287d73cd1cb6092bb8fdef6173974955fdef345ae579ee9f475ea7432"+    failTest @Keccak256 "0234" "56570de287d73cd1cb6092bb8fdee6173974955fdef345ae579ee9f475ea7432"+    failTest @Keccak256 "1235" "56570de287d73cd1cb6092bb8fdee6173974955fdef345ae579ee9f475ea7432"+    failTest @Keccak256 helloWorld "47173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fae"+    failTest @Keccak256 helloWorld "57173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fad"+    failTest @Keccak256 helloWorld "07173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fad"++correctKeccakVersion :: Spec+correctKeccakVersion = describe "correct Keccak version" $ do+    it "is 32 bytes long" $+        shouldBe (BS.length (coerce (hashByteString_ @Keccak256 ""))) 32+    describe "Keccak256 is not SHA3" $ do+        failTest @Sha3_256 "" "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470"+        failTest @Sha3_256 "1234" "56570de287d73cd1cb6092bb8fdee6173974955fdef345ae579ee9f475ea7432"+        failTest @Sha3_256 helloWorld "47173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fad"++        it "yields different results" $ property $ \l ->+            let bs = fromString @B.ByteString l+            in (hashByteString_ @Keccak256 bs) =/= coerce (hashByteString_ @Sha3_256 bs)++    describe "Keccak256 is not SHA2" $ do+        failTest @Sha2_256 "" "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470"+        failTest @Sha2_256 "1234" "56570de287d73cd1cb6092bb8fdee6173974955fdef345ae579ee9f475ea7432"+        failTest @Sha2_256 helloWorld "47173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fad"++        it "yields different results" $ property $ \l ->+            let bs = fromString @B.ByteString l+            in (hashByteString_ @Keccak256 bs) =/= coerce (hashByteString_ @Sha2_256 bs)++-- -------------------------------------------------------------------------- --+-- Tools++helloWorld :: B16ShortByteString+helloWorld = B16ShortByteString "hello world"++succeed+    :: forall a+    . Hash a+    => Eq a+    => Show a+    => Coercible a B16ShortByteString+    => B16ShortByteString+    -> a+    -> TestDefM '[] () ()+succeed a b = do+    it (show a) $ shouldBe (hashShortByteString_ @a $ coerce a) b++failTest+    :: forall a+    . Hash a+    => Eq a+    => Show a+    => Coercible a B16ShortByteString+    => B16ShortByteString+    -> a+    -> TestDefM '[] () ()+failTest a b = do+    it (show a) $ shouldNotBe (hashShortByteString_ @a $ coerce a) b+

@@ -0,0 +1,97 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Test.Data.Hash.SHA2+-- Copyright: Copyright © 2024 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- Test with test vectors from the+-- [NIST Cryptographic Algorithm Validation Program](https://csrc.nist.gov/projects/cryptographic-algorithm-validation-program/secure-hashing#Testing).+--+-- For details about the test proceedure cf. https://csrc.nist.gov/csrc/media/projects/cryptographic-algorithm-validation-program/documents/shs/shavs.pdf.+--+-- The test data (response files) are provided by the+-- [sha-validation package](https://hackage.haskell.org/package/sha-validation).+--+module Test.Data.Hash.SHA2+( tests+) where++import qualified Data.ByteString.Short as BS+import Data.Coerce++import Test.Syd+import Test.Hash.SHA++-- internal modules++import Data.Hash.SHA2++-- -------------------------------------------------------------------------- --+--++tests :: Spec+tests = describe "SHA2 Test Vectors" $ do+    shortMsgTests+    longMsgTests+    monteTests++-- -------------------------------------------------------------------------- --+-- NIST Msg Tests++shortMsgTests :: Spec+shortMsgTests = describe "ShortMsg" $ do+    describe "224" $ runMsgTest @Sha2_224 sha224ShortMsg+    describe "256" $ runMsgTest @Sha2_256 sha256ShortMsg+    describe "384" $ runMsgTest @Sha2_384 sha384ShortMsg+    describe "512" $ runMsgTest @Sha2_512 sha512ShortMsg+    describe "512_224" $ runMsgTest @Sha2_512_224 sha512_224ShortMsg+    describe "512_256" $ runMsgTest @Sha2_512_256 sha512_256ShortMsg++longMsgTests :: Spec+longMsgTests = describe "LongMsg" $ do+    describe "224" $ runMsgTest @Sha2_224 sha224LongMsg+    describe "256" $ runMsgTest @Sha2_256 sha256LongMsg+    describe "384" $ runMsgTest @Sha2_384 sha384LongMsg+    describe "512" $ runMsgTest @Sha2_512 sha512LongMsg+    describe "512_224" $ runMsgTest @Sha2_512_224 sha512_224LongMsg+    describe "512_256" $ runMsgTest @Sha2_512_256 sha512_256LongMsg++runMsgTest+    :: forall a+    . Hash a+    => Coercible a BS.ShortByteString+    => MsgFile+    -> Spec+runMsgTest = msgAssert+    (\l a b -> it l (a == b))+    (BS.fromShort . coerce . hashByteString_ @a)++-- -------------------------------------------------------------------------- --+-- Monte Tests++monteTests :: Spec+monteTests = describe "Monte" $ do+    describe "224" $ runMonteTest @Sha2_224 sha224Monte+    describe "256" $ runMonteTest @Sha2_256 sha256Monte+    describe "384" $ runMonteTest @Sha2_384 sha384Monte+    describe "512" $ runMonteTest @Sha2_512 sha512Monte+    describe "512_224" $ runMonteTest @Sha2_512_224 sha512_224Monte+    describe "512_256" $ runMonteTest @Sha2_512_256 sha512_256Monte++runMonteTest+    :: forall a+    . Hash a+    => Coercible a BS.ShortByteString+    => MonteFile+    -> Spec+runMonteTest = monteAssert+    (\l a b -> it l (a == b))+    (BS.fromShort . coerce . hashByteString_ @a)+

@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -6,13 +7,19 @@  -- | -- Module: Test.Data.Hash.SHA3--- Copyright: Copyright © 2022 Kadena LLC.+-- Copyright: Copyright © 2022-2024 Kadena LLC. -- License: MIT -- Maintainer: Lars Kuhtz <lars@kadena.io> -- Stability: experimental ----- TODO+-- Test with test vectors from the+-- [NIST Cryptographic Algorithm Validation Program](https://csrc.nist.gov/projects/cryptographic-algorithm-validation-program/secure-hashing#Testing). --+-- For details about the test proceedure cf. https://csrc.nist.gov/CSRC/media/Projects/Cryptographic-Algorithm-Validation-Program/documents/sha3/sha3vs.pdf+--+-- The test data (response files) are provided by the+-- [sha-validation package](https://hackage.haskell.org/package/sha-validation).+-- module Test.Data.Hash.SHA3 ( tests ) where@@ -26,17 +33,44 @@ -- internal modules  import Data.Hash.SHA3+import Data.Hash.Internal.Utils  -- -------------------------------------------------------------------------- -----  tests :: Spec tests = describe "SHA3 Test Vectors" $ do+    trivial     shortMsgTests     longMsgTests     monteTests  -- -------------------------------------------------------------------------- --+-- Trivial Tests++trivial :: Spec+trivial = describe "trivial hashes" $ do++    go @Sha3_224 "224" "6b4e03423667dbb73b6e15454f0eb1abd4597f9a1b078e3f5b5a6bc7"+    go @Sha3_256 "256" "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a"+    go @Sha3_384 "384" "0c63a75b845e4f7d01107d852e4c2485c51a50aaaa94fc61995e71bbee983a2ac3713831264adb47fb6bd1e058d5f004"+    go @Sha3_512 "512" "a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26"+    go @Shake128_256 "Shake128_256" "7f9c2ba4e88f827d616045507605853ed73b8093f6efbc88eb1a6eacfa66ef26"+    go @Shake256_512 "shake256_512" "46b9dd2b0ba88d13233b3feb743eeb243fcd52ea62b81b82b50c27646ed5762fd75dc4ddd8c0f200cb05019d67b592f6fc821c49479ab48640292eacb3b7c4be"+  where+    go+        :: forall a+        . Hash a+        => Eq a+        => Show a+        => Coercible a B16ShortByteString+        => String+        -> a+        -> TestDefM '[] () ()+    go l b = do+        it l $ shouldBe (hashShortByteString_ @a "") b+++-- -------------------------------------------------------------------------- -- -- Msg Tests  shortMsgTests :: Spec@@ -61,7 +95,7 @@     -> Spec runMsgTest = msgAssert     (\l a b -> it l (a == b))-    (BS.fromShort . coerce . hashByteString @a)+    (BS.fromShort . coerce . hashByteString_ @a)  -- -------------------------------------------------------------------------- -- -- Monte Tests@@ -81,5 +115,5 @@     -> Spec runMonteTest = monteAssert     (\l a b -> it l (a == b))-    (BS.fromShort . coerce . hashByteString @a)+    (BS.fromShort . coerce . hashByteString_ @a) 

@@ -6,7 +6,7 @@  -- | -- Module: Test.Data.Hash.SipHash--- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com> -- License: MIT -- Maintainer: Lars Kuhtz <lakuhtz@gmail.com> -- Stability: experimental@@ -32,7 +32,7 @@ -- Utils  bytesToWord64:: [Word8] -> Word64-bytesToWord64 l = unsafePerformIO $+bytesToWord64 l = unsafeDupablePerformIO $     B.useAsCStringLen (B.pack l) $ \(b, _) -> peek @Word64 (castPtr b)  -- -------------------------------------------------------------------------- --