sha1 (empty) → 0.1.0.0
raw patch · 7 files changed
+448/−0 lines, 7 filesdep +basedep +bytebuilddep +byteslicesetup-changed
Dependencies added: base, bytebuild, byteslice, natural-arithmetic, primitive, sha1, small-bytearray-builder
Files
- CHANGELOG.md +5/−0
- LICENSE +28/−0
- Setup.hs +2/−0
- cbits/sha1.c +288/−0
- sha1.cabal +47/−0
- src/Hash/Sha1.hs +29/−0
- test/Main.hs +49/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for sha1++## 0.1.0.0 -- 2020-03-09++* Initial release
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/sha1.c view
@@ -0,0 +1,288 @@+/*+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>+ * 2016 Herbert Valerio Riedel <hvr@gnu.org>+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ * notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ * notice, this list of conditions and the following disclaimer in the+ * documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ */++#include "sha1.h"++#include <assert.h>+#include <string.h>+#include <ghcautoconf.h>++#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);+}
+ sha1.cabal view
@@ -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
+ src/Hash/Sha1.hs view
@@ -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)+ )
+ test/Main.hs view
@@ -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+ ]