packages feed

cryptohash-sha1 (empty) → 0.11.7.1

raw patch · 10 files changed

+915/−0 lines, 10 filesdep +basedep +bytestringdep +criterionsetup-changed

Dependencies added: base, bytestring, criterion, cryptohash-sha1, tasty, tasty-hunit, tasty-quickcheck

Files

+ Bench/Bench.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE BangPatterns #-}+import Criterion.Main+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Crypto.Hash.SHA1 as SHA1++hashmany (i,u,f) = f . foldl u i++allHashs =+    [ ("SHA-1",SHA1.hash, hashmany (SHA1.init,SHA1.update,SHA1.finalize))+    ]++benchHash :: a -> (a -> B.ByteString) -> Benchmarkable+benchHash bs f = whnf f bs++withHashesFilter out f = map f $ filter (\(n,_,_) -> not (n `elem` out)) allHashs+withHashes f = map f allHashs++main = do+    let !bs32     = B.replicate 32 0+        !bs256    = B.replicate 256 0+        !bs4096   = B.replicate 4096 0+        !bs1M     = B.replicate (1*1024*1024) 0+    let !lbs64x256 = (map (const (B.replicate 64 0)) [0..3])+        !lbs64x4096 = (map (const (B.replicate 64 0)) [0..63])+    defaultMain+        [ bgroup "hash-32b" (withHashes (\(name, f,_) -> bench name $ benchHash bs32 f))+        , bgroup "hash-256b" (withHashes (\(name, f,_) -> bench name $ benchHash bs256 f))+        , bgroup "hash-4Kb" (withHashes (\(name, f,_) -> bench name $ benchHash bs4096 f))+        , bgroup "hash-1Mb" (withHashesFilter ["MD2"] (\(name, f,_) -> bench name $ benchHash bs1M f))+        , bgroup "iuf-64x256" (withHashes (\(name, _,f) -> bench name $ benchHash lbs64x256 f))+        , bgroup "iuf-64x4096" (withHashes (\(name, _,f) -> bench name $ benchHash lbs64x4096 f))+        ]
+ Crypto/Hash/SHA1.hs view
@@ -0,0 +1,184 @@+-- |+-- Module      : Crypto.Hash.SHA1+-- License     : BSD-style+-- Maintainer  : Herbert Valerio Riedel <hvr@gnu.org>+-- Stability   : stable+-- Portability : unknown+--+-- A module containing <https://en.wikipedia.org/wiki/SHA-1 SHA-1> bindings+--+module Crypto.Hash.SHA1+    (++    -- * 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 bytestring+    --  - '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.SHA1 as SHA1+    -- >+    -- > main = print digest+    -- >   where+    -- >     digest = SHA1.finalize ctx+    -- >     ctx    = foldl SHA1.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])+    -- >     ctx0   = SHA1.init++      Ctx(..)+    , init     -- :: Ctx+    , update   -- :: Ctx -> ByteString -> Ctx+    , updates  -- :: Ctx -> [ByteString] -> Ctx+    , finalize -- :: Ctx -> ByteString++    -- * Single Pass API+    --+    -- | This API use the incremental API under the hood to provide+    -- the common all-in-one operations to create digests out of a+    -- 'ByteString' and lazy 'L.ByteString'.+    --+    --  - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString'+    --  - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString'+    --+    -- Example:+    --+    -- > import qualified Data.ByteString+    -- > import qualified Crypto.Hash.SHA1 as SHA1+    -- >+    -- > main = print $ SHA1.hash (Data.ByteString.pack [0..255])+    --+    -- __NOTE__: The returned digest is a binary 'ByteString'. For+    -- converting to a base16/hex encoded digest the+    -- <https://hackage.haskell.org/package/base16-bytestring base16-bytestring>+    -- package is recommended.++    , hash     -- :: ByteString -> ByteString+    , hashlazy -- :: ByteString -> ByteString+    ) where++import Prelude hiding (init)+import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Storable+import Foreign.Marshal.Alloc+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B+import Data.ByteString (ByteString)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.ByteString.Internal (create, toForeignPtr)+import Data.Word+import System.IO.Unsafe (unsafeDupablePerformIO)++-- | perform IO for hashes that do allocation and ffi.+-- unsafeDupablePerformIO is used when possible as the+-- computation is pure and the output is directly linked+-- to the input. we also do not modify anything after it has+-- been returned to the user.+unsafeDoIO :: IO a -> a+unsafeDoIO = unsafeDupablePerformIO++-- | SHA-1 Context+newtype Ctx = Ctx ByteString++{-# INLINE digestSize #-}+digestSize :: Int+digestSize = 20++{-# INLINE sizeCtx #-}+sizeCtx :: Int+sizeCtx = 96++{-# RULES "digestSize" B.length (finalize init) = digestSize #-}+{-# RULES "hash" forall b. finalize (update init b) = hash b #-}+{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}+{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}+{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}++{-# INLINE withByteStringPtr #-}+withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteStringPtr b f =+    withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)+    where (fptr, off, _) = toForeignPtr b++{-# INLINE memcopy64 #-}+memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()+memcopy64 dst src = mapM_ peekAndPoke [0..(12-1)]+    where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i++withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx+withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx+    where createCtx = create sizeCtx $ \dstPtr ->+                      withByteStringPtr ctxB $ \srcPtr -> do+                          memcopy64 (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+        memcopy64 (castPtr dstPtr) (castPtr srcPtr)+        f (castPtr dstPtr)++withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx+withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)++withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a+withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)++foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_init"+    c_sha1_init :: Ptr Ctx -> IO ()++foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_update"+    c_sha1_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()++foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_finalize"+    c_sha1_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()++updateInternalIO :: Ptr Ctx -> ByteString -> IO ()+updateInternalIO ptr d =+    unsafeUseAsCStringLen d (\(cs, len) -> c_sha1_update ptr (castPtr cs) (fromIntegral len))++finalizeInternalIO :: Ptr Ctx -> IO ByteString+finalizeInternalIO ptr = create digestSize (c_sha1_finalize ptr)++{-# NOINLINE init #-}+-- | init a context+init :: Ctx+init = unsafeDoIO $ withCtxNew $ c_sha1_init++{-# NOINLINE update #-}+-- | update a context with a bytestring+update :: Ctx -> ByteString -> Ctx+update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d++{-# NOINLINE updates #-}+-- | updates a context with multiples bytestring+updates :: Ctx -> [ByteString] -> Ctx+updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d++{-# NOINLINE finalize #-}+-- | finalize the context into a digest bytestring+finalize :: Ctx -> ByteString+finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO++{-# NOINLINE hash #-}+-- | hash a strict bytestring into a digest bytestring+hash :: ByteString -> ByteString+hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do+    c_sha1_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr++{-# NOINLINE hashlazy #-}+-- | hash a lazy bytestring into a digest bytestring+hashlazy :: L.ByteString -> ByteString+hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do+    c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2010-2014 Vincent Hanquez <vincent@snarc.org>+              2016      Herbert Valerio Riedel <hvr@gnu.org>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Tests/KAT.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+import Data.Char+import Data.Bits+import Data.Word+import Data.ByteString (ByteString)+import Data.Foldable (foldl')+import Data.Monoid (mconcat)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Crypto.Hash.SHA1 as SHA1++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit++v0,v1,v2 :: ByteString+v0 = ""+v1 = "The quick brown fox jumps over the lazy dog"+v2 = "The quick brown fox jumps over the lazy cog"+vectors = [ v0, v1, v2 ]++instance Arbitrary ByteString where+    arbitrary = B.pack `fmap` arbitrary++data HashFct = HashFct+    { fctHash   :: (B.ByteString -> B.ByteString)+    , fctInc    :: ([B.ByteString] -> B.ByteString) }++hashinc i u f = f . foldl u i++sha1Hash = HashFct { fctHash = SHA1.hash, fctInc = hashinc SHA1.init SHA1.update SHA1.finalize }+++results :: [ (String, HashFct, [String]) ]+results = [+    ("SHA1", sha1Hash, [+        "da39a3ee5e6b4b0d3255bfef95601890afd80709",+        "2fd4e1c67a2d28fced849ee1bb76e7391b93eb12",+        "de9f2c7fd25e1b3afad3e85a0bd17d9b100db4b3" ])+    ]++hexalise s = concatMap (\c -> [ hex $ c `div` 16, hex $ c `mod` 16 ]) s+        where hex i+                | i >= 0 && i <= 9   = fromIntegral (ord '0') + i+                | i >= 10 && i <= 15 = fromIntegral (ord 'a') + i - 10+                | otherwise          = 0++hexaliseB :: B.ByteString -> B.ByteString+hexaliseB = B.pack . hexalise . B.unpack++splitB :: Int -> ByteString -> [ByteString]+splitB l b =+    if B.length b > l+        then+            let (b1, b2) = B.splitAt l b in+            b1 : splitB l b2+        else+            [ b ]++showHash :: B.ByteString -> String+showHash = map (toEnum.fromEnum) . hexalise . B.unpack++runhash hash v = showHash $ (fctHash hash) $ v+runhashinc hash v = showHash $ (fctInc hash) $ v++makeTestAlg (name, hash, results) = testGroup name $ concatMap maketest (zip3 [0..] vectors results)+    where+        runtest :: ByteString -> String+        runtest v = runhash hash v++        runtestinc :: Int -> ByteString -> String+        runtestinc i v = runhashinc hash $ splitB i v++        maketest (i, v, r) =+            [ testCase (show i ++ " one-pass") (r @=? runtest v)+            , testCase (show i ++ " inc 1") (r @=? runtestinc 1 v)+            , testCase (show i ++ " inc 2") (r @=? runtestinc 2 v)+            , testCase (show i ++ " inc 3") (r @=? runtestinc 3 v)+            , testCase (show i ++ " inc 4") (r @=? runtestinc 4 v)+            , testCase (show i ++ " inc 5") (r @=? runtestinc 5 v)+            , testCase (show i ++ " inc 9") (r @=? runtestinc 9 v)+            , testCase (show i ++ " inc 16") (r @=? runtestinc 16 v)+            ]++katTests :: [TestTree]+katTests = map makeTestAlg results+++main = defaultMain $ testGroup "cryptohash"+    [ testGroup "KATs" katTests+    ]
+ cbits/bitfn.h view
@@ -0,0 +1,240 @@+/*+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ */++#ifndef BITFN_H+#define BITFN_H+#include <stdint.h>++#ifndef NO_INLINE_ASM+/**********************************************************/+# if (defined(__i386__))+#  define ARCH_HAS_SWAP32+static inline uint32_t bitfn_swap32(uint32_t a)+{+	asm ("bswap %0" : "=r" (a) : "0" (a));+	return a;+}+/**********************************************************/+# elif (defined(__arm__))+#  define ARCH_HAS_SWAP32+static inline uint32_t bitfn_swap32(uint32_t a)+{+	uint32_t tmp = a;+	asm volatile ("eor %1, %0, %0, ror #16\n"+	              "bic %1, %1, #0xff0000\n"+	              "mov %0, %0, ror #8\n"+	              "eor %0, %0, %1, lsr #8\n"+	             : "=r" (a), "=r" (tmp) : "0" (a), "1" (tmp));+	return a;+}+/**********************************************************/+# elif defined(__x86_64__)+#  define ARCH_HAS_SWAP32+#  define ARCH_HAS_SWAP64+static inline uint32_t bitfn_swap32(uint32_t a)+{+	asm ("bswap %0" : "=r" (a) : "0" (a));+	return a;+}++static inline uint64_t bitfn_swap64(uint64_t a)+{+	asm ("bswap %0" : "=r" (a) : "0" (a));+	return a;+}++# endif+#endif /* NO_INLINE_ASM */+/**********************************************************/++#ifndef ARCH_HAS_ROL32+static inline uint32_t rol32(uint32_t word, uint32_t shift)+{+	return (word << shift) | (word >> (32 - shift));+}+#endif++#ifndef ARCH_HAS_ROR32+static inline uint32_t ror32(uint32_t word, uint32_t shift)+{+	return (word >> shift) | (word << (32 - shift));+}+#endif++#ifndef ARCH_HAS_ROL64+static inline uint64_t rol64(uint64_t word, uint32_t shift)+{+	return (word << shift) | (word >> (64 - shift));+}+#endif++#ifndef ARCH_HAS_ROR64+static inline uint64_t ror64(uint64_t word, uint32_t shift)+{+	return (word >> shift) | (word << (64 - shift));+}+#endif++#ifndef ARCH_HAS_SWAP32+static inline uint32_t bitfn_swap32(uint32_t a)+{+	return (a << 24) | ((a & 0xff00) << 8) | ((a >> 8) & 0xff00) | (a >> 24);+}+#endif++#ifndef ARCH_HAS_ARRAY_SWAP32+static inline void array_swap32(uint32_t *d, uint32_t *s, uint32_t nb)+{+	while (nb--)+		*d++ = bitfn_swap32(*s++);+}+#endif++#ifndef ARCH_HAS_SWAP64+static inline uint64_t bitfn_swap64(uint64_t a)+{+	return ((uint64_t) bitfn_swap32((uint32_t) (a >> 32))) |+	       (((uint64_t) bitfn_swap32((uint32_t) a)) << 32);+}+#endif++#ifndef ARCH_HAS_ARRAY_SWAP64+static inline void array_swap64(uint64_t *d, uint64_t *s, uint32_t nb)+{+	while (nb--)+		*d++ = bitfn_swap64(*s++);+}+#endif++#ifndef ARCH_HAS_MEMORY_ZERO+static inline void memory_zero(void *ptr, uint32_t len)+{+	uint32_t *ptr32 = ptr;+	uint8_t *ptr8;+	int i;++	for (i = 0; i < len / 4; i++)+		*ptr32++ = 0;+	if (len % 4) {+		ptr8 = (uint8_t *) ptr32;+		for (i = len % 4; i >= 0; i--)+			ptr8[i] = 0;+	}+}+#endif++#ifndef ARCH_HAS_ARRAY_COPY32+static inline void array_copy32(uint32_t *d, uint32_t *s, uint32_t nb)+{+	while (nb--) *d++ = *s++;+}+#endif++#ifndef ARCH_HAS_ARRAY_COPY64+static inline void array_copy64(uint64_t *d, uint64_t *s, uint32_t nb)+{+	while (nb--) *d++ = *s++;+}+#endif++#ifdef __MINGW32__+  # define LITTLE_ENDIAN 1234+  # define BYTE_ORDER    LITTLE_ENDIAN+#elif defined(__FreeBSD__) || defined(__DragonFly__) || defined(__NetBSD__)+  # include <sys/endian.h>+#elif defined(__OpenBSD__) || defined(__SVR4)+  # include <sys/types.h>+#elif defined(__APPLE__)+  # include <machine/endian.h>+#elif defined( BSD ) && ( BSD >= 199103 )+  # include <machine/endian.h>+#elif defined( __QNXNTO__ ) && defined( __LITTLEENDIAN__ )+  # define LITTLE_ENDIAN 1234+  # define BYTE_ORDER    LITTLE_ENDIAN+#elif defined( __QNXNTO__ ) && defined( __BIGENDIAN__ )+  # define BIG_ENDIAN 1234+  # define BYTE_ORDER    BIG_ENDIAN+#elif defined( _AIX )+  # include <sys/machine.h>+#else+  # include <endian.h>+#endif+/* big endian to cpu */+#if LITTLE_ENDIAN == BYTE_ORDER++# define be32_to_cpu(a) bitfn_swap32(a)+# define cpu_to_be32(a) bitfn_swap32(a)+# define le32_to_cpu(a) (a)+# define cpu_to_le32(a) (a)+# define be64_to_cpu(a) bitfn_swap64(a)+# define cpu_to_be64(a) bitfn_swap64(a)+# define le64_to_cpu(a) (a)+# define cpu_to_le64(a) (a)++# define cpu_to_le32_array(d, s, l) array_copy32(d, s, l)+# define le32_to_cpu_array(d, s, l) array_copy32(d, s, l)+# define cpu_to_be32_array(d, s, l) array_swap32(d, s, l)+# define be32_to_cpu_array(d, s, l) array_swap32(d, s, l)++# define cpu_to_le64_array(d, s, l) array_copy64(d, s, l)+# define le64_to_cpu_array(d, s, l) array_copy64(d, s, l)+# define cpu_to_be64_array(d, s, l) array_swap64(d, s, l)+# define be64_to_cpu_array(d, s, l) array_swap64(d, s, l)++# define ror32_be(a, s) rol32(a, s)+# define rol32_be(a, s) ror32(a, s)++# define ARCH_IS_LITTLE_ENDIAN++#elif BIG_ENDIAN == BYTE_ORDER++# define be32_to_cpu(a) (a)+# define cpu_to_be32(a) (a)+# define be64_to_cpu(a) (a)+# define cpu_to_be64(a) (a)+# define le64_to_cpu(a) bitfn_swap64(a)+# define cpu_to_le64(a) bitfn_swap64(a)+# define le32_to_cpu(a) bitfn_swap32(a)+# define cpu_to_le32(a) bitfn_swap32(a)++# define cpu_to_le32_array(d, s, l) array_swap32(d, s, l)+# define le32_to_cpu_array(d, s, l) array_swap32(d, s, l)+# define cpu_to_be32_array(d, s, l) array_copy32(d, s, l)+# define be32_to_cpu_array(d, s, l) array_copy32(d, s, l)++# define cpu_to_le64_array(d, s, l) array_swap64(d, s, l)+# define le64_to_cpu_array(d, s, l) array_swap64(d, s, l)+# define cpu_to_be64_array(d, s, l) array_copy64(d, s, l)+# define be64_to_cpu_array(d, s, l) array_copy64(d, s, l)++# define ror32_be(a, s) ror32(a, s)+# define rol32_be(a, s) rol32(a, s)++# define ARCH_IS_BIG_ENDIAN++#else+# error "endian not supported"+#endif++#endif /* !BITFN_H */
+ cbits/sha1.c view
@@ -0,0 +1,214 @@+/*+ * 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 <string.h>+#include "sha1.h"+#include "bitfn.h"++void +hs_cryptohash_sha1_init(struct sha1_ctx *ctx)+{+	memset(ctx, 0, sizeof(*ctx));++	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 inline void +sha1_do_chunk(struct sha1_ctx *ctx, uint32_t *buf)+{+	uint32_t a, b, c, d, e;+	uint32_t w[16];+#define CPY(i)	w[i] = be32_to_cpu(buf[i])+	CPY(0); CPY(1); CPY(2); CPY(3); CPY(4); CPY(5); CPY(6); CPY(7);+	CPY(8); CPY(9); CPY(10); CPY(11); CPY(12); CPY(13); CPY(14); CPY(15);+#undef CPY++	a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; 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;+}++void +hs_cryptohash_sha1_update(struct sha1_ctx *ctx, uint8_t *data, uint32_t len)+{+	uint32_t index, to_fill;++	index = (uint32_t) (ctx->sz & 0x3f);+	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, (uint32_t *) ctx->buf);+		len -= to_fill;+		data += to_fill;+		index = 0;+	}++	/* process as much 64-block as possible */+	for (; len >= 64; len -= 64, data += 64)+		sha1_do_chunk(ctx, (uint32_t *) data);++	/* append data into buf */+	if (len)+		memcpy(ctx->buf + index, data, len);+}++void+hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out)+{+	static uint8_t padding[64] = { 0x80, };+	uint64_t bits;+	uint32_t index, padlen;+	uint32_t *p = (uint32_t *) out;++	/* add padding and update data with it */+	bits = cpu_to_be64(ctx->sz << 3);++	/* pad out to 56 */+	index = (uint32_t) (ctx->sz & 0x3f);+	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 */+	p[0] = cpu_to_be32(ctx->h[0]);+	p[1] = cpu_to_be32(ctx->h[1]);+	p[2] = cpu_to_be32(ctx->h[2]);+	p[3] = cpu_to_be32(ctx->h[3]);+	p[4] = cpu_to_be32(ctx->h[4]);+}
+ cbits/sha1.h view
@@ -0,0 +1,45 @@+/*+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>+ *               2016      Herbert Valerio Riedel <hvr@gnu.org>+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ */++#ifndef CRYPTOHASH_SHA1_H+#define CRYPTOHASH_SHA1_H++#include <stdint.h>++struct sha1_ctx+{+	uint64_t sz;+	uint8_t  buf[64];+	uint32_t h[5];+};++#define SHA1_DIGEST_SIZE	20+#define SHA1_CTX_SIZE 		(sizeof(struct sha1_ctx))++void hs_cryptohash_sha1_init(struct sha1_ctx *ctx);+void hs_cryptohash_sha1_update(struct sha1_ctx *ctx, uint8_t *data, uint32_t len);+void hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out);++#endif
+ changelog.md view
@@ -0,0 +1,3 @@+## 0.11.7.1++ - first version forked off `cryptohash-0.11.7` release
+ cryptohash-sha1.cabal view
@@ -0,0 +1,74 @@+name:                cryptohash-sha1+version:             0.11.7.1+description:+    A practical incremental and one-pass, pure API to the+    <https://en.wikipedia.org/wiki/SHA-1 SHA-1 hash algorithm>+    with performance close to the fastest implementations available in other languages.+    .+    The implementation is made in C with a haskell FFI wrapper that hides the C implementation.+    .+    NOTE: This package has been forked off @cryptohash-0.11.7@ because the @cryptohash@ package has been+    deprecated and so this package continues to satisfy the need for a lightweight package+    providing the SHA1 hash algorithm without any dependencies on packages other than+    @base@ and @bytestring@.+    .+    Consequently, this package can be used as a drop-in replacement for @cryptohash@'s+    "Crypto.Hash.SHA1" module, though with a clearly smaller footprint.++license:             BSD3+license-file:        LICENSE+copyright:           Vincent Hanquez, Herbert Valerio Riedel+maintainer:          Herbert Valerio Riedel <hvr@gnu.org>+homepage:            https://github.com/hvr/cryptohash-sha1+bug-reports:         https://github.com/hvr/cryptohash-sha1/issues+synopsis:            Fast, pure and practical SHA-1 implementation+category:            Data, Cryptography+build-type:          Simple+cabal-version:       >=1.10+tested-with:         GHC == 7.4.2+                   , GHC == 7.6.3+                   , GHC == 7.8.4+                   , GHC == 7.10.3+                   , GHC == 8.0.1++extra-source-files:  cbits/bitfn.h+                     cbits/sha1.h+                     changelog.md++source-repository head+  type:     git+  location: https://github.com/hvr/cryptohash-sha1.git++library+  default-language:  Haskell2010+  build-depends:     base             >= 4.5   && < 4.10+                   , bytestring       >= 0.9.2 && < 0.11++  exposed-modules:   Crypto.Hash.SHA1+  ghc-options:       -Wall -fno-cse -O2+  cc-options:        -O3+  c-sources:         cbits/sha1.c+  include-dirs:      cbits++test-suite test-sha1+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  hs-source-dirs:    Tests+  main-is:           KAT.hs+  build-depends:     cryptohash-sha1+                   , base+                   , bytestring++                   , tasty            == 0.11.*+                   , tasty-quickcheck == 0.8.*+                   , tasty-hunit      == 0.9.*++benchmark bench-sha1+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  main-is:           Bench.hs+  hs-source-dirs:    Bench+  build-depends:     cryptohash-sha1+                   , base+                   , bytestring+                   , criterion        == 1.1.*