cryptohash-md5 (empty) → 0.11.7.1
raw patch · 10 files changed
+928/−0 lines, 10 filesdep +basedep +bytestringdep +criterionsetup-changed
Dependencies added: base, bytestring, criterion, cryptohash-md5, tasty, tasty-hunit, tasty-quickcheck
Files
- Bench/Bench.hs +33/−0
- Bench/BenchAPI.hs +39/−0
- Crypto/Hash/MD5.hs +184/−0
- LICENSE +28/−0
- Setup.hs +2/−0
- Tests/KAT.hs +92/−0
- cbits/bitfn.h +240/−0
- cbits/md5.c +183/−0
- cbits/md5.h +45/−0
- cryptohash-md5.cabal +82/−0
+ 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.MD5 as MD5++hashmany (i,u,f) = f . foldl u i++allHashs =+ [ ("MD5",MD5.hash, hashmany (MD5.init,MD5.update,MD5.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))+ ]
+ Bench/BenchAPI.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE BangPatterns #-}+import Criterion.Main+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Crypto.Hash.MD5 as MD5++md5F = ( "MD5"+ , MD5.hash+ , MD5.finalize . MD5.update MD5.init+ )++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])++ let (fname, fHash, fIncr) = md5F+ let benchName ty z = fname ++ "." ++ ty -- ++ " " ++ show z+ defaultMain+ [ bgroup "hash-0b"+ [ bench (benchName "hash" 0) $ whnf fHash B.empty+ , bench (benchName "incr" 0) $ whnf fIncr B.empty+ ]+ , bgroup "hash-32b"+ [ bench (benchName "hash" 32) $ whnf fHash bs32+ , bench (benchName "incr" 32) $ whnf fIncr bs32+ ]+ , bgroup "hash-256b"+ [ bench (benchName "hash" 256) $ whnf fHash bs256+ , bench (benchName "incr" 256) $ whnf fIncr bs256+ ]+ , bgroup "hash-4Kb"+ [ bench (benchName "hash" 4096) $ whnf fHash bs4096+ , bench (benchName "incr" 4096) $ whnf fIncr bs4096+ ]+ ]
+ Crypto/Hash/MD5.hs view
@@ -0,0 +1,184 @@+-- |+-- Module : Crypto.Hash.MD5+-- License : BSD-style+-- Maintainer : Herbert Valerio Riedel <hvr@gnu.org>+-- Stability : stable+-- Portability : unknown+--+-- A module containing <https://en.wikipedia.org/wiki/MD5 MD5> bindings+--+module Crypto.Hash.MD5+ (++ -- * 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.MD5 as MD5+ -- >+ -- > main = print digest+ -- > where+ -- > digest = MD5.finalize ctx+ -- > ctx = foldl MD5.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ])+ -- > ctx0 = MD5.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.MD5 as MD5+ -- >+ -- > main = print $ MD5.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++-- | MD5 Context+newtype Ctx = Ctx ByteString++{-# INLINE digestSize #-}+digestSize :: Int+digestSize = 16++{-# 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 "md5.h hs_cryptohash_md5_init"+ c_md5_init :: Ptr Ctx -> IO ()++foreign import ccall unsafe "md5.h hs_cryptohash_md5_update"+ c_md5_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()++foreign import ccall unsafe "md5.h hs_cryptohash_md5_finalize"+ c_md5_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()++updateInternalIO :: Ptr Ctx -> ByteString -> IO ()+updateInternalIO ptr d =+ unsafeUseAsCStringLen d (\(cs, len) -> c_md5_update ptr (castPtr cs) (fromIntegral len))++finalizeInternalIO :: Ptr Ctx -> IO ByteString+finalizeInternalIO ptr = create digestSize (c_md5_finalize ptr)++{-# NOINLINE init #-}+-- | init a context+init :: Ctx+init = unsafeDoIO $ withCtxNew $ c_md5_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_md5_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_md5_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.MD5 as MD5++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++md5Hash = HashFct { fctHash = MD5.hash, fctInc = hashinc MD5.init MD5.update MD5.finalize }+++results :: [ (String, HashFct, [String]) ]+results = [+ ("MD5", md5Hash, [+ "d41d8cd98f00b204e9800998ecf8427e",+ "9e107d9d372bb6826bd81d3542a419d6",+ "1055d3e698d289f2af8663725127bd4b" ])+ ]++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/md5.c view
@@ -0,0 +1,183 @@+/*+ * 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 <stdio.h>+#include "bitfn.h"+#include "md5.h"++void+hs_cryptohash_md5_init(struct md5_ctx *ctx)+{+ memset(ctx, 0, sizeof(*ctx));++ ctx->sz = 0ULL;+ ctx->h[0] = 0x67452301;+ ctx->h[1] = 0xefcdab89;+ ctx->h[2] = 0x98badcfe;+ ctx->h[3] = 0x10325476;+}++#define f1(x, y, z) (z ^ (x & (y ^ z)))+#define f2(x, y, z) f1(z, x, y)+#define f3(x, y, z) (x ^ y ^ z)+#define f4(x, y, z) (y ^ (x | ~z))+#define R(f, a, b, c, d, i, k, s) a += f(b, c, d) + w[i] + k; a = rol32(a, s); a += b++static void+md5_do_chunk(struct md5_ctx *ctx, uint32_t *buf)+{+ uint32_t a, b, c, d;+#ifdef ARCH_IS_BIG_ENDIAN+ uint32_t w[16];+ cpu_to_le32_array(w, buf, 16);+#else+ uint32_t *w = buf;+#endif+ a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3];++ R(f1, a, b, c, d, 0, 0xd76aa478, 7);+ R(f1, d, a, b, c, 1, 0xe8c7b756, 12);+ R(f1, c, d, a, b, 2, 0x242070db, 17);+ R(f1, b, c, d, a, 3, 0xc1bdceee, 22);+ R(f1, a, b, c, d, 4, 0xf57c0faf, 7);+ R(f1, d, a, b, c, 5, 0x4787c62a, 12);+ R(f1, c, d, a, b, 6, 0xa8304613, 17);+ R(f1, b, c, d, a, 7, 0xfd469501, 22);+ R(f1, a, b, c, d, 8, 0x698098d8, 7);+ R(f1, d, a, b, c, 9, 0x8b44f7af, 12);+ R(f1, c, d, a, b, 10, 0xffff5bb1, 17);+ R(f1, b, c, d, a, 11, 0x895cd7be, 22);+ R(f1, a, b, c, d, 12, 0x6b901122, 7);+ R(f1, d, a, b, c, 13, 0xfd987193, 12);+ R(f1, c, d, a, b, 14, 0xa679438e, 17);+ R(f1, b, c, d, a, 15, 0x49b40821, 22);++ R(f2, a, b, c, d, 1, 0xf61e2562, 5);+ R(f2, d, a, b, c, 6, 0xc040b340, 9);+ R(f2, c, d, a, b, 11, 0x265e5a51, 14);+ R(f2, b, c, d, a, 0, 0xe9b6c7aa, 20);+ R(f2, a, b, c, d, 5, 0xd62f105d, 5);+ R(f2, d, a, b, c, 10, 0x02441453, 9);+ R(f2, c, d, a, b, 15, 0xd8a1e681, 14);+ R(f2, b, c, d, a, 4, 0xe7d3fbc8, 20);+ R(f2, a, b, c, d, 9, 0x21e1cde6, 5);+ R(f2, d, a, b, c, 14, 0xc33707d6, 9);+ R(f2, c, d, a, b, 3, 0xf4d50d87, 14);+ R(f2, b, c, d, a, 8, 0x455a14ed, 20);+ R(f2, a, b, c, d, 13, 0xa9e3e905, 5);+ R(f2, d, a, b, c, 2, 0xfcefa3f8, 9);+ R(f2, c, d, a, b, 7, 0x676f02d9, 14);+ R(f2, b, c, d, a, 12, 0x8d2a4c8a, 20);++ R(f3, a, b, c, d, 5, 0xfffa3942, 4);+ R(f3, d, a, b, c, 8, 0x8771f681, 11);+ R(f3, c, d, a, b, 11, 0x6d9d6122, 16);+ R(f3, b, c, d, a, 14, 0xfde5380c, 23);+ R(f3, a, b, c, d, 1, 0xa4beea44, 4);+ R(f3, d, a, b, c, 4, 0x4bdecfa9, 11);+ R(f3, c, d, a, b, 7, 0xf6bb4b60, 16);+ R(f3, b, c, d, a, 10, 0xbebfbc70, 23);+ R(f3, a, b, c, d, 13, 0x289b7ec6, 4);+ R(f3, d, a, b, c, 0, 0xeaa127fa, 11);+ R(f3, c, d, a, b, 3, 0xd4ef3085, 16);+ R(f3, b, c, d, a, 6, 0x04881d05, 23);+ R(f3, a, b, c, d, 9, 0xd9d4d039, 4);+ R(f3, d, a, b, c, 12, 0xe6db99e5, 11);+ R(f3, c, d, a, b, 15, 0x1fa27cf8, 16);+ R(f3, b, c, d, a, 2, 0xc4ac5665, 23);++ R(f4, a, b, c, d, 0, 0xf4292244, 6);+ R(f4, d, a, b, c, 7, 0x432aff97, 10);+ R(f4, c, d, a, b, 14, 0xab9423a7, 15);+ R(f4, b, c, d, a, 5, 0xfc93a039, 21);+ R(f4, a, b, c, d, 12, 0x655b59c3, 6);+ R(f4, d, a, b, c, 3, 0x8f0ccc92, 10);+ R(f4, c, d, a, b, 10, 0xffeff47d, 15);+ R(f4, b, c, d, a, 1, 0x85845dd1, 21);+ R(f4, a, b, c, d, 8, 0x6fa87e4f, 6);+ R(f4, d, a, b, c, 15, 0xfe2ce6e0, 10);+ R(f4, c, d, a, b, 6, 0xa3014314, 15);+ R(f4, b, c, d, a, 13, 0x4e0811a1, 21);+ R(f4, a, b, c, d, 4, 0xf7537e82, 6);+ R(f4, d, a, b, c, 11, 0xbd3af235, 10);+ R(f4, c, d, a, b, 2, 0x2ad7d2bb, 15);+ R(f4, b, c, d, a, 9, 0xeb86d391, 21);++ ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d;+}++void+hs_cryptohash_md5_update(struct md5_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;++ if (index && len >= to_fill) {+ memcpy(ctx->buf + index, data, to_fill);+ md5_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)+ md5_do_chunk(ctx, (uint32_t *) data);++ /* append data into buf */+ if (len)+ memcpy(ctx->buf + index, data, len);+}++void+hs_cryptohash_md5_finalize(struct md5_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_le64(ctx->sz << 3);++ /* pad out to 56 */+ index = (uint32_t) (ctx->sz & 0x3f);+ padlen = (index < 56) ? (56 - index) : ((64 + 56) - index);+ hs_cryptohash_md5_update(ctx, padding, padlen);++ /* append length */+ hs_cryptohash_md5_update(ctx, (uint8_t *) &bits, sizeof(bits));++ /* output hash */+ p[0] = cpu_to_le32(ctx->h[0]);+ p[1] = cpu_to_le32(ctx->h[1]);+ p[2] = cpu_to_le32(ctx->h[2]);+ p[3] = cpu_to_le32(ctx->h[3]);+}
+ cbits/md5.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_MD5_H+#define CRYPTOHASH_MD5_H++#include <stdint.h>++struct md5_ctx+{+ uint64_t sz;+ uint8_t buf[64];+ uint32_t h[4];+};++#define MD5_DIGEST_SIZE 16+#define MD5_CTX_SIZE sizeof(struct md5_ctx)++void hs_cryptohash_md5_init(struct md5_ctx *ctx);+void hs_cryptohash_md5_update(struct md5_ctx *ctx, uint8_t *data, uint32_t len);+void hs_cryptohash_md5_finalize(struct md5_ctx *ctx, uint8_t *out);++#endif
+ cryptohash-md5.cabal view
@@ -0,0 +1,82 @@+name: cryptohash-md5+version: 0.11.7.1+description:+ A practical incremental and one-pass, pure API to the+ <https://en.wikipedia.org/wiki/MD5 MD5 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 MD5 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.MD5" 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-md5+bug-reports: https://github.com/hvr/cryptohash-md5/issues+synopsis: Fast, pure and practical MD5 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/md5.h++source-repository head+ type: git+ location: https://github.com/hvr/cryptohash-md5.git++library+ default-language: Haskell2010+ build-depends: base >= 4.5 && < 4.10+ , bytestring >= 0.9.2 && < 0.11++ exposed-modules: Crypto.Hash.MD5+ ghc-options: -Wall -fno-cse -O2+ cc-options: -O3+ c-sources: cbits/md5.c+ include-dirs: cbits++test-suite test-kat+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: Tests+ main-is: KAT.hs+ build-depends: cryptohash-md5+ , base+ , bytestring+ , tasty == 0.11.*+ , tasty-quickcheck == 0.8.*+ , tasty-hunit == 0.9.*++benchmark bench-hashes+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ hs-source-dirs: Bench+ build-depends: cryptohash-md5+ , base+ , bytestring+ , criterion == 1.1.*++benchmark bench-api+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: BenchAPI.hs+ hs-source-dirs: Bench+ build-depends: cryptohash-md5+ , base+ , bytestring+ , criterion == 1.1.*