diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for sha1 + +## 0.1.0.0 -- 2020-03-09 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright 2020 Andrew Martin + +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 copyright holder nor the names of its +contributors may be used to endorse or promote products derived from +this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT +HOLDER 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 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/sha1.c b/cbits/sha1.c new file mode 100644 --- /dev/null +++ b/cbits/sha1.c @@ -0,0 +1,288 @@ +/* + * 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. + */ + +#include "sha1.h" + +#include +#include +#include + +#if defined(static_assert) +static_assert(offsetof(struct sha1_ctx, h[5]) == SHA1_CTX_SIZE, "unexpected sha1_ctx size"); +#else +/* poor man's pre-C11 _Static_assert */ +typedef char static_assertion__unexpected_sha1_ctx_size[(offsetof(struct sha1_ctx, h[5]) == SHA1_CTX_SIZE)?1:-1]; +#endif + +#define ptr_uint32_aligned(ptr) (!((uintptr_t)(ptr) & 0x3)) + +static inline uint32_t +rol32(const uint32_t word, const unsigned shift) +{ + /* GCC usually transforms this into a 'rol'-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 +} + + +void +hs_cryptohash_sha1_init(struct sha1_ctx *ctx) +{ + memset(ctx, 0, SHA1_CTX_SIZE); + + ctx->h[0] = 0x67452301; + ctx->h[1] = 0xefcdab89; + ctx->h[2] = 0x98badcfe; + ctx->h[3] = 0x10325476; + ctx->h[4] = 0xc3d2e1f0; +} + +#define f1(x, y, z) (z ^ (x & (y ^ z))) +#define f2(x, y, z) (x ^ y ^ z) +#define f3(x, y, z) ((x & y) + (z & (x ^ y))) +#define f4(x, y, z) f2(x, y, z) + +#define K1 0x5a827999 +#define K2 0x6ed9eba1 +#define K3 0x8f1bbcdc +#define K4 0xca62c1d6 + +#define R(a, b, c, d, e, f, k, w) \ + e += rol32(a, 5) + f(b, c, d) + k + w; b = rol32(b, 30) + +#define M(i) (w[i & 0x0f] = rol32(w[i & 0x0f] ^ w[(i - 14) & 0x0f] \ + ^ w[(i - 8) & 0x0f] ^ w[(i - 3) & 0x0f], 1)) + +static void +sha1_do_chunk_aligned(struct sha1_ctx *ctx, uint32_t w[]) +{ + 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]; + + R(a, b, c, d, e, f1, K1, w[0]); + R(e, a, b, c, d, f1, K1, w[1]); + R(d, e, a, b, c, f1, K1, w[2]); + R(c, d, e, a, b, f1, K1, w[3]); + R(b, c, d, e, a, f1, K1, w[4]); + R(a, b, c, d, e, f1, K1, w[5]); + R(e, a, b, c, d, f1, K1, w[6]); + R(d, e, a, b, c, f1, K1, w[7]); + R(c, d, e, a, b, f1, K1, w[8]); + R(b, c, d, e, a, f1, K1, w[9]); + R(a, b, c, d, e, f1, K1, w[10]); + R(e, a, b, c, d, f1, K1, w[11]); + R(d, e, a, b, c, f1, K1, w[12]); + R(c, d, e, a, b, f1, K1, w[13]); + R(b, c, d, e, a, f1, K1, w[14]); + R(a, b, c, d, e, f1, K1, w[15]); + R(e, a, b, c, d, f1, K1, M(16)); + R(d, e, a, b, c, f1, K1, M(17)); + R(c, d, e, a, b, f1, K1, M(18)); + R(b, c, d, e, a, f1, K1, M(19)); + + R(a, b, c, d, e, f2, K2, M(20)); + R(e, a, b, c, d, f2, K2, M(21)); + R(d, e, a, b, c, f2, K2, M(22)); + R(c, d, e, a, b, f2, K2, M(23)); + R(b, c, d, e, a, f2, K2, M(24)); + R(a, b, c, d, e, f2, K2, M(25)); + R(e, a, b, c, d, f2, K2, M(26)); + R(d, e, a, b, c, f2, K2, M(27)); + R(c, d, e, a, b, f2, K2, M(28)); + R(b, c, d, e, a, f2, K2, M(29)); + R(a, b, c, d, e, f2, K2, M(30)); + R(e, a, b, c, d, f2, K2, M(31)); + R(d, e, a, b, c, f2, K2, M(32)); + R(c, d, e, a, b, f2, K2, M(33)); + R(b, c, d, e, a, f2, K2, M(34)); + R(a, b, c, d, e, f2, K2, M(35)); + R(e, a, b, c, d, f2, K2, M(36)); + R(d, e, a, b, c, f2, K2, M(37)); + R(c, d, e, a, b, f2, K2, M(38)); + R(b, c, d, e, a, f2, K2, M(39)); + + R(a, b, c, d, e, f3, K3, M(40)); + R(e, a, b, c, d, f3, K3, M(41)); + R(d, e, a, b, c, f3, K3, M(42)); + R(c, d, e, a, b, f3, K3, M(43)); + R(b, c, d, e, a, f3, K3, M(44)); + R(a, b, c, d, e, f3, K3, M(45)); + R(e, a, b, c, d, f3, K3, M(46)); + R(d, e, a, b, c, f3, K3, M(47)); + R(c, d, e, a, b, f3, K3, M(48)); + R(b, c, d, e, a, f3, K3, M(49)); + R(a, b, c, d, e, f3, K3, M(50)); + R(e, a, b, c, d, f3, K3, M(51)); + R(d, e, a, b, c, f3, K3, M(52)); + R(c, d, e, a, b, f3, K3, M(53)); + R(b, c, d, e, a, f3, K3, M(54)); + R(a, b, c, d, e, f3, K3, M(55)); + R(e, a, b, c, d, f3, K3, M(56)); + R(d, e, a, b, c, f3, K3, M(57)); + R(c, d, e, a, b, f3, K3, M(58)); + R(b, c, d, e, a, f3, K3, M(59)); + + R(a, b, c, d, e, f4, K4, M(60)); + R(e, a, b, c, d, f4, K4, M(61)); + R(d, e, a, b, c, f4, K4, M(62)); + R(c, d, e, a, b, f4, K4, M(63)); + R(b, c, d, e, a, f4, K4, M(64)); + R(a, b, c, d, e, f4, K4, M(65)); + R(e, a, b, c, d, f4, K4, M(66)); + R(d, e, a, b, c, f4, K4, M(67)); + R(c, d, e, a, b, f4, K4, M(68)); + R(b, c, d, e, a, f4, K4, M(69)); + R(a, b, c, d, e, f4, K4, M(70)); + R(e, a, b, c, d, f4, K4, M(71)); + R(d, e, a, b, c, f4, K4, M(72)); + R(c, d, e, a, b, f4, K4, M(73)); + R(b, c, d, e, a, f4, K4, M(74)); + R(a, b, c, d, e, f4, K4, M(75)); + R(e, a, b, c, d, f4, K4, M(76)); + R(d, e, a, b, c, f4, K4, M(77)); + R(c, d, e, a, b, f4, K4, M(78)); + R(b, c, d, e, a, f4, K4, M(79)); + + ctx->h[0] += a; + ctx->h[1] += b; + ctx->h[2] += c; + ctx->h[3] += d; + ctx->h[4] += e; +} + +static void +sha1_do_chunk(struct sha1_ctx *ctx, const uint8_t buf[]) +{ + uint32_t w[16]; + 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 + } + sha1_do_chunk_aligned(ctx, w); +} + +void +hs_cryptohash_sha1_update(struct sha1_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); + sha1_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) { + sha1_do_chunk(ctx, data); + len -= 64; + data += 64; + } + + /* append data into buf */ + if (len) + memcpy(ctx->buf + index, data, len); +} + +void +hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *restrict out) +{ + static const uint8_t padding[64] = { 0x80, }; + + /* 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_sha1_update(ctx, padding, padlen); + + /* append length */ + hs_cryptohash_sha1_update(ctx, (uint8_t *) &bits, sizeof(bits)); + + /* output hash */ + cpu_to_be32_array((uint32_t *) out, ctx->h, 5); +} + +void hs_cryptohash_sha1_onepass + ( uint8_t * restrict out + , HsInt out_off + , const uint8_t *data + , HsInt data_off + , HsInt data_len + ) { + struct sha1_ctx ctx; + hs_cryptohash_sha1_init(&ctx); + hs_cryptohash_sha1_update(&ctx,data+data_off,data_len); + hs_cryptohash_sha1_finalize(&ctx,out+out_off); +} diff --git a/sha1.cabal b/sha1.cabal new file mode 100644 --- /dev/null +++ b/sha1.cabal @@ -0,0 +1,47 @@ +cabal-version: 2.2 +name: sha1 +version: 0.1.0.0 +synopsis: SHA-1 Hash +description: + This library is a copy of cryptohash-sha1 that works on GC-managed + byte arrays instead of ByteString. The C code is a copied from + that library. If you find an issue with the C code, you should + open an issue on cryptohash-sha1. +homepage: https://github.com/byteverse/sha1 +bug-reports: https://github.com/byteverse/sha1/issues +license: BSD-3-Clause +license-file: LICENSE +author: Andrew Martin +maintainer: andrew.thaddeus@gmail.com +copyright: 2020 Andrew Martin +category: Data +build-type: Simple +extra-source-files: CHANGELOG.md + +library + c-sources: cbits/sha1.c + cc-options: -Wall -O3 + include-dirs: cbits + hs-source-dirs: src + exposed-modules: Hash.Sha1 + build-depends: + , base >=4.12 && <5 + , primitive >=0.7 && <0.8 + , bytebuild >=0.3.4 && <0.4 + , byteslice >=0.2.2 && <0.3 + default-language: Haskell2010 + ghc-options: -O2 -Wall + +test-suite test + Default-Language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + type: exitcode-stdio-1.0 + build-depends: + , base + , sha1 + , natural-arithmetic >=0.1.1 + , small-bytearray-builder + , primitive + , byteslice >=0.1.4.0 + ghc-options: -O2 -Wall diff --git a/src/Hash/Sha1.hs b/src/Hash/Sha1.hs new file mode 100644 --- /dev/null +++ b/src/Hash/Sha1.hs @@ -0,0 +1,29 @@ +{-# language DataKinds #-} +{-# language MagicHash #-} +{-# language UnliftedFFITypes #-} + +module Hash.Sha1 + ( boundedBuilder + ) where + +import Control.Monad.ST (ST) +import Data.Bytes.Builder.Bounded as BB +import Data.Bytes.Builder.Bounded.Unsafe as BBU +import Data.Bytes.Types (Bytes(Bytes)) +import Data.Primitive (ByteArray(..),MutableByteArray(..)) +import GHC.Exts (Int(I#),Int#,MutableByteArray#,ByteArray#) +import GHC.IO (unsafeIOToST) + +foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_onepass" + c_hash :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> IO () + +performHash :: MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s () +performHash (MutableByteArray x) (I# a) (ByteArray y) (I# b) (I# c) = + unsafeIOToST (c_hash x a y b c) + +boundedBuilder :: Bytes -> BB.Builder 20 +boundedBuilder (Bytes arr off len) = BBU.construct + (\buf ix -> do + performHash buf ix arr off len + pure (ix + 20) + ) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,49 @@ +{-# language BangPatterns #-} + +import Data.Primitive (ByteArray) +import Data.Word (Word8) +import Numeric (showHex) + +import qualified Arithmetic.Nat as Nat +import qualified Data.ByteArray.Builder.Bounded as BB +import qualified Data.Bytes as Bytes +import qualified Data.Primitive as PM +import qualified GHC.Exts as Exts +import qualified Hash.Sha1 as Sha1 + +main :: IO () +main = do + putStrLn "Hashing: theoceanscovertheearth" + putStr "Expected: " + printHash expected + putStr "Got: " + printHash actual + if actual == expected + then putStrLn "Success" + else fail "Did not match" + +printHash :: ByteArray -> IO () +printHash !b = putStr (go 0) where + go !ix = if ix < 20 + then let val = PM.indexByteArray b ix :: Word8 in + if val < 16 + then '0' : showHex val (go (ix + 1)) + else showHex val (go (ix + 1)) + else "\n" + +actual :: ByteArray +actual = BB.run Nat.constant + (Sha1.boundedBuilder + (Bytes.unsafeDrop 5 + (Bytes.fromAsciiString "12345theoceanscovertheearth") + ) + ) + +expected :: ByteArray +expected = Exts.fromList + [ 0x2d, 0x4c, 0xbf, 0xa2 + , 0x04, 0xb2, 0x0a, 0xda + , 0x06, 0xee, 0xbf, 0x8b + , 0x2c, 0x22, 0x23, 0x0c + , 0x51, 0xe7, 0x55, 0x8f + ]