cryptohash-sha512 (empty) → 0.11.100.1
raw patch · 9 files changed
+907/−0 lines, 9 filesdep +SHAdep +basedep +base16-bytestringsetup-changed
Dependencies added: SHA, base, base16-bytestring, bytestring, criterion, cryptohash-sha512, tasty, tasty-hunit, tasty-quickcheck
Files
- LICENSE +28/−0
- Setup.hs +2/−0
- cbits/sha512.c +242/−0
- cbits/sha512.h +48/−0
- changelog.md +18/−0
- cryptohash-sha512.cabal +78/−0
- src-bench/bench-sha512.hs +36/−0
- src-tests/test-sha512.hs +195/−0
- src/Crypto/Hash/SHA512.hs +260/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2010-2014 Vincent Hanquez <vincent@snarc.org>+ 2016 Herbert Valerio Riedel <hvr@gnu.org>++All rights reserved.++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.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``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 AUTHORS OR CONTRIBUTORS 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/sha512.c view
@@ -0,0 +1,242 @@+/*+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>+ * 2016 Herbert Valerio Riedel <hvr@gnu.org>+ *+ * 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 "sha512.h"++#include <assert.h>+#include <string.h>+#include <ghcautoconf.h>++#if defined(static_assert)+static_assert(sizeof(struct sha512_ctx) == SHA512_CTX_SIZE, "unexpected sha512_ctx size");+#else+/* poor man's pre-C11 _Static_assert */+typedef char static_assertion__unexpected_sha512_ctx_size[(sizeof(struct sha512_ctx) == SHA512_CTX_SIZE)?1:-1];+#endif++#define ptr_uint64_aligned(ptr) (!((uintptr_t)(ptr) & 0x7))++static inline uint64_t+ror64(const uint64_t word, const unsigned shift)+{+ /* GCC usually transforms this into a 'ror'-insn */+ return (word >> shift) | (word << (64 - shift));+}++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+ /* GCC & Clang usually transforms this into a bswap insn */+ return ((hll & 0xff00000000000000) >> 56) |+ ((hll & 0x00ff000000000000) >> 40) |+ ((hll & 0x0000ff0000000000) >> 24) |+ ((hll & 0x000000ff00000000) >> 8) |+ ((hll & 0x00000000ff000000) << 8) |+ ((hll & 0x0000000000ff0000) << 24) |+ ((hll & 0x000000000000ff00) << 40) |+ ((hll & 0x00000000000000ff) << 56);+#endif+}++static inline void+cpu_to_be64_array(uint64_t *dest, const uint64_t *src, unsigned wordcnt)+{+ while (wordcnt--)+ *dest++ = cpu_to_be64(*src++);+}++void+hs_cryptohash_sha512_init (struct sha512_ctx *ctx)+{+ memset(ctx, 0, SHA512_CTX_SIZE);+ + ctx->h[0] = 0x6a09e667f3bcc908ULL;+ ctx->h[1] = 0xbb67ae8584caa73bULL;+ ctx->h[2] = 0x3c6ef372fe94f82bULL;+ ctx->h[3] = 0xa54ff53a5f1d36f1ULL;+ ctx->h[4] = 0x510e527fade682d1ULL;+ ctx->h[5] = 0x9b05688c2b3e6c1fULL;+ ctx->h[6] = 0x1f83d9abfb41bd6bULL;+ ctx->h[7] = 0x5be0cd19137e2179ULL;+}++/* 232 times the cube root of the first 64 primes 2..311 */+static const uint64_t k[] = {+ 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+};++#define e0(x) (ror64(x, 28) ^ ror64(x, 34) ^ ror64(x, 39))+#define e1(x) (ror64(x, 14) ^ ror64(x, 18) ^ ror64(x, 41))+#define s0(x) (ror64(x, 1) ^ ror64(x, 8) ^ (x >> 7))+#define s1(x) (ror64(x, 19) ^ ror64(x, 61) ^ (x >> 6))++static void+sha512_do_chunk_aligned(struct sha512_ctx *ctx, uint64_t w[])+{+ int i;+ + for (i = 16; i < 80; i++)+ w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16];++ uint64_t a = ctx->h[0];+ uint64_t b = ctx->h[1];+ uint64_t c = ctx->h[2];+ uint64_t d = ctx->h[3];+ uint64_t e = ctx->h[4];+ uint64_t f = ctx->h[5];+ uint64_t g = ctx->h[6];+ uint64_t h = ctx->h[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 < 80; i += 8) {+ uint64_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++ ctx->h[0] += a;+ ctx->h[1] += b;+ ctx->h[2] += c;+ ctx->h[3] += d;+ ctx->h[4] += e;+ ctx->h[5] += f;+ ctx->h[6] += g;+ ctx->h[7] += h;+}++static void+sha512_do_chunk(struct sha512_ctx *ctx, const uint8_t buf[])+{+ uint64_t w[80]; /* only first 16 words are filled in */+ if (ptr_uint64_aligned(buf)) { /* aligned buf */+ cpu_to_be64_array(w, (const uint64_t *)buf, 16);+ } else { /* unaligned buf */+ memcpy(w, buf, 128);+#if !WORDS_BIGENDIAN+ cpu_to_be64_array(w, w, 16);+#endif+ }+ sha512_do_chunk_aligned(ctx, w);+}++void+hs_cryptohash_sha512_update(struct sha512_ctx *ctx, const uint8_t *data, size_t len)+{+ size_t index = ctx->sz & 0x7f;+ const size_t to_fill = 128 - index;++ ctx->sz += len;+ // handle overflow+ if (ctx->sz < len)+ ctx->sz_hi++;++ /* process partial buffer if there's enough data to make a block */+ if (index && len >= to_fill) {+ memcpy(ctx->buf + index, data, to_fill);+ sha512_do_chunk(ctx, ctx->buf);+ /* memset(ctx->buf, 0, 128); */+ len -= to_fill;+ data += to_fill;+ index = 0;+ }++ /* process as many 128b-blocks as possible */+ while (len >= 128) {+ sha512_do_chunk(ctx, data);+ len -= 128;+ data += 128;+ }++ /* append data into buf */+ if (len)+ memcpy(ctx->buf + index, data, len);+}++void+hs_cryptohash_sha512_finalize (struct sha512_ctx *ctx, uint8_t *out)+{+ static const uint8_t padding[128] = { 0x80, };++ /* add padding and update data with it */+ uint64_t bits[2];+ bits[0] = cpu_to_be64((ctx->sz_hi << 3) | (ctx->sz >> 61));+ bits[1] = cpu_to_be64(ctx->sz << 3);++ /* pad out to 112 */+ const size_t index = ctx->sz & 0x7f;+ const size_t padlen = (index < 112) ? (112 - index) : ((128 + 112) - index);+ hs_cryptohash_sha512_update(ctx, padding, padlen);++ /* append length */+ hs_cryptohash_sha512_update(ctx, (uint8_t *) bits, sizeof(bits));++ /* output hash */+ cpu_to_be64_array((uint64_t *) out, ctx->h, 8);+}
+ cbits/sha512.h view
@@ -0,0 +1,48 @@+/*+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>+ * 2016 Herbert Valerio Riedel <hvr@gnu.org>+ *+ * 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.+ */++#ifndef CRYPTOHASH_SHA512_H+#define CRYPTOHASH_SHA512_H++#include <stdint.h>+#include <stddef.h>++struct sha512_ctx+{+ uint64_t sz;+ uint64_t sz_hi;+ uint8_t buf[128];+ uint64_t h[8];+};++/* keep this synchronised with 'digestSize'/'sizeCtx' in SHA512.hs */+#define SHA512_DIGEST_SIZE 64+#define SHA512_CTX_SIZE 208++void hs_cryptohash_sha512_init (struct sha512_ctx *ctx);+void hs_cryptohash_sha512_update (struct sha512_ctx *ctx, const uint8_t *data, size_t len);+void hs_cryptohash_sha512_finalize (struct sha512_ctx *ctx, uint8_t *out);++#endif
+ changelog.md view
@@ -0,0 +1,18 @@+## 0.11.100.1++ - First public release++## 0.11.100.0 *(unreleased)*++ - new `hmac` and `hmaclazy` functions providing HMAC-SHA-512+ computation conforming to RFC2104 and RFC4231+ - fix unaligned memory-accesses+ - switch to 'safe' FFI for calls where overhead becomes neglible+ - removed inline assembly in favour of portable C constructs+ - fix 32bit length overflow bug in `hash` function+ - fix inaccurate context-size+ - add context-size verification to incremental API operations++## 0.11.7.1 *(unreleased)*++ - first version forked off `cryptohash-0.11.7` release
+ cryptohash-sha512.cabal view
@@ -0,0 +1,78 @@+name: cryptohash-sha512+version: 0.11.100.1+description:+ A practical incremental and one-pass, pure API to the+ <https://en.wikipedia.org/wiki/SHA-2 SHA-512 hash algorithm>+ (including <https://en.wikipedia.org/wiki/HMAC HMAC> support)+ with performance close to the fastest implementations available in other languages.+ .+ The implementation is made in C with a haskell FFI wrapper that hides the C implementation.+ .+ NOTE: This package has been forked off @cryptohash-0.11.7@ because the @cryptohash@ package has been+ deprecated and so this package continues to satisfy the need for a lightweight package+ providing the SHA512 hash algorithm without any dependencies on packages other than+ @base@ and @bytestring@.+ .+ Consequently, this package can be used as a drop-in replacement for @cryptohash@'s+ "Crypto.Hash.SHA512" module, though with a clearly smaller footprint.++license: BSD3+license-file: LICENSE+copyright: Vincent Hanquez, Herbert Valerio Riedel+maintainer: Herbert Valerio Riedel <hvr@gnu.org>+homepage: https://github.com/hvr/cryptohash-sha512+bug-reports: https://github.com/hvr/cryptohash-sha512/issues+synopsis: Fast, pure and practical SHA-512 implementation+category: Data, Cryptography+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.4.2+ , GHC == 7.6.3+ , GHC == 7.8.4+ , GHC == 7.10.3+ , GHC == 8.0.1++extra-source-files: cbits/sha512.h+ changelog.md++source-repository head+ type: git+ location: https://github.com/hvr/cryptohash-sha512.git++library+ default-language: Haskell2010+ build-depends: base >= 4.5 && < 4.10+ , bytestring >= 0.9.2 && < 0.11++ hs-source-dirs: src+ exposed-modules: Crypto.Hash.SHA512+ ghc-options: -Wall -fno-cse -O2+ cc-options: -Wall -O3+ c-sources: cbits/sha512.c+ include-dirs: cbits++test-suite test-sha512+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: src-tests+ main-is: test-sha512.hs+ ghc-options: -Wall -threaded+ build-depends: cryptohash-sha512+ , base+ , bytestring++ , base16-bytestring >= 0.1.1 && < 0.2+ , SHA >= 1.6.4 && < 1.7+ , tasty == 0.11.*+ , tasty-quickcheck == 0.8.*+ , tasty-hunit == 0.9.*++benchmark bench-sha512+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: bench-sha512.hs+ hs-source-dirs: src-bench+ build-depends: cryptohash-sha512+ , base+ , bytestring+ , criterion == 1.1.*
+ src-bench/bench-sha512.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE BangPatterns #-}++import Criterion.Main+import qualified Crypto.Hash.SHA512 as SHA512+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++benchSize :: Int -> Benchmark+benchSize sz = bs `seq` bench msg (whnf SHA512.hash bs)+ where+ bs = B.replicate sz 0+ msg = "bs-" ++ show sz++main :: IO ()+main = do+ let !lbs64x256 = L.fromChunks $ replicate 4 (B.replicate 64 0)+ !lbs64x4096 = L.fromChunks $ replicate 64 (B.replicate 64 0)+ defaultMain+ [ bgroup "cryptohash-sha512"+ [ benchSize 0+ , benchSize 8+ , benchSize 32+ , benchSize 64+ , benchSize 128+ , benchSize 256+ , benchSize 1024+ , benchSize 4096+ , benchSize (128*1024)+ , benchSize (1024*1024)+ , benchSize (2*1024*1024)+ , benchSize (4*1024*1024)++ , L.length lbs64x256 `seq` bench "lbs64x256" (whnf SHA512.hashlazy lbs64x256)+ , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf SHA512.hashlazy lbs64x4096)+ ]+ ]
+ src-tests/test-sha512.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Base16 as B16++-- reference implementation+import qualified Data.Digest.Pure.SHA as REF++-- implementation under test+import qualified Crypto.Hash.SHA512 as IUT++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC++vectors :: [ByteString]+vectors =+ [ ""+ , "The quick brown fox jumps over the lazy dog"+ , "The quick brown fox jumps over the lazy cog"+ , "abc"+ , "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"+ , "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"+ , B.replicate 1000000 0x61+ ]++answers :: [ByteString]+answers = map (B.filter (/= 0x20))+ [ "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e"+ , "07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6"+ , "3eeee1d0e11733ef152a6c29503b3ae20c4f1f3cda4cb26f1bc1a41f91c7fe4ab3bd86494049e201c4bd5155f31ecb7a3c8606843c4cc8dfcab7da11c8ae5045"+ , "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f"+ , "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445"+ , "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909"+ , "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973ebde0ff244877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b"+ ]++ansXLTest :: ByteString+ansXLTest = B.filter (/= 0x20)+ "b47c933421ea2db149ad6e10fce6c7f93d0752380180ffd7f4629a712134831d77be6091b819ed352c2967a2e2d4fa5050723c9630691f1a05a7281dbe6c1086"++katTests :: [TestTree]+katTests+ | length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest]+ | otherwise = error "vectors/answers length mismatch"+ where+ makeTest (i, v, r) = testGroup ("vec"++show i) $+ [ testCase "one-pass" (r @=? runTest v)+ , testCase "inc-1" (r @=? runTestInc 1 v)+ , testCase "inc-2" (r @=? runTestInc 2 v)+ , testCase "inc-3" (r @=? runTestInc 3 v)+ , testCase "inc-4" (r @=? runTestInc 4 v)+ , testCase "inc-5" (r @=? runTestInc 5 v)+ , testCase "inc-7" (r @=? runTestInc 7 v)+ , testCase "inc-8" (r @=? runTestInc 8 v)+ , testCase "inc-9" (r @=? runTestInc 9 v)+ , testCase "inc-16" (r @=? runTestInc 16 v)+ , testCase "lazy-1" (r @=? runTestLazy 1 v)+ , testCase "lazy-2" (r @=? runTestLazy 2 v)+ , testCase "lazy-7" (r @=? runTestLazy 7 v)+ , testCase "lazy-8" (r @=? runTestLazy 8 v)+ , testCase "lazy-16" (r @=? runTestLazy 16 v)+ ] +++ [ testCase "lazy-63u" (r @=? runTestLazyU 63 v) | B.length v > 63 ] +++ [ testCase "lazy-65u" (r @=? runTestLazyU 65 v) | B.length v > 65 ] +++ [ testCase "lazy-97u" (r @=? runTestLazyU 97 v) | B.length v > 97 ] +++ [ testCase "lazy-131u" (r @=? runTestLazyU 131 v) | B.length v > 131 ]++ runTest :: ByteString -> ByteString+ runTest = B16.encode . IUT.hash++ runTestInc :: Int -> ByteString -> ByteString+ runTestInc i = B16.encode . IUT.finalize . myfoldl' IUT.update IUT.init . splitB i++ runTestLazy :: Int -> ByteString -> ByteString+ runTestLazy i = B16.encode . IUT.hashlazy . BL.fromChunks . splitB i++ -- force unaligned md5-blocks+ runTestLazyU :: Int -> ByteString -> ByteString+ runTestLazyU i = B16.encode . IUT.hashlazy . BL.fromChunks . map B.copy . splitB i++ ----++ xltest = testGroup "XL-vec"+ [ testCase "inc" (ansXLTest @=? (B16.encode . IUT.hashlazy) vecXL) ]+ where+ vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno")++splitB :: Int -> ByteString -> [ByteString]+splitB l b+ | B.length b > l = b1 : splitB l b2+ | otherwise = [b]+ where+ (b1, b2) = B.splitAt l b+++rfc4231Vectors :: [(ByteString,ByteString,ByteString)]+rfc4231Vectors = -- (secrect,msg,mac)+ [ (rep 20 0x0b, "Hi There", x"87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854")+ , ("Jefe", "what do ya want for nothing?", x"164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737")+ , (rep 20 0xaa, rep 50 0xdd, x"fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb")+ , (B.pack [1..25], rep 50 0xcd, x"b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd")+ , (rep 20 0x0c, "Test With Truncation", x"415fad6271580a531d4179bc891d87a650188707922a4fbb36663a1eb16da008711c5b50ddd0fc235084eb9d3364a1454fb2ef67cd1d29fe6773068ea266e96b")+ , (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598")+ , (rep 131 0xaa, "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.", x"e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58")+ ]+ where+ x = fst.B16.decode+ rep n c = B.replicate n c++rfc4231Tests :: [TestTree]+rfc4231Tests = zipWith makeTest [1::Int ..] rfc4231Vectors+ where+ makeTest i (key, msg, mac) = testGroup ("vec"++show i) $+ [ testCase "hmac" (hex mac @=? hex (IUT.hmac key msg))+ , testCase "hmaclazy" (hex mac @=? hex (IUT.hmaclazy key lazymsg))+ ]+ where+ lazymsg = BL.fromChunks . splitB 1 $ msg++ hex = B16.encode++-- define own 'foldl' here to avoid RULE rewriting to 'hashlazy'+myfoldl' :: (b -> a -> b) -> b -> [a] -> b+myfoldl' f z0 xs0 = lgo z0 xs0+ where+ lgo z [] = z+ lgo z (x:xs) = let z' = f z x+ in z' `seq` lgo z' xs++newtype RandBS = RandBS { unRandBS :: ByteString }+newtype RandLBS = RandLBS BL.ByteString++instance Arbitrary RandBS where+ arbitrary = fmap (RandBS . B.pack) arbitrary+ shrink (RandBS x) = fmap RandBS (go x)+ where+ go bs = zipWith B.append (B.inits bs) (tail $ B.tails bs)++instance Show RandBS where+ show (RandBS x) = "RandBS {len=" ++ show (B.length x)++"}"++instance Arbitrary RandLBS where+ arbitrary = fmap (RandLBS . BL.fromChunks . map unRandBS) arbitrary++instance Show RandLBS where+ show (RandLBS x) = "RandLBS {len=" ++ show (BL.length x) ++ ", chunks=" ++ show (length $ BL.toChunks x)++"}"+++refImplTests :: [TestTree]+refImplTests =+ [ testProperty "hash" prop_hash+ , testProperty "hashlazy" prop_hashlazy+ , testProperty "hmac" prop_hmac+ , testProperty "hmaclazy" prop_hmaclazy+ ]+ where+ prop_hash (RandBS bs)+ = ref_hash bs == IUT.hash bs++ prop_hashlazy (RandLBS bs)+ = ref_hashlazy bs == IUT.hashlazy bs++ prop_hmac (RandBS k) (RandBS bs)+ = ref_hmac k bs == IUT.hmac k bs++ prop_hmaclazy (RandBS k) (RandLBS bs)+ = ref_hmaclazy k bs == IUT.hmaclazy k bs++ ref_hash :: ByteString -> ByteString+ ref_hash = ref_hashlazy . fromStrict++ ref_hashlazy :: BL.ByteString -> ByteString+ ref_hashlazy = toStrict . REF.bytestringDigest . REF.sha512++ ref_hmac :: ByteString -> ByteString -> ByteString+ ref_hmac secret = ref_hmaclazy secret . fromStrict++ ref_hmaclazy :: ByteString -> BL.ByteString -> ByteString+ ref_hmaclazy secret = toStrict . REF.bytestringDigest . REF.hmacSha512 (fromStrict secret)++ -- toStrict/fromStrict only available with bytestring-0.10 and later+ toStrict = B.concat . BL.toChunks+ fromStrict = BL.fromChunks . (:[])++main :: IO ()+main = defaultMain $ testGroup "cryptohash-sha512"+ [ testGroup "KATs" katTests+ , testGroup "RFC4231" rfc4231Tests+ , testGroup "REF" refImplTests+ ]
+ src/Crypto/Hash/SHA512.hs view
@@ -0,0 +1,260 @@+-- |+-- Module : Crypto.Hash.SHA512+-- License : BSD-style+-- Maintainer : Herbert Valerio Riedel <hvr@gnu.org>+-- Stability : stable+-- Portability : unknown+--+-- A module containing <https://en.wikipedia.org/wiki/SHA-2 SHA-512> bindings+--+module Crypto.Hash.SHA512+ (++ -- * Incremental API+ --+ -- | This API is based on 4 different functions, similar to the+ -- lowlevel operations of a typical hash:+ --+ -- - 'init': create a new hash context+ -- - 'update': update non-destructively a new hash context with a strict bytestring+ -- - 'updates': same as update, except that it takes a list of strict bytestrings+ -- - 'finalize': finalize the context and returns a digest bytestring.+ --+ -- all those operations are completely pure, and instead of+ -- changing the context as usual in others language, it+ -- re-allocates a new context each time.+ --+ -- Example:+ --+ -- > import qualified Data.ByteString+ -- > import qualified Crypto.Hash.SHA512 as SHA512+ -- >+ -- > main = print digest+ -- > where+ -- > digest = SHA512.finalize ctx+ -- > ctx = foldl SHA512.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])+ -- > ctx0 = SHA512.init++ Ctx(..)+ , init -- :: Ctx+ , update -- :: Ctx -> ByteString -> Ctx+ , updates -- :: Ctx -> [ByteString] -> Ctx+ , finalize -- :: Ctx -> ByteString++ -- * Single Pass API+ --+ -- | This API use the incremental API under the hood to provide+ -- the common all-in-one operations to create digests out of a+ -- 'ByteString' and lazy 'L.ByteString'.+ --+ -- - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString'+ -- - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString'+ --+ -- Example:+ --+ -- > import qualified Data.ByteString+ -- > import qualified Crypto.Hash.SHA512 as SHA512+ -- >+ -- > main = print $ SHA512.hash (Data.ByteString.pack [0..255])+ --+ -- __NOTE__: The returned digest is a binary 'ByteString'. For+ -- converting to a base16/hex encoded digest the+ -- <https://hackage.haskell.org/package/base16-bytestring base16-bytestring>+ -- package is recommended.++ , hash -- :: ByteString -> ByteString+ , hashlazy -- :: L.ByteString -> ByteString++ -- ** HMAC-SHA-512+ --+ -- | <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+ -- <https://en.wikipedia.org/wiki/HMAC HMAC>-SHA-512 digests++ , hmac -- :: ByteString -> ByteString -> ByteString+ , hmaclazy -- :: ByteString -> L.ByteString -> ByteString+ ) where++import Prelude hiding (init)+import Foreign.C.Types+import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Alloc+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B+import Data.ByteString (ByteString)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr, memcpy)+import Data.Bits (xor)+import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)++-- | perform IO for hashes that do allocation and ffi.+-- unsafeDupablePerformIO is used when possible as the+-- computation is pure and the output is directly linked+-- to the input. we also do not modify anything after it has+-- been returned to the user.+unsafeDoIO :: IO a -> a+unsafeDoIO = unsafeDupablePerformIO++-- | SHA-512 Context+--+-- The context data is exactly 208 bytes long, however+-- the data in the context is stored in host-endianness.+--+-- The context data is made up of+--+-- * Two 'Word64's representing the number of bytes already feed to hash algorithm so far (lower word first),+--+-- * a 128-element 'Word8' buffer holding partial input-chunks, and finally+--+-- * a 8-element 'Word64' array holding the current work-in-progress digest-value.+--+-- Consequently, a SHA-512 digest as produced by 'hash', 'hashlazy', or 'finalize' is 64 bytes long.+newtype Ctx = Ctx ByteString++-- keep this synchronised with cbits/sha512.h+{-# INLINE digestSize #-}+digestSize :: Int+digestSize = 64++{-# INLINE sizeCtx #-}+sizeCtx :: Int+sizeCtx = 208++{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}++{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+ withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+ where (fptr, off, _) = toForeignPtr b++copyCtx :: Ptr Ctx -> Ptr Ctx -> IO ()+copyCtx dst src = memcpy (castPtr dst) (castPtr src) (fromIntegral sizeCtx)++withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+ where+ createCtx = create sizeCtx $ \dstPtr ->+ withByteStringPtr ctxB $ \srcPtr -> do+ copyCtx (castPtr dstPtr) (castPtr srcPtr)+ f (castPtr dstPtr)++withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a+withCtxThrow (Ctx ctxB) f =+ allocaBytes sizeCtx $ \dstPtr ->+ withByteStringPtr ctxB $ \srcPtr -> do+ copyCtx (castPtr dstPtr) (castPtr srcPtr)+ f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)++foreign import ccall unsafe "sha512.h hs_cryptohash_sha512_init"+ c_sha512_init :: Ptr Ctx -> IO ()++foreign import ccall unsafe "sha512.h hs_cryptohash_sha512_update"+ c_sha512_update_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()++foreign import ccall safe "sha512.h hs_cryptohash_sha512_update"+ c_sha512_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()++-- 'safe' call overhead neglible for 4KiB and more+c_sha512_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO ()+c_sha512_update pctx pbuf sz+ | sz < 4096 = c_sha512_update_unsafe pctx pbuf sz+ | otherwise = c_sha512_update_safe pctx pbuf sz++foreign import ccall unsafe "sha512.h hs_cryptohash_sha512_finalize"+ c_sha512_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()++updateInternalIO :: Ptr Ctx -> ByteString -> IO ()+updateInternalIO ptr d =+ unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len))++finalizeInternalIO :: Ptr Ctx -> IO ByteString+finalizeInternalIO ptr = create digestSize (c_sha512_finalize ptr)++{-# NOINLINE init #-}+-- | create a new hash context+init :: Ctx+init = unsafeDoIO $ withCtxNew $ c_sha512_init++validCtx :: Ctx -> Bool+validCtx (Ctx b) = B.length b == sizeCtx++{-# NOINLINE update #-}+-- | update a context with a bytestring+update :: Ctx -> ByteString -> Ctx+update ctx d+ | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d+ | otherwise = error "SHA512.update: invalid Ctx"++{-# NOINLINE updates #-}+-- | updates a context with multiple bytestrings+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d+ | validCtx ctx = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d+ | otherwise = error "SHA512.updates: invalid Ctx"++{-# NOINLINE finalize #-}+-- | finalize the context into a digest bytestring (64 bytes)+finalize :: Ctx -> ByteString+finalize ctx+ | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO+ | otherwise = error "SHA512.finalize: invalid Ctx"++{-# NOINLINE hash #-}+-- | hash a strict bytestring into a digest bytestring (64 bytes)+hash :: ByteString -> ByteString+hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do+ c_sha512_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr++{-# NOINLINE hashlazy #-}+-- | hash a lazy bytestring into a digest bytestring (64 bytes)+hashlazy :: L.ByteString -> ByteString+hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do+ c_sha512_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr+++{-# NOINLINE hmac #-}+-- | Compute 64-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+-- HMAC-SHA-512 digest for a strict bytestring message+--+-- @since 0.11.100.0+hmac :: ByteString -- ^ secret+ -> ByteString -- ^ message+ -> ByteString+hmac secret msg = hash $ B.append opad (hash $ B.append ipad msg)+ where+ opad = B.map (xor 0x5c) k'+ ipad = B.map (xor 0x36) k'++ k' = B.append kt pad+ kt = if B.length secret > 128 then hash secret else secret+ pad = B.replicate (128 - B.length kt) 0+++{-# NOINLINE hmaclazy #-}+-- | Compute 64-byte <https://tools.ietf.org/html/rfc2104 RFC2104>-compatible+-- HMAC-SHA-512 digest for a lazy bytestring message+--+-- @since 0.11.100.0+hmaclazy :: ByteString -- ^ secret+ -> L.ByteString -- ^ message+ -> ByteString+hmaclazy secret msg = hash $ B.append opad (hashlazy $ L.append ipad msg)+ where+ opad = B.map (xor 0x5c) k'+ ipad = L.fromChunks [B.map (xor 0x36) k']++ k' = B.append kt pad+ kt = if B.length secret > 128 then hash secret else secret+ pad = B.replicate (128 - B.length kt) 0