ppad-sha512 0.2.5 → 0.2.6
raw patch · 8 files changed
+1039/−778 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +6/−0
- cbits/sha512_arm.c +0/−500
- cbits/sha512_native.c +754/−0
- lib/Crypto/Hash/SHA512.hs +6/−6
- lib/Crypto/Hash/SHA512/Arm.hs +0/−268
- lib/Crypto/Hash/SHA512/Native.hs +269/−0
- lib/Crypto/Hash/SHA512/Pure.hs +1/−1
- ppad-sha512.cabal +3/−3
CHANGELOG view
@@ -1,5 +1,11 @@ # Changelog +- 0.2.6 (2026-10-31)+ * Uses the x86 SHA512 extensions on x86_64 CPUs that support them,+ detected at runtime, falling back to the pure Haskell+ implementation elsewhere. The x86 kernel requires GCC 14 or Clang+ 18 or later to build; older compilers always use the fallback.+ - 0.2.5 (2026-10-10) * Further defends MAC comparison timing against "helpful" LLVM optimizations.
− cbits/sha512_arm.c
@@ -1,500 +0,0 @@-#include <stdint.h>-#include <string.h>--#if defined(__aarch64__)--#include <arm_neon.h>--#if defined(__APPLE__)-#include <sys/sysctl.h>-#elif defined(__linux__)-#include <sys/auxv.h>-#ifndef HWCAP_SHA512-#define HWCAP_SHA512 (1UL << 21)-#endif-#endif--static const uint64_t K[80] = {- 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL,- 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL,- 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL,- 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL,- 0xd807aa98a3030242ULL, 0x12835b0145706fbeULL,- 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL,- 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL,- 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL,- 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL,- 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL,- 0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL,- 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL,- 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL,- 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL,- 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL,- 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL,- 0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL,- 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL,- 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL,- 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL,- 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL,- 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL,- 0xd192e819d6ef5218ULL, 0xd69906245565a910ULL,- 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL,- 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL,- 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL,- 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL,- 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL,- 0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL,- 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL,- 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL,- 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL,- 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL,- 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL,- 0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL,- 0x113f9804bef90daeULL, 0x1b710b35131c471bULL,- 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL,- 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL,- 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL,- 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL-};--/*- * Process one 128-byte block using ARM SHA512 crypto instructions.- *- * state: pointer to 8 uint64_t words (a,b,c,d,e,f,g,h)- * block: pointer to 16 uint64_t words (already native endian)- *- * The state is updated in place.- *- * Compiled for the SHA512 extension only; callers must first check- * 'sha512_arm_available'.- */-__attribute__((target("+sha3")))-void sha512_block_arm(uint64_t *state, const uint64_t *block) {- /* Load current hash state */- uint64x2_t ab = vld1q_u64(&state[0]);- uint64x2_t cd = vld1q_u64(&state[2]);- uint64x2_t ef = vld1q_u64(&state[4]);- uint64x2_t gh = vld1q_u64(&state[6]);-- /* Save original for final addition */- uint64x2_t ab_orig = ab;- uint64x2_t cd_orig = cd;- uint64x2_t ef_orig = ef;- uint64x2_t gh_orig = gh;-- /* Load message (already native endian) */- uint64x2_t m0 = vld1q_u64(&block[0]);- uint64x2_t m1 = vld1q_u64(&block[2]);- uint64x2_t m2 = vld1q_u64(&block[4]);- uint64x2_t m3 = vld1q_u64(&block[6]);- uint64x2_t m4 = vld1q_u64(&block[8]);- uint64x2_t m5 = vld1q_u64(&block[10]);- uint64x2_t m6 = vld1q_u64(&block[12]);- uint64x2_t m7 = vld1q_u64(&block[14]);-- uint64x2_t tmp;-- /* Rounds 0-1 */- tmp = vaddq_u64(m0, vld1q_u64(&K[0]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));-- /* Rounds 2-3 */- tmp = vaddq_u64(m1, vld1q_u64(&K[2]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));-- /* Rounds 4-5 */- tmp = vaddq_u64(m2, vld1q_u64(&K[4]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));-- /* Rounds 6-7 */- tmp = vaddq_u64(m3, vld1q_u64(&K[6]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));-- /* Rounds 8-9 */- tmp = vaddq_u64(m4, vld1q_u64(&K[8]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));-- /* Rounds 10-11 */- tmp = vaddq_u64(m5, vld1q_u64(&K[10]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));-- /* Rounds 12-13 */- tmp = vaddq_u64(m6, vld1q_u64(&K[12]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));-- /* Rounds 14-15 */- tmp = vaddq_u64(m7, vld1q_u64(&K[14]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));-- /* Rounds 16-17 */- tmp = vaddq_u64(m0, vld1q_u64(&K[16]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));-- /* Rounds 18-19 */- tmp = vaddq_u64(m1, vld1q_u64(&K[18]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));-- /* Rounds 20-21 */- tmp = vaddq_u64(m2, vld1q_u64(&K[20]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));-- /* Rounds 22-23 */- tmp = vaddq_u64(m3, vld1q_u64(&K[22]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));-- /* Rounds 24-25 */- tmp = vaddq_u64(m4, vld1q_u64(&K[24]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));-- /* Rounds 26-27 */- tmp = vaddq_u64(m5, vld1q_u64(&K[26]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));-- /* Rounds 28-29 */- tmp = vaddq_u64(m6, vld1q_u64(&K[28]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));-- /* Rounds 30-31 */- tmp = vaddq_u64(m7, vld1q_u64(&K[30]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));-- /* Rounds 32-33 */- tmp = vaddq_u64(m0, vld1q_u64(&K[32]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));-- /* Rounds 34-35 */- tmp = vaddq_u64(m1, vld1q_u64(&K[34]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));-- /* Rounds 36-37 */- tmp = vaddq_u64(m2, vld1q_u64(&K[36]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));-- /* Rounds 38-39 */- tmp = vaddq_u64(m3, vld1q_u64(&K[38]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));-- /* Rounds 40-41 */- tmp = vaddq_u64(m4, vld1q_u64(&K[40]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));-- /* Rounds 42-43 */- tmp = vaddq_u64(m5, vld1q_u64(&K[42]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));-- /* Rounds 44-45 */- tmp = vaddq_u64(m6, vld1q_u64(&K[44]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));-- /* Rounds 46-47 */- tmp = vaddq_u64(m7, vld1q_u64(&K[46]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));-- /* Rounds 48-49 */- tmp = vaddq_u64(m0, vld1q_u64(&K[48]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));-- /* Rounds 50-51 */- tmp = vaddq_u64(m1, vld1q_u64(&K[50]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));-- /* Rounds 52-53 */- tmp = vaddq_u64(m2, vld1q_u64(&K[52]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));-- /* Rounds 54-55 */- tmp = vaddq_u64(m3, vld1q_u64(&K[54]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));-- /* Rounds 56-57 */- tmp = vaddq_u64(m4, vld1q_u64(&K[56]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);- m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));-- /* Rounds 58-59 */- tmp = vaddq_u64(m5, vld1q_u64(&K[58]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);- m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));-- /* Rounds 60-61 */- tmp = vaddq_u64(m6, vld1q_u64(&K[60]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);- m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));-- /* Rounds 62-63 */- tmp = vaddq_u64(m7, vld1q_u64(&K[62]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);- m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));-- /* Rounds 64-65 */- tmp = vaddq_u64(m0, vld1q_u64(&K[64]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);-- /* Rounds 66-67 */- tmp = vaddq_u64(m1, vld1q_u64(&K[66]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);-- /* Rounds 68-69 */- tmp = vaddq_u64(m2, vld1q_u64(&K[68]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);-- /* Rounds 70-71 */- tmp = vaddq_u64(m3, vld1q_u64(&K[70]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);-- /* Rounds 72-73 */- tmp = vaddq_u64(m4, vld1q_u64(&K[72]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(gh, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));- gh = vsha512h2q_u64(tmp, cd, ab);- cd = vaddq_u64(cd, tmp);-- /* Rounds 74-75 */- tmp = vaddq_u64(m5, vld1q_u64(&K[74]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ef, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));- ef = vsha512h2q_u64(tmp, ab, gh);- ab = vaddq_u64(ab, tmp);-- /* Rounds 76-77 */- tmp = vaddq_u64(m6, vld1q_u64(&K[76]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(cd, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));- cd = vsha512h2q_u64(tmp, gh, ef);- gh = vaddq_u64(gh, tmp);-- /* Rounds 78-79 */- tmp = vaddq_u64(m7, vld1q_u64(&K[78]));- tmp = vextq_u64(tmp, tmp, 1);- tmp = vaddq_u64(ab, tmp);- tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));- ab = vsha512h2q_u64(tmp, ef, cd);- ef = vaddq_u64(ef, tmp);-- /* Add original state back */- ab = vaddq_u64(ab, ab_orig);- cd = vaddq_u64(cd, cd_orig);- ef = vaddq_u64(ef, ef_orig);- gh = vaddq_u64(gh, gh_orig);-- /* Store result */- vst1q_u64(&state[0], ab);- vst1q_u64(&state[2], cd);- vst1q_u64(&state[4], ef);- vst1q_u64(&state[6], gh);-}--#if defined(__APPLE__)-static int sysctl_flag(const char *name) {- int val = 0;- size_t len = sizeof(val);- if (sysctlbyname(name, &val, &len, NULL, 0) != 0) return 0;- return val != 0;-}-#endif--/*- * Return 1 if the CPU implements the ARM SHA512 extension, 0- * otherwise. We only know how to ask Darwin and Linux, and report 0- * (selecting the pure Haskell fallback) on any other OS.- */-int sha512_arm_available(void) {-#if defined(__APPLE__)- return sysctl_flag("hw.optional.arm.FEAT_SHA512")- || sysctl_flag("hw.optional.armv8_2_sha512");-#elif defined(__linux__)- return (getauxval(AT_HWCAP) & HWCAP_SHA512) != 0;-#else- return 0;-#endif-}--#else--/* Stub implementations for non-aarch64 builds */-void sha512_block_arm(uint64_t *state, const uint64_t *block) {- (void)state;- (void)block;- /* Should never be called - use pure Haskell fallback */-}--int sha512_arm_available(void) {- return 0;-}--#endif
+ cbits/sha512_native.c view
@@ -0,0 +1,754 @@+#include <stdint.h>+#include <string.h>++/*+ * The x86 SHA512 intrinsics arrived in GCC 14 and Clang 18; older+ * compilers get the stubs below.+ */+#if defined(__x86_64__) && defined(__has_include)+#if __has_include(<sha512intrin.h>)+#define HAVE_X86_SHA512+#endif+#endif++#if defined(__aarch64__)++#include <arm_neon.h>++#if defined(__APPLE__)+#include <sys/sysctl.h>+#elif defined(__linux__)+#include <sys/auxv.h>+#ifndef HWCAP_SHA512+#define HWCAP_SHA512 (1UL << 21)+#endif+#endif++#elif defined(HAVE_X86_SHA512)++#include <cpuid.h>+#include <immintrin.h>++#ifndef bit_SHA512+#define bit_SHA512 (1 << 0)+#endif++#endif++#if defined(__aarch64__) || defined(HAVE_X86_SHA512)++static const uint64_t K[80] = {+ 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL,+ 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL,+ 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL,+ 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL,+ 0xd807aa98a3030242ULL, 0x12835b0145706fbeULL,+ 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL,+ 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL,+ 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL,+ 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL,+ 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL,+ 0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL,+ 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL,+ 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL,+ 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL,+ 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL,+ 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL,+ 0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL,+ 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL,+ 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL,+ 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL,+ 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL,+ 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL,+ 0xd192e819d6ef5218ULL, 0xd69906245565a910ULL,+ 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL,+ 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL,+ 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL,+ 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL,+ 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL,+ 0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL,+ 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL,+ 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL,+ 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL,+ 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL,+ 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL,+ 0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL,+ 0x113f9804bef90daeULL, 0x1b710b35131c471bULL,+ 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL,+ 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL,+ 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL,+ 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL+};++#endif++#if defined(__aarch64__)++/*+ * Process one 128-byte block using ARM SHA512 crypto instructions.+ *+ * state: pointer to 8 uint64_t words (a,b,c,d,e,f,g,h)+ * block: pointer to 16 uint64_t words (already native endian)+ *+ * The state is updated in place.+ *+ * Compiled for the SHA512 extension only; callers must first check+ * 'sha512_native_available'.+ */+__attribute__((target("+sha3")))+void sha512_block_native(uint64_t *state, const uint64_t *block) {+ /* Load current hash state */+ uint64x2_t ab = vld1q_u64(&state[0]);+ uint64x2_t cd = vld1q_u64(&state[2]);+ uint64x2_t ef = vld1q_u64(&state[4]);+ uint64x2_t gh = vld1q_u64(&state[6]);++ /* Save original for final addition */+ uint64x2_t ab_orig = ab;+ uint64x2_t cd_orig = cd;+ uint64x2_t ef_orig = ef;+ uint64x2_t gh_orig = gh;++ /* Load message (already native endian) */+ uint64x2_t m0 = vld1q_u64(&block[0]);+ uint64x2_t m1 = vld1q_u64(&block[2]);+ uint64x2_t m2 = vld1q_u64(&block[4]);+ uint64x2_t m3 = vld1q_u64(&block[6]);+ uint64x2_t m4 = vld1q_u64(&block[8]);+ uint64x2_t m5 = vld1q_u64(&block[10]);+ uint64x2_t m6 = vld1q_u64(&block[12]);+ uint64x2_t m7 = vld1q_u64(&block[14]);++ uint64x2_t tmp;++ /* Rounds 0-1 */+ tmp = vaddq_u64(m0, vld1q_u64(&K[0]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));++ /* Rounds 2-3 */+ tmp = vaddq_u64(m1, vld1q_u64(&K[2]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));++ /* Rounds 4-5 */+ tmp = vaddq_u64(m2, vld1q_u64(&K[4]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));++ /* Rounds 6-7 */+ tmp = vaddq_u64(m3, vld1q_u64(&K[6]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));++ /* Rounds 8-9 */+ tmp = vaddq_u64(m4, vld1q_u64(&K[8]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));++ /* Rounds 10-11 */+ tmp = vaddq_u64(m5, vld1q_u64(&K[10]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));++ /* Rounds 12-13 */+ tmp = vaddq_u64(m6, vld1q_u64(&K[12]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));++ /* Rounds 14-15 */+ tmp = vaddq_u64(m7, vld1q_u64(&K[14]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));++ /* Rounds 16-17 */+ tmp = vaddq_u64(m0, vld1q_u64(&K[16]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));++ /* Rounds 18-19 */+ tmp = vaddq_u64(m1, vld1q_u64(&K[18]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));++ /* Rounds 20-21 */+ tmp = vaddq_u64(m2, vld1q_u64(&K[20]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));++ /* Rounds 22-23 */+ tmp = vaddq_u64(m3, vld1q_u64(&K[22]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));++ /* Rounds 24-25 */+ tmp = vaddq_u64(m4, vld1q_u64(&K[24]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));++ /* Rounds 26-27 */+ tmp = vaddq_u64(m5, vld1q_u64(&K[26]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));++ /* Rounds 28-29 */+ tmp = vaddq_u64(m6, vld1q_u64(&K[28]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));++ /* Rounds 30-31 */+ tmp = vaddq_u64(m7, vld1q_u64(&K[30]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));++ /* Rounds 32-33 */+ tmp = vaddq_u64(m0, vld1q_u64(&K[32]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));++ /* Rounds 34-35 */+ tmp = vaddq_u64(m1, vld1q_u64(&K[34]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));++ /* Rounds 36-37 */+ tmp = vaddq_u64(m2, vld1q_u64(&K[36]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));++ /* Rounds 38-39 */+ tmp = vaddq_u64(m3, vld1q_u64(&K[38]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));++ /* Rounds 40-41 */+ tmp = vaddq_u64(m4, vld1q_u64(&K[40]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));++ /* Rounds 42-43 */+ tmp = vaddq_u64(m5, vld1q_u64(&K[42]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));++ /* Rounds 44-45 */+ tmp = vaddq_u64(m6, vld1q_u64(&K[44]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));++ /* Rounds 46-47 */+ tmp = vaddq_u64(m7, vld1q_u64(&K[46]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));++ /* Rounds 48-49 */+ tmp = vaddq_u64(m0, vld1q_u64(&K[48]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1));++ /* Rounds 50-51 */+ tmp = vaddq_u64(m1, vld1q_u64(&K[50]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1));++ /* Rounds 52-53 */+ tmp = vaddq_u64(m2, vld1q_u64(&K[52]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1));++ /* Rounds 54-55 */+ tmp = vaddq_u64(m3, vld1q_u64(&K[54]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1));++ /* Rounds 56-57 */+ tmp = vaddq_u64(m4, vld1q_u64(&K[56]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);+ m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1));++ /* Rounds 58-59 */+ tmp = vaddq_u64(m5, vld1q_u64(&K[58]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);+ m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1));++ /* Rounds 60-61 */+ tmp = vaddq_u64(m6, vld1q_u64(&K[60]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);+ m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1));++ /* Rounds 62-63 */+ tmp = vaddq_u64(m7, vld1q_u64(&K[62]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);+ m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1));++ /* Rounds 64-65 */+ tmp = vaddq_u64(m0, vld1q_u64(&K[64]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);++ /* Rounds 66-67 */+ tmp = vaddq_u64(m1, vld1q_u64(&K[66]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);++ /* Rounds 68-69 */+ tmp = vaddq_u64(m2, vld1q_u64(&K[68]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);++ /* Rounds 70-71 */+ tmp = vaddq_u64(m3, vld1q_u64(&K[70]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);++ /* Rounds 72-73 */+ tmp = vaddq_u64(m4, vld1q_u64(&K[72]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(gh, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1));+ gh = vsha512h2q_u64(tmp, cd, ab);+ cd = vaddq_u64(cd, tmp);++ /* Rounds 74-75 */+ tmp = vaddq_u64(m5, vld1q_u64(&K[74]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ef, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1));+ ef = vsha512h2q_u64(tmp, ab, gh);+ ab = vaddq_u64(ab, tmp);++ /* Rounds 76-77 */+ tmp = vaddq_u64(m6, vld1q_u64(&K[76]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(cd, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1));+ cd = vsha512h2q_u64(tmp, gh, ef);+ gh = vaddq_u64(gh, tmp);++ /* Rounds 78-79 */+ tmp = vaddq_u64(m7, vld1q_u64(&K[78]));+ tmp = vextq_u64(tmp, tmp, 1);+ tmp = vaddq_u64(ab, tmp);+ tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1));+ ab = vsha512h2q_u64(tmp, ef, cd);+ ef = vaddq_u64(ef, tmp);++ /* Add original state back */+ ab = vaddq_u64(ab, ab_orig);+ cd = vaddq_u64(cd, cd_orig);+ ef = vaddq_u64(ef, ef_orig);+ gh = vaddq_u64(gh, gh_orig);++ /* Store result */+ vst1q_u64(&state[0], ab);+ vst1q_u64(&state[2], cd);+ vst1q_u64(&state[4], ef);+ vst1q_u64(&state[6], gh);+}++#if defined(__APPLE__)+static int sysctl_flag(const char *name) {+ int val = 0;+ size_t len = sizeof(val);+ if (sysctlbyname(name, &val, &len, NULL, 0) != 0) return 0;+ return val != 0;+}+#endif++/*+ * Return 1 if the CPU implements the ARM SHA512 extension, 0+ * otherwise. We only know how to ask Darwin and Linux, and report 0+ * (selecting the pure Haskell fallback) on any other OS.+ */+int sha512_native_available(void) {+#if defined(__APPLE__)+ return sysctl_flag("hw.optional.arm.FEAT_SHA512")+ || sysctl_flag("hw.optional.armv8_2_sha512");+#elif defined(__linux__)+ return (getauxval(AT_HWCAP) & HWCAP_SHA512) != 0;+#else+ return 0;+#endif+}++#elif defined(HAVE_X86_SHA512)++/*+ * Four rounds. 'sha512rnds2' 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 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, on the upper two words, does the next two.+ */+#define ROUNDS4(abef, cdgh, msg) \+ do { \+ cdgh = _mm256_sha512rnds2_epi64(cdgh, abef, \+ _mm256_castsi256_si128(msg)); \+ abef = _mm256_sha512rnds2_epi64(abef, cdgh, \+ _mm256_extracti128_si256(msg, 1)); \+ } while (0)++/*+ * The four words following prev[0], i.e. (prev[1], prev[2], prev[3],+ * cur[0]) from lowest lane to highest.+ */+#define ALIGNR1(cur, prev) \+ _mm256_permute4x64_epi64(_mm256_blend_epi32(prev, cur, 0x03), 0x39)++/*+ * Process one 128-byte block using x86 SHA512 instructions.+ *+ * state: pointer to 8 uint64_t words (a,b,c,d,e,f,g,h)+ * block: pointer to 16 uint64_t words (already native endian)+ *+ * The state is updated in place.+ *+ * Compiled for the SHA512 and AVX2 extensions only; callers must first+ * check 'sha512_native_available'.+ *+ * Lane orders in comments are written from highest lane to lowest.+ */+__attribute__((target("avx2,sha512")))+void sha512_block_native(uint64_t *state, const uint64_t *block) {+ __m256i abcd, efgh, abef, cdgh, abef_orig, cdgh_orig;+ __m256i m0, m1, m2, m3, msg;++ /* Load current hash state, rearranging it for the SHA instructions */+ abcd = _mm256_loadu_si256((const __m256i *)&state[0]); /* d c b a */+ efgh = _mm256_loadu_si256((const __m256i *)&state[4]); /* h g f e */+ abef = _mm256_permute4x64_epi64(+ _mm256_permute2x128_si256(abcd, efgh, 0x20), 0x1b);+ /* a b e f */+ cdgh = _mm256_permute4x64_epi64(+ _mm256_permute2x128_si256(abcd, efgh, 0x31), 0x1b);+ /* c d g h */++ /* Save original for final addition */+ abef_orig = abef;+ cdgh_orig = cdgh;++ /* Load message (already native endian) */+ m0 = _mm256_loadu_si256((const __m256i *)&block[0]);+ m1 = _mm256_loadu_si256((const __m256i *)&block[4]);+ m2 = _mm256_loadu_si256((const __m256i *)&block[8]);+ m3 = _mm256_loadu_si256((const __m256i *)&block[12]);++ /* Rounds 0-3 */+ msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[0]));+ ROUNDS4(abef, cdgh, msg);++ /* Rounds 4-7 */+ msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[4]));+ ROUNDS4(abef, cdgh, msg);+ m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1));++ /* Rounds 8-11 */+ msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[8]));+ ROUNDS4(abef, cdgh, msg);+ m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2));++ /* Rounds 12-15 */+ msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[12]));+ ROUNDS4(abef, cdgh, msg);+ m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2));+ m0 = _mm256_sha512msg2_epi64(m0, m3);+ m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3));++ /* Rounds 16-19 */+ msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[16]));+ ROUNDS4(abef, cdgh, msg);+ m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3));+ m1 = _mm256_sha512msg2_epi64(m1, m0);+ m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0));++ /* Rounds 20-23 */+ msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[20]));+ ROUNDS4(abef, cdgh, msg);+ m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0));+ m2 = _mm256_sha512msg2_epi64(m2, m1);+ m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1));++ /* Rounds 24-27 */+ msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[24]));+ ROUNDS4(abef, cdgh, msg);+ m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1));+ m3 = _mm256_sha512msg2_epi64(m3, m2);+ m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2));++ /* Rounds 28-31 */+ msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[28]));+ ROUNDS4(abef, cdgh, msg);+ m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2));+ m0 = _mm256_sha512msg2_epi64(m0, m3);+ m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3));++ /* Rounds 32-35 */+ msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[32]));+ ROUNDS4(abef, cdgh, msg);+ m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3));+ m1 = _mm256_sha512msg2_epi64(m1, m0);+ m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0));++ /* Rounds 36-39 */+ msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[36]));+ ROUNDS4(abef, cdgh, msg);+ m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0));+ m2 = _mm256_sha512msg2_epi64(m2, m1);+ m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1));++ /* Rounds 40-43 */+ msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[40]));+ ROUNDS4(abef, cdgh, msg);+ m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1));+ m3 = _mm256_sha512msg2_epi64(m3, m2);+ m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2));++ /* Rounds 44-47 */+ msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[44]));+ ROUNDS4(abef, cdgh, msg);+ m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2));+ m0 = _mm256_sha512msg2_epi64(m0, m3);+ m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3));++ /* Rounds 48-51 */+ msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[48]));+ ROUNDS4(abef, cdgh, msg);+ m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3));+ m1 = _mm256_sha512msg2_epi64(m1, m0);+ m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0));++ /* Rounds 52-55 */+ msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[52]));+ ROUNDS4(abef, cdgh, msg);+ m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0));+ m2 = _mm256_sha512msg2_epi64(m2, m1);+ m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1));++ /* Rounds 56-59 */+ msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[56]));+ ROUNDS4(abef, cdgh, msg);+ m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1));+ m3 = _mm256_sha512msg2_epi64(m3, m2);+ m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2));++ /* Rounds 60-63 */+ msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[60]));+ ROUNDS4(abef, cdgh, msg);+ m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2));+ m0 = _mm256_sha512msg2_epi64(m0, m3);+ m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3));++ /* Rounds 64-67 */+ msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[64]));+ ROUNDS4(abef, cdgh, msg);+ m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3));+ m1 = _mm256_sha512msg2_epi64(m1, m0);+ m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0));++ /* Rounds 68-71 */+ msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[68]));+ ROUNDS4(abef, cdgh, msg);+ m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0));+ m2 = _mm256_sha512msg2_epi64(m2, m1);++ /* Rounds 72-75 */+ msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[72]));+ ROUNDS4(abef, cdgh, msg);+ m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1));+ m3 = _mm256_sha512msg2_epi64(m3, m2);++ /* Rounds 76-79 */+ msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[76]));+ ROUNDS4(abef, cdgh, msg);++ /* Add original state back */+ abef = _mm256_add_epi64(abef, abef_orig);+ cdgh = _mm256_add_epi64(cdgh, cdgh_orig);++ /* Restore the state's original order and store result */+ abef = _mm256_permute4x64_epi64(abef, 0x1b); /* f e b a */+ cdgh = _mm256_permute4x64_epi64(cdgh, 0x1b); /* h g d c */+ _mm256_storeu_si256((__m256i *)&state[0],+ _mm256_permute2x128_si256(abef, cdgh, 0x20)); /* d c b a */+ _mm256_storeu_si256((__m256i *)&state[4],+ _mm256_permute2x128_si256(abef, cdgh, 0x31)); /* h g f e */+}++/*+ * Return 1 if the CPU implements the x86 SHA512 extension and the AVX2+ * instructions used alongside it, and the OS saves the YMM registers,+ * 0 otherwise.+ */+int sha512_native_available(void) {+ unsigned int eax, ebx, ecx, edx, xcr0;++ if (!__get_cpuid(1, &eax, &ebx, &ecx, &edx))+ return 0;+ if (!(ecx & bit_OSXSAVE) || !(ecx & bit_AVX))+ return 0;+ /* XCR0 bits 1 and 2: the OS saves the XMM and YMM registers */+ __asm__ ("xgetbv" : "=a"(xcr0), "=d"(edx) : "c"(0));+ if ((xcr0 & 0x6) != 0x6)+ return 0;+ if (!__get_cpuid_count(7, 0, &eax, &ebx, &ecx, &edx))+ return 0;+ if (eax < 1 || !(ebx & bit_AVX2))+ return 0;+ __get_cpuid_count(7, 1, &eax, &ebx, &ecx, &edx);+ return (eax & bit_SHA512) != 0;+}++#else++/* Stub implementations for builds without hardware support */+void sha512_block_native(uint64_t *state, const uint64_t *block) {+ (void)state;+ (void)block;+ /* Should never be called - use pure Haskell fallback */+}++int sha512_native_available(void) {+ return 0;+}++#endif
lib/Crypto/Hash/SHA512.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 or x86 SHA512 extensions via FFI if they're available, and -- will otherwise use a pure Haskell implementation. module Crypto.Hash.SHA512 (@@ -33,7 +33,7 @@ import qualified Data.ByteString as BS import Data.Word (Word8, Word64) import Foreign.Ptr (Ptr)-import qualified Crypto.Hash.SHA512.Arm as Arm+import qualified Crypto.Hash.SHA512.Native as Native import Crypto.Hash.SHA512.Internal (MAC(..), Registers) import qualified Crypto.Hash.SHA512.Lazy as Lazy import qualified Crypto.Hash.SHA512.Pure as Pure@@ -49,7 +49,7 @@ -- "<strict 512-bit message digest>" hash :: BS.ByteString -> BS.ByteString hash m- | Arm.sha512_arm_available = Arm.hash m+ | Native.sha512_native_available = Native.hash m | otherwise = Pure.hash m {-# INLINABLE hash #-} @@ -67,7 +67,7 @@ -- "<strict 512-bit MAC>" hmac :: BS.ByteString -> BS.ByteString -> MAC hmac k m- | Arm.sha512_arm_available = MAC (Arm.hmac k m)+ | Native.sha512_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.sha512_arm_available = Arm._hmac_rr rp bp k m+ | Native.sha512_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.sha512_arm_available = Arm._hmac_rsb rp bp k v sep dat+ | Native.sha512_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/SHA512/Arm.hs
@@ -1,268 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE UnboxedTuples #-}---- |--- Module: Crypto.Hash.SHA512.Arm--- Copyright: (c) 2024 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ ARM crypto extension support for SHA-512.--module Crypto.Hash.SHA512.Arm (- sha512_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, 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.SHA512.Internal hiding (update)-import System.IO.Unsafe (unsafeDupablePerformIO)---- ffi --------------------------------------------------------------------------foreign import ccall unsafe "sha512_block_arm"- c_sha512_block :: Ptr Word64 -> Ptr Word64 -> IO ()--foreign import ccall unsafe "sha512_arm_available"- c_sha512_arm_available :: IO CInt---- utilities --------------------------------------------------------------------fi :: (Integral a, Num b) => a -> b-fi = fromIntegral-{-# INLINE fi #-}--peek_registers- :: Ptr Word64- -> Registers-peek_registers (GHC.Ptr.Ptr addr) = R- (Exts.indexWord64OffAddr# addr 0#)- (Exts.indexWord64OffAddr# addr 1#)- (Exts.indexWord64OffAddr# addr 2#)- (Exts.indexWord64OffAddr# addr 3#)- (Exts.indexWord64OffAddr# addr 4#)- (Exts.indexWord64OffAddr# addr 5#)- (Exts.indexWord64OffAddr# addr 6#)- (Exts.indexWord64OffAddr# addr 7#)-{-# INLINE peek_registers #-}--poke_block :: Ptr Word64 -> 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.writeWord64OffAddr# addr 00# w00 s00 of { s01 ->- case Exts.writeWord64OffAddr# addr 01# w01 s01 of { s02 ->- case Exts.writeWord64OffAddr# addr 02# w02 s02 of { s03 ->- case Exts.writeWord64OffAddr# addr 03# w03 s03 of { s04 ->- case Exts.writeWord64OffAddr# addr 04# w04 s04 of { s05 ->- case Exts.writeWord64OffAddr# addr 05# w05 s05 of { s06 ->- case Exts.writeWord64OffAddr# addr 06# w06 s06 of { s07 ->- case Exts.writeWord64OffAddr# addr 07# w07 s07 of { s08 ->- case Exts.writeWord64OffAddr# addr 08# w08 s08 of { s09 ->- case Exts.writeWord64OffAddr# addr 09# w09 s09 of { s10 ->- case Exts.writeWord64OffAddr# addr 10# w10 s10 of { s11 ->- case Exts.writeWord64OffAddr# addr 11# w11 s11 of { s12 ->- case Exts.writeWord64OffAddr# addr 12# w12 s12 of { s13 ->- case Exts.writeWord64OffAddr# addr 13# w13 s13 of { s14 ->- case Exts.writeWord64OffAddr# addr 14# w14 s14 of { s15 ->- case Exts.writeWord64OffAddr# addr 15# w15 s15 of { s16 ->- (# s16, () #) }}}}}}}}}}}}}}}}-{-# INLINE poke_block #-}---- update -----------------------------------------------------------------------update :: Ptr Word64 -> Ptr Word64 -> Block -> IO ()-update rp bp block = do- poke_block bp block- c_sha512_block rp bp-{-# INLINE update #-}---- api --------------------------------------------------------------------------- | Are ARM +sha512 extensions available?-sha512_arm_available :: Bool-sha512_arm_available = unsafeDupablePerformIO c_sha512_arm_available /= 0-{-# NOINLINE sha512_arm_available #-}--hash- :: BS.ByteString- -> BS.ByteString-hash m = unsafeDupablePerformIO $- allocaBytes 64 $ \rp ->- allocaBytes 128 $ \bp -> do- poke_registers rp (iv ())- _hash rp bp 0 m- let !rs = peek_registers rp- pure (cat rs)--_hash- :: Ptr Word64 -- ^ register state- -> Ptr Word64 -- ^ 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` 128) m- !total = el + fi l- if ll < 112- 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 Word64 -- ^ register state- -> Ptr Word64 -- ^ block state- -> BS.ByteString -- ^ input- -> IO ()-hash_blocks rp bp m@(BI.PS _ _ l) = loop 0 where- loop !j- | j + 128 > l = pure ()- | otherwise = do- let !block = parse m j- update rp bp block- loop (j + 128)-{-# INLINE hash_blocks #-}---- hmac -------------------------------------------------------------------------hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString-hmac k m = unsafeDupablePerformIO $- allocaBytes 64 $ \rp ->- allocaBytes 128 $ \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 > 128 = parse_key (hash k)- | otherwise = parse_key k-{-# INLINABLE prep_key #-}---- assume padded key as block.-_hmac- :: Ptr Word64 -- ^ register state- -> Ptr Word64 -- ^ 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.wordToWord64# 0x3636363636363636##))- _hash rp bp 128 m- let !block = pad_registers_with_length (peek_registers rp)- poke_registers rp (iv ())- update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##))- update rp bp block-{-# NOINLINE _hmac #-}--_hmac_rr- :: Ptr Word64 -- ^ register state- -> Ptr Word64 -- ^ 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 Word64 -- ^ register state- -> Ptr Word64 -- ^ 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.wordToWord64# 0x3636363636363636##))- update rp bp m- let !inner = pad_registers_with_length (peek_registers rp)- poke_registers rp (iv ())- update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##))- update rp bp inner-{-# INLINABLE _hmac_bb #-}---- | HMAC(key, v || sep || data) using ARM crypto extensions.--- Writes result to destination pointer.-_hmac_rsb- :: Ptr Word64 -- ^ destination (8 Word64s)- -> Ptr Word64 -- ^ scratch block buffer (16 Word64s)- -> 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.wordToWord64# 0x3636363636363636##))- _hash_vsb rp bp 128 v sep dat- let !inner = pad_registers_with_length (peek_registers rp)- poke_registers rp (iv ())- update rp bp (xor key (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##))- 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 Word64 -- ^ register state- -> Ptr Word64 -- ^ 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 >= 63 = do- -- first block is complete: v || sep || dat[0:63]- let !b0 = parse_vsb v sep dat- update rp bp b0- -- hash remaining complete blocks from dat[63:]- let !rest = BU.unsafeDrop 63 dat- !restLen = l - 63- hash_blocks rp bp rest- -- handle final padding- let !finLen = restLen `rem` 128- !fin = BU.unsafeDrop (restLen - finLen) rest- !total = el + 65 + fi l- if finLen < 112- 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 < 128 bytes total, straight to padding- let !total = el + 65 + fi l- if 65 + l < 112- 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/SHA512/Native.hs view
@@ -0,0 +1,269 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module: Crypto.Hash.SHA512.Native+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Hardware-accelerated SHA-512, via the ARM or x86 SHA512+-- extensions.++module Crypto.Hash.SHA512.Native (+ sha512_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, 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.SHA512.Internal hiding (update)+import System.IO.Unsafe (unsafeDupablePerformIO)++-- ffi ------------------------------------------------------------------------++foreign import ccall unsafe "sha512_block_native"+ c_sha512_block :: Ptr Word64 -> Ptr Word64 -> IO ()++foreign import ccall unsafe "sha512_native_available"+ c_sha512_native_available :: IO CInt++-- utilities ------------------------------------------------------------------++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++peek_registers+ :: Ptr Word64+ -> Registers+peek_registers (GHC.Ptr.Ptr addr) = R+ (Exts.indexWord64OffAddr# addr 0#)+ (Exts.indexWord64OffAddr# addr 1#)+ (Exts.indexWord64OffAddr# addr 2#)+ (Exts.indexWord64OffAddr# addr 3#)+ (Exts.indexWord64OffAddr# addr 4#)+ (Exts.indexWord64OffAddr# addr 5#)+ (Exts.indexWord64OffAddr# addr 6#)+ (Exts.indexWord64OffAddr# addr 7#)+{-# INLINE peek_registers #-}++poke_block :: Ptr Word64 -> 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.writeWord64OffAddr# addr 00# w00 s00 of { s01 ->+ case Exts.writeWord64OffAddr# addr 01# w01 s01 of { s02 ->+ case Exts.writeWord64OffAddr# addr 02# w02 s02 of { s03 ->+ case Exts.writeWord64OffAddr# addr 03# w03 s03 of { s04 ->+ case Exts.writeWord64OffAddr# addr 04# w04 s04 of { s05 ->+ case Exts.writeWord64OffAddr# addr 05# w05 s05 of { s06 ->+ case Exts.writeWord64OffAddr# addr 06# w06 s06 of { s07 ->+ case Exts.writeWord64OffAddr# addr 07# w07 s07 of { s08 ->+ case Exts.writeWord64OffAddr# addr 08# w08 s08 of { s09 ->+ case Exts.writeWord64OffAddr# addr 09# w09 s09 of { s10 ->+ case Exts.writeWord64OffAddr# addr 10# w10 s10 of { s11 ->+ case Exts.writeWord64OffAddr# addr 11# w11 s11 of { s12 ->+ case Exts.writeWord64OffAddr# addr 12# w12 s12 of { s13 ->+ case Exts.writeWord64OffAddr# addr 13# w13 s13 of { s14 ->+ case Exts.writeWord64OffAddr# addr 14# w14 s14 of { s15 ->+ case Exts.writeWord64OffAddr# addr 15# w15 s15 of { s16 ->+ (# s16, () #) }}}}}}}}}}}}}}}}+{-# INLINE poke_block #-}++-- update ---------------------------------------------------------------------++update :: Ptr Word64 -> Ptr Word64 -> Block -> IO ()+update rp bp block = do+ poke_block bp block+ c_sha512_block rp bp+{-# INLINE update #-}++-- api -----------------------------------------------------------------------++-- | Are hardware SHA-512 instructions available?+sha512_native_available :: Bool+sha512_native_available = unsafeDupablePerformIO c_sha512_native_available /= 0+{-# NOINLINE sha512_native_available #-}++hash+ :: BS.ByteString+ -> BS.ByteString+hash m = unsafeDupablePerformIO $+ allocaBytes 64 $ \rp ->+ allocaBytes 128 $ \bp -> do+ poke_registers rp (iv ())+ _hash rp bp 0 m+ let !rs = peek_registers rp+ pure (cat rs)++_hash+ :: Ptr Word64 -- ^ register state+ -> Ptr Word64 -- ^ 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` 128) m+ !total = el + fi l+ if ll < 112+ 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 Word64 -- ^ register state+ -> Ptr Word64 -- ^ block state+ -> BS.ByteString -- ^ input+ -> IO ()+hash_blocks rp bp m@(BI.PS _ _ l) = loop 0 where+ loop !j+ | j + 128 > l = pure ()+ | otherwise = do+ let !block = parse m j+ update rp bp block+ loop (j + 128)+{-# INLINE hash_blocks #-}++-- hmac -----------------------------------------------------------------------++hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString+hmac k m = unsafeDupablePerformIO $+ allocaBytes 64 $ \rp ->+ allocaBytes 128 $ \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 > 128 = parse_key (hash k)+ | otherwise = parse_key k+{-# INLINABLE prep_key #-}++-- assume padded key as block.+_hmac+ :: Ptr Word64 -- ^ register state+ -> Ptr Word64 -- ^ 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.wordToWord64# 0x3636363636363636##))+ _hash rp bp 128 m+ let !block = pad_registers_with_length (peek_registers rp)+ poke_registers rp (iv ())+ update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##))+ update rp bp block+{-# NOINLINE _hmac #-}++_hmac_rr+ :: Ptr Word64 -- ^ register state+ -> Ptr Word64 -- ^ 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 Word64 -- ^ register state+ -> Ptr Word64 -- ^ 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.wordToWord64# 0x3636363636363636##))+ update rp bp m+ let !inner = pad_registers_with_length (peek_registers rp)+ poke_registers rp (iv ())+ update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##))+ update rp bp inner+{-# INLINABLE _hmac_bb #-}++-- | HMAC(key, v || sep || data) using hardware SHA-512 instructions.+-- Writes result to destination pointer.+_hmac_rsb+ :: Ptr Word64 -- ^ destination (8 Word64s)+ -> Ptr Word64 -- ^ scratch block buffer (16 Word64s)+ -> 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.wordToWord64# 0x3636363636363636##))+ _hash_vsb rp bp 128 v sep dat+ let !inner = pad_registers_with_length (peek_registers rp)+ poke_registers rp (iv ())+ update rp bp (xor key (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##))+ update rp bp inner+{-# INLINABLE _hmac_rsb #-}++-- | Hash (v || sep || dat) with hardware SHA-512 instructions.+-- Assumes register state already initialized at rp.+_hash_vsb+ :: Ptr Word64 -- ^ register state+ -> Ptr Word64 -- ^ 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 >= 63 = do+ -- first block is complete: v || sep || dat[0:63]+ let !b0 = parse_vsb v sep dat+ update rp bp b0+ -- hash remaining complete blocks from dat[63:]+ let !rest = BU.unsafeDrop 63 dat+ !restLen = l - 63+ hash_blocks rp bp rest+ -- handle final padding+ let !finLen = restLen `rem` 128+ !fin = BU.unsafeDrop (restLen - finLen) rest+ !total = el + 65 + fi l+ if finLen < 112+ 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 < 128 bytes total, straight to padding+ let !total = el + 65 + fi l+ if 65 + l < 112+ 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/SHA512/Pure.hs view
@@ -10,7 +10,7 @@ -- Maintainer: Jared Tobin <jared@ppad.tech> -- -- Pure Haskell SHA-512 and HMAC-SHA512 implementations for strict--- ByteStrings, used when the ARM cryptographic extensions are+-- ByteStrings, used when hardware SHA-512 instructions are -- unavailable. module Crypto.Hash.SHA512.Pure (
ppad-sha512.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-sha512-version: 0.2.5+version: 0.2.6 synopsis: The SHA-512 and HMAC-SHA512 algorithms license: MIT license-file: LICENSE@@ -41,13 +41,13 @@ Crypto.Hash.SHA512.Lazy Crypto.Hash.SHA512.Pure other-modules:- Crypto.Hash.SHA512.Arm+ Crypto.Hash.SHA512.Native Data.Barrier build-depends: base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13 c-sources:- cbits/sha512_arm.c+ cbits/sha512_native.c if flag(sanitize) cc-options: -fsanitize=address,undefined -fno-omit-frame-pointer ghc-options: -optl=-fsanitize=address,undefined