cryptohash-sha512 0.11.101.0 → 0.11.102.0

raw patch · 10 files changed

+1637/−316 lines, 10 filesdep ~basedep ~bytestringdep ~tastyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, tasty, tasty-quickcheck

API changes (from Hackage documentation)

Files

• cbits/hs_sha512.h +415/−0
• cbits/sha512.h +0/−278
• changelog.md +5/−0
• cryptohash-sha512.cabal +83/−25
• src-tests/test-sha384.hs +244/−0
• src-tests/test-sha512t.hs +237/−0
• src/Crypto/Hash/SHA384.hs +292/−0
• src/Crypto/Hash/SHA512.hs +3/−3
• src/Crypto/Hash/SHA512/FFI.hs +30/−10
• src/Crypto/Hash/SHA512t.hs +328/−0

@@ -0,0 +1,415 @@+/*+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>+ *               2016      Herbert Valerio Riedel <hvr@gnu.org>+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ */++#ifndef CRYPTOHASH_SHA512_H+#define CRYPTOHASH_SHA512_H++#include <stdbool.h>+#include <stdint.h>+#include <stdio.h>+#include <stddef.h>+#include <assert.h>+#include <string.h>+#include <ghcautoconf.h>++struct sha512_ctx+{+  uint64_t sz;+  uint64_t sz_hi;+  uint8_t  buf[128];+  uint64_t h[8];+};++/* keep this synchronised with 'digestSize'/'sizeCtx' in SHA512.hs */+#define SHA512_DIGEST_SIZE	64+#define SHA512t_DIGEST_SIZE(t)	(((t)+7)/8)+#define SHA384_DIGEST_SIZE	48+#define SHA512_CTX_SIZE		208++/* NB: SHA384 and SHA512/t are essentially the same algorithm as SHA512 and+ * therefore share the same data structures and most of the codepaths+ * except for different initialization data and truncating the 512bit+ * digest down to the respective digest bit-length.+ */+static inline void hs_cryptohash_sha384_init(struct sha512_ctx *ctx);+static inline void hs_cryptohash_sha512_init (struct sha512_ctx *ctx);+static inline void hs_cryptohash_sha512t_init(struct sha512_ctx *ctx, const uint16_t t);++static inline void hs_cryptohash_sha512_update (struct sha512_ctx *ctx, const uint8_t *data, size_t len);++static inline uint64_t hs_cryptohash_sha512t_finalize (struct sha512_ctx *ctx, uint16_t outbits, uint8_t *out);++#if defined(static_assert)+static_assert(sizeof(struct sha512_ctx) == SHA512_CTX_SIZE, "unexpected sha512_ctx size");+#else+/* poor man's pre-C11 _Static_assert */+typedef char static_assertion__unexpected_sha512_ctx_size[(sizeof(struct sha512_ctx) == SHA512_CTX_SIZE)?1:-1];+#endif++#define ptr_uint64_aligned(ptr) (!((uintptr_t)(ptr) & 0x7))++static inline uint64_t+ror64(const uint64_t word, const unsigned shift)+{+  /* GCC usually transforms this into a 'ror'-insn */+  return (word >> shift) | (word << (64 - shift));+}++static inline uint64_t+cpu_to_be64(const uint64_t hll)+{+#if WORDS_BIGENDIAN+  return hll;+#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)+  return __builtin_bswap64(hll);+#else+  /* GCC & Clang usually transforms this into a bswap insn */+  return ((hll & 0xff00000000000000) >> 56) |+         ((hll & 0x00ff000000000000) >> 40) |+         ((hll & 0x0000ff0000000000) >> 24) |+         ((hll & 0x000000ff00000000) >>  8) |+         ((hll & 0x00000000ff000000) <<  8) |+         ((hll & 0x0000000000ff0000) << 24) |+         ((hll & 0x000000000000ff00) << 40) |+         ((hll & 0x00000000000000ff) << 56);+#endif+}++static inline void+cpu_to_be64_array(uint64_t *dest, const uint64_t *src, unsigned wordcnt)+{+  while (wordcnt--)+    *dest++ = cpu_to_be64(*src++);+}++static inline void+hs_cryptohash_sha512_init (struct sha512_ctx *ctx)+{+  memset(ctx, 0, SHA512_CTX_SIZE);++  ctx->h[0] = 0x6a09e667f3bcc908ULL;+  ctx->h[1] = 0xbb67ae8584caa73bULL;+  ctx->h[2] = 0x3c6ef372fe94f82bULL;+  ctx->h[3] = 0xa54ff53a5f1d36f1ULL;+  ctx->h[4] = 0x510e527fade682d1ULL;+  ctx->h[5] = 0x9b05688c2b3e6c1fULL;+  ctx->h[6] = 0x1f83d9abfb41bd6bULL;+  ctx->h[7] = 0x5be0cd19137e2179ULL;+}++static inline void+hs_cryptohash_sha384_init (struct sha512_ctx *ctx)+{+  memset(ctx, 0, SHA512_CTX_SIZE);++  ctx->h[0] = 0xcbbb9d5dc1059ed8ULL;+  ctx->h[1] = 0x629a292a367cd507ULL;+  ctx->h[2] = 0x9159015a3070dd17ULL;+  ctx->h[3] = 0x152fecd8f70e5939ULL;+  ctx->h[4] = 0x67332667ffc00b31ULL;+  ctx->h[5] = 0x8eb44a8768581511ULL;+  ctx->h[6] = 0xdb0c2e0d64f98fa7ULL;+  ctx->h[7] = 0x47b5481dbefa4fa4ULL;+}++static inline void+hs_cryptohash_sha512t_init(struct sha512_ctx *ctx, const uint16_t t)+{+  memset(ctx, 0, SHA512_CTX_SIZE);++  if (!((0 < t) && (t < 512)))+    return;++  /* shortcuts for the currently two FIPS 180-4 "approved" parameters */+  switch (t) {+  case 224:+    ctx->h[0] = 0x8c3d37c819544da2ULL;+    ctx->h[1] = 0x73e1996689dcd4d6ULL;+    ctx->h[2] = 0x1dfab7ae32ff9c82ULL;+    ctx->h[3] = 0x679dd514582f9fcfULL;+    ctx->h[4] = 0x0f6d2b697bd44da8ULL;+    ctx->h[5] = 0x77e36f7304c48942ULL;+    ctx->h[6] = 0x3f9d85a86a1d36c8ULL;+    ctx->h[7] = 0x1112e6ad91d692a1ULL;+    return;++  case 256:+    ctx->h[0] = 0x22312194fc2bf72cULL;+    ctx->h[1] = 0x9f555fa3c84c64c2ULL;+    ctx->h[2] = 0x2393b86b6f53b151ULL;+    ctx->h[3] = 0x963877195940eabdULL;+    ctx->h[4] = 0x96283ee2a88effe3ULL;+    ctx->h[5] = 0xbe5e1e2553863992ULL;+    ctx->h[6] = 0x2b0199fc2c85b8aaULL;+    ctx->h[7] = 0x0eb72ddc81c52ca2ULL;+    return;+  }++  /* slow path */+  hs_cryptohash_sha512_init(ctx);+  for (int i = 0; i < 8; i++)+    ctx->h[i] ^= 0xa5a5a5a5a5a5a5a5ULL;++  uint64_t out[8] = { 0, };++  {+    char buf[16] = { 0, };+    const int bufsz = snprintf(buf, 16, "SHA-512/%d", t);+    hs_cryptohash_sha512_update(ctx, (uint8_t*)buf, bufsz);+    hs_cryptohash_sha512t_finalize(ctx, 512, (uint8_t*)out);+  }++  /* re-init the context, otherwise len is changed */+  memset(ctx, 0, SHA512_CTX_SIZE);+  for (int i = 0; i < 8; i++)+    ctx->h[i] = cpu_to_be64(out[i]);++}+++/* 232 times the cube root of the first 64 primes 2..311 */+static const uint64_t k[] = {+  0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL,+  0xe9b5dba58189dbbcULL, 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL,+  0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, 0xd807aa98a3030242ULL,+  0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL,+  0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL,+  0xc19bf174cf692694ULL, 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL,+  0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, 0x2de92c6f592b0275ULL,+  0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL,+  0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL,+  0xbf597fc7beef0ee4ULL, 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL,+  0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, 0x27b70a8546d22ffcULL,+  0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL,+  0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL,+  0x92722c851482353bULL, 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL,+  0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, 0xd192e819d6ef5218ULL,+  0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL,+  0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL,+  0x34b0bcb5e19b48a8ULL, 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL,+  0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, 0x748f82ee5defb2fcULL,+  0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL,+  0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL,+  0xc67178f2e372532bULL, 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL,+  0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, 0x06f067aa72176fbaULL,+  0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL,+  0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL,+  0x431d67c49c100d4cULL, 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL,+  0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL+};++#define e0(x)       (ror64(x, 28) ^ ror64(x, 34) ^ ror64(x, 39))+#define e1(x)       (ror64(x, 14) ^ ror64(x, 18) ^ ror64(x, 41))+#define s0(x)       (ror64(x,  1) ^ ror64(x,  8) ^ (x >> 7))+#define s1(x)       (ror64(x, 19) ^ ror64(x, 61) ^ (x >> 6))++static void+sha512_do_chunk_aligned(struct sha512_ctx *ctx, uint64_t w[])+{+  int i;++  for (i = 16; i < 80; i++)+    w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16];++  uint64_t a = ctx->h[0];+  uint64_t b = ctx->h[1];+  uint64_t c = ctx->h[2];+  uint64_t d = ctx->h[3];+  uint64_t e = ctx->h[4];+  uint64_t f = ctx->h[5];+  uint64_t g = ctx->h[6];+  uint64_t h = ctx->h[7];++#define R(a, b, c, d, e, f, g, h, k, w)             \+    t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w;   \+    t2 = e0(a) + ((a & b) | (c & (a | b)));         \+    d += t1;                                        \+    h = t1 + t2++  for (i = 0; i < 80; i += 8) {+    uint64_t t1, t2;++    R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]);+    R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]);+    R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]);+    R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]);+    R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]);+    R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]);+    R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]);+    R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]);+  }++#undef R++  ctx->h[0] += a;+  ctx->h[1] += b;+  ctx->h[2] += c;+  ctx->h[3] += d;+  ctx->h[4] += e;+  ctx->h[5] += f;+  ctx->h[6] += g;+  ctx->h[7] += h;+}++static void+sha512_do_chunk(struct sha512_ctx *ctx, const uint8_t buf[])+{+  uint64_t w[80]; /* only first 16 words are filled in */+  if (ptr_uint64_aligned(buf)) { /* aligned buf */+    cpu_to_be64_array(w, (const uint64_t *)buf, 16);+  } else { /* unaligned buf */+    memcpy(w, buf, 128);+#if !WORDS_BIGENDIAN+    cpu_to_be64_array(w, w, 16);+#endif+  }+  sha512_do_chunk_aligned(ctx, w);+}++static inline void+hs_cryptohash_sha512_update(struct sha512_ctx *ctx, const uint8_t *data, size_t len)+{+  size_t index = ctx->sz & 0x7f;+  const size_t to_fill = 128 - index;++  ctx->sz += len;+  // handle overflow+  if (ctx->sz < len)+    ctx->sz_hi++;++  /* process partial buffer if there's enough data to make a block */+  if (index && len >= to_fill) {+    memcpy(ctx->buf + index, data, to_fill);+    sha512_do_chunk(ctx, ctx->buf);+    /* memset(ctx->buf, 0, 128); */+    len -= to_fill;+    data += to_fill;+    index = 0;+  }++  /* process as many 128b-blocks as possible */+  while (len >= 128) {+    sha512_do_chunk(ctx, data);+    len -= 128;+    data += 128;+  }++  /* append data into buf */+  if (len)+    memcpy(ctx->buf + index, data, len);+}++static inline uint64_t+hs_cryptohash_sha512t_finalize (struct sha512_ctx *ctx, uint16_t outbits, uint8_t *out)+{+  static const uint8_t padding[128] = { 0x80, };+  const uint64_t sz = ctx->sz;++  /* add padding and update data with it */+  uint64_t bits[2];+  bits[0] = cpu_to_be64((ctx->sz_hi << 3) | (ctx->sz >> 61));+  bits[1] = cpu_to_be64(ctx->sz << 3);++  /* pad out to 112 */+  const size_t index = ctx->sz & 0x7f;+  const size_t padlen = (index < 112) ? (112 - index) : ((128 + 112) - index);+  hs_cryptohash_sha512_update(ctx, padding, padlen);++  /* append length */+  hs_cryptohash_sha512_update(ctx, (uint8_t *) bits, sizeof(bits));++  /* output hash */+  if (outbits > 512)+    outbits = 512; /* clamp to <= 512; better safe than sorry */++  if(outbits % 64 == 0) {+    /* fast path for 0,64,128,192,256,320,384,448,512 */+    cpu_to_be64_array((uint64_t *) out, ctx->h, outbits/64);+  } else {+    /* slow-path */+    uint8_t buf[SHA512_DIGEST_SIZE] = { 0x00, };+    cpu_to_be64_array((uint64_t *) buf, ctx->h, 8);++    const unsigned outbytes = SHA512t_DIGEST_SIZE(outbits);+    assert(outbytes > 0);+    assert(outbytes <= SHA512_DIGEST_SIZE);++    /* Handle case of t parameter not being an integral amount of+     * octects.  FIPS 180-4 states that "the resulting message digest+     * is truncated by selecting an appropriate number of the leftmost+     * bits". Hence in such a case we apply a mask to retain the+     * appropriate number of leftmost bits in the rightmost retained+     * octet.+     */+    const uint8_t outmask = ~(((uint8_t)0xff) >> (outbits % 8));+    if (outmask)+      buf[outbytes-1] &= outmask;++    memcpy(out, buf, outbytes);+  }++  return sz;+}++static inline void+hs_cryptohash_sha512_hash (const uint8_t *data, size_t len, uint8_t *out)+{+  struct sha512_ctx ctx;++  hs_cryptohash_sha512_init(&ctx);++  hs_cryptohash_sha512_update(&ctx, data, len);++  hs_cryptohash_sha512t_finalize(&ctx, 512, out);+}++static inline void+hs_cryptohash_sha384_hash (const uint8_t *data, size_t len, uint8_t *out)+{+  struct sha512_ctx ctx;++  hs_cryptohash_sha384_init(&ctx);++  hs_cryptohash_sha512_update(&ctx, data, len);++  hs_cryptohash_sha512t_finalize(&ctx, 384, out);+}++static inline void+hs_cryptohash_sha512t_hash (const uint8_t *data, size_t len, uint8_t *out, const uint16_t outbits)+{+  struct sha512_ctx ctx;++  if (!(0 < outbits && outbits < 512)) return;++  hs_cryptohash_sha512t_init(&ctx, outbits);++  hs_cryptohash_sha512_update(&ctx, data, len);++  hs_cryptohash_sha512t_finalize(&ctx, outbits, out);+}+++#endif

