cryptohash-sha256-0.11.102.1/0000755000000000000000000000000007346545000013456 5ustar0000000000000000cryptohash-sha256-0.11.102.1/LICENSE0000644000000000000000000000302607346545000014464 0ustar0000000000000000Copyright (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. cryptohash-sha256-0.11.102.1/Setup.hs0000644000000000000000000000005607346545000015113 0ustar0000000000000000import Distribution.Simple main = defaultMain cryptohash-sha256-0.11.102.1/cbits/0000755000000000000000000000000007346545000014562 5ustar0000000000000000cryptohash-sha256-0.11.102.1/cbits/hs_sha256.h0000644000000000000000000001761007346545000016442 0ustar0000000000000000/* * 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 cryptohash-sha256-0.11.102.1/changelog.md0000644000000000000000000000230407346545000015726 0ustar0000000000000000## 0.11.102.0 - Add Eq instance for Ctx - Add start and startlazy producing Ctx - Introduce new `use-cbits` cabal flag in order to add support for FFI-less `cryptohash-sha256-pure` pass-thru ## 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 cryptohash-sha256-0.11.102.1/cryptohash-sha256.cabal0000644000000000000000000001277507346545000017650 0ustar0000000000000000cabal-version: 2.0 name: cryptohash-sha256 version: 0.11.102.1 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.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.4 , GHC == 9.0.1 , GHC == 9.2.0.20210821 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 flag use-cbits description: Use fast optimized C routines via FFI; if flag is disabled falls back to non-FFI Haskell optimized implementation. manual: True default: True library default-language: Haskell2010 ghc-options: -Wall build-depends: base >= 4.5 && < 4.17 exposed-modules: Crypto.Hash.SHA256 if flag(use-cbits) build-depends: bytestring ^>= 0.9.2 || ^>= 0.10.0 || ^>= 0.11.0 other-extensions: BangPatterns CApiFFI CPP Trustworthy Unsafe hs-source-dirs: src other-modules: Crypto.Hash.SHA256.FFI Compat include-dirs: cbits else hs-source-dirs: src-pure build-depends: cryptohash-sha256-pure ^>= 0.1.0 executable sha256sum default-language: Haskell2010 hs-source-dirs: src-exe main-is: sha256sum.hs ghc-options: -Wall -threaded if flag(exe) other-extensions: RecordWildCards build-depends: cryptohash-sha256 , base , bytestring , base16-bytestring ^>= 0.1.1 || ^>= 1.0.0 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 || ^>= 1.0.0 , SHA ^>= 1.6.4 , tasty ^>= 1.4 , tasty-quickcheck ^>= 0.10 , tasty-hunit ^>= 0.10 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 , SHA ^>= 1.6.4 , base , bytestring ^>= 0.10 , criterion ^>= 1.5 -- not yet public -- build-depends: cryptohash-sha256-pure ^>= 0.1.0 cryptohash-sha256-0.11.102.1/src-bench/0000755000000000000000000000000007346545000015322 5ustar0000000000000000cryptohash-sha256-0.11.102.1/src-bench/bench-sha256.hs0000644000000000000000000000543607346545000017753 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PackageImports #-} import Criterion.Main import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as IUT import qualified Data.Digest.Pure.SHA as REF #ifdef VERSION_cryptohash_sha256_pure import qualified "cryptohash-sha256-pure" Crypto.Hash.SHA256.Legacy as Pure #endif import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L benchSize'IUT :: Int -> Benchmark benchSize'IUT sz = bs `seq` bench msg (whnf IUT.hash bs) where bs = B.replicate sz 0 msg = "bs-" ++ show sz #ifdef VERSION_cryptohash_sha256_pure benchSize'Pure :: Int -> Benchmark benchSize'Pure sz = bs `seq` bench msg (whnf Pure.hash bs) where bs = B.replicate sz 0 msg = "bs-" ++ show sz #endif benchSize'REF :: Int -> Benchmark benchSize'REF sz = bs `seq` bench msg (whnf REF.sha256 bs) where bs = L.fromStrict (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'IUT 0 , benchSize'IUT 32 , benchSize'IUT 64 , benchSize'IUT 128 , benchSize'IUT 1024 , benchSize'IUT 4096 , benchSize'IUT (32*1024) , benchSize'IUT (128*1024) , benchSize'IUT (1024*1024) , benchSize'IUT (2*1024*1024) , benchSize'IUT (4*1024*1024) , L.length lbs64x256 `seq` bench "lbs64x256" (whnf IUT.hashlazy lbs64x256) , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf IUT.hashlazy lbs64x4096) ] #ifdef VERSION_cryptohash_sha256_pure , bgroup "cryptohash-sha256-pure" [ benchSize'Pure 0 , benchSize'Pure 32 , benchSize'Pure 64 , benchSize'Pure 128 , benchSize'Pure 1024 , benchSize'Pure 4096 , benchSize'Pure (32*1024) , benchSize'Pure (128*1024) , benchSize'Pure (1024*1024) , benchSize'Pure (2*1024*1024) , benchSize'Pure (4*1024*1024) , L.length lbs64x256 `seq` bench "lbs64x256" (whnf Pure.hashlazy lbs64x256) , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf Pure.hashlazy lbs64x4096) ] #endif , bgroup "SHA" [ benchSize'REF 0 , benchSize'REF 32 , benchSize'REF 64 , benchSize'REF 128 , benchSize'REF 1024 , benchSize'REF 4096 , benchSize'REF (32*1024) , benchSize'REF (128*1024) , benchSize'REF (1024*1024) , benchSize'REF (2*1024*1024) , benchSize'REF (4*1024*1024) ] ] cryptohash-sha256-0.11.102.1/src-exe/0000755000000000000000000000000007346545000015024 5ustar0000000000000000cryptohash-sha256-0.11.102.1/src-exe/sha256sum.hs0000644000000000000000000000414407346545000017120 0ustar0000000000000000{-# 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 cryptohash-sha256-0.11.102.1/src-pure/Crypto/Hash/0000755000000000000000000000000007346545000017361 5ustar0000000000000000cryptohash-sha256-0.11.102.1/src-pure/Crypto/Hash/SHA256.hs0000644000000000000000000000643707346545000020577 0ustar0000000000000000{-# 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) , start -- :: ByteString -> Ct , startlazy -- :: L.ByteString -> Ctx -- * 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 Prelude () import Crypto.Hash.SHA256.Legacy cryptohash-sha256-0.11.102.1/src-tests/0000755000000000000000000000000007346545000015405 5ustar0000000000000000cryptohash-sha256-0.11.102.1/src-tests/test-sha256.hs0000644000000000000000000002721707346545000017737 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} module Main (main) where import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Base16 as B16 -- before bytestring-0.10 instance IsString ByteString -- was imported only from Char8 module import Data.ByteString.Char8 () 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, xltest'] | otherwise = error "vectors/answers length mismatch" where makeTest (i, v, r) = testGroup ("vec"++show i) $ [ testCase "one-pass" (r @=? runTest v) , 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-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] ++ [ 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 runTest' :: ByteString -> ByteString runTest' = B16.encode . IUT.finalize . IUT.start 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 runTestLazy' :: Int -> ByteString -> ByteString runTestLazy' i = B16.encode . IUT.finalize . IUT.startlazy . 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 runTestLazyU' :: Int -> ByteString -> ByteString runTestLazyU' i = B16.encode . IUT.finalize . IUT.startlazy . 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") xltest' = testGroup "XL-vec'" [ testCase "inc'" (ansXLTest @=? (B16.encode . IUT.finalize . IUT.startlazy) 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 -- Minor hack to paper over backward incompat changes introduced in base16-bytestring-1.0 class B16DecRes a where b16DecRes :: a -> ByteString instance B16DecRes (Either String ByteString) where b16DecRes = either error id instance B16DecRes (ByteString, ByteString) where b16DecRes = fst b16decode :: ByteString -> ByteString b16decode = b16DecRes . B16.decode 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 = b16decode 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 = b16decode 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 "start" prop_start , testProperty "hashlazy" prop_hashlazy , testProperty "startlazy" prop_startlazy , 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_start (RandBS bs) = ref_hash bs == (IUT.finalize $ IUT.start bs) prop_hashlazy (RandLBS bs) = ref_hashlazy bs == IUT.hashlazy bs prop_startlazy (RandLBS bs) = ref_hashlazy bs == (IUT.finalize $ IUT.startlazy 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 ] cryptohash-sha256-0.11.102.1/src/0000755000000000000000000000000007346545000014245 5ustar0000000000000000cryptohash-sha256-0.11.102.1/src/Compat.hs0000644000000000000000000000114007346545000016020 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} -- | -- Module : Compat -- License : BSD-3 -- Maintainer : Herbert Valerio Riedel -- Stability : stable -- -- Compat layer to reduce code exposure to CPP to a bare minimum -- module Compat (constructBS) where import Foreign.ForeignPtr (ForeignPtr) import Data.Word (Word8) import Data.ByteString.Internal (ByteString (..)) -- | Directly construct a 'ByteString', unsafely constructBS :: ForeignPtr Word8 -> Int -> ByteString #if MIN_VERSION_bytestring(0,11,0) constructBS = BS #else constructBS = \fp -> PS fp 0 #endif cryptohash-sha256-0.11.102.1/src/Crypto/Hash/0000755000000000000000000000000007346545000016410 5ustar0000000000000000cryptohash-sha256-0.11.102.1/src/Crypto/Hash/SHA256.hs0000644000000000000000000003036407346545000017622 0ustar0000000000000000{-# 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) , start -- :: ByteString -> Ct , startlazy -- :: L.ByteString -> Ctx -- * 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 (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 Compat (constructBS) 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 = constructBS fp 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 start #-} -- | hash a strict bytestring into a Ctx start :: ByteString -> Ctx start d = unsafeDoIO $ withCtxNew $ \ptr -> c_sha256_init ptr >> updateInternalIO ptr d {-# 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 startlazy #-} -- | hash a lazy bytestring into a Ctx startlazy :: L.ByteString -> Ctx startlazy l = unsafeDoIO $ withCtxNew $ \ptr -> c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) {-# 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) cryptohash-sha256-0.11.102.1/src/Crypto/Hash/SHA256/0000755000000000000000000000000007346545000017260 5ustar0000000000000000cryptohash-sha256-0.11.102.1/src/Crypto/Hash/SHA256/FFI.hs0000644000000000000000000000417207346545000020224 0ustar0000000000000000{-# 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 deriving (Eq) 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 ()