sha256 (empty) → 0.1.0.0
raw patch · 19 files changed
+2589/−0 lines, 19 filesdep +basedep +base16dep +bytestringsetup-changed
Dependencies added: base, base16, bytestring, ghc-prim, hash-string, network-byte-order, sha256, tasty, tasty-hunit
Files
- CHANGELOG.md +8/−0
- LICENSE +202/−0
- Setup.hs +2/−0
- csrc/hs_sha256.c +430/−0
- csrc/hs_sha256.h +87/−0
- lib/Crypto/Sha256.hs +126/−0
- lib/Crypto/Sha256/Hkdf.hs +189/−0
- lib/Crypto/Sha256/Hkdf/Subtle.hs +29/−0
- lib/Crypto/Sha256/Hmac.hs +401/−0
- lib/Crypto/Sha256/Hmac/Implementation.hs +233/−0
- lib/Crypto/Sha256/Hmac/Subtle.hs +35/−0
- lib/Crypto/Sha256/Pbkdf2.hs +155/−0
- lib/Crypto/Sha256/Pbkdf2/Subtle.hs +24/−0
- lib/Crypto/Sha256/Subtle.hs +231/−0
- sha256.cabal +65/−0
- test/HKDF.hs +67/−0
- test/HMAC.hs +97/−0
- test/Main.hs +95/−0
- test/PBKDF2.hs +113/−0
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# Revision history for sha256++## 0.1.0.0 -- 2025-01-20++* Rewrite of the FFI portions of the cryptohash-sha256 bindings, in order+ to support precomputed HMAC keys, more efficient streaming and backtracking,+ bitstring inputs, (de)serialization of intermediate states, intermediate+ bytecounts, and more.
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ csrc/hs_sha256.c view
@@ -0,0 +1,430 @@+/*+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>+ * 2016 Herbert Valerio Riedel <hvr@gnu.org>+ * 2024 Leon P Smith+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ * notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ * notice, this list of conditions and the following disclaimer in the+ * documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ */++#include <stdint.h>+#include <stddef.h>+#include <stdio.h>+#include <string.h>+#include <ghcautoconf.h>++#include "hs_hashstring_memcmp.h"+#include "hs_sha256.h"++#define ptr_uint32_aligned(ptr) (!((uintptr_t)(ptr) & 0x3))++static inline uint32_t+ror32(const uint32_t word, const unsigned shift)+{+ /* GCC usually transforms this into a 'ror'-insn */+ return (word >> shift) | (word << (32 - shift));+}++static inline uint32_t+cpu_to_be32(const uint32_t hl)+{+#if WORDS_BIGENDIAN+ return hl;+#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)+ return __builtin_bswap32(hl);+#else+ /* GCC usually transforms this into a bswap insn */+ return ((hl & 0xff000000) >> 24) |+ ((hl & 0x00ff0000) >> 8) |+ ((hl & 0x0000ff00) << 8) |+ ( hl << 24);+#endif+}++static inline void+cpu_to_be32_array(uint32_t *restrict dest, const uint32_t *restrict src, unsigned wordcnt)+{+ while (wordcnt--)+ *dest++ = cpu_to_be32(*src++);+}++static inline uint64_t+cpu_to_be64(const uint64_t hll)+{+#if WORDS_BIGENDIAN+ return hll;+#elif __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)+ return __builtin_bswap64(hll);+#else+ return ((uint64_t)cpu_to_be32(hll & 0xffffffff) << 32LL) | cpu_to_be32(hll >> 32);+#endif+}++const uint32_t hs_sha256_init[SHA256_STATE_LEN] = {+ 0x6a09e667,+ 0xbb67ae85,+ 0x3c6ef372,+ 0xa54ff53a,+ 0x510e527f,+ 0x9b05688c,+ 0x1f83d9ab,+ 0x5be0cd19+};++const uint8_t hs_sha256_padding[SHA256_BLOCK_SIZE + 1] = { 0x80, };++/* 232 times the cube root of the first 64 primes 2..311 */+static const uint32_t k[] = {+ 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+};++#define e0(x) (ror32(x, 2) ^ ror32(x,13) ^ ror32(x,22))+#define e1(x) (ror32(x, 6) ^ ror32(x,11) ^ ror32(x,25))+#define s0(x) (ror32(x, 7) ^ ror32(x,18) ^ (x >> 3))+#define s1(x) (ror32(x,17) ^ ror32(x,19) ^ (x >> 10))++static void+sha256_do_chunk_aligned(uint32_t state[const restrict SHA256_STATE_LEN], uint32_t w[const restrict 64])+{+ int i;++ for (i = 16; i < 64; i++)+ w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16];++ uint32_t a = state[0];+ uint32_t b = state[1];+ uint32_t c = state[2];+ uint32_t d = state[3];+ uint32_t e = state[4];+ uint32_t f = state[5];+ uint32_t g = state[6];+ uint32_t h = state[7];++#define R(a, b, c, d, e, f, g, h, k, w) \+ t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w; \+ t2 = e0(a) + ((a & b) | (c & (a | b))); \+ d += t1; \+ h = t1 + t2;++ for (i = 0; i < 64; i += 8) {+ uint32_t t1, t2;++ R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]);+ R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]);+ R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]);+ R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]);+ R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]);+ R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]);+ R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]);+ R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]);+ }++#undef R++ state[0] += a;+ state[1] += b;+ state[2] += c;+ state[3] += d;+ state[4] += e;+ state[5] += f;+ state[6] += g;+ state[7] += h;+}++static void+sha256_do_chunk+(uint32_t state[const restrict SHA256_STATE_LEN],+ const uint8_t buf[const restrict SHA256_BLOCK_SIZE])+{+ /*+ printf( "state: ");+ for (int i = 0; i < SHA256_STATE_LEN; i++)+ printf("%08x", state[i]);+ printf("\nbuffer: ");+ for (int i = 0; i < SHA256_BLOCK_SIZE; i++)+ printf("%02x", buf[i]);+ printf("\n");+ */+ uint32_t w[64]; /* only first 16 words are filled in */+ if (ptr_uint32_aligned(buf)) { /* aligned buf */+ cpu_to_be32_array(w, (const uint32_t *)buf, 16);+ } else { /* unaligned buf */+ memcpy(w + 16, buf, 64);+#if !WORDS_BIGENDIAN+ cpu_to_be32_array(w, w + 16, 16);+#endif+ }+ sha256_do_chunk_aligned(state, w);+ explicit_bzero(&w, sizeof(w));+ /*+ printf( "state': ");+ for (int i = 0; i < SHA256_STATE_LEN; i++)+ printf("%08x", state[i]);+ printf("\n");+ */+}++size_t+hs_sha256_update+(const uint32_t state[const SHA256_STATE_LEN],+ const uint8_t *const data,+ size_t const datalen,+ uint32_t out[const SHA256_STATE_LEN])+{+ if (out != state) memcpy(out, state, SHA256_DIGEST_SIZE);+ if (data == NULL) return 0;+ size_t i = 0;+ size_t dataLeft = datalen;+ while (dataLeft >= SHA256_BLOCK_SIZE) {+ sha256_do_chunk(out, data + i);+ i += SHA256_BLOCK_SIZE;+ dataLeft -= SHA256_BLOCK_SIZE;+ }+ return i;+}++void+hs_sha256_update_ctx+(const sha256_ctx *const in,+ const uint8_t *const data,+ const size_t datalen,+ sha256_ctx *const out)+{+ const size_t bufferlen = in->count & 0x3F;+ if ( data == NULL || datalen == 0 ) {+ if (in != out) memcpy(out, in, sizeof(sha256_ctx) + bufferlen);+ } else if ( datalen + bufferlen < SHA256_BLOCK_SIZE ) {+ if (in != out) memcpy(out, in, sizeof(sha256_ctx) + bufferlen);+ memcpy(out->buffer + bufferlen, data, datalen);+ out->count += datalen;+ } else if ( bufferlen == 0 ) {+ const size_t processedLen = hs_sha256_update(in->state, data, datalen, out->state);+ out->count = in->count + datalen;+ memcpy(out->buffer, data + processedLen, datalen - processedLen);+ } else {+ // Don't assume the output has enough extra space for a full buffer+ uint8_t mybuf[SHA256_BLOCK_SIZE] __attribute__ ((aligned (4)));+ memcpy(mybuf, in->buffer, bufferlen);+ size_t processedDataLen = SHA256_BLOCK_SIZE - bufferlen;+ memcpy(mybuf + bufferlen, data, processedDataLen);+ hs_sha256_update(in->state, mybuf, SHA256_BLOCK_SIZE, out->state);+ processedDataLen += hs_sha256_update( out->state,+ data + processedDataLen,+ datalen - processedDataLen,+ out->state );+ out->count = in->count + datalen;+ memcpy(out->buffer, data + processedDataLen, datalen - processedDataLen );+ }+}++void+hs_sha256_promote_to_ctx+(const uint32_t state[const SHA256_STATE_LEN],+ uint64_t const blockcount,+ const uint8_t *const data,+ size_t const datalen,+ sha256_ctx *const out)+{+ hs_sha256_update(state, data, datalen, out->state);+ out->count = (blockcount << 6) + datalen;+ size_t const bufferlen = datalen & 0x3F;+ if (data != NULL && bufferlen > 0) {+ memcpy(out->buffer, data + (datalen - bufferlen), bufferlen);+ }+}++void+hs_sha256_encode_state+(const uint32_t in[const SHA256_STATE_LEN],+ uint8_t out[const SHA256_DIGEST_SIZE])+{+#if WORDS_BIGENDIAN+ memcpy(out, (uint8_t *)in, SHA256_DIGEST_SIZE);+#else+ if(ptr_uint32_aligned(out)) {+ cpu_to_be32_array((uint32_t *)out, in, SHA256_STATE_LEN);+ } else {+ for (int i = 0; i < SHA256_STATE_LEN; i++) {+ int pos = i << 2;+ out[pos ] = (in[i] >> 24) & 0xFF;+ out[pos+1] = (in[i] >> 16) & 0xFF;+ out[pos+2] = (in[i] >> 8) & 0xFF;+ out[pos+3] = (in[i] ) & 0xFF;+ }+ }+#endif+}++void+hs_sha256_decode_state+(const uint8_t in[const SHA256_DIGEST_SIZE],+ uint32_t out[const SHA256_STATE_LEN])+{+#if WORDS_BIGENDIAN+ memcpy((uint8_t *)out, in, SHA256_DIGEST_SIZE);+#else+ if(ptr_uint32_aligned(in)) {+ cpu_to_be32_array(out, (uint32_t *)in, SHA256_STATE_LEN);+ } else {+ for (int i = 0; i < SHA256_DIGEST_SIZE; i += 4) {+ out [i >> 2]+ = ((uint32_t)in[i ]) << 24+ | ((uint32_t)in[i+1]) << 16+ | ((uint32_t)in[i+2]) << 8+ | ((uint32_t)in[i+3]);+ }+ }+#endif+}++// The unpinned ByteArray approach I'm taking to the FFI seems to+// necessitate this kind of accessor functions. It'd be nice+// to simply use #{peek sha256_ctx, count} style accessors from+// haskell, but I'm not sure that works with this approach.+uint64_t+hs_sha256_get_count+(const sha256_ctx *const ctx)+{+ return ctx->count;+}++void+hs_sha256_init_ctx+(sha256_ctx *const out)+{+ hs_sha256_promote_to_ctx(hs_sha256_init, 0, NULL, 0, out);+}++void+hs_sha256_finalize_ctx_bits+(const sha256_ctx *const in,+ const uint8_t *const data,+ uint64_t const datalenbits,+ uint8_t out[const SHA256_DIGEST_SIZE])+{+ uint8_t buffer[SHA256_BLOCK_SIZE] __attribute__ ((aligned (4)));+ uint32_t state[SHA256_STATE_LEN];+ size_t bufferPos = in->count & 0x3F;+ size_t bufferLeft = SHA256_BLOCK_SIZE - bufferPos;+ size_t dataLeft = datalenbits >> 3;+ size_t dataPos;+ memcpy(buffer, in->buffer, bufferPos);+ if (data == NULL || datalenbits < 8) {+ memcpy(state, in, SHA256_DIGEST_SIZE);+ dataPos = 0;+ } else if (dataLeft < bufferLeft) {+ memcpy(state, in, SHA256_DIGEST_SIZE);+ dataPos = dataLeft;+ memcpy(buffer + bufferPos, data, dataLeft);+ bufferPos += dataLeft;+ } else {+ memcpy(buffer + bufferPos, data, bufferLeft);+ hs_sha256_update(in->state, buffer, SHA256_BLOCK_SIZE, state);+ dataPos = bufferLeft;+ dataLeft -= bufferLeft;+ size_t processedLen = hs_sha256_update(state, data + dataPos, dataLeft, state);+ dataPos += processedLen;+ dataLeft -= processedLen;+ memcpy(buffer, data + dataPos, dataLeft);+ bufferPos = dataLeft;+ }++ uint8_t bitsLeft = datalenbits & 7;++ // we need this conditional to avoid dereferencing past the end of "data"+ uint8_t lastByte = bitsLeft == 0 ? 0x80+ : (data[dataPos] & (0xFF << (8 - bitsLeft))) | 1 << (7 - bitsLeft);++ buffer[bufferPos++] = lastByte;++ if (bufferPos <= 56) {+ memset(buffer + bufferPos, 0, 56 - bufferPos);+ } else {+ memset(buffer + bufferPos, 0, 64 - bufferPos);+ sha256_do_chunk(state,buffer);+ memset(buffer, 0, 56);+ }++ uint64_t finalBitLen = (in->count << 3) + datalenbits ;++ buffer[56] = (finalBitLen >> 56) & 0xFF;+ buffer[57] = (finalBitLen >> 48) & 0xFF;+ buffer[58] = (finalBitLen >> 40) & 0xFF;+ buffer[59] = (finalBitLen >> 32) & 0xFF;+ buffer[60] = (finalBitLen >> 24) & 0xFF;+ buffer[61] = (finalBitLen >> 16) & 0xFF;+ buffer[62] = (finalBitLen >> 8) & 0xFF;+ buffer[63] = (finalBitLen ) & 0xFF;++ sha256_do_chunk(state, buffer);++ hs_sha256_encode_state(state, out);++ explicit_bzero(&state, sizeof(state));+ explicit_bzero(&buffer, sizeof(buffer));+}++int+hs_sha256_const_memcmp_uint32be+(const uint32_t *const a,+ const uint32_t *const b,+ uint32_t const n )+{+ int d, out = 0;+ uint32_t i = n;+ while (i > 0) {+ i--;+ for (int j = 0; j < 32; j += 8 ) {+ d = ((a[i] >> j) & 0xFF) - ((b[i] >> j) & 0xFF);+ out = d == 0 ? out : d;+ }+ }+ return out;+}++// constant-ish time memcmp, could be better, but should be pretty good+// doesn't handle nulls, must be passed a non-null argument!+int+hs_sha256_const_memcmp_ctx+(const sha256_ctx *const a,+ const sha256_ctx *const b )+{+ int d;+ if ( (d = hs_sha256_const_memcmp_uint32be(a->state, b->state, SHA256_STATE_LEN)) ) return d;+ int x = a->count & 0x3F;+ int y = b->count & 0x3F;+ int n = (x < y) ? x : y;+ if ( (d = hs_hashstring_const_memcmp(a->buffer, b->buffer, n)) ) return d;+ if ( (d = x - y) ) return d;+ // does this last comparison even matter in practice?+ if (a->count == b->count) return 0;+ if (a->count < b->count) return -1;+ return 1;+}
+ csrc/hs_sha256.h view
@@ -0,0 +1,87 @@+#pragma once++#include <stdint.h>+// #include <stddef.h>+// #include <assert.h>+// #include <string.h>++#define SHA256_BLOCK_SIZE 64+#define SHA256_DIGEST_SIZE 32+#define SHA256_STATE_LEN 8++typedef struct sha256_ctx+{+ uint32_t state[SHA256_STATE_LEN];+ uint64_t count;+ uint8_t buffer[];+} sha256_ctx;++size_t+hs_sha256_update+(const uint32_t state[const SHA256_STATE_LEN],+ const uint8_t *const data,+ size_t const datalen,+ uint32_t out[const SHA256_STATE_LEN]);++void+hs_sha256_update_ctx+(const sha256_ctx *const in,+ const uint8_t *const data,+ const size_t datalen,+ sha256_ctx *const out);++void+hs_sha256_promote_to_ctx+(const uint32_t state[const SHA256_STATE_LEN],+ uint64_t const blockcount,+ const uint8_t *const data,+ size_t const datalen,+ sha256_ctx *const out);++void+hs_sha256_finalize_ctx_bits+(const sha256_ctx *const in,+ const uint8_t *const bits,+ uint64_t const bitlen,+ uint8_t out[const SHA256_DIGEST_SIZE]);++void+hs_sha256_encode_state+(const uint32_t in[const SHA256_STATE_LEN],+ uint8_t out[const SHA256_DIGEST_SIZE]);++void+hs_sha256_decode_state+(const uint8_t in[const SHA256_DIGEST_SIZE],+ uint32_t out[const SHA256_STATE_LEN]);++uint64_t+hs_sha256_get_count+(const sha256_ctx *const ctx);++uint8_t *+hs_sha256_get_buffer+(sha256_ctx *const ctx);++uint32_t *+hs_sha256_get_state+(sha256_ctx *const ctx);++void+hs_sha256_init_ctx+(sha256_ctx *const out);++int+hs_sha256_const_memcmp_ctx+(const sha256_ctx *const a,+ const sha256_ctx *const b);++int+hs_sha256_const_memcmp_uint32be+(const uint32_t *const a,+ const uint32_t *const b,+ uint32_t const n );++extern const uint32_t hs_sha256_init[SHA256_STATE_LEN];++extern const uint8_t hs_sha256_padding[(SHA256_BLOCK_SIZE + 1)];
+ lib/Crypto/Sha256.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE MagicHash, UnboxedTuples, OverloadedStrings, ScopedTypeVariables,+ BangPatterns, LambdaCase #-}++-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-- Binding to SHA256, supporting streaming, backtracking, bitstring inputs, and+-- (de)serialization of intermediate states.+--+-------------------------------------------------------------------------------++module Crypto.Sha256+ ( hash+ , hash'+ , Sha256Ctx()+ , sha256_init+ , sha256_update, sha256_feed+ , sha256_updates, sha256_feeds+ , sha256_byteCount+ , sha256_blockCount+ , sha256_bufferLength+ , sha256_state+ , sha256_finalize , sha256_finalize_toByteString+ , sha256_finalizeBits , sha256_finalizeBits_toByteString+ , sha256_finalizeBytes, sha256_finalizeBytes_toByteString+ ) where++import Data.Array.Byte+import Data.Bits((.&.), shiftR)+import Data.ByteString(ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Internal (unsafeCreate)+import Data.ByteString.Unsafe(unsafeUseAsCString, unsafeUseAsCStringLen)+import Data.Foldable(foldl')+import Data.Function((&))+import Data.Word+import GHC.Exts+import GHC.IO++import Crypto.HashString+import Crypto.HashString.FFI (HashString(..))+import Crypto.Sha256.Subtle++-- TODO: there are a number of magic literals scattered throughout that+-- really ought to refer to a symbolic constant of some sort++hash :: ByteString -> ByteString+hash x = sha256_init & sha256_finalizeBits_toByteString x maxBound++hash' :: ByteString -> HashString+hash' x = sha256_init & sha256_finalizeBits x maxBound++sha256_init :: Sha256Ctx+sha256_init =+ unsafePerformIO . IO $ \st ->+ let !(# st0, a #) = newByteArray# 40# st+ !(# st1, _ #) = unIO (c_sha256_init_ctx a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, Sha256Ctx (ByteArray b) #)++sha256_byteCount :: Sha256Ctx -> Word64+sha256_byteCount (Sha256Ctx (ByteArray ctx)) = c_sha256_get_count ctx++sha256_blockCount :: Sha256Ctx -> Word64+sha256_blockCount ctx = sha256_byteCount ctx `shiftR` 6++sha256_bufferLength :: Sha256Ctx -> Word8+sha256_bufferLength ctx = fromIntegral (sha256_byteCount ctx .&. 0x3F)++sha256_state :: Sha256Ctx -> HashString+sha256_state = sha256state_encode . sha256state_fromCtxInplace++sha256_update :: Sha256Ctx -> ByteString -> Sha256Ctx+sha256_update ctx0@(Sha256Ctx (ByteArray ctx)) bytes+ | B.null bytes = ctx0+ | otherwise =+ unsafePerformIO $ do+ let count = c_sha256_get_count ctx + fromIntegral (B.length bytes)+ let !(I# bufLen#) = 40 + fromIntegral (count .&. 0x3F)+ unsafeUseAsCStringLen bytes $ \(bp,bl) -> IO $ \st ->+ let !(# st0, a #) = newByteArray# bufLen# st+ !(# st1, _ #) = unIO (c_sha256_update_ctx ctx bp (fromIntegral bl) a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, Sha256Ctx (ByteArray b) #)++sha256_updates :: Foldable f => Sha256Ctx -> f ByteString -> Sha256Ctx+sha256_updates = foldl' sha256_update++sha256_feed :: ByteString -> Sha256Ctx -> Sha256Ctx+sha256_feed = flip sha256_update++sha256_feeds :: Foldable f => f ByteString -> Sha256Ctx -> Sha256Ctx+sha256_feeds = flip sha256_updates++sha256_finalize :: Sha256Ctx -> HashString+sha256_finalize = sha256_finalizeBits B.empty 0++sha256_finalize_toByteString :: Sha256Ctx -> ByteString+sha256_finalize_toByteString = sha256_finalizeBits_toByteString B.empty 0++sha256_finalizeBits :: ByteString -> Word64 -> Sha256Ctx -> HashString+sha256_finalizeBits bits bitlen0 (Sha256Ctx (ByteArray ctx)) =+ unsafePerformIO . unsafeUseAsCString bits $ \bp -> IO $ \st ->+ let !(# st0, a #) = newByteArray# 32# st+ !(# st1, () #) = unIO (c_sha256_finalize_ctx_bits_ba ctx bp bitlen a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, HashString (ByteArray b) #)+ where+ bitlen = min (fromIntegral (B.length bits) * 8) bitlen0++sha256_finalizeBits_toByteString :: ByteString -> Word64 -> Sha256Ctx -> ByteString+sha256_finalizeBits_toByteString bits bitlen0 (Sha256Ctx (ByteArray ctx)) =+ unsafeCreate 32 $ \rp ->+ unsafeUseAsCString bits $ \bp ->+ c_sha256_finalize_ctx_bits ctx bp bitlen rp+ where+ bitlen = min (fromIntegral (B.length bits) * 8) bitlen0++sha256_finalizeBytes :: ByteString -> Sha256Ctx -> HashString+sha256_finalizeBytes = flip sha256_finalizeBits maxBound++sha256_finalizeBytes_toByteString :: ByteString -> Sha256Ctx -> ByteString+sha256_finalizeBytes_toByteString = flip sha256_finalizeBits_toByteString maxBound
+ lib/Crypto/Sha256/Hkdf.hs view
@@ -0,0 +1,189 @@+-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256.Hkdf+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+--+-- Implementation of HKDF-SHA256 supporting key reuse, backtracking, streaming,+-- and more.+--+-------------------------------------------------------------------------------++module Crypto.Sha256.Hkdf+ ( hkdf+ , hkdf'+ , hkdfList+ , hkdfList'+ , hkdfGen+ , hkdfExtract+ , hkdfExpand+ , hkdfExpand'+ , hkdfExpandList+ , hkdfExpandList'+ , hkdfExpandGen+ , HkdfCtx()+ , hkdfCtx_init+ , hkdfCtx_feed, hkdfCtx_feeds+ , hkdfCtx_update, hkdfCtx_updates+ , hkdfCtx_finalize+ , HkdfGen()+ , hkdfGen_init+ , hkdfGen_read+ , hkdfGen_read'+ , hkdfGen_peek+ ) where++import Control.Arrow((***))+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as SB+import Data.Function((&))+import qualified Data.List as List++import Crypto.HashString ( HashString )+import qualified Crypto.HashString as HS+import Crypto.Sha256.Hmac+import Crypto.Sha256.Hkdf.Subtle++hkdf :: HmacKeyPlain -- ^ salt+ -> ByteString -- ^ initial keying material+ -> ByteString -- ^ info tag+ -> Int -- ^ desired output length+ -> ByteString+hkdf = (fmap . fmap . fmap . fmap $ HS.toByteString) hkdf'++hkdf' :: HmacKeyPlain -- ^ salt+ -> ByteString -- ^ initial keying material+ -> ByteString -- ^ info tag+ -> Int -- ^ desired output length+ -> HashString+hkdf' = (fmap . fmap . fmap $ \gen len ->+ mconcat (HS.takeBytes len (hkdfGen_toList' gen))+ ) hkdfGen++hkdfList+ :: HmacKeyPlain -- ^ salt+ -> ByteString -- ^ initial keying material+ -> ByteString -- ^ info tag+ -> [ByteString]+hkdfList = (fmap . fmap . fmap $ hkdfGen_toList) hkdfGen++hkdfList'+ :: HmacKeyPlain -- ^ salt+ -> ByteString -- ^ initial keying material+ -> ByteString -- ^ info tag+ -> [HashString]+hkdfList' = (fmap . fmap . fmap $ hkdfGen_toList') hkdfGen+++hkdfGen+ :: HmacKeyPlain -- ^ salt+ -> ByteString -- ^ initial keying material+ -> ByteString -- ^ info tag+ -> HkdfGen+hkdfGen = fmap hkdfExpandGen . hkdfExtract . hmacKey_hashed++hkdfExtract+ :: HmacKey -- ^ salt+ -> ByteString -- ^ initial keying material+ -> HmacKey -- ^ pseudorandom key+hkdfExtract = fmap hkdfCtx_finalize . hkdfCtx_update . hkdfCtx_init++hkdfExpand+ :: HmacKey -- ^ pseudorandom key+ -> ByteString -- ^ info tag+ -> Int -- ^ desired length+ -> ByteString+hkdfExpand = (fmap . fmap . fmap $ HS.toByteString) hkdfExpand'++hkdfExpand'+ :: HmacKey -- ^ pseudorandom key+ -> ByteString -- ^ info tag+ -> Int -- ^ desired length+ -> HashString+hkdfExpand' =+ (fmap . fmap $ \gen len ->+ mconcat (HS.takeBytes len (hkdfGen_toList' gen))+ ) hkdfExpandGen++hkdfExpandList+ :: HmacKey -- ^ pseudorandom key+ -> ByteString -- ^ info tag+ -> [ByteString] -- ^ infinite lazy list of output blocks+hkdfExpandList = fmap hkdfGen_toList . hkdfExpandGen++hkdfExpandList'+ :: HmacKey -- ^ pseudorandom key+ -> ByteString -- ^ info tag+ -> [HashString] -- ^ infinite lazy list of output blocks+hkdfExpandList' = fmap hkdfGen_toList' . hkdfExpandGen++hkdfExpandGen+ :: HmacKey -- ^ pseudorandom key+ -> ByteString -- ^ info tag+ -> HkdfGen+hkdfExpandGen prk = hkdfGen_init prk . SB.toShort++hkdfCtx_init :: HmacKey -> HkdfCtx+hkdfCtx_init key = HkdfCtx (hmacCtx_init key)++hkdfCtx_feeds :: Foldable f => f ByteString -> HkdfCtx -> HkdfCtx+hkdfCtx_feeds bs (HkdfCtx ctx) = HkdfCtx (hmacCtx_feeds bs ctx)++hkdfCtx_feed :: ByteString -> HkdfCtx -> HkdfCtx+hkdfCtx_feed bs (HkdfCtx ctx) = HkdfCtx (hmacCtx_feed bs ctx)++hkdfCtx_updates :: Foldable f => HkdfCtx -> f ByteString -> HkdfCtx+hkdfCtx_updates (HkdfCtx ctx) bs = HkdfCtx (hmacCtx_updates ctx bs)++hkdfCtx_update :: HkdfCtx -> ByteString -> HkdfCtx+hkdfCtx_update (HkdfCtx ctx) bs = HkdfCtx (hmacCtx_update ctx bs)++hkdfCtx_finalize :: HkdfCtx -> HmacKey+hkdfCtx_finalize (HkdfCtx ctx) = hmacKey (HS.toByteString (hmacCtx_finalize ctx))++hkdfGen_init :: HmacKey -> ShortByteString -> HkdfGen+hkdfGen_init key info = HkdfGen+ { hkdfGen_info = info+ , hkdfGen_key = key+ , hkdfGen_counter = 1+ , hkdfGen_state = HS.fromShort SB.empty+ }++hkdfGen_read' :: HkdfGen -> (HashString, HkdfGen)+hkdfGen_read' gen = (state',gen')+ where+ info = hkdfGen_info gen+ key = hkdfGen_key gen+ counter = hkdfGen_counter gen+ state = hkdfGen_state gen+ counter' = counter + 1+ state' = hmacCtx_init key &+ hmacCtx_feed (HS.toByteString state) &+ hmacCtx_feed (SB.fromShort info) &+ hmacCtx_finalizeBits (B.singleton counter) 8+ gen' = HkdfGen+ { hkdfGen_info = info+ , hkdfGen_key = key+ , hkdfGen_counter = counter'+ , hkdfGen_state = state'+ }++hkdfGen_read :: HkdfGen -> (ByteString, HkdfGen)+hkdfGen_read = (HS.toByteString *** id) . hkdfGen_read'++hkdfGen_peek :: HkdfGen -> Maybe HashString+hkdfGen_peek gen =+ if (SB.null (HS.toShort st))+ then Nothing+ else Just st+ where+ st = hkdfGen_state gen++hkdfGen_toList' :: HkdfGen -> [HashString]+hkdfGen_toList' = List.unfoldr (Just . hkdfGen_read')++hkdfGen_toList :: HkdfGen -> [ByteString]+hkdfGen_toList = List.unfoldr (Just . hkdfGen_read)
+ lib/Crypto/Sha256/Hkdf/Subtle.hs view
@@ -0,0 +1,29 @@+-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256.Hkdf.Subtle+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-------------------------------------------------------------------------------++module Crypto.Sha256.Hkdf.Subtle where++import Data.ByteString.Short(ShortByteString)+import Data.Word+import Crypto.HashString+import Crypto.Sha256.Hmac++-- | Context type for incremental @hkdfExtract@++newtype HkdfCtx = HkdfCtx {+ hkdfCtx_hmacCtx :: HmacCtx+ } deriving (Eq, Ord)++-- | Plain-old-data representation of the generator for @hkdfExpand@++data HkdfGen = HkdfGen+ { hkdfGen_info :: !ShortByteString+ , hkdfGen_key :: !HmacKey+ , hkdfGen_counter :: !Word8+ , hkdfGen_state :: !HashString+ }
+ lib/Crypto/Sha256/Hmac.hs view
@@ -0,0 +1,401 @@+{-# LANGUAGE ViewPatterns, LambdaCase, BangPatterns #-}++-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256.Hmac+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-- An implementation of HMAC-SHA256 that supports precomputed keys, streaming,+-- backtracking, bitstring inputs, and (de)serialization of intermediate states.+--+-------------------------------------------------------------------------------++module Crypto.Sha256.Hmac+ ( hmac+ , hmac'+ , HmacKeyPlain+ -- , hmacKeyPlain_eq+ , HmacKey()+ , hmacKey+ , hmacKey_hashed+ , hmacKey_toPlain+ , hmacKey_toHashed+ , hmacKey_forgetPlain+ , hmacKey_run+ , HmacKeyLike()+ , hmacKeyLike+ , hmacKeyLike_init+ , hmacKeyLike_initHashed+ , hmacKeyLike_initPrefixed+ , hmacKeyLike_toKey+ , hmacKeyLike_toPlain+ , hmacKeyLike_toHashed+ , hmacKeyLike_toPrefixed+ , hmacKeyLike_run+ , hmacKeyLike_byteCount+ , hmacKeyLike_blockCount+ , hmacKeyLike_bufferLength+ -- , hmacKeyLike_feeds+ -- , hmacKeyLike_feedsWith+ , HmacKeyHashed()+ , hmacKeyHashed+ , hmacKeyHashed_toKey+ , hmacKeyHashed_run+ , hmacKeyHashed_runWith+ , HmacKeyPrefixed()+ , hmacKeyPrefixed+ , hmacKeyPrefixed_init+ , hmacKeyPrefixed_initHashed+ , hmacKeyPrefixed_initLike+ , hmacKeyPrefixed_toHashed+ -- , hmacKeyPrefixed_eqHashed+ , hmacKeyPrefixed_feed+ , hmacKeyPrefixed_feeds+ , hmacKeyPrefixed_feedsWith+ , hmacKeyPrefixed_run+ , hmacKeyPrefixed_byteCount+ , hmacKeyPrefixed_blockCount+ , hmacKeyPrefixed_bufferLength+ , HmacCtx()+ , hmacCtx+ , hmacCtx_init+ , hmacCtx_initWith+ , hmacCtx_update, hmacCtx_feed+ , hmacCtx_updates, hmacCtx_feeds+ , hmacCtx_finalize , hmacCtx_finalize_toByteString+ , hmacCtx_finalizeBits , hmacCtx_finalizeBits_toByteString+ , hmacCtx_finalizeBytes, hmacCtx_finalizeBytes_toByteString+ , hmacCtx_byteCount+ , hmacCtx_blockCount+ , hmacCtx_bufferLength+-- , hmacCtx_toHmacKeyPrefixed+ ) where++import Data.Bits(xor)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.List(scanl')+import Data.Function((&))+import Data.Foldable(Foldable, toList)+import Data.Int+import Data.Word++import Crypto.HashString+import Crypto.Sha256 as Sha256+import Crypto.Sha256.Subtle+import Crypto.Sha256.Hmac.Implementation++-- Should these be made publicly available? Are these available anywhere else?+dropBs :: Int64 -> [ ByteString ] -> [ ByteString ]+dropBs = go+ where+ len = fromIntegral . B.length+ go _ [] = []+ go 0 bs = bs+ go n (b:bs)+ | n >= len b = go (n - len b) bs+ | otherwise = B.drop (fromIntegral n) b : bs++takeBs :: Int64 -> [ ByteString ] -> [ ByteString ]+takeBs = go+ where+ len = fromIntegral . B.length+ go _ [] = []+ go n (b:bs)+ | n <= 0 = []+ | len b < n = b : go (n - len b) bs+ | otherwise = [B.take (fromIntegral n) b]++takeBs' :: Int64 -> [ ByteString ] -> [ ByteString ]+takeBs' n bs = if haveEnough then takeBs n bs else []+ where+ len = fromIntegral . B.length+ haveEnough = any (>= n) (scanl' (+) 0 (map len bs))+++-- Initialize a precomputed hmac key from a plaintext bytestring, which+-- can then be turned into an hmac context using 'hmacKey_run'+--+-- Note this structure retains the plaintext key, which isn't strictly necessary+-- for actually computing the resulting hmac function. The plaintext key can+-- be forgotten using 'hmacKey_forgetPlain'.+hmacKey :: HmacKeyPlain -> HmacKey+hmacKey key = HmacKey_Plain key (hmacKeyHashed key)++-- | If the plaintext hmac key has been remembered by the precomputed key, return it.+-- Otherwise return 'Nothing'. Keys precomputed by 'hmacKey' retain the plaintext,+-- which can subsequently be forgotten by 'hmacKey_forgetPlain'. Alternatively,+-- keys precomputed by 'hmacKey_hashed' never retains the plaintext key in the+-- first place.+hmacKey_toPlain :: HmacKey -> Maybe HmacKeyPlain+hmacKey_toPlain = \case+ HmacKey_Plain a _ -> Just a+ HmacKey_Hashed _ -> Nothing++-- | Forget any plaintext hmac keys being retained by a given precomputed key, meaning+-- that for all x, @hmacKey_toPlain (hmacKey_forgetPlain x) == Nothing@.+--+-- This is potentially useful when implementing PBKDF2, as the plaintext password can+-- immediately be replaced with a precomputed hmac key, even before key-stretching+-- is complete. Note that the precomputed hmac key does provide a fast brute-force+-- attack on the plaintext key, typically as little as 1 SHA256 block, so this cannot be+-- relied upon for secrecy if the hmac key is potentially guessable, such as a weak+-- password or a non-secret salt.++hmacKey_forgetPlain :: HmacKey -> HmacKey+hmacKey_forgetPlain = \case+ HmacKey_Plain _ b -> HmacKey_Hashed b+ x@(HmacKey_Hashed _) -> x++hmacKeyLike :: HmacKeyPlain -> HmacKeyLike+hmacKeyLike key = HmacKeyLike_Plain key (hmacKeyHashed key)++hmacKeyLike_init :: HmacKey -> HmacKeyLike+hmacKeyLike_init = \case+ HmacKey_Plain a b -> HmacKeyLike_Plain a b+ HmacKey_Hashed b -> HmacKeyLike_Hashed b++hmacKeyLike_initHashed :: HmacKeyHashed -> HmacKeyLike+hmacKeyLike_initHashed = HmacKeyLike_Hashed++hmacKeyLike_initPrefixed :: HmacKeyPrefixed -> HmacKeyLike+hmacKeyLike_initPrefixed = HmacKeyLike_Prefixed++hmacKeyLike_toPlain :: HmacKeyLike -> Maybe HmacKeyPlain+hmacKeyLike_toPlain = \case+ HmacKeyLike_Plain a _ -> Just a+ HmacKeyLike_Hashed _ -> Nothing+ HmacKeyLike_Prefixed _ -> Nothing++hmacKeyLike_toHashed :: HmacKeyLike -> Maybe HmacKeyHashed+hmacKeyLike_toHashed = \case+ HmacKeyLike_Plain _ a -> Just a+ HmacKeyLike_Hashed a -> Just a+ HmacKeyLike_Prefixed a -> hmacKeyPrefixed_toHashed a++hmacKeyLike_toKey :: HmacKeyLike -> Maybe HmacKey+hmacKeyLike_toKey = \case+ HmacKeyLike_Plain a b -> Just $ HmacKey_Plain a b+ HmacKeyLike_Hashed b -> Just $ HmacKey_Hashed b+ HmacKeyLike_Prefixed c -> HmacKey_Hashed <$> hmacKeyPrefixed_toHashed c++hmacKeyLike_run :: HmacKeyLike -> HmacCtx+hmacKeyLike_run = \case+ HmacKeyLike_Plain _ a -> hmacKeyHashed_run a+ HmacKeyLike_Hashed a -> hmacKeyHashed_run a+ HmacKeyLike_Prefixed a -> hmacKeyPrefixed_run a++-- | how many bytes have been fed into the SHA256 state machine? This is always 64+-- more bytes than hmac's "message" input.+-- If @hmacKeyLike_toKey x == Just ...@, then @hmacKeyLike_byteCount x == 64@.+-- If @hmacKeyLike_toKey x == Nothing@, then this returns a multiple of 64 that is+-- greater or equal to 128.+-- ++hmacKeyLike_byteCount :: HmacKeyLike -> Word64+hmacKeyLike_byteCount = \case+ HmacKeyLike_Plain _ _ -> 64+ HmacKeyLike_Hashed _ -> 64+ HmacKeyLike_Prefixed b -> hmacKeyPrefixed_byteCount b++hmacKeyLike_blockCount :: HmacKeyLike -> Word64+hmacKeyLike_blockCount = \case+ HmacKeyLike_Plain _ _ -> 1+ HmacKeyLike_Hashed _ -> 1+ HmacKeyLike_Prefixed b -> hmacKeyPrefixed_blockCount b++hmacKeyLike_bufferLength :: HmacKeyLike -> Word8+hmacKeyLike_bufferLength = const 0++-- | Precompute an HmacKey without retaining the plaintext input, equivalent to+-- 'hmacKey_forgetInput . hmacKey'+hmacKey_hashed :: HmacKeyPlain -> HmacKey+hmacKey_hashed = HmacKey_Hashed . hmacKeyHashed++hmacKey_run :: HmacKey -> HmacCtx+hmacKey_run = hmacCtx_init++hmacKeyHashed :: HmacKeyPlain -> HmacKeyHashed+hmacKeyHashed key = HmacKeyHashed opad ipad+ where+ ipad = tweak 0x36+ opad = tweak 0x5c+ k1 = if B.length key > 64 then Sha256.hash key else key+ k2 = B.append k1 (B.replicate (64 - B.length k1) 0)+ tweak c = sha256state_init & sha256state_feed (B.map (xor c) k2)++hmacKeyHashed_toKey :: HmacKeyHashed -> HmacKey+hmacKeyHashed_toKey = HmacKey_Hashed++hmacKeyHashed_run :: HmacKeyHashed -> HmacCtx+hmacKeyHashed_run key = HmacCtx+ { hmacCtx_ipadCtx = hmacKeyHashed_ipadCtx key+ , hmacCtx_opad = hmacKeyHashed_opad key+ }++hmacKeyHashed_runWith :: HmacKeyHashed -> ByteString -> HmacCtx+hmacKeyHashed_runWith key str = HmacCtx+ { hmacCtx_ipadCtx = hmacKeyHashed_runIpadCtx key str+ , hmacCtx_opad = hmacKeyHashed_opad key+ }++hmacKeyPrefixed :: HmacKeyPlain -> HmacKeyPrefixed+hmacKeyPrefixed = hmacKeyPrefixed_initHashed . hmacKeyHashed++hmacKeyPrefixed_init :: HmacKey -> HmacKeyPrefixed+hmacKeyPrefixed_init = hmacKeyPrefixed_initHashed . hmacKey_toHashed++hmacKeyPrefixed_initLike :: HmacKeyLike -> HmacKeyPrefixed+hmacKeyPrefixed_initLike = hmacKeyLike_toPrefixed++hmacKeyPrefixed_toHashed :: HmacKeyPrefixed -> Maybe HmacKeyHashed+hmacKeyPrefixed_toHashed x =+ if hmacKeyPrefixed_blockCount x == 1+ then Just $ HmacKeyHashed+ { hmacKeyHashed_ipad = sha256state_fromCtxInplace (hmacKeyPrefixed_ipadCtx x)+ , hmacKeyHashed_opad = hmacKeyPrefixed_opad x+ }+ else Nothing++hmacKeyPrefixed_feed :: ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)+hmacKeyPrefixed_feed x = hmacKeyPrefixed_feeds [x]++hmacKeyPrefixed_feeds :: Foldable f => f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)+hmacKeyPrefixed_feeds = hmacKeyPrefixed_feedsWith id++hmacKeyPrefixed_feedsWith :: Foldable f => (a -> ByteString) -> f a -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)+hmacKeyPrefixed_feedsWith f = go . map f . toList+ where+ go bss !st =+ case takeBs' 64 bss of+ [] -> (B.concat bss, st)+ x -> go (dropBs 64 bss) st'+ where+ st' = HmacKeyPrefixed+ { hmacKeyPrefixed_ipadCtx = sha256_updates (hmacKeyPrefixed_ipadCtx st) x+ , hmacKeyPrefixed_opad = hmacKeyPrefixed_opad st+ }++hmacKeyPrefixed_run :: HmacKeyPrefixed -> HmacCtx+hmacKeyPrefixed_run key = HmacCtx+ { hmacCtx_ipadCtx = hmacKeyPrefixed_ipadCtx key+ , hmacCtx_opad = hmacKeyPrefixed_opad key+ }++hmacKeyPrefixed_byteCount :: HmacKeyPrefixed -> Word64+hmacKeyPrefixed_byteCount = sha256_byteCount . hmacKeyPrefixed_ipadCtx++hmacKeyPrefixed_bufferLength :: HmacKeyPrefixed -> Word8+hmacKeyPrefixed_bufferLength = const 0++-- | A simple interface to HMAC-SHA256. Note that this function was written+-- to make partial application an efficient way to compute the hmac of+-- multiple messages with exactly the same key:+--+-- @+-- let myHash = hmac "my-key"+-- in (myHash "message 1", myHash "message 2", myHash "message 3")+-- @+--+-- This typically saves two SHA-256 blocks per reused function application.+-- Thus this example saves four block computations from the two reused+-- calls to @myHash@ in this example.+--+-- Initializing the @myHash@ closure requires computing two SHA-256 blocks.+-- Applying the closure requires two further SHA-256 blocks per message,+-- as every message is less than 56 bytes long. Thus the total computation+-- requires 8 SHA-256 blocks with reuse, or 12 SHA-256 blocks without reuse.+--+-- Key reuse can save four or more block computations per application if+-- the reused key is longer than 64 bytes. I don't recommend using HMAC+-- keys that are longer than 64 bytes, as all such keys can be trivially+-- replaced with the SHA256 hash of the key, which is only 32 bytes long.+--+-- This high-level interface is implemented using 'hmacCtx_finalize',+-- 'hmacKeyHashed_run', and 'hmacKeyHashed' composed in a point-free style+-- in order to help ensure key reuse works as expected.++hmac :: HmacKeyPlain -> ByteString -> ByteString+hmac = fmap hmacCtx_finalize_toByteString . hmacCtx_initWith . hmacKey_hashed++hmac' :: HmacKeyPlain -> ByteString -> HashString+hmac' = fmap hmacCtx_finalize . hmacCtx_initWith . hmacKey_hashed++hmacCtx :: HmacKeyPlain -> HmacCtx+hmacCtx = hmacCtx_init . hmacKey_hashed++-- | Initialize a new empty HMAC context from a precomputed HMAC key.++hmacCtx_init :: HmacKey -> HmacCtx+hmacCtx_init = hmacKeyHashed_run . hmacKey_toHashed++hmacCtx_initWith :: HmacKey -> ByteString -> HmacCtx+hmacCtx_initWith = hmacKeyHashed_runWith . hmacKey_toHashed++-- | Append a bytestring onto the end of the message argument to HMAC.++hmacCtx_update :: HmacCtx -> ByteString -> HmacCtx+hmacCtx_update = flip hmacCtx_feed++hmacCtx_feed :: ByteString -> HmacCtx -> HmacCtx+hmacCtx_feed b (HmacCtx oc ic) = HmacCtx oc (sha256_update ic b)++-- | Append zero or more bytestrings onto the end of the message argument to+-- HMAC.++hmacCtx_updates :: Foldable f => HmacCtx -> f ByteString -> HmacCtx+hmacCtx_updates = flip hmacCtx_feeds++hmacCtx_feeds :: Foldable f => f ByteString -> HmacCtx -> HmacCtx+hmacCtx_feeds bs (HmacCtx oc ic) = HmacCtx oc (sha256_updates ic (toList bs))++-- | Finish computing the final 32-byte hash for an HMAC context.++hmacCtx_finalize :: HmacCtx -> HashString+hmacCtx_finalize = hmacCtx_finalizeBits B.empty 0++-- | Append any arbitrary bitstring onto the end of an HMAC context, and+-- finish computing the final 32-byte hash.++hmacCtx_finalizeBits :: ByteString -> Word64 -> HmacCtx -> HashString+hmacCtx_finalizeBits bits bitlen (HmacCtx oc ic) = outer+ where+ inner = sha256_finalizeBits_toByteString bits bitlen ic+ outer = sha256_finalize (sha256state_runWith 1 inner oc)++hmacCtx_finalize_toByteString :: HmacCtx -> ByteString+hmacCtx_finalize_toByteString = hmacCtx_finalizeBits_toByteString B.empty 0++-- | Append any arbitrary bitstring onto the end of an HMAC context, and+-- finish computing the final 32-byte hash.++hmacCtx_finalizeBits_toByteString :: ByteString -> Word64 -> HmacCtx -> ByteString+hmacCtx_finalizeBits_toByteString bits bitlen (HmacCtx oc ic) = outer+ where+ inner = sha256_finalizeBits_toByteString bits bitlen ic+ outer = sha256_finalize_toByteString (sha256state_runWith 1 inner oc)++hmacCtx_finalizeBytes :: ByteString -> HmacCtx -> HashString+hmacCtx_finalizeBytes = flip hmacCtx_finalizeBits maxBound++hmacCtx_finalizeBytes_toByteString :: ByteString -> HmacCtx -> ByteString+hmacCtx_finalizeBytes_toByteString = flip hmacCtx_finalizeBits_toByteString maxBound++hmacCtx_byteCount :: HmacCtx -> Word64+hmacCtx_byteCount = sha256_byteCount . hmacCtx_ipadCtx++hmacCtx_blockCount :: HmacCtx -> Word64+hmacCtx_blockCount = sha256_blockCount . hmacCtx_ipadCtx++hmacCtx_bufferLength :: HmacCtx -> Word8+hmacCtx_bufferLength = sha256_bufferLength . hmacCtx_ipadCtx++-- Ugh, I don't have convenient access to cryptohash's internal counter. I+-- should fix that. I also need to fix the fact that cryptohash-sha256 exposes+-- endianess issues in a publicly-facing bytestrings, thus potentially creating+-- less-than-immediately-obvious problems when serializing/deserializing SHA256+-- states. Thus part of the reason why I started on newer SHA256 bindings for+-- GHC 9.4.++-- hmacCtx_toHmacKeyPrefixed :: HmacCtx -> (ByteString, HmacKeyPrefixed)
+ lib/Crypto/Sha256/Hmac/Implementation.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE ViewPatterns, LambdaCase #-}++module Crypto.Sha256.Hmac.Implementation where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Function(on)+import Data.Word++import Crypto.Sha256 as Sha256+import Crypto.Sha256.Subtle++type HmacKeyPlain = ByteString++nullBuffer :: ByteString+nullBuffer = BS.replicate 64 0++-- | A cached, precomputed hmac key. It comes in two flavors, one that remembers the+-- plaintext key, and one that doesn't, remembering only the precomputed hmac key.+--+-- Computing an hmac key typically requires two SHA256 blocks, unless the key itself+-- is more than 64 bytes, in which case precomputing the key will require at least+-- four SHA256 blocks.++data HmacKey+ = HmacKey_Plain {-# UNPACK #-} !HmacKeyPlain HmacKeyHashed+ | HmacKey_Hashed {-# UNPACK #-} !HmacKeyHashed++instance Eq HmacKey where+ (HmacKey_Plain a _) == (HmacKey_Plain b _) = hmacKeyPlain_eq a b+ a == b = hmacKey_toHashed a == hmacKey_toHashed b++instance Ord HmacKey where+ compare = compare `on` hmacKey_toHashed++-- | This function can in theory return False, when converting both strings+-- to a 'HmacKeyHashed' first and then comparing returns True. However,+-- probabilistically speaking, the recall of this function is+-- cryptographically close to 1, and significantly faster than a full+-- HMAC key derivation.+--+-- There are three ways that a failure of recall, i.e. a false negative, can+-- happen:+--+-- If one key is 32 bytes or shorter, and the other is longer than 64 bytes,+-- recall failures can happen if the SHA-256 hash of the longer key ends in+-- at least 16 null bytes, corresponding to a partial preimage.+--+-- If both keys are longer than 64 bytes, recall failures can happen when+-- those keys collide SHA-256.+--+-- Alternatively, recall failures can happen when HMAC-SHA256's key schedule+-- collides. This should be considerably more difficult than a regular SHA-256+-- collision, because it involves xor'ing each key with two different pads,+-- and then hashing both. Thus, effectively, this requires two SHA-256+-- collisions of a very specific form.++hmacKeyPlain_eq :: HmacKeyPlain -> HmacKeyPlain -> Bool+hmacKeyPlain_eq a b =+ case (BS.length a > 64, BS.length b > 64) of+ (False, False) -> ((==) `on` normalize) a b+ (True, False) -> checkEq a b+ (False, True) -> checkEq b a+ (True, True) -> a == b+ where+ normalize = BS.dropWhileEnd (==0)+ checkEq x (normalize -> y)+ | BS.length y > 32 || BS.length y <= 16 = False+ | otherwise = normalize (Sha256.hash x) == y++hmacKey_ipad :: HmacKey -> Sha256State+hmacKey_ipad = hmacKeyHashed_ipad . hmacKey_toHashed++hmacKey_runIpadCtx :: HmacKey -> ByteString -> Sha256Ctx+hmacKey_runIpadCtx k b = sha256state_runWith 1 b (hmacKey_ipad k)++hmacKey_ipadCtx :: HmacKey -> Sha256Ctx+hmacKey_ipadCtx = flip hmacKey_runIpadCtx BS.empty++hmacKey_opad :: HmacKey -> Sha256State+hmacKey_opad = hmacKeyHashed_opad . hmacKey_toHashed++hmacKey_runOpadCtx :: HmacKey -> ByteString -> Sha256Ctx+hmacKey_runOpadCtx k b = sha256state_runWith 1 b (hmacKey_opad k)++hmacKey_opadCtx :: HmacKey -> Sha256Ctx+hmacKey_opadCtx = flip hmacKey_runOpadCtx BS.empty ++hmacKey_toHashed :: HmacKey -> HmacKeyHashed+hmacKey_toHashed = \case+ HmacKey_Plain _ x -> x+ HmacKey_Hashed x -> x ++-- | An @HmacKeyLike@ context can either be an 'HmacKey', or a+-- 'HmacKeyPrefixed'.++data HmacKeyLike+ = HmacKeyLike_Plain {-# UNPACK #-} !HmacKeyPlain HmacKeyHashed+ | HmacKeyLike_Hashed {-# UNPACK #-} !HmacKeyHashed+ | HmacKeyLike_Prefixed {-# UNPACK #-} !HmacKeyPrefixed++hmacKeyPrefixed_eqHashed :: HmacKeyPrefixed -> HmacKeyHashed -> Bool+hmacKeyPrefixed_eqHashed a+ | hmacKeyPrefixed_blockCount a /= 1 = const False+ | otherwise = \b -> hmacKeyPrefixed_ipadCtx a == hmacKeyHashed_ipadCtx b+ && hmacKeyPrefixed_opad a == hmacKeyHashed_opad b++instance Eq HmacKeyLike where+ (HmacKeyLike_Plain a _) == (HmacKeyLike_Plain b _) = hmacKeyPlain_eq a b+ (HmacKeyLike_Plain _ a) == (HmacKeyLike_Hashed b) = a == b+ (HmacKeyLike_Plain _ a) == (HmacKeyLike_Prefixed b) = hmacKeyPrefixed_eqHashed b a+ (HmacKeyLike_Hashed a) == (HmacKeyLike_Plain _ b) = a == b+ (HmacKeyLike_Hashed a) == (HmacKeyLike_Hashed b) = a == b+ (HmacKeyLike_Hashed a) == (HmacKeyLike_Prefixed b) = hmacKeyPrefixed_eqHashed b a+ (HmacKeyLike_Prefixed a) == (HmacKeyLike_Plain _ b) = hmacKeyPrefixed_eqHashed a b+ (HmacKeyLike_Prefixed a) == (HmacKeyLike_Hashed b) = hmacKeyPrefixed_eqHashed a b+ (HmacKeyLike_Prefixed a) == (HmacKeyLike_Prefixed b) = a == b++instance Ord HmacKeyLike where+ compare = compare `on` hmacKeyLike_toPrefixed++hmacKeyLike_toPrefixed :: HmacKeyLike -> HmacKeyPrefixed+hmacKeyLike_toPrefixed = \case+ HmacKeyLike_Plain _ b -> hmacKeyPrefixed_initHashed b+ HmacKeyLike_Hashed b -> hmacKeyPrefixed_initHashed b+ HmacKeyLike_Prefixed b -> b++hmacKeyPrefixed_initHashed :: HmacKeyHashed -> HmacKeyPrefixed+hmacKeyPrefixed_initHashed k = HmacKeyPrefixed (hmacKeyHashed_opad k) (hmacKeyHashed_ipadCtx k)++hmacKeyLike_ipadCtx :: HmacKeyLike -> Sha256Ctx+hmacKeyLike_ipadCtx = \case+ HmacKeyLike_Plain _ x -> hmacKeyHashed_ipadCtx x+ HmacKeyLike_Hashed x -> hmacKeyHashed_ipadCtx x+ HmacKeyLike_Prefixed x -> hmacKeyPrefixed_ipadCtx x++hmacKeyLike_opad :: HmacKeyLike -> Sha256State+hmacKeyLike_opad = \case+ HmacKeyLike_Plain _ x -> hmacKeyHashed_opad x+ HmacKeyLike_Hashed x -> hmacKeyHashed_opad x+ HmacKeyLike_Prefixed x -> hmacKeyPrefixed_opad x++hmacKeyLike_opadCtx :: HmacKeyLike -> Sha256Ctx+hmacKeyLike_opadCtx = \case+ HmacKeyLike_Plain _ x -> hmacKeyHashed_opadCtx x+ HmacKeyLike_Hashed x -> hmacKeyHashed_opadCtx x+ HmacKeyLike_Prefixed x -> hmacKeyPrefixed_opadCtx x++hmacKeyLike_runIpadCtx :: HmacKeyLike -> ByteString -> Sha256Ctx+hmacKeyLike_runIpadCtx = \case+ HmacKeyLike_Plain _ x -> hmacKeyHashed_runIpadCtx x+ HmacKeyLike_Hashed x -> hmacKeyHashed_runIpadCtx x+ HmacKeyLike_Prefixed x -> hmacKeyPrefixed_runIpadCtx x++hmacKeyLike_runOpadCtx :: HmacKeyLike -> ByteString -> Sha256Ctx+hmacKeyLike_runOpadCtx = \case+ HmacKeyLike_Plain _ x -> hmacKeyHashed_runOpadCtx x+ HmacKeyLike_Hashed x -> hmacKeyHashed_runOpadCtx x+ HmacKeyLike_Prefixed x -> hmacKeyPrefixed_runOpadCtx x++-- | Fixed-size context representing the state of a partial HMAC computation+-- with a complete HMAC key and a partial message parameter. This maintains+-- a buffer of up to 63 unprocessed bytes, so that you may feed it arbitrary+-- bytestring without dealing with buffer boundaries.++data HmacCtx = HmacCtx+ { hmacCtx_opad :: {-# UNPACK #-} !Sha256State+ , hmacCtx_ipadCtx :: {-# UNPACK #-} !Sha256Ctx+ } deriving (Eq, Ord)++-- | A precomputed HMAC key. This structure is 64 bytes long, and consists of two+-- SHA256 hashes.+--+-- Computing an HMAC key typically costs two SHA256 blocks. No additional+-- blocks are incurred for keys that are 64 bytes or less in+-- length. Keys that are longer than 64 bytes long must be first hashed+-- with SHA256 before the key can be derived, incurring extra block+-- comptuations.+--+-- It is not uncommon that implementations of PBKDF2, HKDF, etc unnecessarily+-- redo this computation even though a single HMAC key is used repeatedly.+--+-- Technically these "hashes" are unfinished SHA-256 states,+-- as the standard end-of-message padding has yet to be applied.+-- Thus you can't compute these hashes using the most common+-- command-line tools like sha256sum.+-- +-- The lack of end-of-message padding is also why precomputing+-- HMAC keys on keys up to 64 bytes only requires one SHA-256 block+-- computation for each of the two pads, whereas more typically+-- the boundary for extra block computations happens between the 55th+-- and 56th byte due to end-of-message padding.++-- TODO: Might it be a good idea to pack both states into one ByteArray?++data HmacKeyHashed = HmacKeyHashed+ { hmacKeyHashed_opad :: {-# UNPACK #-} !Sha256State+ , hmacKeyHashed_ipad :: {-# UNPACK #-} !Sha256State+ } deriving (Eq, Ord)++hmacKeyHashed_ipadCtx :: HmacKeyHashed -> Sha256Ctx+hmacKeyHashed_ipadCtx = flip hmacKeyHashed_runIpadCtx BS.empty++hmacKeyHashed_runIpadCtx :: HmacKeyHashed -> ByteString -> Sha256Ctx+hmacKeyHashed_runIpadCtx k b = sha256state_runWith 1 b (hmacKeyHashed_ipad k)++hmacKeyHashed_opadCtx :: HmacKeyHashed -> Sha256Ctx+hmacKeyHashed_opadCtx = flip hmacKeyHashed_runOpadCtx BS.empty++hmacKeyHashed_runOpadCtx :: HmacKeyHashed -> ByteString -> Sha256Ctx+hmacKeyHashed_runOpadCtx k b = sha256state_runWith 1 b (hmacKeyHashed_opad k)++-- | Halfway between an HmacKeyHashed and an HmacCtx.+-- It's both an HmacKeyHashed that's gained a counter,+-- and a HmacCtx that's guaranteed to contain no unprocessed+-- input data.++data HmacKeyPrefixed = HmacKeyPrefixed+ { hmacKeyPrefixed_opad :: {-# UNPACK #-} !Sha256State+ , hmacKeyPrefixed_ipadCtx :: {-# UNPACK #-} !Sha256Ctx+ } deriving (Eq, Ord)++hmacKeyPrefixed_runIpadCtx :: HmacKeyPrefixed -> ByteString -> Sha256Ctx+hmacKeyPrefixed_runIpadCtx k b = sha256_feed b (hmacKeyPrefixed_ipadCtx k)++hmacKeyPrefixed_runOpadCtx :: HmacKeyPrefixed -> ByteString -> Sha256Ctx+hmacKeyPrefixed_runOpadCtx k b = sha256state_runWith 1 b (hmacKeyPrefixed_opad k)++hmacKeyPrefixed_opadCtx :: HmacKeyPrefixed -> Sha256Ctx+hmacKeyPrefixed_opadCtx = flip hmacKeyPrefixed_runOpadCtx BS.empty++hmacKeyPrefixed_blockCount :: HmacKeyPrefixed -> Word64+hmacKeyPrefixed_blockCount = sha256_blockCount . hmacKeyPrefixed_ipadCtx
+ lib/Crypto/Sha256/Hmac/Subtle.hs view
@@ -0,0 +1,35 @@+-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256.Hmac.Subtle+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-- "Internal" data structures and functions for hmac+--+-------------------------------------------------------------------------------++module Crypto.Sha256.Hmac.Subtle+ ( HmacKey(..)+ , hmacKey_ipad+ , hmacKey_ipadCtx+ , hmacKey_opad+ , hmacKey_opadCtx+ , HmacKeyLike(..)+ , hmacKeyLike_ipadCtx+ , hmacKeyLike_opad+ , hmacKeyLike_opadCtx+ , hmacKeyLike_runIpadCtx+ , hmacKeyLike_runOpadCtx+ , HmacKeyHashed(..)+ , hmacKeyHashed_ipadCtx+ , hmacKeyHashed_opadCtx+ , hmacKeyHashed_runIpadCtx+ , hmacKeyHashed_runOpadCtx+ , HmacKeyPrefixed(..)+ , hmacKeyPrefixed_opadCtx+ , hmacKeyPrefixed_runIpadCtx+ , hmacKeyPrefixed_runOpadCtx+ , HmacCtx(..)+ ) where++import Crypto.Sha256.Hmac.Implementation
+ lib/Crypto/Sha256/Pbkdf2.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE BangPatterns #-}++-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256.Pbkdf2+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-- An implementation of PBKDF2-HMAC-SHA256+--+-------------------------------------------------------------------------------++module Crypto.Sha256.Pbkdf2+ ( pbkdf2+ , pbkdf2_index+ , Pbkdf2Ctx()+ , pbkdf2Ctx_init+ , pbkdf2Ctx_feed, pbkdf2Ctx_feeds+ , pbkdf2Ctx_update, pbkdf2Ctx_updates+ , pbkdf2Ctx_finalize+ , Pbkdf2Gen()+ , pbkdf2Gen_iterate+ , pbkdf2Gen_finalize+ )+ where++import Data.ByteString(ByteString)+import qualified Data.ByteString.Short as SB+import Data.Function((&))+import Data.Word+import Crypto.HashString ( HashString )+import qualified Crypto.HashString as HS+import Crypto.Sha256+import Crypto.Sha256.Hmac+import Crypto.Sha256.Hmac.Subtle+import Crypto.Sha256.Pbkdf2.Subtle+import qualified Network.ByteOrder as NB++takeHS :: Int -> [ HashString ] -> [ HashString ]+takeHS = go+ where+ len = SB.length . HS.toShort+ go _ [] = []+ go n (b:bs)+ | n <= 0 = []+ | len b < n = b : go (n - len b) bs+ | otherwise = [HS.fromShort (SB.take n (HS.toShort b))]++-- | Simple interface to PBKDF2. Reusing computations via partial application is+-- not (yet!) supported. TODO: write pbkdf2 and pbkdf2_index functions in a+-- point-free style.++pbkdf2+ :: ByteString -- ^ nominally the "password"+ -> ByteString -- ^ nominally the "salt"+ -> Word64 -- ^ number of rounds+ -> Int -- ^ desired length of output+ -> HashString+pbkdf2 password0 salt rounds len = out+ where+ password = hmacKeyHashed password0+ saltCtx =+ pbkdf2Ctx_init password &+ pbkdf2Ctx_feed salt+ gen index =+ pbkdf2Ctx_finalize index saltCtx &+ pbkdf2Gen_iterate ((max rounds 1) - 1) &+ pbkdf2Gen_finalize+ out = mconcat (takeHS len (map gen [1..maxBound]))++pbkdf2_index+ :: ByteString -- ^ nominally the "password"+ -> ByteString -- ^ nominally the "salt"+ -> Word32 -- ^ the "index", returns the i-th block of output. The first index is 1, thus the result consists of bytes starting at 32*(i-1) and ending before 32*i. This is appended as 4 more bytes after the salt.+ -> Word64 -- ^ number of rounds+ -> HashString -- ^ 32-byte output"+pbkdf2_index password0 salt index rounds = out+ where+ password = hmacKeyHashed password0+ saltCtx =+ pbkdf2Ctx_init password &+ pbkdf2Ctx_feed salt+ out =+ pbkdf2Ctx_finalize index saltCtx &+ pbkdf2Gen_iterate ((max rounds 1) - 1) &+ pbkdf2Gen_finalize++pbkdf2Ctx_init :: HmacKeyHashed -> Pbkdf2Ctx+pbkdf2Ctx_init password = Pbkdf2Ctx+ { pbkdf2Ctx_password = password+ , pbkdf2Ctx_ipadCtx = hmacKeyHashed_ipadCtx password+ }++-- | Append some bytes to the end of the salt. Flipped version of 'pbkdf2Ctx_feed'.++pbkdf2Ctx_update :: Pbkdf2Ctx -> ByteString -> Pbkdf2Ctx+pbkdf2Ctx_update ctx bs = ctx { pbkdf2Ctx_ipadCtx = sha256_update (pbkdf2Ctx_ipadCtx ctx) bs }++-- | Append zero or more bytestrings to the end of the salt. Flipped version of 'pbkdf2Ctx_feeds'++pbkdf2Ctx_updates :: Foldable f => Pbkdf2Ctx -> f ByteString -> Pbkdf2Ctx+pbkdf2Ctx_updates ctx bs = ctx { pbkdf2Ctx_ipadCtx = sha256_updates (pbkdf2Ctx_ipadCtx ctx) bs }++-- | Append some bytes to the end of the salt. Flipped version of 'pbkdf2Ctx_update'.++pbkdf2Ctx_feed :: ByteString -> Pbkdf2Ctx -> Pbkdf2Ctx+pbkdf2Ctx_feed = flip pbkdf2Ctx_update++-- | Append zero or more bytestrings to the end of the salt. Flipped version of 'pbkdf2Ctx_updates'.++pbkdf2Ctx_feeds :: Foldable f => f ByteString -> Pbkdf2Ctx -> Pbkdf2Ctx+pbkdf2Ctx_feeds = flip pbkdf2Ctx_updates++-- | Append the index to the end of the salt, and then initialize a 'Pbkdf2Gen' with+-- one round applied.++pbkdf2Ctx_finalize+ :: Word32 -- ^ index of output block+ -> Pbkdf2Ctx+ -> Pbkdf2Gen+pbkdf2Ctx_finalize index ctx = Pbkdf2Gen+ { pbkdf2Gen_password = password+ , pbkdf2Gen_finalize = state+ , pbkdf2Gen_state = state+ }+ where+ password = pbkdf2Ctx_password ctx+ ipad = pbkdf2Ctx_ipadCtx ctx &+ sha256_finalizeBytes_toByteString (NB.bytestring32 index)+ state = hmacKeyHashed_opadCtx password &+ sha256_finalizeBytes ipad++-- | Apply zero or more rounds to a pbkdf2 computation.++pbkdf2Gen_iterate+ :: Word64 -- ^ number of key-stretching rounds to perform+ -> Pbkdf2Gen+ -> Pbkdf2Gen+pbkdf2Gen_iterate n0 ctx = go n0 xorSum0 state0+ where+ password = pbkdf2Gen_password ctx+ xorSum0 = pbkdf2Gen_finalize ctx+ state0 = pbkdf2Gen_state ctx+ go n xorSum state+ | n <= 0 =+ Pbkdf2Gen+ { pbkdf2Gen_password = password+ , pbkdf2Gen_finalize = xorSum+ , pbkdf2Gen_state = state+ }+ | otherwise =+ let !state' = hmacKeyHashed_run password &+ hmacCtx_finalizeBytes (HS.toByteString state)+ !xorSum' = HS.xorLeft state' xorSum+ in go (n-1) xorSum' state'
+ lib/Crypto/Sha256/Pbkdf2/Subtle.hs view
@@ -0,0 +1,24 @@+-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256.Pbkdf2.Subtle+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-------------------------------------------------------------------------------++module Crypto.Sha256.Pbkdf2.Subtle where++import Crypto.HashString+import Crypto.Sha256+import Crypto.Sha256.Hmac++data Pbkdf2Ctx = Pbkdf2Ctx+ { pbkdf2Ctx_password :: !HmacKeyHashed+ , pbkdf2Ctx_ipadCtx :: !Sha256Ctx+ }++data Pbkdf2Gen = Pbkdf2Gen+ { pbkdf2Gen_password :: !HmacKeyHashed+ , pbkdf2Gen_finalize :: !HashString+ , pbkdf2Gen_state :: !HashString+ }
+ lib/Crypto/Sha256/Subtle.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE MagicHash, UnboxedTuples, CApiFFI, UnliftedFFITypes, BangPatterns #-}++-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Sha256.Subtle+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-------------------------------------------------------------------------------++module Crypto.Sha256.Subtle where++import Data.Array.Byte+import Data.Bits((.&.))+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Unsafe(unsafeUseAsCStringLen)+import Data.Word+import Foreign.C+import Foreign.Ptr+import GHC.Exts+import GHC.IO++import Crypto.HashString+import Crypto.HashString.FFI(HashString(..))++nullBuffer :: ByteString+nullBuffer = B.replicate 64 0++type MutableSha256State# = MutableByteArray#++type Sha256State# = ByteArray#++type MutableSha256Ctx# = MutableByteArray#++type Sha256Ctx# = ByteArray#++newtype Sha256State = Sha256State { unSha256State :: ByteArray }++instance Eq Sha256State where+ x == y = compare x y == EQ++instance Ord Sha256State where+ compare (Sha256State (ByteArray x)) (Sha256State (ByteArray y)) =+ compare (c_const_memcmp_uint32be x y 8) 0++newtype Sha256Ctx = Sha256Ctx { unSha256Ctx :: ByteArray }++instance Eq Sha256Ctx where+ x == y = compare x y == EQ++instance Ord Sha256Ctx where+ compare (Sha256Ctx (ByteArray x)) (Sha256Ctx (ByteArray y)) =+ compare (c_const_memcmp_ctx x y) 0++sha256state_init :: Sha256State+sha256state_init =+ unsafePerformIO . IO $ \st ->+ let !(Ptr addr) = c_sha256_init+ !(# st0, a #) = newByteArray# 32# st+ st1 = copyAddrToByteArray# addr a 0# 32# st0+ -- FIXME? Review this to ensure that 32# is the correct input above+ -- Problem is the documentation is ambiguous, and the source is magic.+ -- I'm assuming copyAddrToByteArray# works similarly as copyByteArray#.+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, (Sha256State (ByteArray b)) #)++-- | Note that this function only processes as many 64-byte blocks as possible,+-- then discards the remainder of the input. Also note that this function does+-- nothing to track the number of bytes that have been fed into the state, which+-- will have to be done externally.++sha256state_feed :: ByteString -> Sha256State -> Sha256State+sha256state_feed bytes (Sha256State (ByteArray p)) =+ unsafePerformIO . unsafeUseAsCStringLen bytes $ \(bp, bl) -> IO $ \st ->+ let !(# st0, a #) = newByteArray# 32# st+ !(# st1, _ #) = unIO (c_sha256_update p bp (fromIntegral bl) a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, Sha256State (ByteArray b) #)++-- | Cast a Sha256Ctx to a Sha256State, without (much, if any) copying.+-- This has the disadvantage that the result will retain at least 8, and up to+-- 71 unnecessary bytes, depending on the length of the buffer. 72 extra bytes+-- will likely be possible once this binding supports mutable contexts and+-- supports freezing mutable contexts into immutable contexts without copying.++sha256state_fromCtxInplace :: Sha256Ctx -> Sha256State+sha256state_fromCtxInplace (Sha256Ctx a) = Sha256State a++-- | Cast a Sha256Ctx to a Sha256State. This copies the first 32 bytes of the+-- Sha256Ctx structure, so the result is always as small as possible.++sha256state_fromCtx :: Sha256Ctx -> Sha256State+sha256state_fromCtx (Sha256Ctx (ByteArray ctx)) =+ unsafePerformIO . IO $ \st ->+ let !(# st0, a #) = newByteArray# 32# st+ st1 = copyByteArray# ctx 0# a 0# 32# st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, Sha256State (ByteArray b) #)++sha256state_runWith :: Word64 -> ByteString -> Sha256State -> Sha256Ctx+sha256state_runWith blocks bytes (Sha256State (ByteArray p)) =+ unsafePerformIO . unsafeUseAsCStringLen bytes $ \(bp, bl) -> IO $ \st ->+ let !(# st0, a #) = newByteArray# ctxLen# st+ !(# st1, () #) = unIO (c_sha256_promote_to_ctx p blocks bp (fromIntegral bl) a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, Sha256Ctx (ByteArray b) #)+ where+ !(I# ctxLen#) = 40 + B.length bytes .&. 0x3F++sha256state_encode :: Sha256State -> HashString+sha256state_encode (Sha256State (ByteArray x)) =+ unsafePerformIO . IO $ \st ->+ let !(# st0, a #) = newByteArray# 32# st+ !(# st1, () #) = unIO (c_sha256_encode_state x a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, HashString (ByteArray b) #)++sha256state_decode :: HashString -> Sha256State+sha256state_decode (HashString (ByteArray x)) =+ unsafePerformIO . IO $ \st ->+ let !(# st0, a #) = newByteArray# 32# st+ !(# st1, () #) = unIO (c_sha256_decode_state x a) st0+ !(# st2, b #) = unsafeFreezeByteArray# a st1+ in (# st2, Sha256State (ByteArray b) #)++-- these calls must be labelled "unsafe", because the datastructures+-- we will be passing in are unpinned... keep that in mind when selecting+-- the size of the updates. (Also, maybe in some cases a different FFI+-- layer that uses safe calls would be desirable? Maybe not... It seems like+-- it should be possible to adequately work around the limitations of+-- long-lived unsafe calls by using smaller updates, making more calls to C.)++-- See the documentation for details:+-- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/ffi.html#guaranteed-call-safety++-- TODO: some functions have more than one binding, mostly for type reasons, and there+-- are several more variants of some of these bindings this module should support.++foreign import ccall unsafe "hs_sha256.h &hs_sha256_init"+ c_sha256_init :: Ptr Word32++foreign import capi unsafe "hs_sha256.h hs_sha256_init_ctx"+ c_sha256_init_ctx :: MutableSha256Ctx# RealWorld -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_promote_to_ctx"+ c_sha256_promote_to_ctx+ :: Sha256State# -- ^ @state@, a pointer to an constant array of eight Word32+ -> Word64 -- ^ @blockCount@, the number of blocks that a sha256 context has processed+ -> CString -- ^ pointer to the constant data to process+ -> CSize -- ^ length of the data to process+ -> MutableSha256Ctx# RealWorld -- ^ output pointer+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_update"+ c_sha256_update+ :: Sha256State# -- ^ @state@, a pointer to an constant array of eight Word32+ -> CString -- ^ pointer to the constant data to process+ -> CSize -- ^ length of the data to process+ -> MutableSha256State# RealWorld -- ^ output pointer+ -> IO Word64 -- ^ the new @count@++foreign import capi unsafe "hs_sha256.h hs_sha256_update_ctx"+ c_sha256_update_ctx+ :: Sha256Ctx# -- ^ @ctx@, a pointer to a constant sha256 context+ -> CString -- ^ pointer to the constant data to process+ -> CSize -- ^ length of the data to process+ -> MutableSha256Ctx# RealWorld -- ^ output pointer+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_update_ctx"+ c_sha256_mutate_ctx+ :: MutableSha256Ctx# RealWorld -- ^ @ctx@, a pointer to a constant sha256 context+ -> CString -- ^ pointer to the constant data to process+ -> CSize -- ^ length of the data to process+ -> MutableSha256Ctx# RealWorld -- ^ output pointer, can be same as the input context+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_get_count"+ c_sha256_get_count+ :: Sha256State#+ -> Word64++foreign import capi unsafe "hs_sha256.h hs_sha256_finalize_ctx_bits"+ c_sha256_finalize_ctx_bits+ :: Sha256Ctx#+ -> CString+ -> Word64+ -> Ptr Word8+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_finalize_ctx_bits"+ c_sha256_finalize_ctx_bits_ba+ :: Sha256Ctx#+ -> CString+ -> Word64+ -> MutableByteArray# RealWorld+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_finalize_ctx_bits"+ c_sha256_finalize_mutable_ctx_bits+ :: MutableSha256Ctx# RealWorld+ -> CString+ -> Word64+ -> CString+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_encode_state"+ c_sha256_encode_state+ :: Sha256State#+ -> MutableByteArray# RealWorld+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_decode_state"+ c_sha256_decode_state+ :: ByteArray#+ -> MutableSha256State# RealWorld+ -> IO ()++foreign import capi unsafe "hs_sha256.h hs_sha256_const_memcmp_uint32be"+ c_const_memcmp_uint32be+ :: ByteArray#+ -> ByteArray#+ -> Word32+ -> CInt++foreign import capi unsafe "hs_sha256.h hs_sha256_const_memcmp_ctx"+ c_const_memcmp_ctx+ :: ByteArray#+ -> ByteArray#+ -> CInt
+ sha256.cabal view
@@ -0,0 +1,65 @@+name: sha256+version: 0.1.0.0+synopsis:+ A modern binding to SHA256, HMAC, HKDF, and PBKDF2+description:+ A modern binding to SHA256, HMAC, HKDF, and PBKDF2 supporting precomputed+ HMAC keys, streaming, backtracking, bitstring inputs, and (de)serialization+ of intermediate states. Both HKDF and PBKDF2 reuse HMAC key computations+ for efficiency.+license: Apache-2.0+license-file: LICENSE+author: Vincent Hanquez, Herbert Valerio Riedel, Leon P Smith+maintainer: Auth Global+copyright: 2006 Vincent Hanquez, 2016 Herbert Valerio Riedel, 2024 Auth Global+category: Graphics+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++library+ exposed-modules:+ Crypto.Sha256+ Crypto.Sha256.Subtle+ Crypto.Sha256.Hmac+ Crypto.Sha256.Hmac.Subtle+ Crypto.Sha256.Hkdf+ Crypto.Sha256.Hkdf.Subtle+ Crypto.Sha256.Pbkdf2+ Crypto.Sha256.Pbkdf2.Subtle+ -- Crypto.Sha256.ST+ -- Crypto.Sha256.ST.Subtle++ other-modules:+ Crypto.Sha256.Hmac.Implementation++ build-depends: base < 5+ , bytestring+ , hash-string+ , network-byte-order+ , ghc-prim++ hs-source-dirs: lib+ include-dirs: csrc+ default-language: Haskell2010+ ghc-options: -Wall+ cc-options: -Wall + install-includes: csrc/hs_sha256.h+ c-sources: csrc/hs_sha256.c++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs++ other-modules: HMAC,+ HKDF,+ PBKDF2+ build-depends: base+ , base16+ , bytestring+ , hash-string+ , sha256+ , tasty+ , tasty-hunit+ default-language: Haskell2010
+ test/HKDF.hs view
@@ -0,0 +1,67 @@+-- Test Vectors for HKDF-SHA256++{-# LANGUAGE OverloadedStrings #-}++module HKDF where++import Data.Base16.Types+import Data.ByteString(ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B+import qualified Data.ByteString.Short as SB+import Data.Function((&))+import Data.Int+import Test.Tasty+import Test.Tasty.HUnit++import Crypto.HashString (HashString(..))+import qualified Crypto.HashString as HS+import Crypto.Sha256.Hkdf++d :: ByteString -> ByteString+d = B.decodeBase16Lenient++tests :: [TestTree]+tests =+ [ testGroup "rfc5869 test vectors"+ [ testCase ("rfc5869-" ++ show n) (run x)+ | (n,x) <- zip [1..] testVectors+ ]+ ]+ where+ run x = HS.toBase16 (hkdf' (salt x) (ikm x) (info x) (B.length (out x))) @?= extractBase16 (B.encodeBase16' (out x))++testVectors :: [TestVector]+testVectors =+ [ rfc5869_testCase1+ , rfc5869_testCase2+ , rfc5869_testCase3+ ]++data TestVector = TestVector+ { salt :: !ByteString+ , ikm :: !ByteString+ , info :: !ByteString+ , out :: !ByteString+ }++rfc5869_testCase1 = TestVector+ { salt = d "000102030405060708090a0b0c"+ , ikm = d "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"+ , info = d "f0f1f2f3f4f5f6f7f8f9"+ , out = d "3cb25f25faacd57a90434f64d0362f2a2d2d0a90cf1a5a4c5db02d56ecc4c5bf34007208d5b887185865"+ }++rfc5869_testCase2 = TestVector+ { salt = d "606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeaf"+ , ikm = d "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f"+ , info = d "b0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"+ , out = d "b11e398dc80327a1c8e7f78c596a49344f012eda2d4efad8a050cc4c19afa97c59045a99cac7827271cb41c65e590e09da3275600c2f09b8367793a9aca3db71cc30c58179ec3e87c14c01d5c1f3434f1d87"+ }++rfc5869_testCase3 = TestVector+ { salt = ""+ , ikm = d "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"+ , info = ""+ , out = d "8da4e775a563c18f715f802a063c5a31b8a11f5c5ee1879ec3454e5f3c738d2d9d201395faa4b61a96c8"+ }
+ test/HMAC.hs view
@@ -0,0 +1,97 @@+-- Test Vectors for HMAC-SHA256++{-# LANGUAGE OverloadedStrings #-}++module HMAC where++import Data.ByteString(ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B+import Data.Function((&))+import Test.Tasty+import Test.Tasty.HUnit++import Crypto.Sha256.Hmac++d :: ByteString -> ByteString+d = B.decodeBase16Lenient++tests :: [TestTree]+tests =+ [ testGroup "rfc4231 test vectors"+ [ testCase ("rfc4231-" ++ show n) (run x)+ | (n,x) <- zip [1..] testVectors+ ]+ ]+ where+ run x = B.encodeBase16 (hmac (key x) (msg x)) @?= B.encodeBase16 (out x)++testVectors :: [TestVector]+testVectors =+ [ rfc4231_testCase1+ , rfc4231_testCase2+ , rfc4231_testCase3+ , rfc4231_testCase4+ , rfc4231_testCase5+ , rfc4231_testCase6+ , rfc4231_testCase7+ ]++data TestVector = TestVector+ { key :: !ByteString+ , msg :: !ByteString+ , out :: !ByteString+ }++rfc4231_testCase1 = TestVector+ { key = B.replicate 20 0x0b+ , msg = "Hi There"+ , out = d "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7"+ }++rfc4231_testCase2 = TestVector+ { key = "Jefe"+ , msg = "what do ya want for nothing?"+ , out = d "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843"+ }++rfc4231_testCase3 = TestVector+ { key = B.replicate 20 0xaa+ , msg = B.replicate 50 0xdd+ , out = d "773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe"+ }++rfc4231_testCase4 = TestVector+ { key = d "0102030405060708090a0b0c0d0e0f10111213141516171819"+ , msg = B.replicate 50 0xcd+ , out = d "82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b"+ }++{-++RFC4231 doesn't provide the second half of the output. This seem odd.+Unlike HKDF, truncation is not explicitly part of the HMAC interface.+Is this test vector supposed teach that this is a safe way to use HMAC?++To avoid unnecessary complications here, I just provided the (unofficial)+second half of the output.++-}++rfc4231_testCase5 = TestVector+ { key = B.replicate 20 0x0c+ , msg = "Test With Truncation"+ , out = d "a3b6167473100ee06e0c796c2955552bfa6f7c0a6a8aef8b93f860aab0cd20c5"+ }++rfc4231_testCase6 = TestVector+ { key = B.replicate 131 0xaa+ , msg = "Test Using Larger Than Block-Size Key - Hash Key First"+ , out = d "60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54"+ }++rfc4231_testCase7 = TestVector+ { key = B.replicate 131 0xaa+ , msg = "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."+ , out = d "9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2"+ }
+ test/Main.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}+import Data.ByteString(ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B+import Data.Function((&))+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit++import Crypto.Sha256+import Crypto.Sha256.Hmac+import Crypto.Sha256.Hkdf+import qualified HMAC+import qualified HKDF+import qualified PBKDF2++d :: ByteString -> ByteString+d = B.decodeBase16Lenient++main = do+ defaultMain $ testGroup "toplevel" [+ testGroup "sha256"+ [ testCase ("sha256-" ++ show n) (run x)+ | (n,x) <- zip [1..] testVectors+ ],+ testGroup "hmac" HMAC.tests,+ testGroup "hkdf" HKDF.tests,+ testGroup "pbkdf2" PBKDF2.tests,+ testGroup "bitstrings" testBitstrings+ ]+ where+ run :: SHA256TestVector -> Assertion+ run x = B.encodeBase16 (hash (msg x)) @?= B.encodeBase16 (out x)++data SHA256TestVector = SHA256TestVector+ { msg :: !ByteString+ , out :: !ByteString+ }++testVectors :: [SHA256TestVector]+testVectors =+ [ sha256_testCase1+ , sha256_testCase2+ , sha256_testCase3+ , sha256_testCase4+ , sha256_testCase5+ , sha256_testCase6+ ]++sha256_testCase1 = SHA256TestVector+ { msg = "abc"+ , out = d "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"+ }++sha256_testCase2 = SHA256TestVector+ { msg = ""+ , out = d "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"+ }++sha256_testCase3 = SHA256TestVector+ { msg = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"+ , out = d "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1"+ }++sha256_testCase4 = SHA256TestVector+ { msg = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"+ , out = d "cf5b16a778af8380036ce59e7b0492370b249b11e8f07a51afac45037afee9d1"+ }++sha256_testCase5 = SHA256TestVector+ { msg = "0123456789ABCDEF0123456789abcdef0123456789ABCDEF0123456789abcde"+ , out = d "a518fbe53475606f8cdf66dfeae0c416f774694843647c810c6f89fd7d24ae4c"+ }++sha256_testCase6 = SHA256TestVector+ { msg = "0123456789ABCDEF0123456789abcdef0123456789ABCDEF0123456789abcdef"+ , out = d "37e68bd16eb5be2f6d591cef9c099db166faf048122f736307fb92a1670ef552"+ }++testBitstrings :: [TestTree]+testBitstrings = [testCase "bitstrings-0" (out @?= "731590e201d1e0c020e78c6d8dbacf6e1e7ab8eae42de9e5dc370d96270f1c32")]+ where+ bitstring :: ByteString+ bitstring = hkdf (d "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f4041") "" "" 128+ myKey = hmacKey (d "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f40")+ sha256bits :: ByteString -> Word64 -> ByteString+ sha256bits x len = sha256_init &+ sha256_finalizeBits_toByteString x len+ hmacbits :: ByteString -> Word64 -> ByteString+ hmacbits x len = hmacCtx_init myKey &+ hmacCtx_finalizeBits_toByteString x len+ out = sha256_init &+ sha256_feeds [ sha256bits bitstring n | n <- [0..1024] ] &+ sha256_feeds [ hmacbits bitstring n | n <- [0..1024] ] &+ sha256_finalize
+ test/PBKDF2.hs view
@@ -0,0 +1,113 @@+-- Test Vectors for PBKDF2-HMAC-SHA256++{-# LANGUAGE OverloadedStrings #-}++module PBKDF2 where++import Data.Base16.Types+import Data.ByteString(ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B+import qualified Data.ByteString.Short as SB+import Data.Function((&))+import Data.Int+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit++import Crypto.HashString (HashString(..))+import qualified Crypto.HashString as HS+import Crypto.Sha256.Pbkdf2++d :: ByteString -> ByteString+d = B.decodeBase16Lenient++tests :: [TestTree]+tests =+ [ testGroup "test vectors"+ [ testCase (show n) (run x)+ | (n,x) <- zip ([1..3]++[5..]) testVectors+ ]+ ]+ where+ run x = HS.toBase16 (pbkdf2 (password x) (salt x) (rounds x) (B.length (out x))) @?= extractBase16 (B.encodeBase16' (out x))++testVectors :: [TestVector]+testVectors =+ [ testCase1+ , testCase2+ , testCase3+ , testCase5+ , testCase6+ , testCase7+ , testCase8+ , testCase9+ ]++data TestVector = TestVector+ { password :: !ByteString+ , salt :: !ByteString+ , rounds :: !Word64+ , out :: !ByteString+ }++-- Borrowed from:+-- https://github.com/brycx/Test-Vector-Generation/blob/72810c03e22af1b26fe5b254340e9ae5d9e44b06/PBKDF2/pbkdf2-hmac-sha2-test-vectors.md++-- FIXME: the code coverage of these test vectors leaves much to be desired.++testCase1 = TestVector+ { password = "password"+ , salt = "salt"+ , rounds = 1+ , out = d "120fb6cffcf8b32c43e7225256c4f837a86548c9"+ }++testCase2 = TestVector+ { password = "password"+ , salt = "salt"+ , rounds = 2+ , out = d "ae4d0c95af6b46d32d0adff928f06dd02a303f8e"+ }++testCase3 = TestVector+ { password = "password"+ , salt = "salt"+ , rounds = 4096+ , out = d "c5e478d59288c841aa530db6845c4c8d962893a0"+ }++testCase5 = TestVector+ { password = "passwordPASSWORDpassword"+ , salt = "saltSALTsaltSALTsaltSALTsaltSALTsalt"+ , rounds = 4096+ , out = d "348c89dbcbd32b2f32d814b8116e84cf2b17347ebc1800181c"+ }++testCase6 = TestVector+ { password = "pass\x00word"+ , salt = "sa\x00lt"+ , rounds = 4096+ , out = d "89b69d0516f829893c696226650a8687"+ }++testCase7 = TestVector+ { password = "passwd"+ , salt = "salt"+ , rounds = 1+ , out = d "55ac046e56e3089fec1691c22544b605f94185216dde0465e68b9d57c20dacbc49ca9cccf179b645991664b39d77ef317c71b845b1e30bd509112041d3a19783c294e850150390e1160c34d62e9665d659ae49d314510fc98274cc79681968104b8f89237e69b2d549111868658be62f59bd715cac44a1147ed5317c9bae6b2a"+ }++testCase8 = TestVector+ { password = "Password"+ , salt = "NaCl"+ , rounds = 80000+ , out = d "4ddcd8f60b98be21830cee5ef22701f9641a4418d04c0414aeff08876b34ab56a1d425a1225833549adb841b51c9b3176a272bdebba1d078478f62b397f33c8d62aae85a11cdde829d89cb6ffd1ab0e63a981f8747d2f2f9fe5874165c83c168d2eed1d2d5ca4052dec2be5715623da019b8c0ec87dc36aa751c38f9893d15c3"+ }++testCase9 = TestVector+ { password = "Password"+ , salt = "sa\x00lt"+ , rounds = 4096+ , out = d "436c82c6af9010bb0fdb274791934ac7dee21745dd11fb57bb90112ab187c495ad82df776ad7cefb606f34fedca59baa5922a57f3e91bc0e11960da7ec87ed0471b456a0808b60dff757b7d313d4068bf8d337a99caede24f3248f87d1bf16892b70b076a07dd163a8a09db788ae34300ff2f2d0a92c9e678186183622a636f4cbce15680dfea46f6d224e51c299d4946aa2471133a649288eef3e4227b609cf203dba65e9fa69e63d35b6ff435ff51664cbd6773d72ebc341d239f0084b004388d6afa504eee6719a7ae1bb9daf6b7628d851fab335f1d13948e8ee6f7ab033a32df447f8d0950809a70066605d6960847ed436fa52cdfbcf261b44d2a87061"+ }