@@ -1,278 +0,0 @@-/*- * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>- *               2016      Herbert Valerio Riedel <hvr@gnu.org>- *- * Redistribution and use in source and binary forms, with or without- * modification, are permitted provided that the following conditions- * are met:- * 1. Redistributions of source code must retain the above copyright- *    notice, this list of conditions and the following disclaimer.- * 2. Redistributions in binary form must reproduce the above copyright- *    notice, this list of conditions and the following disclaimer in the- *    documentation and/or other materials provided with the distribution.- *- * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.- * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT- * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,- * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY- * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.- */--#ifndef CRYPTOHASH_SHA512_H-#define CRYPTOHASH_SHA512_H--#include <stdint.h>-#include <stddef.h>-#include <assert.h>-#include <string.h>-#include <ghcautoconf.h>--struct sha512_ctx-{-  uint64_t sz;-  uint64_t sz_hi;-  uint8_t  buf[128];-  uint64_t h[8];-};--/* keep this synchronised with 'digestSize'/'sizeCtx' in SHA512.hs */-#define SHA512_DIGEST_SIZE	64-#define SHA512_CTX_SIZE		208--static inline void hs_cryptohash_sha512_init (struct sha512_ctx *ctx);-static inline void hs_cryptohash_sha512_update (struct sha512_ctx *ctx, const uint8_t *data, size_t len);-static inline uint64_t hs_cryptohash_sha512_finalize (struct sha512_ctx *ctx, uint8_t *out);--#if defined(static_assert)-static_assert(sizeof(struct sha512_ctx) == SHA512_CTX_SIZE, "unexpected sha512_ctx size");-#else-/* poor man's pre-C11 _Static_assert */-typedef char static_assertion__unexpected_sha512_ctx_size[(sizeof(struct sha512_ctx) == SHA512_CTX_SIZE)?1:-1];-#endif--#define ptr_uint64_aligned(ptr) (!((uintptr_t)(ptr) & 0x7))--static inline uint64_t-ror64(const uint64_t word, const unsigned shift)-{-  /* GCC usually transforms this into a 'ror'-insn */-  return (word >> shift) | (word << (64 - shift));-}--static inline uint64_t-cpu_to_be64(const uint64_t hll)-{-#if WORDS_BIGENDIAN-  return hll;-#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)-  return __builtin_bswap64(hll);-#else-  /* GCC & Clang usually transforms this into a bswap insn */-  return ((hll & 0xff00000000000000) >> 56) |-         ((hll & 0x00ff000000000000) >> 40) |-         ((hll & 0x0000ff0000000000) >> 24) |-         ((hll & 0x000000ff00000000) >>  8) |-         ((hll & 0x00000000ff000000) <<  8) |-         ((hll & 0x0000000000ff0000) << 24) |-         ((hll & 0x000000000000ff00) << 40) |-         ((hll & 0x00000000000000ff) << 56);-#endif-}--static inline void-cpu_to_be64_array(uint64_t *dest, const uint64_t *src, unsigned wordcnt)-{-  while (wordcnt--)-    *dest++ = cpu_to_be64(*src++);-}--static inline void-hs_cryptohash_sha512_init (struct sha512_ctx *ctx)-{-  memset(ctx, 0, SHA512_CTX_SIZE);-  -  ctx->h[0] = 0x6a09e667f3bcc908ULL;-  ctx->h[1] = 0xbb67ae8584caa73bULL;-  ctx->h[2] = 0x3c6ef372fe94f82bULL;-  ctx->h[3] = 0xa54ff53a5f1d36f1ULL;-  ctx->h[4] = 0x510e527fade682d1ULL;-  ctx->h[5] = 0x9b05688c2b3e6c1fULL;-  ctx->h[6] = 0x1f83d9abfb41bd6bULL;-  ctx->h[7] = 0x5be0cd19137e2179ULL;-}--/* 232 times the cube root of the first 64 primes 2..311 */-static const uint64_t k[] = {-  0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL,-  0xe9b5dba58189dbbcULL, 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL,-  0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, 0xd807aa98a3030242ULL,-  0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL,-  0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL,-  0xc19bf174cf692694ULL, 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL,-  0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, 0x2de92c6f592b0275ULL,-  0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL,-  0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL,-  0xbf597fc7beef0ee4ULL, 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL,-  0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, 0x27b70a8546d22ffcULL,-  0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL,-  0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL,-  0x92722c851482353bULL, 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL,-  0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, 0xd192e819d6ef5218ULL,-  0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL,-  0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL,-  0x34b0bcb5e19b48a8ULL, 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL,-  0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, 0x748f82ee5defb2fcULL,-  0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL,-  0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL,-  0xc67178f2e372532bULL, 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL,-  0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, 0x06f067aa72176fbaULL,-  0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL,-  0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL,-  0x431d67c49c100d4cULL, 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL,-  0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL-};--#define e0(x)       (ror64(x, 28) ^ ror64(x, 34) ^ ror64(x, 39))-#define e1(x)       (ror64(x, 14) ^ ror64(x, 18) ^ ror64(x, 41))-#define s0(x)       (ror64(x,  1) ^ ror64(x,  8) ^ (x >> 7))-#define s1(x)       (ror64(x, 19) ^ ror64(x, 61) ^ (x >> 6))--static void-sha512_do_chunk_aligned(struct sha512_ctx *ctx, uint64_t w[])-{-  int i;-  -  for (i = 16; i < 80; i++)-    w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16];--  uint64_t a = ctx->h[0];-  uint64_t b = ctx->h[1];-  uint64_t c = ctx->h[2];-  uint64_t d = ctx->h[3];-  uint64_t e = ctx->h[4];-  uint64_t f = ctx->h[5];-  uint64_t g = ctx->h[6];-  uint64_t h = ctx->h[7];--#define R(a, b, c, d, e, f, g, h, k, w)             \-    t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w;   \-    t2 = e0(a) + ((a & b) | (c & (a | b)));         \-    d += t1;                                        \-    h = t1 + t2--  for (i = 0; i < 80; i += 8) {-    uint64_t t1, t2;--    R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]);-    R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]);-    R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]);-    R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]);-    R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]);-    R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]);-    R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]);-    R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]);-  }--#undef R--  ctx->h[0] += a;-  ctx->h[1] += b;-  ctx->h[2] += c;-  ctx->h[3] += d;-  ctx->h[4] += e;-  ctx->h[5] += f;-  ctx->h[6] += g;-  ctx->h[7] += h;-}--static void-sha512_do_chunk(struct sha512_ctx *ctx, const uint8_t buf[])-{-  uint64_t w[80]; /* only first 16 words are filled in */-  if (ptr_uint64_aligned(buf)) { /* aligned buf */-    cpu_to_be64_array(w, (const uint64_t *)buf, 16);-  } else { /* unaligned buf */-    memcpy(w, buf, 128);-#if !WORDS_BIGENDIAN-    cpu_to_be64_array(w, w, 16);-#endif-  }-  sha512_do_chunk_aligned(ctx, w);-}--static inline void-hs_cryptohash_sha512_update(struct sha512_ctx *ctx, const uint8_t *data, size_t len)-{-  size_t index = ctx->sz & 0x7f;-  const size_t to_fill = 128 - index;--  ctx->sz += len;-  // handle overflow-  if (ctx->sz < len)-    ctx->sz_hi++;--  /* process partial buffer if there's enough data to make a block */-  if (index && len >= to_fill) {-    memcpy(ctx->buf + index, data, to_fill);-    sha512_do_chunk(ctx, ctx->buf);-    /* memset(ctx->buf, 0, 128); */-    len -= to_fill;-    data += to_fill;-    index = 0;-  }--  /* process as many 128b-blocks as possible */-  while (len >= 128) {-    sha512_do_chunk(ctx, data);-    len -= 128;-    data += 128;-  }--  /* append data into buf */-  if (len)-    memcpy(ctx->buf + index, data, len);-}--static inline uint64_t-hs_cryptohash_sha512_finalize (struct sha512_ctx *ctx, uint8_t *out)-{-  static const uint8_t padding[128] = { 0x80, };-  const uint64_t sz = ctx->sz;--  /* add padding and update data with it */-  uint64_t bits[2];-  bits[0] = cpu_to_be64((ctx->sz_hi << 3) | (ctx->sz >> 61));-  bits[1] = cpu_to_be64(ctx->sz << 3);--  /* pad out to 112 */-  const size_t index = ctx->sz & 0x7f;-  const size_t padlen = (index < 112) ? (112 - index) : ((128 + 112) - index);-  hs_cryptohash_sha512_update(ctx, padding, padlen);--  /* append length */-  hs_cryptohash_sha512_update(ctx, (uint8_t *) bits, sizeof(bits));--  /* output hash */-  cpu_to_be64_array((uint64_t *) out, ctx->h, 8);--  return sz;-}--static inline void-hs_cryptohash_sha512_hash (const uint8_t *data, size_t len, uint8_t *out)-{-  struct sha512_ctx ctx;--  hs_cryptohash_sha512_init(&ctx);--  hs_cryptohash_sha512_update(&ctx, data, len);--  hs_cryptohash_sha512_finalize(&ctx, out);-}--#endif

