diff --git a/Bench/Bench.hs b/Bench/Bench.hs new file mode 100644 --- /dev/null +++ b/Bench/Bench.hs @@ -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)) + ] diff --git a/Crypto/Hash/SHA1.hs b/Crypto/Hash/SHA1.hs new file mode 100644 --- /dev/null +++ b/Crypto/Hash/SHA1.hs @@ -0,0 +1,184 @@ +-- | +-- Module : Crypto.Hash.SHA1 +-- License : BSD-style +-- Maintainer : Herbert Valerio Riedel +-- Stability : stable +-- Portability : unknown +-- +-- A module containing 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 + -- + -- 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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2010-2014 Vincent Hanquez + 2016 Herbert Valerio Riedel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Tests/KAT.hs b/Tests/KAT.hs new file mode 100644 --- /dev/null +++ b/Tests/KAT.hs @@ -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 + ] diff --git a/cbits/bitfn.h b/cbits/bitfn.h new file mode 100644 --- /dev/null +++ b/cbits/bitfn.h @@ -0,0 +1,240 @@ +/* + * Copyright (C) 2006-2009 Vincent Hanquez + * + * 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 + +#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 +#elif defined(__OpenBSD__) || defined(__SVR4) + # include +#elif defined(__APPLE__) + # include +#elif defined( BSD ) && ( BSD >= 199103 ) + # include +#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 +#else + # include +#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 */ diff --git a/cbits/sha1.c b/cbits/sha1.c new file mode 100644 --- /dev/null +++ b/cbits/sha1.c @@ -0,0 +1,214 @@ +/* + * 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 +#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]); +} diff --git a/cbits/sha1.h b/cbits/sha1.h new file mode 100644 --- /dev/null +++ b/cbits/sha1.h @@ -0,0 +1,45 @@ +/* + * 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 CRYPTOHASH_SHA1_H +#define CRYPTOHASH_SHA1_H + +#include + +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 diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +## 0.11.7.1 + + - first version forked off `cryptohash-0.11.7` release diff --git a/cryptohash-sha1.cabal b/cryptohash-sha1.cabal new file mode 100644 --- /dev/null +++ b/cryptohash-sha1.cabal @@ -0,0 +1,74 @@ +name: cryptohash-sha1 +version: 0.11.7.1 +description: + A practical incremental and one-pass, pure API to the + + 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 +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.*