ppad-sha256 0.3.5 → 0.3.6
raw patch · 8 files changed
+691/−486 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +6/−0
- cbits/sha256_arm.c +0/−209
- cbits/sha256_native.c +407/−0
- lib/Crypto/Hash/SHA256.hs +6/−6
- lib/Crypto/Hash/SHA256/Arm.hs +0/−267
- lib/Crypto/Hash/SHA256/Native.hs +268/−0
- lib/Crypto/Hash/SHA256/Pure.hs +1/−1
- ppad-sha256.cabal +3/−3
CHANGELOG view
@@ -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.
− cbits/sha256_arm.c
@@ -1,209 +0,0 @@-#include <stdint.h>-#include <string.h>--#if defined(__aarch64__)--#include <arm_neon.h>--#if defined(__linux__)-#include <sys/auxv.h>-#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
+ cbits/sha256_native.c view
@@ -0,0 +1,407 @@+#include <stdint.h>+#include <string.h>++#if defined(__aarch64__)++#include <arm_neon.h>++#if defined(__linux__)+#include <sys/auxv.h>+#ifndef HWCAP_SHA2+#define HWCAP_SHA2 (1UL << 6)+#endif+#endif++#elif defined(__x86_64__)++#include <cpuid.h>+#include <immintrin.h>++#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
lib/Crypto/Hash/SHA256.hs view
@@ -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 @@ -- "<strict 256-bit message digest>" 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 @@ -- "<strict 256-bit MAC>" 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 #-}
− lib/Crypto/Hash/SHA256/Arm.hs
@@ -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 <jared@ppad.tech>------ 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 #-}
+ lib/Crypto/Hash/SHA256/Native.hs view
@@ -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 <jared@ppad.tech>+--+-- 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 #-}
lib/Crypto/Hash/SHA256/Pure.hs view
@@ -10,7 +10,7 @@ -- Maintainer: Jared Tobin <jared@ppad.tech> -- -- 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 (
ppad-sha256.cabal view
@@ -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