@@ -1,3 +1,8 @@+## 0.11.102.0++ - Expose SHA512/t variant via new `Crypto.Hash.SHA512t` module+ - Expose SHA384 variant via new `Crypto.Hash.SHA384` module+ ## 0.11.101.0   - Add Eq instance for Ctx

@@ -1,31 +1,56 @@+cabal-version:       2.0 name:                cryptohash-sha512-version:             0.11.101.0-description:-    A practical incremental and one-pass, pure API to the-    <https://en.wikipedia.org/wiki/SHA-2 SHA-512 hash algorithm>-    (including <https://en.wikipedia.org/wiki/HMAC HMAC> support)-    with performance close to the fastest implementations available in other languages.-    .-    The implementation is made in C with a haskell FFI wrapper that hides the C implementation.-    .-    NOTE: This package has been forked off @cryptohash-0.11.7@ because the @cryptohash@ package has been-    deprecated and so this package continues to satisfy the need for a lightweight package-    providing the SHA512 hash algorithm without any dependencies on packages other than-    @base@ and @bytestring@.-    .-    Consequently, this package can be used as a drop-in replacement for @cryptohash@'s-    "Crypto.Hash.SHA512" module, though with a clearly smaller footprint.+version:             0.11.102.0 +synopsis:            Fast, pure and practical SHA-512 implementation+description: {++A practical incremental and one-pass, pure API to+the [SHA-512, SHA512/t and SHA-384 cryptographic hash algorithms](https://en.wikipedia.org/wiki/SHA-2) according+to [FIPS 180-4](http://dx.doi.org/10.6028/NIST.FIPS.180-4)+with performance close to the fastest implementations available in other languages.+.+The core SHA-512 algorithm is implemented in C and is thus expected+to be as fast as the standard [sha512sum(1) tool](https://linux.die.net/man/1/sha512sum).+(If, instead, you require a pure Haskell implementation and performance is secondary, please refer to the [SHA package](https://hackage.haskell.org/package/SHA).)+.+Additionally, this package provides support for+.+- HMAC-SHA-384: SHA-384-based [Hashed Message Authentication Codes](https://en.wikipedia.org/wiki/HMAC) (HMAC)+- HMAC-SHA-512: SHA-512-based [Hashed Message Authentication Codes](https://en.wikipedia.org/wiki/HMAC) (HMAC)+- HMAC-SHA-512\/t: SHA-512\/t-based [Hashed Message Authentication Codes](https://en.wikipedia.org/wiki/HMAC) (HMAC)+.+conforming to [RFC6234](https://tools.ietf.org/html/rfc6234), [RFC4231](https://tools.ietf.org/html/rfc4231), [RFC5869](https://tools.ietf.org/html/rfc5869), et al..+.+=== Packages in the @cryptohash-*@ family+.+- <https://hackage.haskell.org/package/cryptohash-md5    cryptohash-md5>+- <https://hackage.haskell.org/package/cryptohash-sha1   cryptohash-sha1>+- <https://hackage.haskell.org/package/cryptohash-sha256 cryptohash-sha256>+- <https://hackage.haskell.org/package/cryptohash-sha512 cryptohash-sha512>+.+=== Relationship to the @cryptohash@ package and its API+.+This package has been originally a fork of @cryptohash-0.11.7@ because the @cryptohash@+package had been deprecated and so this package continues to satisfy the need for a+lightweight package providing the SHA-512 hash algorithms without any dependencies on packages+other than @base@ and @bytestring@. The API exposed by @cryptohash-sha512-0.11.*@'s+"Crypto.Hash.SHA512", "Crypto.Hash.SHA512t", and "Crypto.Hash.SHA384" module is guaranteed to remain a compatible superset of the API provided+by the @cryptohash-0.11.7@'s module of the same name.+.+Consequently, this package is designed to be used as a drop-in replacement for the @cryptohash-0.11.7@ modules mentioned above, though with+a [clearly smaller footprint by almost 3 orders of magnitude](https://www.reddit.com/r/haskell/comments/5lxv75/psa_please_use_unique_module_names_when_uploading/dbzegx3/).++}+ license:             BSD3 license-file:        LICENSE copyright:           Vincent Hanquez, Herbert Valerio Riedel maintainer:          Herbert Valerio Riedel <hvr@gnu.org> homepage:            https://github.com/hvr/cryptohash-sha512 bug-reports:         https://github.com/hvr/cryptohash-sha512/issues-synopsis:            Fast, pure and practical SHA-512 implementation category:            Data, Cryptography build-type:          Simple-cabal-version:       >=1.10 tested-with:         GHC == 7.4.2                    , GHC == 7.6.3                    , GHC == 7.8.4@@ -35,11 +60,12 @@                    , GHC == 8.4.4                    , GHC == 8.6.5                    , GHC == 8.8.4-                   , GHC == 8.10.4-                   , GHC == 9.0.1-                   , GHC == 9.2.1+                   , GHC == 8.10.7+                   , GHC == 9.0.2+                   , GHC == 9.2.4+                   , GHC == 9.4.1 -extra-source-files:  cbits/sha512.h+extra-source-files:  cbits/hs_sha512.h                      changelog.md  source-repository head@@ -48,11 +74,11 @@  library   default-language:  Haskell2010-  build-depends:     base             >= 4.5   && < 4.17+  build-depends:     base             >= 4.5   && < 4.18                    , bytestring       >= 0.9.2 && < 0.12    hs-source-dirs:    src-  exposed-modules:   Crypto.Hash.SHA512+  exposed-modules:   Crypto.Hash.SHA512 Crypto.Hash.SHA512t Crypto.Hash.SHA384   other-modules:     Crypto.Hash.SHA512.FFI Compat   ghc-options:       -Wall -fno-cse -O2   cc-options:        -Wall@@ -74,6 +100,38 @@                    , tasty-quickcheck  >= 0.10     && < 0.11                    , tasty-hunit       >= 0.10     && < 0.11 +test-suite test-sha512t+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  hs-source-dirs:    src-tests+  main-is:           test-sha512t.hs+  ghc-options:       -Wall -threaded+  build-depends:     cryptohash-sha512+                   , base+                   , bytestring++                   , base16-bytestring >= 1.0.1.0  && < 1.1+                   , SHA               >= 1.6.4    && < 1.7+                   , tasty             >= 1.4      && < 1.5+                   , tasty-quickcheck  >= 0.10     && < 0.11+                   , tasty-hunit       >= 0.10     && < 0.11++test-suite test-sha384+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  hs-source-dirs:    src-tests+  main-is:           test-sha384.hs+  ghc-options:       -Wall -threaded+  build-depends:     cryptohash-sha512+                   , base+                   , bytestring++                   , base16-bytestring >= 1.0.1.0  && < 1.1+                   , SHA               >= 1.6.4    && < 1.7+                   , tasty             >= 1.4      && < 1.5+                   , tasty-quickcheck  >= 0.10     && < 0.11+                   , tasty-hunit       >= 0.10     && < 0.11+ benchmark bench-sha512   default-language:  Haskell2010   type:              exitcode-stdio-1.0@@ -82,4 +140,4 @@   build-depends:     cryptohash-sha512                    , base                    , bytestring-                   , criterion        >= 1.5 && <1.6+                   , criterion        >= 1.5 && <1.7

