diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..467bf18 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2010-2014 Vincent Hanquez + 2016 Herbert Valerio Riedel + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/hs_sha256.h b/cbits/hs_sha256.h new file mode 100644 index 0000000..b936c7c --- /dev/null +++ b/cbits/hs_sha256.h @@ -0,0 +1,265 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * 2016 Herbert Valerio Riedel + * + * 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 HS_CRYPTOHASH_SHA256_H +#define HS_CRYPTOHASH_SHA256_H + +#include +#include +#include +#include +#include + +struct sha256_ctx +{ + uint64_t sz; + uint8_t buf[64]; + uint32_t h[8]; +}; + +/* keep this synchronised with 'digestSize'/'sizeCtx' in SHA256.hs */ +#define SHA256_DIGEST_SIZE 32 +#define SHA256_CTX_SIZE 104 + +static inline void hs_cryptohash_sha256_init (struct sha256_ctx *ctx); +static inline void hs_cryptohash_sha256_update (struct sha256_ctx *ctx, const uint8_t *data, size_t len); +static inline uint64_t hs_cryptohash_sha256_finalize (struct sha256_ctx *ctx, uint8_t *out); + +#if defined(static_assert) +static_assert(sizeof(struct sha256_ctx) == SHA256_CTX_SIZE, "unexpected sha256_ctx size"); +#else +/* poor man's pre-C11 _Static_assert */ +typedef char static_assertion__unexpected_sha256_ctx_size[(sizeof(struct sha256_ctx) == SHA256_CTX_SIZE)?1:-1]; +#endif + +#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 *dest, const uint32_t *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 +} + + +static inline void +hs_cryptohash_sha256_init (struct sha256_ctx *ctx) +{ + memset(ctx, 0, SHA256_CTX_SIZE); + + ctx->h[0] = 0x6a09e667; + ctx->h[1] = 0xbb67ae85; + ctx->h[2] = 0x3c6ef372; + ctx->h[3] = 0xa54ff53a; + ctx->h[4] = 0x510e527f; + ctx->h[5] = 0x9b05688c; + ctx->h[6] = 0x1f83d9ab; + ctx->h[7] = 0x5be0cd19; +} + +/* 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(struct sha256_ctx *ctx, uint32_t w[]) +{ + 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 = ctx->h[0]; + uint32_t b = ctx->h[1]; + uint32_t c = ctx->h[2]; + uint32_t d = ctx->h[3]; + uint32_t e = ctx->h[4]; + uint32_t f = ctx->h[5]; + uint32_t g = ctx->h[6]; + uint32_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 < 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 + + 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 +sha256_do_chunk(struct sha256_ctx *ctx, const uint8_t buf[]) +{ + 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, buf, 64); +#if !WORDS_BIGENDIAN + cpu_to_be32_array(w, w, 16); +#endif + } + sha256_do_chunk_aligned(ctx, w); +} + +static inline void +hs_cryptohash_sha256_update(struct sha256_ctx *ctx, const uint8_t *data, size_t len) +{ + size_t index = ctx->sz & 0x3f; + const size_t to_fill = 64 - index; + + ctx->sz += len; + + /* process partial buffer if there's enough data to make a block */ + if (index && len >= to_fill) { + memcpy(ctx->buf + index, data, to_fill); + sha256_do_chunk(ctx, ctx->buf); + /* memset(ctx->buf, 0, 64); */ + len -= to_fill; + data += to_fill; + index = 0; + } + + /* process as many 64-blocks as possible */ + while (len >= 64) { + sha256_do_chunk(ctx, data); + len -= 64; + data += 64; + } + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +static inline uint64_t +hs_cryptohash_sha256_finalize (struct sha256_ctx *ctx, uint8_t *out) +{ + static const uint8_t padding[64] = { 0x80, }; + const uint64_t sz = ctx->sz; + + /* add padding and update data with it */ + uint64_t bits = cpu_to_be64(ctx->sz << 3); + + /* pad out to 56 */ + const size_t index = ctx->sz & 0x3f; + const size_t padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); + hs_cryptohash_sha256_update(ctx, padding, padlen); + + /* append length */ + hs_cryptohash_sha256_update(ctx, (uint8_t *) &bits, sizeof(bits)); + + /* output hash */ + cpu_to_be32_array((uint32_t *) out, ctx->h, 8); + + return sz; +} + +static inline void +hs_cryptohash_sha256_hash (const uint8_t *data, size_t len, uint8_t *out) +{ + struct sha256_ctx ctx; + + hs_cryptohash_sha256_init(&ctx); + + hs_cryptohash_sha256_update(&ctx, data, len); + + hs_cryptohash_sha256_finalize(&ctx, out); +} + +#endif diff --git a/changelog.md b/changelog.md new file mode 100644 index 0000000..51b80a0 --- /dev/null +++ b/changelog.md @@ -0,0 +1,36 @@ +## 0.11.101.0 + + - Add `hkdf` function providing HKDF-SHA256 conforming to RFC5869 + - Declare `Crypto.Hash.SHA256` module `-XTrustworthy` + - Remove ineffective RULES + - Convert to `CApiFFI` + - Added `...AndLength` variants of hashing functions: + + - `finalizeAndLength` + - `hashlazyAndLength` + - `hmaclazyAndLength` + + - Minor optimizations in `hmac` and `hash` + +## 0.11.100.1 + + - Use `__builtin_bswap{32,64}` only with GCC >= 4.3 + ([#1](https://github.com/hvr/cryptohash-sha256/issues/1)) + +## 0.11.100.0 + + - new `hmac` and `hmaclazy` functions providing HMAC-SHA256 + computation conforming to RFC2104 and RFC4231 + - fix unaligned memory-accesses + +## 0.11.7.2 + + - 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 + + - first version forked off `cryptohash-0.11.7` release diff --git a/cryptohash-sha256.cabal b/cryptohash-sha256.cabal new file mode 100644 index 0000000..6cfc4d8 --- /dev/null +++ b/cryptohash-sha256.cabal @@ -0,0 +1,128 @@ +cabal-version: 1.12 +name: cryptohash-sha256 +version: 0.11.101.0 + +synopsis: Fast, pure and practical SHA-256 implementation +description: { + +A practical incremental and one-pass, pure API to +the [SHA-256 cryptographic hash algorithm](https://en.wikipedia.org/wiki/SHA-2) according +to [FIPS 180-4](http://dx.doi.org/10.6028/NIST.FIPS.180-4) +with performance close to the fastest implementations available in other languages. +. +The core SHA-256 algorithm is implemented in C and is thus expected +to be as fast as the standard [sha256sum(1) tool](https://linux.die.net/man/1/sha256sum); +for instance, on an /Intel Core i7-3770/ at 3.40GHz this implementation can +compute a SHA-256 hash over 230 MiB of data in under one second. +(If, instead, you require a pure Haskell implementation and performance is secondary, please refer to the [SHA package](https://hackage.haskell.org/package/SHA).) +. + +. +Additionally, this package provides support for +. +- HMAC-SHA-256: SHA-256-based [Hashed Message Authentication Codes](https://en.wikipedia.org/wiki/HMAC) (HMAC) +- HKDF-SHA-256: [HMAC-SHA-256-based Key Derivation Function](https://en.wikipedia.org/wiki/HKDF) (HKDF) +. +conforming to [RFC6234](https://tools.ietf.org/html/rfc6234), [RFC4231](https://tools.ietf.org/html/rfc4231), [RFC5869](https://tools.ietf.org/html/rfc5869), et al.. +. +=== Relationship to the @cryptohash@ package and its API +. +This package has been originally a fork of @cryptohash-0.11.7@ because the @cryptohash@ +package had been deprecated and so this package continues to satisfy the need for a +lightweight package providing the SHA-256 hash algorithm without any dependencies on packages +other than @base@ and @bytestring@. The API exposed by @cryptohash-sha256-0.11.*@'s +"Crypto.Hash.SHA256" module is guaranteed to remain a compatible superset of the API provided +by the @cryptohash-0.11.7@'s module of the same name. +. +Consequently, this package is designed to be used as a drop-in replacement for @cryptohash-0.11.7@'s +"Crypto.Hash.SHA256" module, though with +a [clearly smaller footprint by almost 3 orders of magnitude](https://www.reddit.com/r/haskell/comments/5lxv75/psa_please_use_unique_module_names_when_uploading/dbzegx3/). + +} + +license: BSD3 +license-file: LICENSE +copyright: Vincent Hanquez, Herbert Valerio Riedel +maintainer: Herbert Valerio Riedel +homepage: https://github.com/hvr/cryptohash-sha256 +bug-reports: https://github.com/hvr/cryptohash-sha256/issues +category: Data, Cryptography +build-type: Simple +tested-with: GHC == 7.4.2 + , GHC == 7.6.3 + , GHC == 7.8.4 + , GHC == 7.10.3 + , GHC == 8.0.2 + , GHC == 8.2.1 + +extra-source-files: cbits/hs_sha256.h + changelog.md + +source-repository head + type: git + location: https://github.com/hvr/cryptohash-sha256.git + +flag exe + description: Enable building @sha256sum@ executable + manual: True + default: False + +library + default-language: Haskell2010 + other-extensions: BangPatterns + CApiFFI + Trustworthy + Unsafe + + build-depends: base >= 4.5 && < 4.11 + , bytestring >= 0.9.2 && < 0.11 + + ghc-options: -Wall + + hs-source-dirs: src + exposed-modules: Crypto.Hash.SHA256 + other-modules: Crypto.Hash.SHA256.FFI + include-dirs: cbits + +executable sha256sum + hs-source-dirs: src-exe + main-is: sha256sum.hs + ghc-options: -Wall -threaded + if flag(exe) + default-language: Haskell2010 + other-extensions: RecordWildCards + build-depends: cryptohash-sha256 + , base + , bytestring + + , base16-bytestring >= 0.1.1 && < 0.2 + else + buildable: False + +test-suite test-sha256 + default-language: Haskell2010 + other-extensions: OverloadedStrings + type: exitcode-stdio-1.0 + hs-source-dirs: src-tests + main-is: test-sha256.hs + ghc-options: -Wall -threaded + build-depends: cryptohash-sha256 + , 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-sha256 + default-language: Haskell2010 + other-extensions: BangPatterns + type: exitcode-stdio-1.0 + main-is: bench-sha256.hs + hs-source-dirs: src-bench + build-depends: cryptohash-sha256 + , base + , bytestring + , criterion == 1.1.* diff --git a/src-bench/bench-sha256.hs b/src-bench/bench-sha256.hs new file mode 100644 index 0000000..e9af9f8 --- /dev/null +++ b/src-bench/bench-sha256.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE BangPatterns #-} + +import Criterion.Main +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +benchSize :: Int -> Benchmark +benchSize sz = bs `seq` bench msg (whnf SHA256.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-sha256" + [ 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 SHA256.hashlazy lbs64x256) + , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf SHA256.hashlazy lbs64x4096) + ] + ] diff --git a/src-exe/sha256sum.hs b/src-exe/sha256sum.hs new file mode 100644 index 0000000..e0a353a --- /dev/null +++ b/src-exe/sha256sum.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Control.Monad +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as BL +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO + +import qualified Crypto.Hash.SHA256 as H + + +data Options = Options + { optBinary :: Bool + , optHelp :: Bool + , optTag :: Bool + } deriving Show + +defOptions :: Options +defOptions = Options + { optBinary = True + , optHelp = False + , optTag = False + } + +options :: [OptDescr (Options -> Options)] +options = [ Option ['b'] ["binary"] + (NoArg (\o -> o { optBinary = True})) + "read in binary mode (default)" + , Option ['t'] ["text"] + (NoArg (\o -> o { optBinary = False})) + "read in text mode (ignored)" + , Option [] ["help"] + (NoArg (\o -> o { optHelp = True})) + "display help and exit" + , Option [] ["tag"] + (NoArg (\o -> o { optTag = True})) + "create a BSD-style checksum" + ] + +main :: IO () +main = do + argv <- getArgs + + let Options{..} = foldl (flip id) defOptions optset + (optset,args0,cliErr) = getOpt Permute options argv + args | null args0 = ["-"] + | otherwise = args0 + + unless (null cliErr) $ do + hPutStrLn stderr ("sha256sum: " ++ head cliErr ++ "Try 'sha256sum --help' for more information.") + exitFailure + + when optHelp $ do + putStrLn (usageInfo "Usage: sha256sum [OPTION]... [FILE]...\nPrint or check SHA-256 hashes\n" options) + exitSuccess + + forM_ args $ \fn -> do + h <- (B16.encode . H.hashlazy) `fmap` bReadFile fn + + case optTag of + False -> do + B.hPutStr stdout h + hPutStrLn stdout (' ':' ':fn) + True -> do + hPutStrLn stdout $ concat [ "SHA256 (", fn, ") = ", B.unpack h ] + + return () + +bReadFile :: FilePath -> IO BL.ByteString +bReadFile "-" = do + clsd <- hIsClosed stdin + if clsd then return BL.empty else BL.getContents +bReadFile fn = BL.readFile fn diff --git a/src-tests/test-sha256.hs b/src-tests/test-sha256.hs new file mode 100644 index 0000000..0750dce --- /dev/null +++ b/src-tests/test-sha256.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Lazy as BL +import Data.Word + +-- reference implementation +import qualified Data.Digest.Pure.SHA as REF + +-- implementation under test +import qualified Crypto.Hash.SHA256 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)) + [ "e3b0c442 98fc1c14 9afbf4c8 996fb924 27ae41e4 649b934c a495991b 7852b855" + , "d7a8fbb3 07d78094 69ca9abc b0082e4f 8d5651e4 6d3cdb76 2d02d0bf 37c9e592" + , "e4c4d8f3 bf76b692 de791a17 3e053211 50f7a345 b46484fe 427f6acc 7ecc81be" + , "ba7816bf 8f01cfea 414140de 5dae2223 b00361a3 96177a9c b410ff61 f20015ad" + , "248d6a61 d20638b8 e5c02693 0c3e6039 a33ce459 64ff2167 f6ecedd4 19db06c1" + , "cf5b16a7 78af8380 036ce59e 7b049237 0b249b11 e8f07a51 afac4503 7afee9d1" + , "cdc76e5c 9914fb92 81a1c7e2 84d73e67 f1809a48 a497200e 046d39cc c7112cd0" + ] + +ansXLTest :: ByteString +ansXLTest = B.filter (/= 0x20) + "50e72a0e 26442fe2 552dc393 8ac58658 228c0cbf b1d2ca87 2ae43526 6fcd055e" + +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"b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7") + , ("Jefe", "what do ya want for nothing?", x"5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843") + , (rep 20 0xaa, rep 50 0xdd, x"773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe") + , (B.pack [1..25], rep 50 0xcd, x"82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b") + , (rep 20 0x0c, "Test With Truncation", x"a3b6167473100ee06e0c796c2955552bfa6f7c0a6a8aef8b93f860aab0cd20c5") + , (rep 131 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54") + , (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"9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2") + ] + 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 + +rfc5869Vectors :: [(Int,ByteString,ByteString,ByteString,ByteString)] +rfc5869Vectors = -- (l,ikm,salt,info,okm) + [ (42, rep 22 0x0b, x"000102030405060708090a0b0c", x"f0f1f2f3f4f5f6f7f8f9", x"3cb25f25faacd57a90434f64d0362f2a2d2d0a90cf1a5a4c5db02d56ecc4c5bf34007208d5b887185865") + , ( 82 + , x"000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f" + , x"606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeaf" + , x"b0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" + , x"b11e398dc80327a1c8e7f78c596a49344f012eda2d4efad8a050cc4c19afa97c59045a99cac7827271cb41c65e590e09da3275600c2f09b8367793a9aca3db71cc30c58179ec3e87c14c01d5c1f3434f1d87" + ) + , ( 42, rep 22 0x0b, "", "", x"8da4e775a563c18f715f802a063c5a31b8a11f5c5ee1879ec3454e5f3c738d2d9d201395faa4b61a96c8") + ] + where + x = fst.B16.decode + rep n c = B.replicate n c + +rfc5869Tests :: [TestTree] +rfc5869Tests = zipWith makeTest [1::Int ..] rfc5869Vectors + where + makeTest i (l,ikm,salt,info,okm) = testGroup ("vec"++show i) $ + [ testCase "hkdf" (hex okm @=? hex (IUT.hkdf ikm salt info l)) ] + + 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 "hashlazyAndLength" prop_hashlazyAndLength + , testProperty "hmac" prop_hmac + , testProperty "hmaclazy" prop_hmaclazy + , testProperty "hmaclazyAndLength" prop_hmaclazyAndLength + ] + where + prop_hash (RandBS bs) + = ref_hash bs == IUT.hash bs + + prop_hashlazy (RandLBS bs) + = ref_hashlazy bs == IUT.hashlazy bs + + prop_hashlazyAndLength (RandLBS bs) + = ref_hashlazyAndLength bs == IUT.hashlazyAndLength 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 + + prop_hmaclazyAndLength (RandBS k) (RandLBS bs) + = ref_hmaclazyAndLength k bs == IUT.hmaclazyAndLength k bs + + ref_hash :: ByteString -> ByteString + ref_hash = ref_hashlazy . fromStrict + + ref_hashlazy :: BL.ByteString -> ByteString + ref_hashlazy = toStrict . REF.bytestringDigest . REF.sha256 + + ref_hashlazyAndLength :: BL.ByteString -> (ByteString,Word64) + ref_hashlazyAndLength x = (ref_hashlazy x, fromIntegral (BL.length x)) + + 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.hmacSha256 (fromStrict secret) + + ref_hmaclazyAndLength :: ByteString -> BL.ByteString -> (ByteString,Word64) + ref_hmaclazyAndLength secret msg = (ref_hmaclazy secret msg, fromIntegral (BL.length msg)) + + -- toStrict/fromStrict only available with bytestring-0.10 and later + toStrict = B.concat . BL.toChunks + fromStrict = BL.fromChunks . (:[]) + +main :: IO () +main = defaultMain $ testGroup "cryptohash-sha256" + [ testGroup "KATs" katTests + , testGroup "RFC4231" rfc4231Tests + , testGroup "RFC5869" rfc5869Tests + , testGroup "REF" refImplTests + ] diff --git a/src/Crypto/Hash/SHA256.hs b/src/Crypto/Hash/SHA256.hs new file mode 100644 index 0000000..cd56d1d --- /dev/null +++ b/src/Crypto/Hash/SHA256.hs @@ -0,0 +1,322 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE Trustworthy #-} + +-- | +-- Module : Crypto.Hash.SHA256 +-- License : BSD-3 +-- Maintainer : Herbert Valerio Riedel +-- Stability : stable +-- +-- A module containing bindings +-- +module Crypto.Hash.SHA256 + ( + + -- * 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.SHA256 as SHA256 + -- > + -- > main = print digest + -- > where + -- > digest = SHA256.finalize ctx + -- > ctx = foldl SHA256.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ]) + -- > ctx0 = SHA256.init + + Ctx(..) + , init -- :: Ctx + , update -- :: Ctx -> ByteString -> Ctx + , updates -- :: Ctx -> [ByteString] -> Ctx + , finalize -- :: Ctx -> ByteString + , finalizeAndLength -- :: Ctx -> (ByteString,Word64) + + -- * 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' + -- - 'hashlazyAndLength': create a digest ('init' + 'update' + 'finalizeAndLength') from a lazy 'L.ByteString' + -- + -- Example: + -- + -- > import qualified Data.ByteString + -- > import qualified Crypto.Hash.SHA256 as SHA256 + -- > + -- > main = print $ SHA256.hash (Data.ByteString.pack [0..255]) + -- + -- __NOTE__: The returned digest is a binary 'ByteString'. For + -- converting to a base16/hex encoded digest the + -- + -- package is recommended. + + , hash -- :: ByteString -> ByteString + , hashlazy -- :: L.ByteString -> ByteString + , hashlazyAndLength -- :: L.ByteString -> (ByteString,Int64) + + -- ** HMAC-SHA-256 + -- + -- | -compatible + -- -SHA-256 digests + + , hmac -- :: ByteString -> ByteString -> ByteString + , hmaclazy -- :: ByteString -> L.ByteString -> ByteString + , hmaclazyAndLength -- :: ByteString -> L.ByteString -> (ByteString,Word64) + + -- ** HKDF-SHA-256 + -- + -- | -compatible + -- -SHA-256 key derivation function + + , hkdf + ) where + +import Data.Bits (xor) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Internal (ByteString (PS), create, + createAndTrim, mallocByteString, + memcpy, toForeignPtr) +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Prelude hiding (init) +import System.IO.Unsafe (unsafeDupablePerformIO) + +import Crypto.Hash.SHA256.FFI + +-- | 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 + +-- keep this synchronised with cbits/sha256.h +{-# INLINE digestSize #-} +digestSize :: Int +digestSize = 32 + +{-# INLINE sizeCtx #-} +sizeCtx :: Int +sizeCtx = 104 + +{-# 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 + +{-# INLINE create' #-} +-- | Variant of 'create' which allows to return an argument +create' :: Int -> (Ptr Word8 -> IO a) -> IO (ByteString,a) +create' l f = do + fp <- mallocByteString l + x <- withForeignPtr fp $ \p -> f p + let bs = PS fp 0 l + return $! x `seq` bs `seq` (bs,x) + +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) + +-- 'safe' call overhead neglible for 4KiB and more +c_sha256_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () +c_sha256_update pctx pbuf sz + | sz < 4096 = c_sha256_update_unsafe pctx pbuf sz + | otherwise = c_sha256_update_safe pctx pbuf sz + +-- 'safe' call overhead neglible for 4KiB and more +c_sha256_hash :: Ptr Word8 -> CSize -> Ptr Word8 -> IO () +c_sha256_hash pbuf sz pout + | sz < 4096 = c_sha256_hash_unsafe pbuf sz pout + | otherwise = c_sha256_hash_safe pbuf sz pout + +updateInternalIO :: Ptr Ctx -> ByteString -> IO () +updateInternalIO ptr d = + unsafeUseAsCStringLen d (\(cs, len) -> c_sha256_update ptr (castPtr cs) (fromIntegral len)) + +finalizeInternalIO :: Ptr Ctx -> IO ByteString +finalizeInternalIO ptr = create digestSize (c_sha256_finalize ptr) + +finalizeInternalIO' :: Ptr Ctx -> IO (ByteString,Word64) +finalizeInternalIO' ptr = create' digestSize (c_sha256_finalize_len ptr) + + +{-# NOINLINE init #-} +-- | create a new hash context +init :: Ctx +init = unsafeDoIO $ withCtxNew c_sha256_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 "SHA256.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 "SHA256.updates: invalid Ctx" + +{-# NOINLINE finalize #-} +-- | finalize the context into a digest bytestring (32 bytes) +finalize :: Ctx -> ByteString +finalize ctx + | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO + | otherwise = error "SHA256.finalize: invalid Ctx" + +{-# NOINLINE finalizeAndLength #-} +-- | Variant of 'finalize' also returning length of hashed content +-- +-- @since 0.11.101.0 +finalizeAndLength :: Ctx -> (ByteString,Word64) +finalizeAndLength ctx + | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO' + | otherwise = error "SHA256.finalize: invalid Ctx" + +{-# NOINLINE hash #-} +-- | hash a strict bytestring into a digest bytestring (32 bytes) +hash :: ByteString -> ByteString +-- hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> c_sha256_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr +hash d = unsafeDoIO $ unsafeUseAsCStringLen d $ \(cs, len) -> create digestSize (c_sha256_hash (castPtr cs) (fromIntegral len)) + +{-# NOINLINE hashlazy #-} +-- | hash a lazy bytestring into a digest bytestring (32 bytes) +hashlazy :: L.ByteString -> ByteString +hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> + c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + +{-# NOINLINE hashlazyAndLength #-} +-- | Variant of 'hashlazy' which simultaneously computes the hash and length of a lazy bytestring. +-- +-- @since 0.11.101.0 +hashlazyAndLength :: L.ByteString -> (ByteString,Word64) +hashlazyAndLength l = unsafeDoIO $ withCtxNewThrow $ \ptr -> + c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO' ptr + + +-- | Compute 32-byte -compatible +-- HMAC-SHA-256 digest for a strict bytestring message +-- +-- @since 0.11.100.0 +hmac :: ByteString -- ^ secret + -> ByteString -- ^ message + -> ByteString -- ^ digest (32 bytes) +hmac secret msg = hash $ B.append opad (hashlazy $ L.fromChunks [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 > 64 then hash secret else secret + pad = B.replicate (64 - B.length kt) 0 + + +-- | Compute 32-byte -compatible +-- HMAC-SHA-256 digest for a lazy bytestring message +-- +-- @since 0.11.100.0 +hmaclazy :: ByteString -- ^ secret + -> L.ByteString -- ^ message + -> ByteString -- ^ digest (32 bytes) +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 > 64 then hash secret else secret + pad = B.replicate (64 - B.length kt) 0 + + +-- | Variant of 'hmaclazy' which also returns length of message +-- +-- @since 0.11.101.0 +hmaclazyAndLength :: ByteString -- ^ secret + -> L.ByteString -- ^ message + -> (ByteString,Word64) -- ^ digest (32 bytes) and length of message +hmaclazyAndLength secret msg = + (hash (B.append opad htmp), sz' - fromIntegral ipadLen) + where + (htmp, sz') = hashlazyAndLength (L.append ipad msg) + + opad = B.map (xor 0x5c) k' + ipad = L.fromChunks [B.map (xor 0x36) k'] + ipadLen = B.length k' + + k' = B.append kt pad + kt = if B.length secret > 64 then hash secret else secret + pad = B.replicate (64 - B.length kt) 0 + +{-# NOINLINE hkdf #-} +-- | -compatible +-- HKDF-SHA-256 key derivation function. +-- +-- @since 0.11.101.0 +hkdf :: ByteString -- ^ /IKM/ Input keying material + -> ByteString -- ^ /salt/ Optional salt value, a non-secret random value (can be @""@) + -> ByteString -- ^ /info/ Optional context and application specific information (can be @""@) + -> Int -- ^ /L/ length of output keying material in octets (at most 255*32 bytes) + -> ByteString -- ^ /OKM/ Output keying material (/L/ bytes) +hkdf ikm salt info l + | l == 0 = B.empty + | 0 > l || l > 255*32 = error "hkdf: invalid L parameter" + | otherwise = unsafeDoIO $ createAndTrim (32*fromIntegral cnt) (go 0 B.empty) + where + prk = hmac salt ikm + cnt = fromIntegral ((l+31) `div` 32) :: Word8 + + go :: Word8 -> ByteString -> Ptr Word8 -> IO Int + go !i t !p | i == cnt = return l + | otherwise = do + let t' = hmaclazy prk (L.fromChunks [t,info,B.singleton (i+1)]) + withByteStringPtr t' $ \tptr' -> memcpy p tptr' 32 + go (i+1) t' (p `plusPtr` 32) diff --git a/src/Crypto/Hash/SHA256/FFI.hs b/src/Crypto/Hash/SHA256/FFI.hs new file mode 100644 index 0000000..a11bb5a --- /dev/null +++ b/src/Crypto/Hash/SHA256/FFI.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE Unsafe #-} + +-- Ugly hack to workaround https://ghc.haskell.org/trac/ghc/ticket/14452 +{-# OPTIONS_GHC -O0 + -fdo-lambda-eta-expansion + -fcase-merge + -fstrictness + -fno-omit-interface-pragmas + -fno-ignore-interface-pragmas #-} + +{-# OPTIONS_GHC -optc-Wall -optc-O3 #-} + +-- | +-- Module : Crypto.Hash.SHA256.FFI +-- License : BSD-3 +-- Maintainer : Herbert Valerio Riedel +-- +module Crypto.Hash.SHA256.FFI where + +import Data.ByteString (ByteString) +import Data.Word +import Foreign.C.Types +import Foreign.Ptr + +-- | SHA-256 Context +-- +-- The context data is exactly 104 bytes long, however +-- the data in the context is stored in host-endianness. +-- +-- The context data is made up of +-- +-- * a 'Word64' representing the number of bytes already feed to hash algorithm so far, +-- +-- * a 64-element 'Word8' buffer holding partial input-chunks, and finally +-- +-- * a 8-element 'Word32' array holding the current work-in-progress digest-value. +-- +-- Consequently, a SHA-256 digest as produced by 'hash', 'hashlazy', or 'finalize' is 32 bytes long. +newtype Ctx = Ctx ByteString + +foreign import capi unsafe "hs_sha256.h hs_cryptohash_sha256_init" + c_sha256_init :: Ptr Ctx -> IO () + +foreign import capi unsafe "hs_sha256.h hs_cryptohash_sha256_update" + c_sha256_update_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () + +foreign import capi safe "hs_sha256.h hs_cryptohash_sha256_update" + c_sha256_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () + +foreign import capi unsafe "hs_sha256.h hs_cryptohash_sha256_finalize" + c_sha256_finalize_len :: Ptr Ctx -> Ptr Word8 -> IO Word64 + +foreign import capi unsafe "hs_sha256.h hs_cryptohash_sha256_finalize" + c_sha256_finalize :: Ptr Ctx -> Ptr Word8 -> IO () + +foreign import capi unsafe "hs_sha256.h hs_cryptohash_sha256_hash" + c_sha256_hash_unsafe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO () + +foreign import capi safe "hs_sha256.h hs_cryptohash_sha256_hash" + c_sha256_hash_safe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()