diff --git a/cbits/sha1.c b/cbits/sha1.c deleted file mode 100644 --- a/cbits/sha1.c +++ /dev/null @@ -1,275 +0,0 @@ -/* - * Copyright (C) 2006-2009 Vincent Hanquez - * 2016 Herbert Valerio Riedel - * - * 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 -#include -#include - -#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); -} diff --git a/cbits/sha1.h b/cbits/sha1.h --- a/cbits/sha1.h +++ b/cbits/sha1.h @@ -28,6 +28,9 @@ #include #include +#include +#include +#include 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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 diff --git a/cryptohash-sha1.cabal b/cryptohash-sha1.cabal --- a/cryptohash-sha1.cabal +++ b/cryptohash-sha1.cabal @@ -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 @@ -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.* diff --git a/src-tests/test-sha1.hs b/src-tests/test-sha1.hs --- a/src-tests/test-sha1.hs +++ b/src-tests/test-sha1.hs @@ -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 diff --git a/src/Compat.hs b/src/Compat.hs new file mode 100644 --- /dev/null +++ b/src/Compat.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} + +-- | +-- Module : Compat +-- License : BSD-3 +-- Maintainer : Herbert Valerio Riedel +-- 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 diff --git a/src/Crypto/Hash/SHA1.hs b/src/Crypto/Hash/SHA1.hs --- a/src/Crypto/Hash/SHA1.hs +++ b/src/Crypto/Hash/SHA1.hs @@ -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 -compatible -- HMAC-SHA1 digest for a strict bytestring message @@ -244,7 +270,7 @@ {-# NOINLINE hmaclazy #-} -- | Compute 20-byte -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 diff --git a/src/Crypto/Hash/SHA1/FFI.hs b/src/Crypto/Hash/SHA1/FFI.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Hash/SHA1/FFI.hs @@ -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 ()