cryptohash-sha1 0.11.100.1 → 0.11.101.0
raw patch · 8 files changed
+521/−333 lines, 8 filesdep ~basedep ~base16-bytestringdep ~bytestringnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, base16-bytestring, bytestring, criterion, tasty, tasty-hunit, tasty-quickcheck
API changes (from Hackage documentation)
+ Crypto.Hash.SHA1: finalizeAndLength :: Ctx -> (ByteString, Word64)
+ Crypto.Hash.SHA1: hashlazyAndLength :: ByteString -> (ByteString, Word64)
+ Crypto.Hash.SHA1: hmaclazyAndLength :: ByteString -> ByteString -> (ByteString, Word64)
+ Crypto.Hash.SHA1: start :: ByteString -> Ctx
+ Crypto.Hash.SHA1: startlazy :: ByteString -> Ctx
Files
- cbits/sha1.c +0/−275
- cbits/sha1.h +266/−3
- changelog.md +16/−1
- cryptohash-sha1.cabal +19/−12
- src-tests/test-sha1.hs +52/−4
- src/Compat.hs +24/−0
- src/Crypto/Hash/SHA1.hs +83/−38
- src/Crypto/Hash/SHA1/FFI.hs +61/−0
− cbits/sha1.c
@@ -1,275 +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.- */--#include "sha1.h"--#include <assert.h>-#include <string.h>-#include <ghcautoconf.h>--#if defined(static_assert)-static_assert(offsetof(struct sha1_ctx, h[5]) == SHA1_CTX_SIZE, "unexpected sha1_ctx size");-#else-/* poor man's pre-C11 _Static_assert */-typedef char static_assertion__unexpected_sha1_ctx_size[(offsetof(struct sha1_ctx, h[5]) == SHA1_CTX_SIZE)?1:-1];-#endif--#define ptr_uint32_aligned(ptr) (!((uintptr_t)(ptr) & 0x3))--static inline uint32_t-rol32(const uint32_t word, const unsigned shift)-{- /* GCC usually transforms this into a 'rol'-insn */- return (word << shift) | (word >> (32 - shift));-}--static inline uint32_t-cpu_to_be32(const uint32_t hl)-{-#if WORDS_BIGENDIAN- return hl;-#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)- return __builtin_bswap32(hl);-#else- /* GCC usually transforms this into a bswap insn */- return ((hl & 0xff000000) >> 24) |- ((hl & 0x00ff0000) >> 8) |- ((hl & 0x0000ff00) << 8) |- ( hl << 24);-#endif-}--static inline void-cpu_to_be32_array(uint32_t *dest, const uint32_t *src, unsigned wordcnt)-{- while (wordcnt--)- *dest++ = cpu_to_be32(*src++);-}--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- return ((uint64_t)cpu_to_be32(hll & 0xffffffff) << 32LL) | cpu_to_be32(hll >> 32);-#endif-}---void-hs_cryptohash_sha1_init(struct sha1_ctx *ctx)-{- memset(ctx, 0, SHA1_CTX_SIZE);-- ctx->h[0] = 0x67452301;- ctx->h[1] = 0xefcdab89;- ctx->h[2] = 0x98badcfe;- ctx->h[3] = 0x10325476;- ctx->h[4] = 0xc3d2e1f0;-}--#define f1(x, y, z) (z ^ (x & (y ^ z)))-#define f2(x, y, z) (x ^ y ^ z)-#define f3(x, y, z) ((x & y) + (z & (x ^ y)))-#define f4(x, y, z) f2(x, y, z)--#define K1 0x5a827999-#define K2 0x6ed9eba1-#define K3 0x8f1bbcdc-#define K4 0xca62c1d6--#define R(a, b, c, d, e, f, k, w) \- e += rol32(a, 5) + f(b, c, d) + k + w; b = rol32(b, 30)--#define M(i) (w[i & 0x0f] = rol32(w[i & 0x0f] ^ w[(i - 14) & 0x0f] \- ^ w[(i - 8) & 0x0f] ^ w[(i - 3) & 0x0f], 1))--static void-sha1_do_chunk_aligned(struct sha1_ctx *ctx, uint32_t w[])-{- uint32_t a = ctx->h[0];- uint32_t b = ctx->h[1];- uint32_t c = ctx->h[2];- uint32_t d = ctx->h[3];- uint32_t e = ctx->h[4];-- R(a, b, c, d, e, f1, K1, w[0]);- R(e, a, b, c, d, f1, K1, w[1]);- R(d, e, a, b, c, f1, K1, w[2]);- R(c, d, e, a, b, f1, K1, w[3]);- R(b, c, d, e, a, f1, K1, w[4]);- R(a, b, c, d, e, f1, K1, w[5]);- R(e, a, b, c, d, f1, K1, w[6]);- R(d, e, a, b, c, f1, K1, w[7]);- R(c, d, e, a, b, f1, K1, w[8]);- R(b, c, d, e, a, f1, K1, w[9]);- R(a, b, c, d, e, f1, K1, w[10]);- R(e, a, b, c, d, f1, K1, w[11]);- R(d, e, a, b, c, f1, K1, w[12]);- R(c, d, e, a, b, f1, K1, w[13]);- R(b, c, d, e, a, f1, K1, w[14]);- R(a, b, c, d, e, f1, K1, w[15]);- R(e, a, b, c, d, f1, K1, M(16));- R(d, e, a, b, c, f1, K1, M(17));- R(c, d, e, a, b, f1, K1, M(18));- R(b, c, d, e, a, f1, K1, M(19));-- R(a, b, c, d, e, f2, K2, M(20));- R(e, a, b, c, d, f2, K2, M(21));- R(d, e, a, b, c, f2, K2, M(22));- R(c, d, e, a, b, f2, K2, M(23));- R(b, c, d, e, a, f2, K2, M(24));- R(a, b, c, d, e, f2, K2, M(25));- R(e, a, b, c, d, f2, K2, M(26));- R(d, e, a, b, c, f2, K2, M(27));- R(c, d, e, a, b, f2, K2, M(28));- R(b, c, d, e, a, f2, K2, M(29));- R(a, b, c, d, e, f2, K2, M(30));- R(e, a, b, c, d, f2, K2, M(31));- R(d, e, a, b, c, f2, K2, M(32));- R(c, d, e, a, b, f2, K2, M(33));- R(b, c, d, e, a, f2, K2, M(34));- R(a, b, c, d, e, f2, K2, M(35));- R(e, a, b, c, d, f2, K2, M(36));- R(d, e, a, b, c, f2, K2, M(37));- R(c, d, e, a, b, f2, K2, M(38));- R(b, c, d, e, a, f2, K2, M(39));-- R(a, b, c, d, e, f3, K3, M(40));- R(e, a, b, c, d, f3, K3, M(41));- R(d, e, a, b, c, f3, K3, M(42));- R(c, d, e, a, b, f3, K3, M(43));- R(b, c, d, e, a, f3, K3, M(44));- R(a, b, c, d, e, f3, K3, M(45));- R(e, a, b, c, d, f3, K3, M(46));- R(d, e, a, b, c, f3, K3, M(47));- R(c, d, e, a, b, f3, K3, M(48));- R(b, c, d, e, a, f3, K3, M(49));- R(a, b, c, d, e, f3, K3, M(50));- R(e, a, b, c, d, f3, K3, M(51));- R(d, e, a, b, c, f3, K3, M(52));- R(c, d, e, a, b, f3, K3, M(53));- R(b, c, d, e, a, f3, K3, M(54));- R(a, b, c, d, e, f3, K3, M(55));- R(e, a, b, c, d, f3, K3, M(56));- R(d, e, a, b, c, f3, K3, M(57));- R(c, d, e, a, b, f3, K3, M(58));- R(b, c, d, e, a, f3, K3, M(59));-- R(a, b, c, d, e, f4, K4, M(60));- R(e, a, b, c, d, f4, K4, M(61));- R(d, e, a, b, c, f4, K4, M(62));- R(c, d, e, a, b, f4, K4, M(63));- R(b, c, d, e, a, f4, K4, M(64));- R(a, b, c, d, e, f4, K4, M(65));- R(e, a, b, c, d, f4, K4, M(66));- R(d, e, a, b, c, f4, K4, M(67));- R(c, d, e, a, b, f4, K4, M(68));- R(b, c, d, e, a, f4, K4, M(69));- R(a, b, c, d, e, f4, K4, M(70));- R(e, a, b, c, d, f4, K4, M(71));- R(d, e, a, b, c, f4, K4, M(72));- R(c, d, e, a, b, f4, K4, M(73));- R(b, c, d, e, a, f4, K4, M(74));- R(a, b, c, d, e, f4, K4, M(75));- R(e, a, b, c, d, f4, K4, M(76));- R(d, e, a, b, c, f4, K4, M(77));- R(c, d, e, a, b, f4, K4, M(78));- R(b, c, d, e, a, f4, K4, M(79));-- ctx->h[0] += a;- ctx->h[1] += b;- ctx->h[2] += c;- ctx->h[3] += d;- ctx->h[4] += e;-}--static void-sha1_do_chunk(struct sha1_ctx *ctx, const uint8_t buf[])-{- uint32_t w[16];- if (ptr_uint32_aligned(buf)) { /* aligned buf */- cpu_to_be32_array(w, (const uint32_t *)buf, 16);- } else { /* unaligned buf */- memcpy(w, buf, 64);-#if !WORDS_BIGENDIAN- cpu_to_be32_array(w, w, 16);-#endif- }- sha1_do_chunk_aligned(ctx, w);-}--void-hs_cryptohash_sha1_update(struct sha1_ctx *ctx, const uint8_t *data, size_t len)-{- size_t index = ctx->sz & 0x3f;- const size_t to_fill = 64 - index;-- ctx->sz += len;-- /* process partial buffer if there's enough data to make a block */- if (index && len >= to_fill) {- memcpy(ctx->buf + index, data, to_fill);- sha1_do_chunk(ctx, ctx->buf);- /* memset(ctx->buf, 0, 64); */- len -= to_fill;- data += to_fill;- index = 0;- }-- /* process as many 64-blocks as possible */- while (len >= 64) {- sha1_do_chunk(ctx, data);- len -= 64;- data += 64;- }-- /* append data into buf */- if (len)- memcpy(ctx->buf + index, data, len);-}--void-hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out)-{- static const uint8_t padding[64] = { 0x80, };-- /* add padding and update data with it */- uint64_t bits = cpu_to_be64(ctx->sz << 3);-- /* pad out to 56 */- const size_t index = ctx->sz & 0x3f;- const size_t padlen = (index < 56) ? (56 - index) : ((64 + 56) - index);- hs_cryptohash_sha1_update(ctx, padding, padlen);-- /* append length */- hs_cryptohash_sha1_update(ctx, (uint8_t *) &bits, sizeof(bits));-- /* output hash */- cpu_to_be32_array((uint32_t *) out, ctx->h, 5);-}
cbits/sha1.h view
@@ -28,6 +28,9 @@ #include <stdint.h> #include <stddef.h>+#include <assert.h>+#include <string.h>+#include <ghcautoconf.h> struct sha1_ctx {@@ -39,8 +42,268 @@ #define SHA1_DIGEST_SIZE 20 #define SHA1_CTX_SIZE 92 /* NB: no 64-bit padding */ -void hs_cryptohash_sha1_init(struct sha1_ctx *ctx);-void hs_cryptohash_sha1_update(struct sha1_ctx *ctx, const uint8_t *data, size_t len);-void hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out);+static inline void hs_cryptohash_sha1_init(struct sha1_ctx *ctx);+static inline void hs_cryptohash_sha1_update(struct sha1_ctx *ctx, const uint8_t *data, size_t len);+static inline uint64_t hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out);++#if defined(static_assert)+static_assert(offsetof(struct sha1_ctx, h[5]) == SHA1_CTX_SIZE, "unexpected sha1_ctx size");+#else+/* poor man's pre-C11 _Static_assert */+typedef char static_assertion__unexpected_sha1_ctx_size[(offsetof(struct sha1_ctx, h[5]) == SHA1_CTX_SIZE)?1:-1];+#endif++#define ptr_uint32_aligned(ptr) (!((uintptr_t)(ptr) & 0x3))++static inline uint32_t+rol32(const uint32_t word, const unsigned shift)+{+ /* GCC usually transforms this into a 'rol'-insn */+ return (word << shift) | (word >> (32 - shift));+}++static inline uint32_t+cpu_to_be32(const uint32_t hl)+{+#if WORDS_BIGENDIAN+ return hl;+#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)+ return __builtin_bswap32(hl);+#else+ /* GCC usually transforms this into a bswap insn */+ return ((hl & 0xff000000) >> 24) |+ ((hl & 0x00ff0000) >> 8) |+ ((hl & 0x0000ff00) << 8) |+ ( hl << 24);+#endif+}++static inline void+cpu_to_be32_array(uint32_t *dest, const uint32_t *src, unsigned wordcnt)+{+ while (wordcnt--)+ *dest++ = cpu_to_be32(*src++);+}++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+ return ((uint64_t)cpu_to_be32(hll & 0xffffffff) << 32LL) | cpu_to_be32(hll >> 32);+#endif+}+++static inline void+hs_cryptohash_sha1_init(struct sha1_ctx *ctx)+{+ memset(ctx, 0, SHA1_CTX_SIZE);++ ctx->h[0] = 0x67452301;+ ctx->h[1] = 0xefcdab89;+ ctx->h[2] = 0x98badcfe;+ ctx->h[3] = 0x10325476;+ ctx->h[4] = 0xc3d2e1f0;+}++#define f1(x, y, z) (z ^ (x & (y ^ z)))+#define f2(x, y, z) (x ^ y ^ z)+#define f3(x, y, z) ((x & y) + (z & (x ^ y)))+#define f4(x, y, z) f2(x, y, z)++#define K1 0x5a827999+#define K2 0x6ed9eba1+#define K3 0x8f1bbcdc+#define K4 0xca62c1d6++#define R(a, b, c, d, e, f, k, w) \+ e += rol32(a, 5) + f(b, c, d) + k + w; b = rol32(b, 30)++#define M(i) (w[i & 0x0f] = rol32(w[i & 0x0f] ^ w[(i - 14) & 0x0f] \+ ^ w[(i - 8) & 0x0f] ^ w[(i - 3) & 0x0f], 1))++static void+sha1_do_chunk_aligned(struct sha1_ctx *ctx, uint32_t w[])+{+ uint32_t a = ctx->h[0];+ uint32_t b = ctx->h[1];+ uint32_t c = ctx->h[2];+ uint32_t d = ctx->h[3];+ uint32_t e = ctx->h[4];++ R(a, b, c, d, e, f1, K1, w[0]);+ R(e, a, b, c, d, f1, K1, w[1]);+ R(d, e, a, b, c, f1, K1, w[2]);+ R(c, d, e, a, b, f1, K1, w[3]);+ R(b, c, d, e, a, f1, K1, w[4]);+ R(a, b, c, d, e, f1, K1, w[5]);+ R(e, a, b, c, d, f1, K1, w[6]);+ R(d, e, a, b, c, f1, K1, w[7]);+ R(c, d, e, a, b, f1, K1, w[8]);+ R(b, c, d, e, a, f1, K1, w[9]);+ R(a, b, c, d, e, f1, K1, w[10]);+ R(e, a, b, c, d, f1, K1, w[11]);+ R(d, e, a, b, c, f1, K1, w[12]);+ R(c, d, e, a, b, f1, K1, w[13]);+ R(b, c, d, e, a, f1, K1, w[14]);+ R(a, b, c, d, e, f1, K1, w[15]);+ R(e, a, b, c, d, f1, K1, M(16));+ R(d, e, a, b, c, f1, K1, M(17));+ R(c, d, e, a, b, f1, K1, M(18));+ R(b, c, d, e, a, f1, K1, M(19));++ R(a, b, c, d, e, f2, K2, M(20));+ R(e, a, b, c, d, f2, K2, M(21));+ R(d, e, a, b, c, f2, K2, M(22));+ R(c, d, e, a, b, f2, K2, M(23));+ R(b, c, d, e, a, f2, K2, M(24));+ R(a, b, c, d, e, f2, K2, M(25));+ R(e, a, b, c, d, f2, K2, M(26));+ R(d, e, a, b, c, f2, K2, M(27));+ R(c, d, e, a, b, f2, K2, M(28));+ R(b, c, d, e, a, f2, K2, M(29));+ R(a, b, c, d, e, f2, K2, M(30));+ R(e, a, b, c, d, f2, K2, M(31));+ R(d, e, a, b, c, f2, K2, M(32));+ R(c, d, e, a, b, f2, K2, M(33));+ R(b, c, d, e, a, f2, K2, M(34));+ R(a, b, c, d, e, f2, K2, M(35));+ R(e, a, b, c, d, f2, K2, M(36));+ R(d, e, a, b, c, f2, K2, M(37));+ R(c, d, e, a, b, f2, K2, M(38));+ R(b, c, d, e, a, f2, K2, M(39));++ R(a, b, c, d, e, f3, K3, M(40));+ R(e, a, b, c, d, f3, K3, M(41));+ R(d, e, a, b, c, f3, K3, M(42));+ R(c, d, e, a, b, f3, K3, M(43));+ R(b, c, d, e, a, f3, K3, M(44));+ R(a, b, c, d, e, f3, K3, M(45));+ R(e, a, b, c, d, f3, K3, M(46));+ R(d, e, a, b, c, f3, K3, M(47));+ R(c, d, e, a, b, f3, K3, M(48));+ R(b, c, d, e, a, f3, K3, M(49));+ R(a, b, c, d, e, f3, K3, M(50));+ R(e, a, b, c, d, f3, K3, M(51));+ R(d, e, a, b, c, f3, K3, M(52));+ R(c, d, e, a, b, f3, K3, M(53));+ R(b, c, d, e, a, f3, K3, M(54));+ R(a, b, c, d, e, f3, K3, M(55));+ R(e, a, b, c, d, f3, K3, M(56));+ R(d, e, a, b, c, f3, K3, M(57));+ R(c, d, e, a, b, f3, K3, M(58));+ R(b, c, d, e, a, f3, K3, M(59));++ R(a, b, c, d, e, f4, K4, M(60));+ R(e, a, b, c, d, f4, K4, M(61));+ R(d, e, a, b, c, f4, K4, M(62));+ R(c, d, e, a, b, f4, K4, M(63));+ R(b, c, d, e, a, f4, K4, M(64));+ R(a, b, c, d, e, f4, K4, M(65));+ R(e, a, b, c, d, f4, K4, M(66));+ R(d, e, a, b, c, f4, K4, M(67));+ R(c, d, e, a, b, f4, K4, M(68));+ R(b, c, d, e, a, f4, K4, M(69));+ R(a, b, c, d, e, f4, K4, M(70));+ R(e, a, b, c, d, f4, K4, M(71));+ R(d, e, a, b, c, f4, K4, M(72));+ R(c, d, e, a, b, f4, K4, M(73));+ R(b, c, d, e, a, f4, K4, M(74));+ R(a, b, c, d, e, f4, K4, M(75));+ R(e, a, b, c, d, f4, K4, M(76));+ R(d, e, a, b, c, f4, K4, M(77));+ R(c, d, e, a, b, f4, K4, M(78));+ R(b, c, d, e, a, f4, K4, M(79));++ ctx->h[0] += a;+ ctx->h[1] += b;+ ctx->h[2] += c;+ ctx->h[3] += d;+ ctx->h[4] += e;+}++static void+sha1_do_chunk(struct sha1_ctx *ctx, const uint8_t buf[])+{+ uint32_t w[16];+ if (ptr_uint32_aligned(buf)) { /* aligned buf */+ cpu_to_be32_array(w, (const uint32_t *)buf, 16);+ } else { /* unaligned buf */+ memcpy(w, buf, 64);+#if !WORDS_BIGENDIAN+ cpu_to_be32_array(w, w, 16);+#endif+ }+ sha1_do_chunk_aligned(ctx, w);+}++static inline void+hs_cryptohash_sha1_update(struct sha1_ctx *ctx, const uint8_t *data, size_t len)+{+ size_t index = ctx->sz & 0x3f;+ const size_t to_fill = 64 - index;++ ctx->sz += len;++ /* process partial buffer if there's enough data to make a block */+ if (index && len >= to_fill) {+ memcpy(ctx->buf + index, data, to_fill);+ sha1_do_chunk(ctx, ctx->buf);+ /* memset(ctx->buf, 0, 64); */+ len -= to_fill;+ data += to_fill;+ index = 0;+ }++ /* process as many 64-blocks as possible */+ while (len >= 64) {+ sha1_do_chunk(ctx, data);+ len -= 64;+ data += 64;+ }++ /* append data into buf */+ if (len)+ memcpy(ctx->buf + index, data, len);+}++static inline uint64_t+hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out)+{+ static const uint8_t padding[64] = { 0x80, };+ const uint64_t sz = ctx->sz;++ /* add padding and update data with it */+ uint64_t bits = cpu_to_be64(ctx->sz << 3);++ /* pad out to 56 */+ const size_t index = ctx->sz & 0x3f;+ const size_t padlen = (index < 56) ? (56 - index) : ((64 + 56) - index);+ hs_cryptohash_sha1_update(ctx, padding, padlen);++ /* append length */+ hs_cryptohash_sha1_update(ctx, (uint8_t *) &bits, sizeof(bits));++ /* output hash */+ cpu_to_be32_array((uint32_t *) out, ctx->h, 5);++ return sz;+}++static inline void+hs_cryptohash_sha1_hash (const uint8_t *data, size_t len, uint8_t *out)+{+ struct sha1_ctx ctx;++ hs_cryptohash_sha1_init(&ctx);++ hs_cryptohash_sha1_update(&ctx, data, len);++ hs_cryptohash_sha1_finalize(&ctx, out);+} #endif
changelog.md view
@@ -1,3 +1,18 @@+## 0.11.101.0++ - Add Eq instance for Ctx+ - add start and startlazy producing Ctx+ - Remove ineffective RULES+ - Declare `Crypto.Hash.MD5` module `-XTrustworthy`+ - Convert to `CApiFFI`+ - Added `...AndLength` variants of hashing functions:++ - `finalizeAndLength`+ - `hashlazyAndLength`+ - `hmaclazyAndLength`++ - Minor optimizations in `hmac` and `hash`+ ## 0.11.100.1 - Use `__builtin_bswap{32,64}` only with GCC >= 4.3@@ -9,7 +24,7 @@ ## 0.11.7.2 - - switch to 'safe' FFI for calls where overhead becomes neglible+ - switch to 'safe' FFI for calls where overhead becomes negligible - removed inline assembly in favour of portable C constructs - fix 32bit length overflow bug in `hash` function - fix inaccurate context-size
cryptohash-sha1.cabal view
@@ -1,5 +1,5 @@ name: cryptohash-sha1-version: 0.11.100.1+version: 0.11.101.0 description: A practical incremental and one-pass, pure API to the <https://en.wikipedia.org/wiki/SHA-1 SHA-1 hash algorithm>@@ -30,7 +30,14 @@ , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3- , GHC == 8.0.1+ , GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.1+ , GHC == 9.2.1 extra-source-files: cbits/sha1.h changelog.md@@ -41,14 +48,14 @@ library default-language: Haskell2010- build-depends: base >= 4.5 && < 4.10- , bytestring >= 0.9.2 && < 0.11+ build-depends: base >= 4.5 && < 4.17+ , bytestring >= 0.9.2 && < 0.12 hs-source-dirs: src exposed-modules: Crypto.Hash.SHA1+ other-modules: Crypto.Hash.SHA1.FFI Compat ghc-options: -Wall -fno-cse -O2- cc-options: -Wall -O3- c-sources: cbits/sha1.c+ cc-options: -Wall include-dirs: cbits test-suite test-sha1@@ -61,11 +68,11 @@ , base , bytestring - , base16-bytestring >= 0.1.1 && < 0.2- , SHA >= 1.6.4 && < 1.7- , tasty == 0.11.*- , tasty-quickcheck == 0.8.*- , tasty-hunit == 0.9.*+ , base16-bytestring >= 1.0.1.0 && < 1.1+ , SHA >= 1.6.4 && < 1.7+ , tasty >= 1.4 && < 1.5+ , tasty-quickcheck == 0.10.*+ , tasty-hunit == 0.10.* benchmark bench-sha1 default-language: Haskell2010@@ -75,4 +82,4 @@ build-depends: cryptohash-sha1 , base , bytestring- , criterion == 1.1.*+ , criterion == 1.5.*
src-tests/test-sha1.hs view
@@ -2,6 +2,7 @@ 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@@ -45,11 +46,12 @@ katTests :: [TestTree] katTests- | length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest]+ | 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)@@ -64,25 +66,43 @@ , 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-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"@@ -90,6 +110,12 @@ 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@@ -111,7 +137,7 @@ , (rep 80 0xaa, "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data", x"e8e99d0f45237d786d6bbaa7965c7808bbff1a91") ] where- x = fst.B16.decode+ x = B16.decodeLenient rep n c = B.replicate n c rfc2202Tests = zipWith makeTest [1::Int ..] rfc2202Vectors@@ -155,34 +181,56 @@ refImplTests :: [TestTree] refImplTests = [ testProperty "hash" prop_hash+ , testProperty "start" prop_hash , 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.sha1 + 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.hmacSha1 (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
+ src/Compat.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Compat+-- License : BSD-3+-- Maintainer : Herbert Valerio Riedel <hvr@gnu.org>+-- Stability : stable+--+-- Compat layer to reduce code exposure to CPP to a bare minimum+--+module Compat (constructBS) where++import Foreign.ForeignPtr (ForeignPtr)+import Data.Word (Word8)+import Data.ByteString.Internal (ByteString (..))++-- | Directly construct a 'ByteString', unsafely+constructBS :: ForeignPtr Word8 -> Int -> ByteString+#if MIN_VERSION_bytestring(0,11,0)+constructBS = BS+#else+constructBS = \fp -> PS fp 0+#endif
src/Crypto/Hash/SHA1.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Trustworthy #-} -- | -- Module : Crypto.Hash.SHA1 -- License : BSD-style@@ -40,6 +41,9 @@ , 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 --@@ -64,6 +68,7 @@ , hash -- :: ByteString -> ByteString , hashlazy -- :: L.ByteString -> ByteString+ , hashlazyAndLength -- :: L.ByteString -> (ByteString,Word64) -- ** HMAC-SHA1 --@@ -72,6 +77,7 @@ , hmac -- :: ByteString -> ByteString -> ByteString , hmaclazy -- :: ByteString -> L.ByteString -> ByteString+ , hmaclazyAndLength -- :: ByteString -> L.ByteString -> (ByteString,Word64) ) where import Prelude hiding (init)@@ -83,11 +89,14 @@ import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.ByteString.Internal (create, toForeignPtr, memcpy)+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.SHA1.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@@ -96,22 +105,6 @@ unsafeDoIO :: IO a -> a unsafeDoIO = unsafeDupablePerformIO --- | SHA-1 Context------ The context data is exactly 92 bytes long, however--- the data in the context is stored in host-endianness.------ The context data is made up of------ * a 'Word64' representing the number of bytes already feed to hash algorithm so far,------ * a 64-element 'Word8' buffer holding partial input-chunks, and finally------ * a 5-element 'Word32' array holding the current work-in-progress digest-value.------ Consequently, a SHA-1 digest as produced by 'hash', 'hashlazy', or 'finalize' is 20 bytes long.-newtype Ctx = Ctx ByteString- -- keep this synchronised with cbits/sha1.h {-# INLINE digestSize #-} digestSize :: Int@@ -121,18 +114,21 @@ sizeCtx :: Int sizeCtx = 92 -{-# RULES "digestSize" B.length (finalize init) = digestSize #-}-{-# RULES "hash" forall b. finalize (update init b) = hash b #-}-{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}-{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}-{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}- {-# 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) @@ -157,23 +153,17 @@ withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr) -foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_init"- c_sha1_init :: Ptr Ctx -> IO ()--foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_update"- c_sha1_update_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()--foreign import ccall safe "sha1.h hs_cryptohash_sha1_update"- c_sha1_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()---- 'safe' call overhead neglible for 8KiB and more+-- 'safe' call overhead is negligible for 8KiB and more c_sha1_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () c_sha1_update pctx pbuf sz | sz < 8192 = c_sha1_update_unsafe pctx pbuf sz | otherwise = c_sha1_update_safe pctx pbuf sz -foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_finalize"- c_sha1_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()+-- 'safe' call overhead neglible for 4KiB and more+c_sha1_hash :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()+c_sha1_hash pbuf sz pout+ | sz < 4096 = c_sha1_hash_unsafe pbuf sz pout+ | otherwise = c_sha1_hash_safe pbuf sz pout updateInternalIO :: Ptr Ctx -> ByteString -> IO () updateInternalIO ptr d =@@ -182,6 +172,9 @@ finalizeInternalIO :: Ptr Ctx -> IO ByteString finalizeInternalIO ptr = create digestSize (c_sha1_finalize ptr) +finalizeInternalIO' :: Ptr Ctx -> IO (ByteString,Word64)+finalizeInternalIO' ptr = create' digestSize (c_sha1_finalize_len ptr)+ {-# NOINLINE init #-} -- | create a new hash context init :: Ctx@@ -211,19 +204,52 @@ | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO | otherwise = error "SHA1.finalize: invalid Ctx" +{-# NOINLINE finalizeAndLength #-}+-- | Variant of 'finalize' also returning length of hashed content+--+-- @since 0.11.101.0+finalizeAndLength :: Ctx -> (ByteString,Word64)+finalizeAndLength ctx+ | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO'+ | otherwise = error "SHA256.finalize: invalid Ctx"+ {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring (20 bytes) hash :: ByteString -> ByteString-hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do- c_sha1_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+-- hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do c_sha1_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr+hash d = unsafeDoIO $ unsafeUseAsCStringLen d $ \(cs, len) -> create digestSize (c_sha1_hash (castPtr cs) (fromIntegral len)) +{-# NOINLINE start #-}+-- | hash a strict bytestring into a Ctx+--+-- @since 0.11.101.0+start :: ByteString -> Ctx+start d = unsafeDoIO $ withCtxNew $ \ptr -> do+ c_sha1_init ptr >> updateInternalIO ptr d+ {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring (20 bytes) hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do c_sha1_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.+--+-- @since 0.11.101.0+hashlazyAndLength :: L.ByteString -> (ByteString,Word64)+hashlazyAndLength l = unsafeDoIO $ withCtxNewThrow $ \ptr ->+ c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO' ptr +{-# NOINLINE startlazy #-}+-- | hash a lazy bytestring into a Ctx+--+-- @since 0.11.101.0+startlazy :: L.ByteString -> Ctx+startlazy l = unsafeDoIO $ withCtxNew $ \ptr -> do+ c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l)++ {-# NOINLINE hmac #-} -- | Compute 20-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible -- HMAC-SHA1 digest for a strict bytestring message@@ -244,7 +270,7 @@ {-# NOINLINE hmaclazy #-} -- | Compute 20-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible--- HMAC-SHA1 digest for a lazy bytestring message+-- HMAC-SHA1 digest for a lazy bytestring messagvoide -- -- @since 0.11.100.0 hmaclazy :: ByteString -- ^ secret@@ -254,6 +280,25 @@ 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 > 64 then hash secret else secret+ pad = B.replicate (64 - B.length kt) 0++-- | Variant of 'hmaclazy' which also returns length of message+--+-- @since 0.11.101.0+hmaclazyAndLength :: ByteString -- ^ secret+ -> L.ByteString -- ^ message+ -> (ByteString,Word64) -- ^ digest (20 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 > 64 then hash secret else secret
+ src/Crypto/Hash/SHA1/FFI.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE Unsafe #-}++-- Ugly hack to workaround https://ghc.haskell.org/trac/ghc/ticket/14452+{-# OPTIONS_GHC -O0+ -fdo-lambda-eta-expansion+ -fcase-merge+ -fstrictness+ -fno-omit-interface-pragmas+ -fno-ignore-interface-pragmas #-}++{-# OPTIONS_GHC -optc-Wall -optc-O3 #-}++-- |+-- Module : Crypto.Hash.SHA1.FFI+-- License : BSD-3+--+module Crypto.Hash.SHA1.FFI where++import Data.ByteString (ByteString)+import Data.Word+import Foreign.C.Types+import Foreign.Ptr++-- | SHA-1 Context+--+-- The context data is exactly 92 bytes long, however+-- the data in the context is stored in host-endianness.+--+-- The context data is made up of+--+-- * a 'Word64' representing the number of bytes already feed to hash algorithm so far,+--+-- * a 64-element 'Word8' buffer holding partial input-chunks, and finally+--+-- * a 5-element 'Word32' array holding the current work-in-progress digest-value.+--+-- Consequently, a SHA-1 digest as produced by 'hash', 'hashlazy', or 'finalize' is 20 bytes long.+newtype Ctx = Ctx ByteString+ deriving (Eq)++foreign import capi unsafe "sha1.h hs_cryptohash_sha1_init"+ c_sha1_init :: Ptr Ctx -> IO ()++foreign import capi unsafe "sha1.h hs_cryptohash_sha1_update"+ c_sha1_update_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()++foreign import capi safe "sha1.h hs_cryptohash_sha1_update"+ c_sha1_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()++foreign import capi unsafe "sha1.h hs_cryptohash_sha1_finalize"+ c_sha1_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()++foreign import capi unsafe "sha1.h hs_cryptohash_sha1_finalize"+ c_sha1_finalize_len :: Ptr Ctx -> Ptr Word8 -> IO Word64++foreign import capi unsafe "sha1.h hs_cryptohash_sha1_hash"+ c_sha1_hash_unsafe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()++foreign import capi safe "sha1.h hs_cryptohash_sha1_hash"+ c_sha1_hash_safe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()