cryptohash-sha1-0.11.100.1/0000755000000000000000000000000012734421647013307 5ustar0000000000000000cryptohash-sha1-0.11.100.1/LICENSE0000644000000000000000000000302612734421647014315 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-sha1-0.11.100.1/Setup.hs0000644000000000000000000000005612734421647014744 0ustar0000000000000000import Distribution.Simple main = defaultMain cryptohash-sha1-0.11.100.1/cryptohash-sha1.cabal0000644000000000000000000000561012734421647017313 0ustar0000000000000000name: cryptohash-sha1 version: 0.11.100.1 description: A practical incremental and one-pass, pure API to the (including support) 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/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 hs-source-dirs: src exposed-modules: Crypto.Hash.SHA1 ghc-options: -Wall -fno-cse -O2 cc-options: -Wall -O3 c-sources: cbits/sha1.c include-dirs: cbits test-suite test-sha1 default-language: Haskell2010 other-extensions: OverloadedStrings type: exitcode-stdio-1.0 hs-source-dirs: src-tests main-is: test-sha1.hs build-depends: cryptohash-sha1 , base , bytestring , base16-bytestring >= 0.1.1 && < 0.2 , SHA >= 1.6.4 && < 1.7 , 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-sha1.hs hs-source-dirs: src-bench build-depends: cryptohash-sha1 , base , bytestring , criterion == 1.1.* cryptohash-sha1-0.11.100.1/changelog.md0000644000000000000000000000110712734421647015557 0ustar0000000000000000## 0.11.100.1 - Use `__builtin_bswap{32,64}` only with GCC >= 4.3 ## 0.11.100.0 - new `hmac` and `hmaclazy` functions providing HMAC-SHA1 computation conforming to RFC2104 and RFC2202 ## 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 - fix unaligned memory-accesses ## 0.11.7.1 - first version forked off `cryptohash-0.11.7` release cryptohash-sha1-0.11.100.1/src/0000755000000000000000000000000012734421647014076 5ustar0000000000000000cryptohash-sha1-0.11.100.1/src/Crypto/0000755000000000000000000000000012734421647015356 5ustar0000000000000000cryptohash-sha1-0.11.100.1/src/Crypto/Hash/0000755000000000000000000000000012734421647016241 5ustar0000000000000000cryptohash-sha1-0.11.100.1/src/Crypto/Hash/SHA1.hs0000644000000000000000000002175012734421647017276 0ustar0000000000000000-- | -- 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 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.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 -- :: L.ByteString -> ByteString -- ** HMAC-SHA1 -- -- | -compatible -- -SHA1 digests , hmac -- :: ByteString -> ByteString -> ByteString , hmaclazy -- :: ByteString -> L.ByteString -> ByteString ) where import Prelude hiding (init) import Foreign.C.Types import Foreign.Ptr import Foreign.ForeignPtr (withForeignPtr) 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, memcpy) import Data.Bits (xor) 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 -- -- The context data is exactly 92 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 5-element 'Word32' array holding the current work-in-progress digest-value. -- -- Consequently, a SHA-1 digest as produced by 'hash', 'hashlazy', or 'finalize' is 20 bytes long. newtype Ctx = Ctx ByteString -- keep this synchronised with cbits/sha1.h {-# INLINE digestSize #-} digestSize :: Int digestSize = 20 {-# INLINE sizeCtx #-} sizeCtx :: Int sizeCtx = 92 {-# 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 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) 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_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () foreign import ccall safe "sha1.h hs_cryptohash_sha1_update" c_sha1_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () -- 'safe' call overhead neglible for 8KiB and more c_sha1_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () c_sha1_update pctx pbuf sz | sz < 8192 = c_sha1_update_unsafe pctx pbuf sz | otherwise = c_sha1_update_safe pctx pbuf sz 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 #-} -- | create a new hash context init :: Ctx init = unsafeDoIO $ withCtxNew $ c_sha1_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 "SHA1.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 "SHA1.updates: invalid Ctx" {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring (20 bytes) finalize :: Ctx -> ByteString finalize ctx | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO | otherwise = error "SHA1.finalize: invalid Ctx" {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring (20 bytes) 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 (20 bytes) hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do c_sha1_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr {-# NOINLINE hmac #-} -- | Compute 20-byte -compatible -- HMAC-SHA1 digest for a strict bytestring message -- -- @since 0.11.100.0 hmac :: ByteString -- ^ secret -> ByteString -- ^ message -> ByteString hmac secret msg = hash $ B.append opad (hash $ B.append 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 {-# NOINLINE hmaclazy #-} -- | Compute 20-byte -compatible -- HMAC-SHA1 digest for a lazy bytestring message -- -- @since 0.11.100.0 hmaclazy :: ByteString -- ^ secret -> L.ByteString -- ^ message -> ByteString 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 cryptohash-sha1-0.11.100.1/cbits/0000755000000000000000000000000012734421647014413 5ustar0000000000000000cryptohash-sha1-0.11.100.1/cbits/sha1.c0000644000000000000000000002106412734421647015416 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. */ #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 *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); } cryptohash-sha1-0.11.100.1/cbits/sha1.h0000644000000000000000000000347612734421647015432 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 CRYPTOHASH_SHA1_H #define CRYPTOHASH_SHA1_H #include #include struct sha1_ctx { uint64_t sz; uint8_t buf[64]; uint32_t h[5]; }; #define SHA1_DIGEST_SIZE 20 #define SHA1_CTX_SIZE 92 /* NB: no 64-bit padding */ void hs_cryptohash_sha1_init(struct sha1_ctx *ctx); void hs_cryptohash_sha1_update(struct sha1_ctx *ctx, const uint8_t *data, size_t len); void hs_cryptohash_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out); #endif cryptohash-sha1-0.11.100.1/src-tests/0000755000000000000000000000000012734421647015236 5ustar0000000000000000cryptohash-sha1-0.11.100.1/src-tests/test-sha1.hs0000644000000000000000000001635212734421647017412 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main (main) where import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base16 as B16 -- reference implementation import qualified Data.Digest.Pure.SHA as REF -- implementation under test import qualified Crypto.Hash.SHA1 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)) [ "da39a3ee 5e6b4b0d 3255bfef 95601890 afd80709" , "2fd4e1c6 7a2d28fc ed849ee1 bb76e739 1b93eb12" , "de9f2c7f d25e1b3a fad3e85a 0bd17d9b 100db4b3" , "a9993e36 4706816a ba3e2571 7850c26c 9cd0d89d" , "84983e44 1c3bd26e baae4aa1 f95129e5 e54670f1" , "a49b2446 a02c645b f419f995 b6709125 3a04a259" , "34aa973c d4c4daa4 f61eeb2b dbad2731 6534016f" ] ansXLTest :: ByteString ansXLTest = B.filter (/= 0x20) "7789f0c9 ef7bfc40 d9331114 3dfbe69e 2017f592" katTests :: [TestTree] katTests | length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest] | otherwise = error "vectors/answers length mismatch" where makeTest (i, v, r) = testGroup ("vec"++show i) $ [ 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-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 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 -- force unaligned md5-blocks runTestLazyU :: Int -> ByteString -> ByteString runTestLazyU i = B16.encode . IUT.hashlazy . 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") splitB :: Int -> ByteString -> [ByteString] splitB l b | B.length b > l = b1 : splitB l b2 | otherwise = [b] where (b1, b2) = B.splitAt l b rfc2202Vectors :: [(ByteString,ByteString,ByteString)] rfc2202Vectors = -- (secrect,msg,mac) [ (rep 20 0x0b, "Hi There", x"b617318655057264e28bc0b6fb378c8ef146be00") , ("Jefe", "what do ya want for nothing?", x"effcdf6ae5eb2fa2d27416d5f184df9c259a7c79") , (rep 20 0xaa, rep 50 0xdd, x"125d7342b9ac11cd91a39af48aa17b4f63f175d3") , (B.pack [1..25], rep 50 0xcd, x"4c9007f4026250c6bc8414f9bf50c86c2d7235da") , (rep 20 0x0c, "Test With Truncation", x"4c1a03424b55e07fe7f27be1d58bb9324a9a5a04") , (rep 80 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"aa4ae5e15272d00e95705637ce8a3b55ed402112") , (rep 80 0xaa, "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data", x"e8e99d0f45237d786d6bbaa7965c7808bbff1a91") , (rep 80 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"aa4ae5e15272d00e95705637ce8a3b55ed402112") , (rep 80 0xaa, "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data", x"e8e99d0f45237d786d6bbaa7965c7808bbff1a91") ] where x = fst.B16.decode rep n c = B.replicate n c rfc2202Tests = zipWith makeTest [1::Int ..] rfc2202Vectors 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 -- 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 "hashlazy" prop_hashlazy , testProperty "hmac" prop_hmac , testProperty "hmaclazy" prop_hmaclazy ] where prop_hash (RandBS bs) = ref_hash bs == IUT.hash bs prop_hashlazy (RandLBS bs) = ref_hashlazy bs == IUT.hashlazy 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 ref_hash :: ByteString -> ByteString ref_hash = ref_hashlazy . fromStrict ref_hashlazy :: BL.ByteString -> ByteString ref_hashlazy = toStrict . REF.bytestringDigest . REF.sha1 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.hmacSha1 (fromStrict secret) -- toStrict/fromStrict only available with bytestring-0.10 and later toStrict = B.concat . BL.toChunks fromStrict = BL.fromChunks . (:[]) main :: IO () main = defaultMain $ testGroup "cryptohash-sha1" [ testGroup "KATs" katTests , testGroup "RFC2202" rfc2202Tests , testGroup "REF" refImplTests ] cryptohash-sha1-0.11.100.1/src-bench/0000755000000000000000000000000012734421647015153 5ustar0000000000000000cryptohash-sha1-0.11.100.1/src-bench/bench-sha1.hs0000644000000000000000000000214012734421647017415 0ustar0000000000000000import Criterion.Main import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L benchSize :: Int -> Benchmark benchSize sz = bs `seq` bench msg (whnf SHA1.hash bs) where bs = 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-sha1" [ benchSize 0 , benchSize 8 , benchSize 32 , benchSize 64 , benchSize 128 , benchSize 256 , benchSize 1024 , benchSize 4096 , benchSize 8192 , benchSize 16384 , benchSize (128*1024) , benchSize (1024*1024) , benchSize (2*1024*1024) , benchSize (4*1024*1024) , L.length lbs64x256 `seq` bench "lbs64x256" (whnf SHA1.hashlazy lbs64x256) , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf SHA1.hashlazy lbs64x4096) ] ]