@@ -0,0 +1,244 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import           Data.Word              (Word64)+import           Data.ByteString        (ByteString)+import qualified Data.ByteString        as B+import qualified Data.ByteString.Lazy   as BL+import qualified Data.ByteString.Base16 as B16++-- reference implementation+import qualified Data.Digest.Pure.SHA   as REF++-- implementation under test+import qualified Crypto.Hash.SHA384     as IUT++import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck  as QC++vectors :: [ByteString]+vectors =+    [ ""+    , "The quick brown fox jumps over the lazy dog"+    , "The quick brown fox jumps over the lazy cog"+    , "abc"+    , "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"+    , "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"+    , B.replicate 1000000 0x61+    ]++answers :: [ByteString]+answers = map (B.filter (/= 0x20))+    [ "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b"+    , "ca737f1014a48f4c0b6dd43cb177b0afd9e5169367544c494011e3317dbf9a509cb1e5dc1e85a941bbee3d7f2afbc9b1"+    , "098cea620b0978caa5f0befba6ddcf22764bea977e1c70b3483edfdf1de25f4b40d6cea3cadf00f809d422feb1f0161b"+    , "cb00753f45a35e8bb5a03d699ac65007272c32ab0eded1631a8b605a43ff5bed8086072ba1e7cc2358baeca134c825a7"+    , "3391fdddfc8dc7393707a65b1b4709397cf8b1d162af05abfe8f450de5f36bc6b0455a8520bc4e6f5fe95b1fe3c8452b"+    , "09330c33f71147e83d192fc782cd1b4753111b173b3b05d22fa08086e3b0f712fcc7c71a557e2db966c3e9fa91746039"+    , "9d0e1809716474cb086e834e310a4a1ced149e9c00f248527972cec5704c2a5b07b8b3dc38ecc4ebae97ddd87f3d8985"+    ]++ansXLTest :: ByteString+ansXLTest = B.filter (/= 0x20)+    "5441235cc0235341ed806a64fb354742b5e5c02a3c5cb71b5f63fb793458d8fdae599c8cd8884943c04f11b31b89f023"++katTests :: [TestTree]+katTests+  | length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest,xltest']+  | otherwise = error "vectors/answers length mismatch"+  where+    makeTest (i, v, r) = testGroup ("vec"++show i) $+        [ testCase "one-pass" (r @=? runTest v)+        , testCase "one-pass'" (r @=? runTest' v)+        , testCase "inc-1"    (r @=? runTestInc 1 v)+        , testCase "inc-2"    (r @=? runTestInc 2 v)+        , testCase "inc-3"    (r @=? runTestInc 3 v)+        , testCase "inc-4"    (r @=? runTestInc 4 v)+        , testCase "inc-5"    (r @=? runTestInc 5 v)+        , testCase "inc-7"    (r @=? runTestInc 7 v)+        , testCase "inc-8"    (r @=? runTestInc 8 v)+        , testCase "inc-9"    (r @=? runTestInc 9 v)+        , testCase "inc-16"   (r @=? runTestInc 16 v)+        , testCase "lazy-1"   (r @=? runTestLazy 1 v)+        , testCase "lazy-2"   (r @=? runTestLazy 2 v)+        , testCase "lazy-7"   (r @=? runTestLazy 7 v)+        , testCase "lazy-8"   (r @=? runTestLazy 8 v)+        , testCase "lazy-16"  (r @=? runTestLazy 16 v)+        , testCase "lazy-1'"   (r @=? runTestLazy' 1 v)+        , testCase "lazy-2'"   (r @=? runTestLazy' 2 v)+        , testCase "lazy-7'"   (r @=? runTestLazy' 7 v)+        , testCase "lazy-8'"   (r @=? runTestLazy' 8 v)+        , testCase "lazy-16'"  (r @=? runTestLazy' 16 v)+        ] +++        [ testCase "lazy-63u"  (r @=? runTestLazyU 63 v) | B.length v > 63 ] +++        [ testCase "lazy-65u"  (r @=? runTestLazyU 65 v) | B.length v > 65 ] +++        [ testCase "lazy-97u"  (r @=? runTestLazyU 97 v) | B.length v > 97 ] +++        [ testCase "lazy-131u" (r @=? runTestLazyU 131 v) | B.length v > 131 ] +++        [ testCase "lazy-63u'"  (r @=? runTestLazyU' 63 v) | B.length v > 63 ] +++        [ testCase "lazy-65u'"  (r @=? runTestLazyU' 65 v) | B.length v > 65 ] +++        [ testCase "lazy-97u'"  (r @=? runTestLazyU' 97 v) | B.length v > 97 ] +++        [ testCase "lazy-131u'" (r @=? runTestLazyU' 131 v) | B.length v > 131 ]++    runTest :: ByteString -> ByteString+    runTest = B16.encode . IUT.hash++    runTest' :: ByteString -> ByteString+    runTest' = B16.encode . IUT.finalize . IUT.start++    runTestInc :: Int -> ByteString -> ByteString+    runTestInc i = B16.encode . IUT.finalize . myfoldl' IUT.update IUT.init . splitB i++    runTestLazy :: Int -> ByteString -> ByteString+    runTestLazy i = B16.encode . IUT.hashlazy . BL.fromChunks . splitB i++    runTestLazy' :: Int -> ByteString -> ByteString+    runTestLazy' i = B16.encode . IUT.finalize . IUT.startlazy . BL.fromChunks . splitB i++    -- force unaligned md5-blocks+    runTestLazyU :: Int -> ByteString -> ByteString+    runTestLazyU i = B16.encode . IUT.hashlazy . BL.fromChunks . map B.copy . splitB i++    runTestLazyU' :: Int -> ByteString -> ByteString+    runTestLazyU' i = B16.encode . IUT.finalize . IUT.startlazy . BL.fromChunks . map B.copy . splitB i+++    ----++    xltest = testGroup "XL-vec"+        [ testCase "inc" (ansXLTest @=? (B16.encode . IUT.hashlazy) vecXL) ]+      where+        vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno")++    xltest' = testGroup "XL-vec'"+        [ testCase "inc" (ansXLTest @=? (B16.encode . IUT.finalize . IUT.startlazy) vecXL) ]+      where+        vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno")+++splitB :: Int -> ByteString -> [ByteString]+splitB l b+  | B.length b > l = b1 : splitB l b2+  | otherwise = [b]+  where+    (b1, b2) = B.splitAt l b+++rfc4231Vectors :: [(ByteString,ByteString,ByteString)]+rfc4231Vectors = -- (secrect,msg,mac)+    [ (rep 20 0x0b, "Hi There", x"afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6")+    , ("Jefe", "what do ya want for nothing?", x"af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649")+    , (rep 20 0xaa, rep 50 0xdd, x"88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27")+    , (B.pack [1..25], rep 50 0xcd, x"3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb")+    , (rep 20 0x0c, "Test With Truncation", x"3abf34c3503b2a23a46efc619baef897f4c8e42c934ce55ccbae9740fcbc1af4ca62269e2a37cd88ba926341efe4aeea")+    , (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952")+    , (rep 131 0xaa, "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.", x"6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e")+    ]+  where+    x = B16.decodeLenient+    rep n c = B.replicate n c++rfc4231Tests :: [TestTree]+rfc4231Tests = zipWith makeTest [1::Int ..] rfc4231Vectors+  where+    makeTest i (key, msg, mac) = testGroup ("vec"++show i) $+        [ testCase "hmac" (hex mac  @=? hex (IUT.hmac key msg))+        , testCase "hmaclazy" (hex mac  @=? hex (IUT.hmaclazy key lazymsg))+        ]+      where+        lazymsg = BL.fromChunks . splitB 1 $ msg++    hex = B16.encode++-- define own 'foldl' here to avoid RULE rewriting to 'hashlazy'+myfoldl' :: (b -> a -> b) -> b -> [a] -> b+myfoldl' f z0 xs0 = lgo z0 xs0+  where+    lgo z []     = z+    lgo z (x:xs) = let z' = f z x+                   in z' `seq` lgo z' xs++newtype RandBS = RandBS { unRandBS :: ByteString }+newtype RandLBS = RandLBS BL.ByteString++instance Arbitrary RandBS where+    arbitrary = fmap (RandBS . B.pack) arbitrary+    shrink (RandBS x) = fmap RandBS (go x)+      where+        go bs = zipWith B.append (B.inits bs) (tail $ B.tails bs)++instance Show RandBS where+    show (RandBS x) = "RandBS {len=" ++ show (B.length x)++"}"++instance Arbitrary RandLBS where+    arbitrary = fmap (RandLBS . BL.fromChunks . map unRandBS) arbitrary++instance Show RandLBS where+    show (RandLBS x) = "RandLBS {len=" ++ show (BL.length x) ++ ", chunks=" ++ show (length $ BL.toChunks x)++"}"+++refImplTests :: [TestTree]+refImplTests =+    [ testProperty "hash" prop_hash+    , testProperty "start" prop_start+    , testProperty "hashlazy" prop_hashlazy+    , testProperty "startlazy" prop_startlazy+    , testProperty "hashlazyAndLength" prop_hashlazyAndLength+    , testProperty "hmac" prop_hmac+    , testProperty "hmaclazy" prop_hmaclazy+    , testProperty "hmaclazyAndLength" prop_hmaclazyAndLength+    ]+  where+    prop_hash (RandBS bs)+        = ref_hash bs == IUT.hash bs++    prop_start (RandBS bs)+        = ref_hash bs == (IUT.finalize $ IUT.start bs)++    prop_hashlazy (RandLBS bs)+        = ref_hashlazy bs == IUT.hashlazy bs++    prop_hashlazyAndLength (RandLBS bs)+        = ref_hashlazyAndLength bs == IUT.hashlazyAndLength bs++    prop_startlazy (RandLBS bs)+        = ref_hashlazy bs == (IUT.finalize $ IUT.startlazy bs)++    prop_hmac (RandBS k) (RandBS bs)+        = ref_hmac k bs == IUT.hmac k bs++    prop_hmaclazy (RandBS k) (RandLBS bs)+        = ref_hmaclazy k bs == IUT.hmaclazy k bs++    prop_hmaclazyAndLength (RandBS k) (RandLBS bs)+        = ref_hmaclazyAndLength k bs == IUT.hmaclazyAndLength k bs++    ref_hash :: ByteString -> ByteString+    ref_hash = ref_hashlazy . fromStrict++    ref_hashlazy :: BL.ByteString -> ByteString+    ref_hashlazy = toStrict . REF.bytestringDigest . REF.sha384++    ref_hashlazyAndLength :: BL.ByteString -> (ByteString,Word64)+    ref_hashlazyAndLength x = (ref_hashlazy x, fromIntegral (BL.length x))++    ref_hmac :: ByteString -> ByteString -> ByteString+    ref_hmac secret = ref_hmaclazy secret . fromStrict++    ref_hmaclazy :: ByteString -> BL.ByteString -> ByteString+    ref_hmaclazy secret = toStrict . REF.bytestringDigest . REF.hmacSha384 (fromStrict secret)++    ref_hmaclazyAndLength :: ByteString -> BL.ByteString -> (ByteString,Word64)+    ref_hmaclazyAndLength secret msg = (ref_hmaclazy secret msg, fromIntegral (BL.length msg))++    -- toStrict/fromStrict only available with bytestring-0.10 and later+    toStrict = B.concat . BL.toChunks+    fromStrict = BL.fromChunks . (:[])++main :: IO ()+main = defaultMain $ testGroup "cryptohash-sha384"+    [ testGroup "KATs" katTests+    , testGroup "RFC4231" rfc4231Tests+    , testGroup "REF" refImplTests+    ]

@@ -0,0 +1,237 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import           Data.ByteString        (ByteString)+import qualified Data.ByteString        as B+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Lazy   as BL++-- implementation under test+import qualified Crypto.Hash.SHA512t    as IUT++import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck  as QC++vectors :: Int -> [ByteString]+vectors 224 =+    [ ""+    , "The quick brown fox jumps over the lazy dog"+    , "The quick brown fox jumps over the lazy cog"+    , "abc"+    , "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"+    , "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"+    , B.replicate 1000000 0x61+    ]+vectors 256 = vectors 224++vectors 100 = [ "", "a" ]+vectors 128 = [ "", "a" ]+vectors 160 = [ "", "a" ]+vectors 192 = [ "", "a" ]+vectors _ = undefined++answers :: Int -> [ByteString]+answers 224 = map (B.filter (/= 0x20))+    [ "6ed0dd02806fa89e25de060c19d3ac86cabb87d6a0ddd05c333b84f4"+    , "944cd2847fb54558d4775db0485a50003111c8e5daa63fe722c6aa37"+    , "2b9d6565a7e40f780ba8ab7c8dcf41e3ed3b77997f4c55aa987eede5"+    , "4634270f707b6a54daae7530460842e20e37ed265ceee9a43e8924aa"+    , "e5302d6d54bb242275d1e7622d68df6eb02dedd13f564c13dbda2174"+    , "23fec5bb94d60b23308192640b0c453335d664734fe40e7268674af9"+    , "37ab331d76f0d36de422bd0edeb22a28accd487b7a8453ae965dd287"+    ]+answers 256 = map (B.filter (/= 0x20))+    [ "c672b8d1ef56ed28ab87c3622c5114069bdd3ad7b8f9737498d0c01ecef0967a"+    , "dd9d67b371519c339ed8dbd25af90e976a1eeefd4ad3d889005e532fc5bef04d"+    , "cc8d255a7f2f38fd50388fd1f65ea7910835c5c1e73da46fba01ea50d5dd76fb"+    , "53048e2681941ef99b2e29b76b4c7dabe4c2d0c634fc6d46e0e2f13107e7af23"+    , "bde8e1f9f19bb9fd3406c90ec6bc47bd36d8ada9f11880dbc8a22a7078b6a461"+    , "3928e184fb8690f840da3988121d31be65cb9d3ef83ee6146feac861e19b563a"+    , "9a59a052930187a97038cae692f30708aa6491923ef5194394dc68d56c74fb21"+    ]+answers 100 = map (B.filter (/= 0x20))+    [ "c00f7e9998dd8ee623557a8490"+    , "12ed51ef9eec8c369a200b6c50"+    ]+answers 128 = map (B.filter (/= 0x20))+    [ "deca5d803a5cfcbf4191e9fc4bc065e3"+    , "81dc223475633e08da618cca7053d145"+    ]+answers 160 = map (B.filter (/= 0x20))+    [ "4cc04bc7087617e98d7da7443d79fb481cf169bf"+    , "ffa50d50f314aa7f53e3a215e5789508c2342135"+    ]+answers 192 = map (B.filter (/= 0x20))+    [ "9896f27c73cdc4ecc8eca3e16f6eeb63afe04b6c0d39276c"+    , "08ce8ab4f3bbc3acc1959cd62527b63b4359a54012e167a5"+    ]+answers _ = undefined++ansXLTest :: Int -> ByteString+ansXLTest 224 = B.filter (/= 0x20) "9a7f86727c3be1403d6702617646b15589b8c5a92c70f1703cd25b52"+ansXLTest 256 = B.filter (/= 0x20) "b5855a6179802ce567cbf43888284c6ac7c3f6c48b08c5bc1e8ad75d12782c9e"+ansXLTest _   = ""++katTests :: Int -> [TestTree]+katTests t+  | length (vectors t) == length (answers t) = map makeTest (zip3 [1::Int ..] (vectors t) (answers t)) +++                                               (if B.null (ansXLTest t) then [] else [xltest,xltest'])+  | otherwise = error "vectors/answers length mismatch"+  where+    makeTest (i, v, r) = testGroup ("vec"++show i) $+        [ testCase "one-pass" (r @=? runTest v)+        , testCase "one-pass'" (r @=? runTest' v)+        , testCase "inc-1"    (r @=? runTestInc 1 v)+        , testCase "inc-2"    (r @=? runTestInc 2 v)+        , testCase "inc-3"    (r @=? runTestInc 3 v)+        , testCase "inc-4"    (r @=? runTestInc 4 v)+        , testCase "inc-5"    (r @=? runTestInc 5 v)+        , testCase "inc-7"    (r @=? runTestInc 7 v)+        , testCase "inc-8"    (r @=? runTestInc 8 v)+        , testCase "inc-9"    (r @=? runTestInc 9 v)+        , testCase "inc-16"   (r @=? runTestInc 16 v)+        , testCase "lazy-1"   (r @=? runTestLazy 1 v)+        , testCase "lazy-2"   (r @=? runTestLazy 2 v)+        , testCase "lazy-7"   (r @=? runTestLazy 7 v)+        , testCase "lazy-8"   (r @=? runTestLazy 8 v)+        , testCase "lazy-16"  (r @=? runTestLazy 16 v)+        , testCase "lazy-1'"   (r @=? runTestLazy' 1 v)+        , testCase "lazy-2'"   (r @=? runTestLazy' 2 v)+        , testCase "lazy-7'"   (r @=? runTestLazy' 7 v)+        , testCase "lazy-8'"   (r @=? runTestLazy' 8 v)+        , testCase "lazy-16'"  (r @=? runTestLazy' 16 v)+        ] +++        [ testCase "lazy-63u"  (r @=? runTestLazyU 63 v) | B.length v > 63 ] +++        [ testCase "lazy-65u"  (r @=? runTestLazyU 65 v) | B.length v > 65 ] +++        [ testCase "lazy-97u"  (r @=? runTestLazyU 97 v) | B.length v > 97 ] +++        [ testCase "lazy-131u" (r @=? runTestLazyU 131 v) | B.length v > 131 ] +++        [ testCase "lazy-63u'"  (r @=? runTestLazyU' 63 v) | B.length v > 63 ] +++        [ testCase "lazy-65u'"  (r @=? runTestLazyU' 65 v) | B.length v > 65 ] +++        [ testCase "lazy-97u'"  (r @=? runTestLazyU' 97 v) | B.length v > 97 ] +++        [ testCase "lazy-131u'" (r @=? runTestLazyU' 131 v) | B.length v > 131 ]++    runTest :: ByteString -> ByteString+    runTest = B16.encode . IUT.hash t++    runTest' :: ByteString -> ByteString+    runTest' = B16.encode . IUT.finalize . IUT.start t++    runTestInc :: Int -> ByteString -> ByteString+    runTestInc i = B16.encode . IUT.finalize . myfoldl' IUT.update (IUT.init t) . splitB i++    runTestLazy :: Int -> ByteString -> ByteString+    runTestLazy i = B16.encode . IUT.hashlazy t . BL.fromChunks . splitB i++    runTestLazy' :: Int -> ByteString -> ByteString+    runTestLazy' i = B16.encode . IUT.finalize . IUT.startlazy t . BL.fromChunks . splitB i++    -- force unaligned md5-blocks+    runTestLazyU :: Int -> ByteString -> ByteString+    runTestLazyU i = B16.encode . IUT.hashlazy t . BL.fromChunks . map B.copy . splitB i++    runTestLazyU' :: Int -> ByteString -> ByteString+    runTestLazyU' i = B16.encode . IUT.finalize . IUT.startlazy t . BL.fromChunks . map B.copy . splitB i+++    ----++    xltest = testGroup "XL-vec"+        [ testCase "inc" (ansXLTest t @=? (B16.encode . IUT.hashlazy t) vecXL) ]+      where+        vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno")++    xltest' = testGroup "XL-vec'"+        [ testCase "inc" (ansXLTest t @=? (B16.encode . IUT.finalize . IUT.startlazy t) vecXL) ]+      where+        vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno")+++splitB :: Int -> ByteString -> [ByteString]+splitB l b+  | B.length b > l = b1 : splitB l b2+  | otherwise = [b]+  where+    (b1, b2) = B.splitAt l b+++rfc4231Vectors :: Int -> [(ByteString,ByteString,ByteString)]+rfc4231Vectors t = case t of   -- (secrect,msg,mac)+    224 -> [ (rep 20 0x0b, "Hi There", x"b244ba01307c0e7a8ccaad13b1067a4cf6b961fe0c6a20bda3d92039")+           , ("Jefe", "what do ya want for nothing?", x"4a530b31a79ebcce36916546317c45f247d83241dfb818fd37254bde")+           , (rep 20 0xaa, rep 50 0xdd, x"db34ea525c2c216ee5a6ccb6608bea870bbef12fd9b96a5109e2b6fc")+           , (B.pack [1..25], rep 50 0xcd, x"c2391863cda465c6828af06ac5d4b72d0b792109952da530e11a0d26")+           , (rep 20 0x0c, "Test With Truncation", x"1df8eae8baeedd4eddfb555ec0ba768f4b5ba29e9e3d55f08303120f")+           , (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"29bef8ce88b54d4226c3c7718ea9e32ace2429026f089e38cea9aeda")+           , (rep 131 0xaa, "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.", x"82a9619b47af0cea73a8b9741355ce902d807ad87ee9078522a246e1")+           ]++    256 -> [ (rep 20 0x0b, "Hi There", x"9f9126c3d9c3c330d760425ca8a217e31feae31bfe70196ff81642b868402eab")+           , ("Jefe", "what do ya want for nothing?", x"6df7b24630d5ccb2ee335407081a87188c221489768fa2020513b2d593359456")+           , (rep 20 0xaa, rep 50 0xdd, x"229006391d66c8ecddf43ba5cf8f83530ef221a4e9401840d1bead5137c8a2ea")+           , (B.pack [1..25], rep 50 0xcd, x"36d60c8aa1d0be856e10804cf836e821e8733cbafeae87630589fd0b9b0a2f4c")+           , (rep 20 0x0c, "Test With Truncation", x"337f526924766971bf72b82ad19c2c825301791e3ae2d8bb4ec03817dd821f46")+           , (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"87123c45f7c537a404f8f47cdbedda1fc9bec60eeb971982ce7ef10e774e6539")+           , (rep 131 0xaa, "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.", x"6ea83f8e7315072c0bdaa33b93a26fc1659974637a9db8a887d06c05a7f35a66")+           ]++    _ -> []+  where+    x = B16.decodeLenient+    rep n c = B.replicate n c++rfc4231Tests :: Int -> [TestTree]+rfc4231Tests t = zipWith makeTest [1::Int ..] (rfc4231Vectors t)+  where+    makeTest i (key, msg, mac) = testGroup ("vec"++show i) $+        [ testCase "hmac" (hex mac  @=? hex (IUT.hmac t key msg))+        , testCase "hmaclazy" (hex mac  @=? hex (IUT.hmaclazy t key lazymsg))+        ]+      where+        lazymsg = BL.fromChunks . splitB 1 $ msg++    hex = B16.encode++-- define own 'foldl' here to avoid RULE rewriting to 'hashlazy'+myfoldl' :: (b -> a -> b) -> b -> [a] -> b+myfoldl' f z0 xs0 = lgo z0 xs0+  where+    lgo z []     = z+    lgo z (x:xs) = let z' = f z x+                   in z' `seq` lgo z' xs++newtype RandBS = RandBS { unRandBS :: ByteString }+newtype RandLBS = RandLBS BL.ByteString++instance Arbitrary RandBS where+    arbitrary = fmap (RandBS . B.pack) arbitrary+    shrink (RandBS x) = fmap RandBS (go x)+      where+        go bs = zipWith B.append (B.inits bs) (tail $ B.tails bs)++instance Show RandBS where+    show (RandBS x) = "RandBS {len=" ++ show (B.length x)++"}"++instance Arbitrary RandLBS where+    arbitrary = fmap (RandLBS . BL.fromChunks . map unRandBS) arbitrary++instance Show RandLBS where+    show (RandLBS x) = "RandLBS {len=" ++ show (BL.length x) ++ ", chunks=" ++ show (length $ BL.toChunks x)++"}"+++main :: IO ()+main = defaultMain $ testGroup "cryptohash-sha512t"+    [ testGroup "SHA512/224"+      [ testGroup "KATs" (katTests 224)+      , testGroup "RFC4231" (rfc4231Tests 224)+      ]+    , testGroup "SHA512/256"+      [ testGroup "KATs" (katTests 256)+      , testGroup "RFC4231" (rfc4231Tests 256)+      ]+    , testGroup "SHA512/100" [ testGroup "KATs" (katTests 100) ]+    , testGroup "SHA512/128" [ testGroup "KATs" (katTests 128) ]+    , testGroup "SHA512/160" [ testGroup "KATs" (katTests 160) ]+    , testGroup "SHA512/192" [ testGroup "KATs" (katTests 192) ]+    ]

@@ -0,0 +1,292 @@+{-# LANGUAGE Trustworthy #-}+-- |+-- Module      : Crypto.Hash.SHA384+-- License     : BSD-style+-- Maintainer  : Herbert Valerio Riedel <hvr@gnu.org>+-- Stability   : stable+-- Portability : unknown+--+-- A module containing <https://en.wikipedia.org/wiki/SHA-2 SHA-384> bindings+--+-- @since 0.11.102.0+module Crypto.Hash.SHA384+    (++    -- * Incremental API+    --+    -- | This API is based on 4 different functions, similar to the+    -- lowlevel operations of a typical hash:+    --+    --  - 'init': create a new hash context+    --  - 'update': update non-destructively a new hash context with a strict bytestring+    --  - 'updates': same as update, except that it takes a list of strict bytestrings+    --  - 'finalize': finalize the context and returns a digest bytestring.+    --+    -- all those operations are completely pure, and instead of+    -- changing the context as usual in others language, it+    -- re-allocates a new context each time.+    --+    -- Example:+    --+    -- > import qualified Data.ByteString+    -- > import qualified Crypto.Hash.SHA384 as SHA384+    -- >+    -- > main = print digest+    -- >   where+    -- >     digest = SHA384.finalize ctx+    -- >     ctx    = foldl SHA384.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])+    -- >     ctx0   = SHA384.init++      Ctx(..)+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx+    , finalize -- :: Ctx -> ByteString+    , finalizeAndLength -- :: Ctx -> (ByteString,Word64)+    , start    -- :: ByteString -> Ct+    , startlazy -- :: L.ByteString -> Ctx+++    -- * Single Pass API+    --+    -- | This API use the incremental API under the hood to provide+    -- the common all-in-one operations to create digests out of a+    -- 'ByteString' and lazy 'L.ByteString'.+    --+    --  - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString'+    --  - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString'+    --+    -- Example:+    --+    -- > import qualified Data.ByteString+    -- > import qualified Crypto.Hash.SHA384 as SHA384+    -- >+    -- > main = print $ SHA384.hash (Data.ByteString.pack [0..255])+    --+    -- __NOTE__: The returned digest is a binary 'ByteString'. For+    -- converting to a base16/hex encoded digest the+    -- <https://hackage.haskell.org/package/base16-bytestring base16-bytestring>+    -- package is recommended.++    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: L.ByteString -> ByteString+    , hashlazyAndLength -- :: L.ByteString -> (ByteString,Word64)++    -- ** HMAC-SHA-384+    --+    -- | <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+    -- <https://en.wikipedia.org/wiki/HMAC HMAC>-SHA-384 digests++    , hmac     -- :: ByteString -> ByteString -> ByteString+    , hmaclazy -- :: ByteString -> L.ByteString -> ByteString+    , hmaclazyAndLength -- :: ByteString -> L.ByteString -> (ByteString,Word64)+    ) where++import Prelude hiding (init)+import Foreign.C.Types+import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Alloc+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B+import Data.ByteString (ByteString)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, memcpy, mallocByteString)+import Data.Bits (xor)+import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)++import Compat (constructBS)+import Crypto.Hash.SHA512.FFI++-- | perform IO for hashes that do allocation and ffi.+-- unsafeDupablePerformIO is used when possible as the+-- computation is pure and the output is directly linked+-- to the input. we also do not modify anything after it has+-- been returned to the user.+unsafeDoIO :: IO a -> a+unsafeDoIO = unsafeDupablePerformIO++-- keep this synchronised with cbits/sha512.h+{-# INLINE digestSize #-}+digestSize :: Int+digestSize = 48++{-# INLINE sizeCtx #-}+sizeCtx :: Int+sizeCtx = 208++{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b++{-# INLINE create' #-}+-- | Variant of 'create' which allows to return an argument+create' :: Int -> (Ptr Word8 -> IO a) -> IO (ByteString,a)+create' l f = do+    fp <- mallocByteString l+    x <- withForeignPtr fp $ \p -> f p+    let bs = constructBS fp l+    return $! x `seq` bs `seq` (bs,x)++copyCtx :: Ptr Ctx -> Ptr Ctx -> IO ()+copyCtx dst src = memcpy (castPtr dst) (castPtr src) (fromIntegral sizeCtx)++withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+  where+    createCtx = create sizeCtx $ \dstPtr ->+                withByteStringPtr ctxB $ \srcPtr -> do+                    copyCtx (castPtr dstPtr) (castPtr srcPtr)+                    f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        copyCtx (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)++-- 'safe' call overhead neglible for 4KiB and more+c_sha512_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()+c_sha512_update pctx pbuf sz+  | sz < 4096 = c_sha512_update_unsafe pctx pbuf sz+  | otherwise = c_sha512_update_safe   pctx pbuf sz++-- 'safe' call overhead neglible for 4KiB and more+c_sha384_hash :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()+c_sha384_hash pbuf sz pout+  | sz < 4096 = c_sha384_hash_unsafe pbuf sz pout+  | otherwise = c_sha384_hash_safe   pbuf sz pout++updateInternalIO :: Ptr Ctx -> ByteString -> IO ()+updateInternalIO ptr d =+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len))++finalizeInternalIO :: Ptr Ctx -> IO ByteString+finalizeInternalIO ptr = create digestSize (c_sha512t_finalize ptr 384)++finalizeInternalIO' :: Ptr Ctx -> IO (ByteString,Word64)+finalizeInternalIO' ptr = create' digestSize (c_sha512t_finalize_len ptr 384)++{-# NOINLINE init #-}+-- | create a new hash context+init :: Ctx+init = unsafeDoIO $ withCtxNew $ c_sha384_init++validCtx :: Ctx -> Bool+validCtx (Ctx b) = B.length b == sizeCtx++{-# NOINLINE update #-}+-- | update a context with a bytestring+update :: Ctx -> ByteString -> Ctx+update ctx d+  | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+  | otherwise    = error "SHA384.update: invalid Ctx"++{-# NOINLINE updates #-}+-- | updates a context with multiple bytestrings+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d+  | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+  | otherwise    = error "SHA384.updates: invalid Ctx"++{-# NOINLINE finalize #-}+-- | finalize the context into a digest bytestring (48 bytes)+finalize :: Ctx -> ByteString+finalize ctx+  | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO+  | otherwise    = error "SHA384.finalize: invalid Ctx"++{-# NOINLINE finalizeAndLength #-}+-- | Variant of 'finalize' also returning length of hashed content+finalizeAndLength :: Ctx -> (ByteString,Word64)+finalizeAndLength ctx+  | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO'+  | otherwise    = error "SHA384.finalize: invalid Ctx"++{-# NOINLINE hash #-}+-- | hash a strict bytestring into a digest bytestring (48 bytes)+hash :: ByteString -> ByteString+-- hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do c_sha384_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = unsafeDoIO $ unsafeUseAsCStringLen d $ \(cs, len) -> create digestSize (c_sha384_hash (castPtr cs) (fromIntegral len))++{-# NOINLINE start #-}+-- | hash a strict bytestring into a Ctx+start :: ByteString -> Ctx+start d = unsafeDoIO $ withCtxNew $ \ptr -> do+    c_sha384_init ptr >> updateInternalIO ptr d++{-# NOINLINE hashlazy #-}+-- | hash a lazy bytestring into a digest bytestring (48 bytes)+hashlazy :: L.ByteString -> ByteString+hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do+    c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr++{-# NOINLINE hashlazyAndLength #-}+-- | Variant of 'hashlazy' which simultaneously computes the hash and length of a lazy bytestring.+hashlazyAndLength :: L.ByteString -> (ByteString,Word64)+hashlazyAndLength l = unsafeDoIO $ withCtxNewThrow $ \ptr ->+    c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO' ptr++{-# NOINLINE startlazy #-}+-- | hash a lazy bytestring into a Ctx+startlazy :: L.ByteString -> Ctx+startlazy l = unsafeDoIO $ withCtxNew $ \ptr -> do+    c_sha384_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l)++{-# NOINLINE hmac #-}+-- | Compute 48-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+-- HMAC-SHA-384 digest for a strict bytestring message+hmac :: ByteString -- ^ secret+     -> ByteString -- ^ message+     -> ByteString+hmac secret msg = hash $ B.append opad (hash $ B.append ipad msg)+  where+    opad = B.map (xor 0x5c) k'+    ipad = B.map (xor 0x36) k'++    k'  = B.append kt pad+    kt  = if B.length secret > 128 then hash secret else secret+    pad = B.replicate (128 - B.length kt) 0+++{-# NOINLINE hmaclazy #-}+-- | Compute 48-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+-- HMAC-SHA-384 digest for a lazy bytestring message+hmaclazy :: ByteString   -- ^ secret+         -> L.ByteString -- ^ message+         -> ByteString+hmaclazy secret msg = hash $ B.append opad (hashlazy $ L.append ipad msg)+  where+    opad = B.map (xor 0x5c) k'+    ipad = L.fromChunks [B.map (xor 0x36) k']++    k'  = B.append kt pad+    kt  = if B.length secret > 128 then hash secret else secret+    pad = B.replicate (128 - B.length kt) 0++-- | Variant of 'hmaclazy' which also returns length of message+hmaclazyAndLength :: ByteString   -- ^ secret+                  -> L.ByteString -- ^ message+                  -> (ByteString,Word64) -- ^ digest (48 bytes) and length of message+hmaclazyAndLength secret msg =+    (hash (B.append opad htmp), sz' - fromIntegral ipadLen)+  where+    (htmp, sz') = hashlazyAndLength (L.append ipad msg)++    opad = B.map (xor 0x5c) k'+    ipad = L.fromChunks [B.map (xor 0x36) k']+    ipadLen = B.length k'++    k'  = B.append kt pad+    kt  = if B.length secret > 128 then hash secret else secret+    pad = B.replicate (128 - B.length kt) 0

@@ -171,10 +171,10 @@     unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len))  finalizeInternalIO :: Ptr Ctx -> IO ByteString-finalizeInternalIO ptr = create digestSize (c_sha512_finalize ptr)+finalizeInternalIO ptr = create digestSize (c_sha512t_finalize ptr 512)  finalizeInternalIO' :: Ptr Ctx -> IO (ByteString,Word64)-finalizeInternalIO' ptr = create' digestSize (c_sha512_finalize_len ptr)+finalizeInternalIO' ptr = create' digestSize (c_sha512t_finalize_len ptr 512)  {-# NOINLINE init #-} -- | create a new hash context@@ -212,7 +212,7 @@ finalizeAndLength :: Ctx -> (ByteString,Word64) finalizeAndLength ctx   | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO'-  | otherwise    = error "SHA256.finalize: invalid Ctx"+  | otherwise    = error "SHA512.finalize: invalid Ctx"  {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring (64 bytes)

@@ -35,27 +35,47 @@ -- --  * a 8-element 'Word64' array holding the current work-in-progress digest-value. ----- Consequently, a SHA-512 digest as produced by 'hash', 'hashlazy', or 'finalize' is 64 bytes long. newtype Ctx = Ctx ByteString   deriving (Eq) -foreign import capi unsafe "sha512.h hs_cryptohash_sha512_init"+foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha384_init"+    c_sha384_init :: Ptr Ctx -> IO ()++foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha512_init"     c_sha512_init :: Ptr Ctx -> IO () -foreign import capi unsafe "sha512.h hs_cryptohash_sha512_update"+foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha512t_init"+    c_sha512t_init :: Ptr Ctx -> Word16 -> IO ()+++foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha512_update"     c_sha512_update_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () -foreign import capi safe "sha512.h hs_cryptohash_sha512_update"+foreign import capi safe "hs_sha512.h hs_cryptohash_sha512_update"     c_sha512_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () -foreign import capi unsafe "sha512.h hs_cryptohash_sha512_finalize"-    c_sha512_finalize :: Ptr Ctx -> Ptr Word8 -> IO () -foreign import capi unsafe "sha512.h hs_cryptohash_sha512_finalize"-    c_sha512_finalize_len :: Ptr Ctx -> Ptr Word8 -> IO Word64+foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha512t_finalize"+    c_sha512t_finalize :: Ptr Ctx -> Word16 -> Ptr Word8 -> IO () -foreign import capi unsafe "sha512.h hs_cryptohash_sha512_hash"+foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha512t_finalize"+    c_sha512t_finalize_len :: Ptr Ctx -> Word16 -> Ptr Word8 -> IO Word64+++foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha384_hash"+    c_sha384_hash_unsafe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()++foreign import capi safe "hs_sha512.h hs_cryptohash_sha384_hash"+    c_sha384_hash_safe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()++foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha512_hash"     c_sha512_hash_unsafe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO () -foreign import capi safe "sha512.h hs_cryptohash_sha512_hash"+foreign import capi safe "hs_sha512.h hs_cryptohash_sha512_hash"     c_sha512_hash_safe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()++foreign import capi unsafe "hs_sha512.h hs_cryptohash_sha512t_hash"+    c_sha512t_hash_unsafe :: Ptr Word8 -> CSize -> Ptr Word8 -> Word16 -> IO ()++foreign import capi safe "hs_sha512.h hs_cryptohash_sha512t_hash"+    c_sha512t_hash_safe :: Ptr Word8 -> CSize -> Ptr Word8 -> Word16 -> IO ()

@@ -0,0 +1,328 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Crypto.Hash.SHA512t+-- License     : BSD-style+-- Maintainer  : Herbert Valerio Riedel <hvr@gnu.org>+-- Stability   : stable+-- Portability : unknown+--+-- A module containing <https://en.wikipedia.org/wiki/SHA-2 SHA-512/t> bindings+--+-- @since 0.11.102.0+module Crypto.Hash.SHA512t+    (++    -- * Incremental API+    --+    -- | This API is based on 4 different functions, similar to the+    -- lowlevel operations of a typical hash:+    --+    --  - 'init': create a new hash context+    --  - 'update': update non-destructively a new hash context with a strict bytestring+    --  - 'updates': same as update, except that it takes a list of strict bytestrings+    --  - 'finalize': finalize the context and returns a digest bytestring.+    --+    -- all those operations are completely pure, and instead of+    -- changing the context as usual in others language, it+    -- re-allocates a new context each time.+    --+    -- Example:+    --+    -- > import qualified Data.ByteString+    -- > import qualified Crypto.Hash.SHA512t as SHA512t+    -- >+    -- > main = print digest+    -- >   where+    -- >     digest = SHA512t.finalize ctx+    -- >     ctx    = foldl SHA512t.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])+    -- >     ctx0   = SHA512t.init 224++      Ctx(..)+    , init     -- :: Int -> Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx+    , finalize -- :: Ctx -> ByteString+    , finalizeAndLength -- :: Ctx -> (ByteString,Word64)+    , start    -- :: Int -> ByteString -> Ctx+    , startlazy -- :: Int -> L.ByteString -> Ctx+++    -- * Single Pass API+    --+    -- | This API use the incremental API under the hood to provide+    -- the common all-in-one operations to create digests out of a+    -- 'ByteString' and lazy 'L.ByteString'.+    --+    --  - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString'+    --  - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString'+    --+    -- Example:+    --+    -- > import qualified Data.ByteString+    -- > import qualified Crypto.Hash.SHA512t as SHA512t+    -- >+    -- > main = print $ SHA512t.hash 224 (Data.ByteString.pack [0..255])+    --+    -- __NOTE__: The returned digest is a binary 'ByteString'. For+    -- converting to a base16/hex encoded digest the+    -- <https://hackage.haskell.org/package/base16-bytestring base16-bytestring>+    -- package is recommended.++    , hash     -- :: Int -> ByteString -> ByteString+    , hashlazy -- :: Int -> L.ByteString -> ByteString+    , hashlazyAndLength -- :: Int -> L.ByteString -> (ByteString,Word64)++    -- ** HMAC-SHA-512/t+    --+    -- | <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+    -- <https://en.wikipedia.org/wiki/HMAC HMAC>-SHA-512/t digests++    , hmac     -- :: Int -> ByteString -> ByteString -> ByteString+    , hmaclazy -- :: Int -> ByteString -> L.ByteString -> ByteString+    , hmaclazyAndLength -- :: Int -> ByteString -> L.ByteString -> (ByteString,Word64)+    ) where++import Prelude hiding (init)+import Foreign.C.Types+import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Alloc+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B+import Data.ByteString (ByteString)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, memcpy, mallocByteString)+import Data.Bits (xor)+import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)++import Compat (constructBS)+import Crypto.Hash.SHA512.FFI hiding (Ctx(..))+import qualified Crypto.Hash.SHA512.FFI as FFI (Ctx(..))++-- | SHA-512/t Context+--+-- This extends the non-truncated SHA-512 Context (see 'FFI.Ctx')+-- with the value of the /t/ parameter which must be within the+-- range @[1..511]@ excluding the value @384@ as per FIPS-180-4+-- section 5.3.6.+data Ctx = Ctx !Int !FFI.Ctx+  deriving (Eq)++-- | perform IO for hashes that do allocation and ffi.+-- unsafeDupablePerformIO is used when possible as the+-- computation is pure and the output is directly linked+-- to the input. we also do not modify anything after it has+-- been returned to the user.+unsafeDoIO :: IO a -> a+unsafeDoIO = unsafeDupablePerformIO++{-# INLINE digestSize #-}+digestSize :: Int -> Int+digestSize t = (t+7) `div` 8++{-# INLINE sizeCtx #-}+sizeCtx :: Int+sizeCtx = 208++{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b++{-# INLINE create' #-}+-- | Variant of 'create' which allows to return an argument+create' :: Int -> (Ptr Word8 -> IO a) -> IO (ByteString,a)+create' l f = do+    fp <- mallocByteString l+    x <- withForeignPtr fp $ \p -> f p+    let bs = constructBS fp l+    return $! x `seq` bs `seq` (bs,x)++copyCtx :: Ptr FFI.Ctx -> Ptr FFI.Ctx -> IO ()+copyCtx dst src = memcpy (castPtr dst) (castPtr src) (fromIntegral sizeCtx)++withCtxCopy :: Ctx -> (Ptr FFI.Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx tbits (FFI.Ctx ctxB)) f = (Ctx tbits . FFI.Ctx) `fmap` createCtx+  where+    createCtx = create sizeCtx $ \dstPtr ->+                withByteStringPtr ctxB $ \srcPtr -> do+                    copyCtx (castPtr dstPtr) (castPtr srcPtr)+                    f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr FFI.Ctx -> IO a) -> IO a+withCtxThrow (Ctx _ (FFI.Ctx ctxB)) f =+    allocaBytes sizeCtx $ \dstPtr ->+    withByteStringPtr ctxB $ \srcPtr -> do+        copyCtx (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: Int -> (Ptr FFI.Ctx -> IO ()) -> IO Ctx+withCtxNew t f = (Ctx t . FFI.Ctx) `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr FFI.Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)++-- 'safe' call overhead neglible for 4KiB and more+c_sha512_update :: Ptr FFI.Ctx -> Ptr Word8 -> CSize -> IO ()+c_sha512_update pctx pbuf sz+  | sz < 4096 = c_sha512_update_unsafe pctx pbuf sz+  | otherwise = c_sha512_update_safe   pctx pbuf sz++-- 'safe' call overhead neglible for 4KiB and more+c_sha512t_hash :: Word16 -> Ptr Word8 -> CSize -> Ptr Word8 -> IO ()+c_sha512t_hash t pbuf sz pout+  | sz < 4096 = c_sha512t_hash_unsafe pbuf sz pout t+  | otherwise = c_sha512t_hash_safe   pbuf sz pout t++updateInternalIO :: Ptr FFI.Ctx -> ByteString -> IO ()+updateInternalIO ptr d =+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len))++finalizeInternalIO :: Int -> Ptr FFI.Ctx -> IO ByteString+finalizeInternalIO t ptr = create (digestSize t) (c_sha512t_finalize ptr (fromIntegral t))++finalizeInternalIO' :: Int -> Ptr FFI.Ctx -> IO (ByteString,Word64)+finalizeInternalIO' t ptr = create' (digestSize t) (c_sha512t_finalize_len ptr (fromIntegral t))++{-# NOINLINE init #-}+-- | create a new hash context+init :: Int -> Ctx+init 224 = unsafeDoIO $ withCtxNew 224 $ flip c_sha512t_init 224+init 256 = unsafeDoIO $ withCtxNew 256 $ flip c_sha512t_init 256+init t   = unsafeDoIO $ withCtxNew t $ flip c_sha512t_init t'+  where+    !t' = tFromInt t -- will 'error' for invalid values++tFromInt :: Int -> Word16+tFromInt t+  | isValidT t = fromIntegral t+  | otherwise  = error ("invalid SHA512/t (with t=" ++ show t ++ ") requested")++-- see FIPS 180-4 section 5.3.6.+isValidT :: Int -> Bool+isValidT t = t > 0 && t < 512 && t /= 384++validCtx :: Ctx -> Bool+validCtx (Ctx t (FFI.Ctx b)) = isValidT t && B.length b == sizeCtx++{-# NOINLINE update #-}+-- | update a context with a bytestring+update :: Ctx -> ByteString -> Ctx+update ctx d+  | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+  | otherwise    = error "SHA512t.update: invalid Ctx"++{-# NOINLINE updates #-}+-- | updates a context with multiple bytestrings+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d+  | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+  | otherwise    = error "SHA512t.updates: invalid Ctx"++{-# NOINLINE finalize #-}+-- | finalize the context into a digest bytestring (/t/ bits)+finalize :: Ctx -> ByteString+finalize ctx@(Ctx t _)+  | validCtx ctx = unsafeDoIO $ withCtxThrow ctx (finalizeInternalIO t)+  | otherwise    = error "SHA512t.finalize: invalid Ctx"++{-# NOINLINE finalizeAndLength #-}+-- | Variant of 'finalize' also returning length of hashed content+finalizeAndLength :: Ctx -> (ByteString,Word64)+finalizeAndLength ctx@(Ctx t _)+  | validCtx ctx = unsafeDoIO $ withCtxThrow ctx (finalizeInternalIO' t)+  | otherwise    = error "SHA512t.finalize: invalid Ctx"++{-# NOINLINE hash #-}+-- | hash a strict bytestring into a digest bytestring (/t/ bits)+hash :: Int -> ByteString -> ByteString+hash t d = unsafeDoIO $ unsafeUseAsCStringLen d $ \(cs, len) ->+    create (digestSize t) (c_sha512t_hash t' (castPtr cs) (fromIntegral len))+  where+    !t' = tFromInt t++{-# NOINLINE start #-}+-- | hash a strict bytestring into a Ctx+start :: Int -> ByteString -> Ctx+start t d = unsafeDoIO $ withCtxNew t $ \ptr -> do+    c_sha512t_init ptr t' >> updateInternalIO ptr d+  where+    !t' = tFromInt t++{-# NOINLINE hashlazy #-}+-- | hash a lazy bytestring into a digest bytestring (/t/ bits)+hashlazy :: Int -> L.ByteString -> ByteString+hashlazy t l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do+    c_sha512t_init ptr t' >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO t ptr+  where+    !t' = tFromInt t++{-# NOINLINE hashlazyAndLength #-}+-- | Variant of 'hashlazy' which simultaneously computes the hash and length of a lazy bytestring.+hashlazyAndLength :: Int -> L.ByteString -> (ByteString,Word64)+hashlazyAndLength t l = unsafeDoIO $ withCtxNewThrow $ \ptr ->+    c_sha512t_init ptr t' >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO' t ptr+  where+    !t' = tFromInt t++{-# NOINLINE startlazy #-}+-- | hash a lazy bytestring into a Ctx+startlazy :: Int -> L.ByteString -> Ctx+startlazy t l = unsafeDoIO $ withCtxNew t $ \ptr -> do+    c_sha512t_init ptr t' >> mapM_ (updateInternalIO ptr) (L.toChunks l)+  where+    t' = tFromInt t++{-# NOINLINE hmac #-}+-- | Compute /t/-bit <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+-- HMAC-SHA-512/t digest for a strict bytestring message+hmac :: Int        -- ^ digest length /t/ in bits+     -> ByteString -- ^ secret+     -> ByteString -- ^ message+     -> ByteString+hmac t secret msg = hash t $ B.append opad (hash t $ B.append ipad msg)+  where+    opad = B.map (xor 0x5c) k'+    ipad = B.map (xor 0x36) k'++    k'  = B.append kt pad+    kt  = if B.length secret > 128 then hash t secret else secret+    pad = B.replicate (128 - B.length kt) 0+++{-# NOINLINE hmaclazy #-}+-- | Compute4 /t/-bit <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+-- HMAC-SHA-512/t digest for a lazy bytestring message+hmaclazy :: Int          -- ^ digest length /t/ in bits+         -> ByteString   -- ^ secret+         -> L.ByteString -- ^ message+         -> ByteString+hmaclazy t secret msg = hash t $ B.append opad (hashlazy t $ L.append ipad msg)+  where+    opad = B.map (xor 0x5c) k'+    ipad = L.fromChunks [B.map (xor 0x36) k']++    k'  = B.append kt pad+    kt  = if B.length secret > 128 then hash t secret else secret+    pad = B.replicate (128 - B.length kt) 0++-- | Variant of 'hmaclazy' which also returns length of message+hmaclazyAndLength :: Int          -- ^ digest length /t/ in bits+                  -> ByteString   -- ^ secret+                  -> L.ByteString -- ^ message+                  -> (ByteString,Word64) -- ^ digest (/t/ bits) and length of message+hmaclazyAndLength t secret msg =+    (hash t (B.append opad htmp), sz' - fromIntegral ipadLen)+  where+    (htmp, sz') = hashlazyAndLength t (L.append ipad msg)++    opad = B.map (xor 0x5c) k'+    ipad = L.fromChunks [B.map (xor 0x36) k']+    ipadLen = B.length k'++    k'  = B.append kt pad+    kt  = if B.length secret > 128 then hash t secret else secret+    pad = B.replicate (128 - B.length kt) 0