diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ # Changelog +- 0.3.6 (2026-10-31) + * Uses the x86 SHA extensions on x86_64 CPUs that support them, + detected at runtime, falling back to the pure Haskell + implementation elsewhere. 'hash' and 'hmac' on such CPUs are + roughly 2-4x faster. + - 0.3.5 (2026-10-10) * Further defends MAC comparison timing against "helpful" LLVM optimizations. diff --git a/cbits/sha256_arm.c b/cbits/sha256_arm.c deleted file mode 100644 --- a/cbits/sha256_arm.c +++ /dev/null @@ -1,209 +0,0 @@ -#include -#include - -#if defined(__aarch64__) - -#include - -#if defined(__linux__) -#include -#ifndef HWCAP_SHA2 -#define HWCAP_SHA2 (1UL << 6) -#endif -#endif - -static const uint32_t K[64] = { - 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, - 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, - 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, - 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, - 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, - 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, - 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, - 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, - 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, - 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, - 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, - 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, - 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, - 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, - 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, - 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 -}; - -/* - * Process one 64-byte block using ARM SHA256 crypto instructions. - * - * state: pointer to 8 uint32_t words (a,b,c,d,e,f,g,h) - * block: pointer to 16 uint32_t words (already native endian) - * - * The state is updated in place. - * - * Compiled for the SHA2 extension only; callers must first check - * 'sha256_arm_available'. - */ -__attribute__((target("+sha2"))) -void sha256_block_arm(uint32_t *state, const uint32_t *block) { - /* Load current hash state */ - uint32x4_t abcd = vld1q_u32(&state[0]); - uint32x4_t efgh = vld1q_u32(&state[4]); - - /* Save original for final addition */ - uint32x4_t abcd_orig = abcd; - uint32x4_t efgh_orig = efgh; - - /* Load message (already native endian) */ - uint32x4_t m0 = vld1q_u32(&block[0]); - uint32x4_t m1 = vld1q_u32(&block[4]); - uint32x4_t m2 = vld1q_u32(&block[8]); - uint32x4_t m3 = vld1q_u32(&block[12]); - - uint32x4_t tmp, tmp2; - - /* Rounds 0-3 */ - tmp = vaddq_u32(m0, vld1q_u32(&K[0])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m0 = vsha256su1q_u32(vsha256su0q_u32(m0, m1), m2, m3); - - /* Rounds 4-7 */ - tmp = vaddq_u32(m1, vld1q_u32(&K[4])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m1 = vsha256su1q_u32(vsha256su0q_u32(m1, m2), m3, m0); - - /* Rounds 8-11 */ - tmp = vaddq_u32(m2, vld1q_u32(&K[8])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m2 = vsha256su1q_u32(vsha256su0q_u32(m2, m3), m0, m1); - - /* Rounds 12-15 */ - tmp = vaddq_u32(m3, vld1q_u32(&K[12])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m3 = vsha256su1q_u32(vsha256su0q_u32(m3, m0), m1, m2); - - /* Rounds 16-19 */ - tmp = vaddq_u32(m0, vld1q_u32(&K[16])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m0 = vsha256su1q_u32(vsha256su0q_u32(m0, m1), m2, m3); - - /* Rounds 20-23 */ - tmp = vaddq_u32(m1, vld1q_u32(&K[20])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m1 = vsha256su1q_u32(vsha256su0q_u32(m1, m2), m3, m0); - - /* Rounds 24-27 */ - tmp = vaddq_u32(m2, vld1q_u32(&K[24])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m2 = vsha256su1q_u32(vsha256su0q_u32(m2, m3), m0, m1); - - /* Rounds 28-31 */ - tmp = vaddq_u32(m3, vld1q_u32(&K[28])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m3 = vsha256su1q_u32(vsha256su0q_u32(m3, m0), m1, m2); - - /* Rounds 32-35 */ - tmp = vaddq_u32(m0, vld1q_u32(&K[32])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m0 = vsha256su1q_u32(vsha256su0q_u32(m0, m1), m2, m3); - - /* Rounds 36-39 */ - tmp = vaddq_u32(m1, vld1q_u32(&K[36])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m1 = vsha256su1q_u32(vsha256su0q_u32(m1, m2), m3, m0); - - /* Rounds 40-43 */ - tmp = vaddq_u32(m2, vld1q_u32(&K[40])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m2 = vsha256su1q_u32(vsha256su0q_u32(m2, m3), m0, m1); - - /* Rounds 44-47 */ - tmp = vaddq_u32(m3, vld1q_u32(&K[44])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - m3 = vsha256su1q_u32(vsha256su0q_u32(m3, m0), m1, m2); - - /* Rounds 48-51 */ - tmp = vaddq_u32(m0, vld1q_u32(&K[48])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - - /* Rounds 52-55 */ - tmp = vaddq_u32(m1, vld1q_u32(&K[52])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - - /* Rounds 56-59 */ - tmp = vaddq_u32(m2, vld1q_u32(&K[56])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - - /* Rounds 60-63 */ - tmp = vaddq_u32(m3, vld1q_u32(&K[60])); - tmp2 = abcd; - abcd = vsha256hq_u32(abcd, efgh, tmp); - efgh = vsha256h2q_u32(efgh, tmp2, tmp); - - /* Add original state back */ - abcd = vaddq_u32(abcd, abcd_orig); - efgh = vaddq_u32(efgh, efgh_orig); - - /* Store result */ - vst1q_u32(&state[0], abcd); - vst1q_u32(&state[4], efgh); -} - -/* - * Return 1 if the CPU implements the ARM SHA2 extension, 0 otherwise. - * Every Apple arm64 core implements it. Elsewhere we only know how to - * ask Linux, and report 0 (selecting the pure Haskell fallback) on - * any other OS. - */ -int sha256_arm_available(void) { -#if defined(__APPLE__) - return 1; -#elif defined(__linux__) - return (getauxval(AT_HWCAP) & HWCAP_SHA2) != 0; -#else - return 0; -#endif -} - -#else - -/* Stub implementations for non-aarch64 builds */ -void sha256_block_arm(uint32_t *state, const uint32_t *block) { - (void)state; - (void)block; - /* Should never be called - use pure Haskell fallback */ -} - -int sha256_arm_available(void) { - return 0; -} - -#endif diff --git a/cbits/sha256_native.c b/cbits/sha256_native.c new file mode 100644 --- /dev/null +++ b/cbits/sha256_native.c @@ -0,0 +1,407 @@ +#include +#include + +#if defined(__aarch64__) + +#include + +#if defined(__linux__) +#include +#ifndef HWCAP_SHA2 +#define HWCAP_SHA2 (1UL << 6) +#endif +#endif + +#elif defined(__x86_64__) + +#include +#include + +#ifndef bit_SHA +#define bit_SHA (1 << 29) +#endif + +#endif + +#if defined(__aarch64__) || defined(__x86_64__) + +static const uint32_t K[64] = { + 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, + 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, + 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, + 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, + 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, + 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, + 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, + 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, + 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, + 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, + 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, + 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, + 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, + 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, + 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, + 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 +}; + +#endif + +#if defined(__aarch64__) + +/* + * Process one 64-byte block using ARM SHA256 crypto instructions. + * + * state: pointer to 8 uint32_t words (a,b,c,d,e,f,g,h) + * block: pointer to 16 uint32_t words (already native endian) + * + * The state is updated in place. + * + * Compiled for the SHA2 extension only; callers must first check + * 'sha256_native_available'. + */ +__attribute__((target("+sha2"))) +void sha256_block_native(uint32_t *state, const uint32_t *block) { + /* Load current hash state */ + uint32x4_t abcd = vld1q_u32(&state[0]); + uint32x4_t efgh = vld1q_u32(&state[4]); + + /* Save original for final addition */ + uint32x4_t abcd_orig = abcd; + uint32x4_t efgh_orig = efgh; + + /* Load message (already native endian) */ + uint32x4_t m0 = vld1q_u32(&block[0]); + uint32x4_t m1 = vld1q_u32(&block[4]); + uint32x4_t m2 = vld1q_u32(&block[8]); + uint32x4_t m3 = vld1q_u32(&block[12]); + + uint32x4_t tmp, tmp2; + + /* Rounds 0-3 */ + tmp = vaddq_u32(m0, vld1q_u32(&K[0])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m0 = vsha256su1q_u32(vsha256su0q_u32(m0, m1), m2, m3); + + /* Rounds 4-7 */ + tmp = vaddq_u32(m1, vld1q_u32(&K[4])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m1 = vsha256su1q_u32(vsha256su0q_u32(m1, m2), m3, m0); + + /* Rounds 8-11 */ + tmp = vaddq_u32(m2, vld1q_u32(&K[8])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m2 = vsha256su1q_u32(vsha256su0q_u32(m2, m3), m0, m1); + + /* Rounds 12-15 */ + tmp = vaddq_u32(m3, vld1q_u32(&K[12])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m3 = vsha256su1q_u32(vsha256su0q_u32(m3, m0), m1, m2); + + /* Rounds 16-19 */ + tmp = vaddq_u32(m0, vld1q_u32(&K[16])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m0 = vsha256su1q_u32(vsha256su0q_u32(m0, m1), m2, m3); + + /* Rounds 20-23 */ + tmp = vaddq_u32(m1, vld1q_u32(&K[20])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m1 = vsha256su1q_u32(vsha256su0q_u32(m1, m2), m3, m0); + + /* Rounds 24-27 */ + tmp = vaddq_u32(m2, vld1q_u32(&K[24])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m2 = vsha256su1q_u32(vsha256su0q_u32(m2, m3), m0, m1); + + /* Rounds 28-31 */ + tmp = vaddq_u32(m3, vld1q_u32(&K[28])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m3 = vsha256su1q_u32(vsha256su0q_u32(m3, m0), m1, m2); + + /* Rounds 32-35 */ + tmp = vaddq_u32(m0, vld1q_u32(&K[32])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m0 = vsha256su1q_u32(vsha256su0q_u32(m0, m1), m2, m3); + + /* Rounds 36-39 */ + tmp = vaddq_u32(m1, vld1q_u32(&K[36])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m1 = vsha256su1q_u32(vsha256su0q_u32(m1, m2), m3, m0); + + /* Rounds 40-43 */ + tmp = vaddq_u32(m2, vld1q_u32(&K[40])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m2 = vsha256su1q_u32(vsha256su0q_u32(m2, m3), m0, m1); + + /* Rounds 44-47 */ + tmp = vaddq_u32(m3, vld1q_u32(&K[44])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + m3 = vsha256su1q_u32(vsha256su0q_u32(m3, m0), m1, m2); + + /* Rounds 48-51 */ + tmp = vaddq_u32(m0, vld1q_u32(&K[48])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + + /* Rounds 52-55 */ + tmp = vaddq_u32(m1, vld1q_u32(&K[52])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + + /* Rounds 56-59 */ + tmp = vaddq_u32(m2, vld1q_u32(&K[56])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + + /* Rounds 60-63 */ + tmp = vaddq_u32(m3, vld1q_u32(&K[60])); + tmp2 = abcd; + abcd = vsha256hq_u32(abcd, efgh, tmp); + efgh = vsha256h2q_u32(efgh, tmp2, tmp); + + /* Add original state back */ + abcd = vaddq_u32(abcd, abcd_orig); + efgh = vaddq_u32(efgh, efgh_orig); + + /* Store result */ + vst1q_u32(&state[0], abcd); + vst1q_u32(&state[4], efgh); +} + +/* + * Return 1 if the CPU implements the ARM SHA2 extension, 0 otherwise. + * Every Apple arm64 core implements it. Elsewhere we only know how to + * ask Linux, and report 0 (selecting the pure Haskell fallback) on + * any other OS. + */ +int sha256_native_available(void) { +#if defined(__APPLE__) + return 1; +#elif defined(__linux__) + return (getauxval(AT_HWCAP) & HWCAP_SHA2) != 0; +#else + return 0; +#endif +} + +#elif defined(__x86_64__) + +/* + * Four rounds. 'sha256rnds2' does two: it takes the (c,d,g,h) and + * (a,b,e,f) halves of the state, and two message-plus-constant words in + * the low lanes of its third argument, and returns the new (a,b,e,f). + * The old (a,b,e,f) is then the new (c,d,g,h), so a second call with + * the halves swapped does the next two. + */ +#define ROUNDS4(abef, cdgh, msg) \ + do { \ + cdgh = _mm_sha256rnds2_epu32(cdgh, abef, msg); \ + msg = _mm_shuffle_epi32(msg, 0x0e); \ + abef = _mm_sha256rnds2_epu32(abef, cdgh, msg); \ + } while (0) + +/* + * Process one 64-byte block using x86 SHA instructions. + * + * state: pointer to 8 uint32_t words (a,b,c,d,e,f,g,h) + * block: pointer to 16 uint32_t words (already native endian) + * + * The state is updated in place. + * + * Compiled for the SHA and SSE4.1 extensions only; callers must first + * check 'sha256_native_available'. + * + * Lane orders in comments are written from highest lane to lowest. + */ +__attribute__((target("sha,sse4.1"))) +void sha256_block_native(uint32_t *state, const uint32_t *block) { + __m128i abef, cdgh, abef_orig, cdgh_orig; + __m128i m0, m1, m2, m3, msg, tmp; + + /* Load current hash state, rearranging it for the SHA instructions */ + tmp = _mm_loadu_si128((const __m128i *)&state[0]); /* d c b a */ + cdgh = _mm_loadu_si128((const __m128i *)&state[4]); /* h g f e */ + tmp = _mm_shuffle_epi32(tmp, 0xb1); /* c d a b */ + cdgh = _mm_shuffle_epi32(cdgh, 0x1b); /* e f g h */ + abef = _mm_alignr_epi8(tmp, cdgh, 8); /* a b e f */ + cdgh = _mm_blend_epi16(cdgh, tmp, 0xf0); /* c d g h */ + + /* Save original for final addition */ + abef_orig = abef; + cdgh_orig = cdgh; + + /* Load message (already native endian) */ + m0 = _mm_loadu_si128((const __m128i *)&block[0]); + m1 = _mm_loadu_si128((const __m128i *)&block[4]); + m2 = _mm_loadu_si128((const __m128i *)&block[8]); + m3 = _mm_loadu_si128((const __m128i *)&block[12]); + + /* Rounds 0-3 */ + msg = _mm_add_epi32(m0, _mm_loadu_si128((const __m128i *)&K[0])); + ROUNDS4(abef, cdgh, msg); + + /* Rounds 4-7 */ + msg = _mm_add_epi32(m1, _mm_loadu_si128((const __m128i *)&K[4])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm_sha256msg1_epu32(m0, m1); + + /* Rounds 8-11 */ + msg = _mm_add_epi32(m2, _mm_loadu_si128((const __m128i *)&K[8])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm_sha256msg1_epu32(m1, m2); + + /* Rounds 12-15 */ + msg = _mm_add_epi32(m3, _mm_loadu_si128((const __m128i *)&K[12])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm_add_epi32(m0, _mm_alignr_epi8(m3, m2, 4)); + m0 = _mm_sha256msg2_epu32(m0, m3); + m2 = _mm_sha256msg1_epu32(m2, m3); + + /* Rounds 16-19 */ + msg = _mm_add_epi32(m0, _mm_loadu_si128((const __m128i *)&K[16])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm_add_epi32(m1, _mm_alignr_epi8(m0, m3, 4)); + m1 = _mm_sha256msg2_epu32(m1, m0); + m3 = _mm_sha256msg1_epu32(m3, m0); + + /* Rounds 20-23 */ + msg = _mm_add_epi32(m1, _mm_loadu_si128((const __m128i *)&K[20])); + ROUNDS4(abef, cdgh, msg); + m2 = _mm_add_epi32(m2, _mm_alignr_epi8(m1, m0, 4)); + m2 = _mm_sha256msg2_epu32(m2, m1); + m0 = _mm_sha256msg1_epu32(m0, m1); + + /* Rounds 24-27 */ + msg = _mm_add_epi32(m2, _mm_loadu_si128((const __m128i *)&K[24])); + ROUNDS4(abef, cdgh, msg); + m3 = _mm_add_epi32(m3, _mm_alignr_epi8(m2, m1, 4)); + m3 = _mm_sha256msg2_epu32(m3, m2); + m1 = _mm_sha256msg1_epu32(m1, m2); + + /* Rounds 28-31 */ + msg = _mm_add_epi32(m3, _mm_loadu_si128((const __m128i *)&K[28])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm_add_epi32(m0, _mm_alignr_epi8(m3, m2, 4)); + m0 = _mm_sha256msg2_epu32(m0, m3); + m2 = _mm_sha256msg1_epu32(m2, m3); + + /* Rounds 32-35 */ + msg = _mm_add_epi32(m0, _mm_loadu_si128((const __m128i *)&K[32])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm_add_epi32(m1, _mm_alignr_epi8(m0, m3, 4)); + m1 = _mm_sha256msg2_epu32(m1, m0); + m3 = _mm_sha256msg1_epu32(m3, m0); + + /* Rounds 36-39 */ + msg = _mm_add_epi32(m1, _mm_loadu_si128((const __m128i *)&K[36])); + ROUNDS4(abef, cdgh, msg); + m2 = _mm_add_epi32(m2, _mm_alignr_epi8(m1, m0, 4)); + m2 = _mm_sha256msg2_epu32(m2, m1); + m0 = _mm_sha256msg1_epu32(m0, m1); + + /* Rounds 40-43 */ + msg = _mm_add_epi32(m2, _mm_loadu_si128((const __m128i *)&K[40])); + ROUNDS4(abef, cdgh, msg); + m3 = _mm_add_epi32(m3, _mm_alignr_epi8(m2, m1, 4)); + m3 = _mm_sha256msg2_epu32(m3, m2); + m1 = _mm_sha256msg1_epu32(m1, m2); + + /* Rounds 44-47 */ + msg = _mm_add_epi32(m3, _mm_loadu_si128((const __m128i *)&K[44])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm_add_epi32(m0, _mm_alignr_epi8(m3, m2, 4)); + m0 = _mm_sha256msg2_epu32(m0, m3); + m2 = _mm_sha256msg1_epu32(m2, m3); + + /* Rounds 48-51 */ + msg = _mm_add_epi32(m0, _mm_loadu_si128((const __m128i *)&K[48])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm_add_epi32(m1, _mm_alignr_epi8(m0, m3, 4)); + m1 = _mm_sha256msg2_epu32(m1, m0); + m3 = _mm_sha256msg1_epu32(m3, m0); + + /* Rounds 52-55 */ + msg = _mm_add_epi32(m1, _mm_loadu_si128((const __m128i *)&K[52])); + ROUNDS4(abef, cdgh, msg); + m2 = _mm_add_epi32(m2, _mm_alignr_epi8(m1, m0, 4)); + m2 = _mm_sha256msg2_epu32(m2, m1); + + /* Rounds 56-59 */ + msg = _mm_add_epi32(m2, _mm_loadu_si128((const __m128i *)&K[56])); + ROUNDS4(abef, cdgh, msg); + m3 = _mm_add_epi32(m3, _mm_alignr_epi8(m2, m1, 4)); + m3 = _mm_sha256msg2_epu32(m3, m2); + + /* Rounds 60-63 */ + msg = _mm_add_epi32(m3, _mm_loadu_si128((const __m128i *)&K[60])); + ROUNDS4(abef, cdgh, msg); + + /* Add original state back */ + abef = _mm_add_epi32(abef, abef_orig); + cdgh = _mm_add_epi32(cdgh, cdgh_orig); + + /* Restore the state's original order and store result */ + tmp = _mm_shuffle_epi32(abef, 0x1b); /* f e b a */ + cdgh = _mm_shuffle_epi32(cdgh, 0xb1); /* d c h g */ + _mm_storeu_si128((__m128i *)&state[0], + _mm_blend_epi16(tmp, cdgh, 0xf0)); /* d c b a */ + _mm_storeu_si128((__m128i *)&state[4], + _mm_alignr_epi8(cdgh, tmp, 8)); /* h g f e */ +} + +/* + * Return 1 if the CPU implements the x86 SHA extensions and the SSSE3 + * and SSE4.1 instructions used alongside them, 0 otherwise. + */ +int sha256_native_available(void) { + unsigned int eax, ebx, ecx, edx; + + if (!__get_cpuid(1, &eax, &ebx, &ecx, &edx)) + return 0; + if (!(ecx & bit_SSSE3) || !(ecx & bit_SSE4_1)) + return 0; + if (!__get_cpuid_count(7, 0, &eax, &ebx, &ecx, &edx)) + return 0; + return (ebx & bit_SHA) != 0; +} + +#else + +/* Stub implementations for builds without hardware support */ +void sha256_block_native(uint32_t *state, const uint32_t *block) { + (void)state; + (void)block; + /* Should never be called - use pure Haskell fallback */ +} + +int sha256_native_available(void) { + return 0; +} + +#endif diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs --- a/lib/Crypto/Hash/SHA256.hs +++ b/lib/Crypto/Hash/SHA256.hs @@ -12,7 +12,7 @@ -- [2104](https://datatracker.ietf.org/doc/html/rfc2104). -- -- The 'hash' and 'hmac' functions will use primitive instructions from --- the ARM cryptographic extensions via FFI if they're available, and +-- the ARM SHA2 or x86 SHA extensions via FFI if they're available, and -- will otherwise use a pure Haskell implementation. module Crypto.Hash.SHA256 ( @@ -33,7 +33,7 @@ import qualified Data.ByteString as BS import Data.Word (Word8, Word32) import Foreign.Ptr (Ptr) -import qualified Crypto.Hash.SHA256.Arm as Arm +import qualified Crypto.Hash.SHA256.Native as Native import Crypto.Hash.SHA256.Internal (MAC(..), Registers) import qualified Crypto.Hash.SHA256.Lazy as Lazy import qualified Crypto.Hash.SHA256.Pure as Pure @@ -49,7 +49,7 @@ -- "" hash :: BS.ByteString -> BS.ByteString hash m - | Arm.sha256_arm_available = Arm.hash m + | Native.sha256_native_available = Native.hash m | otherwise = Pure.hash m {-# INLINABLE hash #-} @@ -67,7 +67,7 @@ -- "" hmac :: BS.ByteString -> BS.ByteString -> MAC hmac k m - | Arm.sha256_arm_available = MAC (Arm.hmac k m) + | Native.sha256_native_available = MAC (Native.hmac k m) | otherwise = MAC (Pure.hmac k m) {-# INLINABLE hmac #-} @@ -84,7 +84,7 @@ -> Registers -- ^ message -> IO () _hmac_rr rp bp k m - | Arm.sha256_arm_available = Arm._hmac_rr rp bp k m + | Native.sha256_native_available = Native._hmac_rr rp bp k m | otherwise = Pure._hmac_rr rp bp k m {-# INLINABLE _hmac_rr #-} @@ -102,6 +102,6 @@ -> BS.ByteString -- ^ data -> IO () _hmac_rsb rp bp k v sep dat - | Arm.sha256_arm_available = Arm._hmac_rsb rp bp k v sep dat + | Native.sha256_native_available = Native._hmac_rsb rp bp k v sep dat | otherwise = Pure._hmac_rsb rp bp k v sep dat {-# INLINABLE _hmac_rsb #-} diff --git a/lib/Crypto/Hash/SHA256/Arm.hs b/lib/Crypto/Hash/SHA256/Arm.hs deleted file mode 100644 --- a/lib/Crypto/Hash/SHA256/Arm.hs +++ /dev/null @@ -1,267 +0,0 @@ -{-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE UnboxedTuples #-} - --- | --- Module: Crypto.Hash.SHA256.Arm --- Copyright: (c) 2024 Jared Tobin --- License: MIT --- Maintainer: Jared Tobin --- --- ARM crypto extension support for SHA-256. - -module Crypto.Hash.SHA256.Arm ( - sha256_arm_available - , hash - , hmac - , _hmac_rr - , _hmac_rsb - ) where - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Internal as BI -import qualified Data.ByteString.Unsafe as BU -import Data.Word (Word8, Word32, Word64) -import Foreign.C.Types (CInt(..)) -import Foreign.Marshal.Alloc (allocaBytes) -import Foreign.Ptr (Ptr) -import qualified GHC.Exts as Exts -import qualified GHC.IO (IO(..)) -import qualified GHC.Ptr -import Crypto.Hash.SHA256.Internal hiding (update) -import System.IO.Unsafe (unsafeDupablePerformIO) - --- ffi ------------------------------------------------------------------------ - -foreign import ccall unsafe "sha256_block_arm" - c_sha256_block :: Ptr Word32 -> Ptr Word32 -> IO () - -foreign import ccall unsafe "sha256_arm_available" - c_sha256_arm_available :: IO CInt - --- utilities ------------------------------------------------------------------ - -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral -{-# INLINE fi #-} - -peek_registers - :: Ptr Word32 - -> Registers -peek_registers (GHC.Ptr.Ptr addr) = R - (Exts.indexWord32OffAddr# addr 0#) - (Exts.indexWord32OffAddr# addr 1#) - (Exts.indexWord32OffAddr# addr 2#) - (Exts.indexWord32OffAddr# addr 3#) - (Exts.indexWord32OffAddr# addr 4#) - (Exts.indexWord32OffAddr# addr 5#) - (Exts.indexWord32OffAddr# addr 6#) - (Exts.indexWord32OffAddr# addr 7#) -{-# INLINE peek_registers #-} - -poke_block :: Ptr Word32 -> Block -> IO () -poke_block - (GHC.Ptr.Ptr addr) - (B w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 w10 w11 w12 w13 w14 w15) - = GHC.IO.IO $ \s00 -> - case Exts.writeWord32OffAddr# addr 00# w00 s00 of { s01 -> - case Exts.writeWord32OffAddr# addr 01# w01 s01 of { s02 -> - case Exts.writeWord32OffAddr# addr 02# w02 s02 of { s03 -> - case Exts.writeWord32OffAddr# addr 03# w03 s03 of { s04 -> - case Exts.writeWord32OffAddr# addr 04# w04 s04 of { s05 -> - case Exts.writeWord32OffAddr# addr 05# w05 s05 of { s06 -> - case Exts.writeWord32OffAddr# addr 06# w06 s06 of { s07 -> - case Exts.writeWord32OffAddr# addr 07# w07 s07 of { s08 -> - case Exts.writeWord32OffAddr# addr 08# w08 s08 of { s09 -> - case Exts.writeWord32OffAddr# addr 09# w09 s09 of { s10 -> - case Exts.writeWord32OffAddr# addr 10# w10 s10 of { s11 -> - case Exts.writeWord32OffAddr# addr 11# w11 s11 of { s12 -> - case Exts.writeWord32OffAddr# addr 12# w12 s12 of { s13 -> - case Exts.writeWord32OffAddr# addr 13# w13 s13 of { s14 -> - case Exts.writeWord32OffAddr# addr 14# w14 s14 of { s15 -> - case Exts.writeWord32OffAddr# addr 15# w15 s15 of { s16 -> - (# s16, () #) }}}}}}}}}}}}}}}} -{-# INLINE poke_block #-} - --- update --------------------------------------------------------------------- - -update :: Ptr Word32 -> Ptr Word32 -> Block -> IO () -update rp bp block = do - poke_block bp block - c_sha256_block rp bp -{-# INLINE update #-} - --- api ----------------------------------------------------------------------- - --- | Are ARM +sha2 extensions available? -sha256_arm_available :: Bool -sha256_arm_available = unsafeDupablePerformIO c_sha256_arm_available /= 0 -{-# NOINLINE sha256_arm_available #-} - -hash - :: BS.ByteString - -> BS.ByteString -hash m = unsafeDupablePerformIO $ - allocaBytes 32 $ \rp -> - allocaBytes 64 $ \bp -> do - poke_registers rp (iv ()) - _hash rp bp 0 m - let !rs = peek_registers rp - pure (cat rs) - -_hash - :: Ptr Word32 -- ^ register state - -> Ptr Word32 -- ^ block state - -> Word64 -- ^ extra prefix length, for padding calculation - -> BS.ByteString -- ^ input - -> IO () -_hash rp bp el m@(BI.PS _ _ l) = do - hash_blocks rp bp m - let !fin@(BI.PS _ _ ll) = BU.unsafeDrop (l - l `rem` 64) m - !total = el + fi l - if ll < 56 - then do - let !ult = parse_pad1 fin total - update rp bp ult - else do - let !(# pen, ult #) = parse_pad2 fin total - update rp bp pen - update rp bp ult -{-# INLINABLE _hash #-} - -hash_blocks - :: Ptr Word32 -- ^ register state - -> Ptr Word32 -- ^ block state - -> BS.ByteString -- ^ input - -> IO () -hash_blocks rp bp m@(BI.PS _ _ l) = loop 0 where - loop !j - | j + 64 > l = pure () - | otherwise = do - let !block = parse m j - update rp bp block - loop (j + 64) -{-# INLINE hash_blocks #-} - --- hmac ------------------------------------------------------------------------ - -hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString -hmac k m = unsafeDupablePerformIO $ - allocaBytes 32 $ \rp -> - allocaBytes 64 $ \bp -> do - _hmac rp bp (prep_key k) m - pure (cat (peek_registers rp)) - -prep_key :: BS.ByteString -> Block -prep_key k@(BI.PS _ _ l) - | l > 64 = parse_key (hash k) - | otherwise = parse_key k -{-# INLINABLE prep_key #-} - --- assume padded key as block. -_hmac - :: Ptr Word32 -- ^ register state - -> Ptr Word32 -- ^ block state - -> Block -- ^ padded key - -> BS.ByteString -- ^ message - -> IO () -_hmac rp bp k m = do - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord32# 0x36363636##)) - _hash rp bp 64 m - let !block = pad_registers_with_length (peek_registers rp) - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord32# 0x5C5C5C5C##)) - update rp bp block -{-# NOINLINE _hmac #-} - -_hmac_rr - :: Ptr Word32 -- ^ register state - -> Ptr Word32 -- ^ block state - -> Registers -- ^ key - -> Registers -- ^ message - -> IO () -_hmac_rr rp bp k m = do - let !key = pad_registers k - !block = pad_registers_with_length m - _hmac_bb rp bp key block -{-# INLINABLE _hmac_rr #-} - -_hmac_bb - :: Ptr Word32 -- ^ register state - -> Ptr Word32 -- ^ block state - -> Block -- ^ padded key - -> Block -- ^ padded message - -> IO () -_hmac_bb rp bp k m = do - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord32# 0x36363636##)) - update rp bp m - let !inner = pad_registers_with_length (peek_registers rp) - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord32# 0x5C5C5C5C##)) - update rp bp inner -{-# INLINABLE _hmac_bb #-} - --- | HMAC(key, v || sep || data) using ARM crypto extensions. --- Writes result to destination pointer. -_hmac_rsb - :: Ptr Word32 -- ^ destination (8 Word32s) - -> Ptr Word32 -- ^ scratch block buffer (16 Word32s) - -> Registers -- ^ key - -> Registers -- ^ v - -> Word8 -- ^ separator byte - -> BS.ByteString -- ^ data - -> IO () -_hmac_rsb rp bp k v sep dat = do - poke_registers rp (iv ()) - let !key = pad_registers k - update rp bp (xor key (Exts.wordToWord32# 0x36363636##)) - _hash_vsb rp bp 64 v sep dat - let !inner = pad_registers_with_length (peek_registers rp) - poke_registers rp (iv ()) - update rp bp (xor key (Exts.wordToWord32# 0x5C5C5C5C##)) - update rp bp inner -{-# INLINABLE _hmac_rsb #-} - --- | Hash (v || sep || dat) with ARM crypto extensions. --- Assumes register state already initialized at rp. -_hash_vsb - :: Ptr Word32 -- ^ register state - -> Ptr Word32 -- ^ block buffer - -> Word64 -- ^ extra prefix length - -> Registers -- ^ v - -> Word8 -- ^ sep - -> BS.ByteString -- ^ dat - -> IO () -_hash_vsb rp bp el v sep dat@(BI.PS _ _ l) - | l >= 31 = do - -- first block is complete: v || sep || dat[0:31] - let !b0 = parse_vsb v sep dat - update rp bp b0 - -- hash remaining complete blocks from dat[31:] - let !rest = BU.unsafeDrop 31 dat - !restLen = l - 31 - hash_blocks rp bp rest - -- handle final padding - let !finLen = restLen `rem` 64 - !fin = BU.unsafeDrop (restLen - finLen) rest - !total = el + 33 + fi l - if finLen < 56 - then update rp bp (parse_pad1 fin total) - else do - let !(# pen, ult #) = parse_pad2 fin total - update rp bp pen - update rp bp ult - | otherwise = do - -- message < 64 bytes total, straight to padding - let !total = el + 33 + fi l - if 33 + l < 56 - then update rp bp (parse_pad1_vsb v sep dat total) - else do - let !(# pen, ult #) = parse_pad2_vsb v sep dat total - update rp bp pen - update rp bp ult -{-# INLINABLE _hash_vsb #-} diff --git a/lib/Crypto/Hash/SHA256/Native.hs b/lib/Crypto/Hash/SHA256/Native.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/Hash/SHA256/Native.hs @@ -0,0 +1,268 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE UnboxedTuples #-} + +-- | +-- Module: Crypto.Hash.SHA256.Native +-- Copyright: (c) 2024 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Hardware-accelerated SHA-256, via the ARM SHA2 or x86 SHA +-- extensions. + +module Crypto.Hash.SHA256.Native ( + sha256_native_available + , hash + , hmac + , _hmac_rr + , _hmac_rsb + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Unsafe as BU +import Data.Word (Word8, Word32, Word64) +import Foreign.C.Types (CInt(..)) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr (Ptr) +import qualified GHC.Exts as Exts +import qualified GHC.IO (IO(..)) +import qualified GHC.Ptr +import Crypto.Hash.SHA256.Internal hiding (update) +import System.IO.Unsafe (unsafeDupablePerformIO) + +-- ffi ------------------------------------------------------------------------ + +foreign import ccall unsafe "sha256_block_native" + c_sha256_block :: Ptr Word32 -> Ptr Word32 -> IO () + +foreign import ccall unsafe "sha256_native_available" + c_sha256_native_available :: IO CInt + +-- utilities ------------------------------------------------------------------ + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +peek_registers + :: Ptr Word32 + -> Registers +peek_registers (GHC.Ptr.Ptr addr) = R + (Exts.indexWord32OffAddr# addr 0#) + (Exts.indexWord32OffAddr# addr 1#) + (Exts.indexWord32OffAddr# addr 2#) + (Exts.indexWord32OffAddr# addr 3#) + (Exts.indexWord32OffAddr# addr 4#) + (Exts.indexWord32OffAddr# addr 5#) + (Exts.indexWord32OffAddr# addr 6#) + (Exts.indexWord32OffAddr# addr 7#) +{-# INLINE peek_registers #-} + +poke_block :: Ptr Word32 -> Block -> IO () +poke_block + (GHC.Ptr.Ptr addr) + (B w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 w10 w11 w12 w13 w14 w15) + = GHC.IO.IO $ \s00 -> + case Exts.writeWord32OffAddr# addr 00# w00 s00 of { s01 -> + case Exts.writeWord32OffAddr# addr 01# w01 s01 of { s02 -> + case Exts.writeWord32OffAddr# addr 02# w02 s02 of { s03 -> + case Exts.writeWord32OffAddr# addr 03# w03 s03 of { s04 -> + case Exts.writeWord32OffAddr# addr 04# w04 s04 of { s05 -> + case Exts.writeWord32OffAddr# addr 05# w05 s05 of { s06 -> + case Exts.writeWord32OffAddr# addr 06# w06 s06 of { s07 -> + case Exts.writeWord32OffAddr# addr 07# w07 s07 of { s08 -> + case Exts.writeWord32OffAddr# addr 08# w08 s08 of { s09 -> + case Exts.writeWord32OffAddr# addr 09# w09 s09 of { s10 -> + case Exts.writeWord32OffAddr# addr 10# w10 s10 of { s11 -> + case Exts.writeWord32OffAddr# addr 11# w11 s11 of { s12 -> + case Exts.writeWord32OffAddr# addr 12# w12 s12 of { s13 -> + case Exts.writeWord32OffAddr# addr 13# w13 s13 of { s14 -> + case Exts.writeWord32OffAddr# addr 14# w14 s14 of { s15 -> + case Exts.writeWord32OffAddr# addr 15# w15 s15 of { s16 -> + (# s16, () #) }}}}}}}}}}}}}}}} +{-# INLINE poke_block #-} + +-- update --------------------------------------------------------------------- + +update :: Ptr Word32 -> Ptr Word32 -> Block -> IO () +update rp bp block = do + poke_block bp block + c_sha256_block rp bp +{-# INLINE update #-} + +-- api ----------------------------------------------------------------------- + +-- | Are hardware SHA-256 instructions available? +sha256_native_available :: Bool +sha256_native_available = unsafeDupablePerformIO c_sha256_native_available /= 0 +{-# NOINLINE sha256_native_available #-} + +hash + :: BS.ByteString + -> BS.ByteString +hash m = unsafeDupablePerformIO $ + allocaBytes 32 $ \rp -> + allocaBytes 64 $ \bp -> do + poke_registers rp (iv ()) + _hash rp bp 0 m + let !rs = peek_registers rp + pure (cat rs) + +_hash + :: Ptr Word32 -- ^ register state + -> Ptr Word32 -- ^ block state + -> Word64 -- ^ extra prefix length, for padding calculation + -> BS.ByteString -- ^ input + -> IO () +_hash rp bp el m@(BI.PS _ _ l) = do + hash_blocks rp bp m + let !fin@(BI.PS _ _ ll) = BU.unsafeDrop (l - l `rem` 64) m + !total = el + fi l + if ll < 56 + then do + let !ult = parse_pad1 fin total + update rp bp ult + else do + let !(# pen, ult #) = parse_pad2 fin total + update rp bp pen + update rp bp ult +{-# INLINABLE _hash #-} + +hash_blocks + :: Ptr Word32 -- ^ register state + -> Ptr Word32 -- ^ block state + -> BS.ByteString -- ^ input + -> IO () +hash_blocks rp bp m@(BI.PS _ _ l) = loop 0 where + loop !j + | j + 64 > l = pure () + | otherwise = do + let !block = parse m j + update rp bp block + loop (j + 64) +{-# INLINE hash_blocks #-} + +-- hmac ------------------------------------------------------------------------ + +hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString +hmac k m = unsafeDupablePerformIO $ + allocaBytes 32 $ \rp -> + allocaBytes 64 $ \bp -> do + _hmac rp bp (prep_key k) m + pure (cat (peek_registers rp)) + +prep_key :: BS.ByteString -> Block +prep_key k@(BI.PS _ _ l) + | l > 64 = parse_key (hash k) + | otherwise = parse_key k +{-# INLINABLE prep_key #-} + +-- assume padded key as block. +_hmac + :: Ptr Word32 -- ^ register state + -> Ptr Word32 -- ^ block state + -> Block -- ^ padded key + -> BS.ByteString -- ^ message + -> IO () +_hmac rp bp k m = do + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord32# 0x36363636##)) + _hash rp bp 64 m + let !block = pad_registers_with_length (peek_registers rp) + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord32# 0x5C5C5C5C##)) + update rp bp block +{-# NOINLINE _hmac #-} + +_hmac_rr + :: Ptr Word32 -- ^ register state + -> Ptr Word32 -- ^ block state + -> Registers -- ^ key + -> Registers -- ^ message + -> IO () +_hmac_rr rp bp k m = do + let !key = pad_registers k + !block = pad_registers_with_length m + _hmac_bb rp bp key block +{-# INLINABLE _hmac_rr #-} + +_hmac_bb + :: Ptr Word32 -- ^ register state + -> Ptr Word32 -- ^ block state + -> Block -- ^ padded key + -> Block -- ^ padded message + -> IO () +_hmac_bb rp bp k m = do + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord32# 0x36363636##)) + update rp bp m + let !inner = pad_registers_with_length (peek_registers rp) + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord32# 0x5C5C5C5C##)) + update rp bp inner +{-# INLINABLE _hmac_bb #-} + +-- | HMAC(key, v || sep || data) using hardware SHA-256 instructions. +-- Writes result to destination pointer. +_hmac_rsb + :: Ptr Word32 -- ^ destination (8 Word32s) + -> Ptr Word32 -- ^ scratch block buffer (16 Word32s) + -> Registers -- ^ key + -> Registers -- ^ v + -> Word8 -- ^ separator byte + -> BS.ByteString -- ^ data + -> IO () +_hmac_rsb rp bp k v sep dat = do + poke_registers rp (iv ()) + let !key = pad_registers k + update rp bp (xor key (Exts.wordToWord32# 0x36363636##)) + _hash_vsb rp bp 64 v sep dat + let !inner = pad_registers_with_length (peek_registers rp) + poke_registers rp (iv ()) + update rp bp (xor key (Exts.wordToWord32# 0x5C5C5C5C##)) + update rp bp inner +{-# INLINABLE _hmac_rsb #-} + +-- | Hash (v || sep || dat) with hardware SHA-256 instructions. +-- Assumes register state already initialized at rp. +_hash_vsb + :: Ptr Word32 -- ^ register state + -> Ptr Word32 -- ^ block buffer + -> Word64 -- ^ extra prefix length + -> Registers -- ^ v + -> Word8 -- ^ sep + -> BS.ByteString -- ^ dat + -> IO () +_hash_vsb rp bp el v sep dat@(BI.PS _ _ l) + | l >= 31 = do + -- first block is complete: v || sep || dat[0:31] + let !b0 = parse_vsb v sep dat + update rp bp b0 + -- hash remaining complete blocks from dat[31:] + let !rest = BU.unsafeDrop 31 dat + !restLen = l - 31 + hash_blocks rp bp rest + -- handle final padding + let !finLen = restLen `rem` 64 + !fin = BU.unsafeDrop (restLen - finLen) rest + !total = el + 33 + fi l + if finLen < 56 + then update rp bp (parse_pad1 fin total) + else do + let !(# pen, ult #) = parse_pad2 fin total + update rp bp pen + update rp bp ult + | otherwise = do + -- message < 64 bytes total, straight to padding + let !total = el + 33 + fi l + if 33 + l < 56 + then update rp bp (parse_pad1_vsb v sep dat total) + else do + let !(# pen, ult #) = parse_pad2_vsb v sep dat total + update rp bp pen + update rp bp ult +{-# INLINABLE _hash_vsb #-} diff --git a/lib/Crypto/Hash/SHA256/Pure.hs b/lib/Crypto/Hash/SHA256/Pure.hs --- a/lib/Crypto/Hash/SHA256/Pure.hs +++ b/lib/Crypto/Hash/SHA256/Pure.hs @@ -10,7 +10,7 @@ -- Maintainer: Jared Tobin -- -- Pure Haskell SHA-256 and HMAC-SHA256 implementations for strict --- ByteStrings, used when the ARM cryptographic extensions are +-- ByteStrings, used when hardware SHA-256 instructions are -- unavailable. module Crypto.Hash.SHA256.Pure ( diff --git a/ppad-sha256.cabal b/ppad-sha256.cabal --- a/ppad-sha256.cabal +++ b/ppad-sha256.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-sha256 -version: 0.3.5 +version: 0.3.6 synopsis: The SHA-256 and HMAC-SHA256 algorithms license: MIT license-file: LICENSE @@ -41,13 +41,13 @@ Crypto.Hash.SHA256.Lazy Crypto.Hash.SHA256.Pure other-modules: - Crypto.Hash.SHA256.Arm + Crypto.Hash.SHA256.Native Data.Barrier build-depends: base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13 c-sources: - cbits/sha256_arm.c + cbits/sha256_native.c if flag(sanitize) cc-options: -fsanitize=address,undefined -fno-omit-frame-pointer ghc-options: -optl=-fsanitize=address,undefined