cryptohash-md5-0.11.101.0/0000755000000000000000000000000007346545000013131 5ustar0000000000000000cryptohash-md5-0.11.101.0/LICENSE0000644000000000000000000000302607346545000014137 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-md5-0.11.101.0/Setup.hs0000644000000000000000000000005607346545000014566 0ustar0000000000000000import Distribution.Simple main = defaultMain cryptohash-md5-0.11.101.0/cbits/0000755000000000000000000000000007346545000014235 5ustar0000000000000000cryptohash-md5-0.11.101.0/cbits/md5.h0000644000000000000000000002067207346545000015102 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_MD5_H #define CRYPTOHASH_MD5_H #include #include #include #include #include struct md5_ctx { uint64_t sz; uint8_t buf[64]; uint32_t h[4]; }; #define MD5_DIGEST_SIZE 16 #define MD5_CTX_SIZE 88 static inline void hs_cryptohash_md5_init(struct md5_ctx *ctx); static inline void hs_cryptohash_md5_update(struct md5_ctx *ctx, const uint8_t *data, size_t len); static inline uint64_t hs_cryptohash_md5_finalize(struct md5_ctx *ctx, uint8_t *out); #if defined(static_assert) static_assert(sizeof(struct md5_ctx) == MD5_CTX_SIZE, "unexpected md5_ctx size"); #else /* poor man's pre-C11 _Static_assert */ typedef char static_assertion__unexpected_md5_ctx_size[(sizeof(struct md5_ctx) == MD5_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_le32(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_le32_array(uint32_t *dest, const uint32_t *src, unsigned wordcnt) { while (wordcnt--) *dest++ = cpu_to_le32(*src++); } static inline uint64_t cpu_to_le64(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_le32(hll & 0xffffffff) << 32LL) | cpu_to_le32(hll >> 32); #endif } static inline void hs_cryptohash_md5_init(struct md5_ctx *ctx) { memset(ctx, 0, sizeof(*ctx)); 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_aligned(struct md5_ctx *ctx, const 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]; 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; } static void md5_do_chunk(struct md5_ctx *ctx, const uint8_t buf[]) { if (ptr_uint32_aligned(buf)) { /* aligned buf */ #if WORDS_BIGENDIAN uint32_t w[16]; cpu_to_le32_array(w, (const uint32_t *)buf, 16); #else const uint32_t *w = (const uint32_t *)buf; #endif md5_do_chunk_aligned(ctx, w); } else { /* unaligned buf */ uint32_t w[16]; memcpy(w, buf, 64); #if WORDS_BIGENDIAN cpu_to_le32_array(w, w, 16); #endif md5_do_chunk_aligned(ctx, w); } } static inline void hs_cryptohash_md5_update(struct md5_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); md5_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) { md5_do_chunk(ctx, data); len -= 64; data += 64; } /* append data into buf */ if (len) memcpy(ctx->buf + index, data, len); } static inline uint64_t hs_cryptohash_md5_finalize(struct md5_ctx *ctx, uint8_t *out) { static const uint8_t padding[64] = { 0x80, }; const uint64_t sz = ctx->sz; /* add padding and update data with it */ const uint64_t bits = cpu_to_le64(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_md5_update(ctx, padding, padlen); /* append length */ hs_cryptohash_md5_update(ctx, (const uint8_t *) &bits, sizeof(bits)); /* output hash */ cpu_to_le32_array((uint32_t *) out, ctx->h, 4); return sz; } static inline void hs_cryptohash_md5_hash (const uint8_t *data, size_t len, uint8_t *out) { struct md5_ctx ctx; hs_cryptohash_md5_init(&ctx); hs_cryptohash_md5_update(&ctx, data, len); hs_cryptohash_md5_finalize(&ctx, out); } #endif cryptohash-md5-0.11.101.0/changelog.md0000644000000000000000000000170507346545000015405 0ustar0000000000000000## 0.11.101.0 - Add `Eq` instance for `Ctx` - Add `start` and `startlazy` producing `Ctx` - Remove ineffective RULES - Declare `Crypto.Hash.MD5` module `-XTrustworthy` - Convert to `CApiFFI` - Added `...AndLength` variants of hashing functions: - `finalizeAndLength` - `hashlazyAndLength` - `hmaclazyAndLength` - Minor optimizations in `hmac` and `hash` ## 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-MD5 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-md5-0.11.101.0/cryptohash-md5.cabal0000644000000000000000000000624307346545000016771 0ustar0000000000000000name: cryptohash-md5 version: 0.11.101.0 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 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 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.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.4 , GHC == 9.0.1 , GHC == 9.2.0.20210821 extra-source-files: cbits/md5.h changelog.md source-repository head type: git location: https://github.com/hvr/cryptohash-md5.git library default-language: Haskell2010 build-depends: base >= 4.5 && < 4.17 , bytestring >= 0.9.2 && < 0.12 hs-source-dirs: src exposed-modules: Crypto.Hash.MD5 other-modules: Crypto.Hash.MD5.FFI Compat ghc-options: -Wall -fno-cse -O2 cc-options: -Wall include-dirs: cbits test-suite test-md5 default-language: Haskell2010 other-extensions: OverloadedStrings type: exitcode-stdio-1.0 hs-source-dirs: src-tests main-is: test-md5.hs ghc-options: -Wall -threaded build-depends: cryptohash-md5 , base , bytestring , base16-bytestring >= 1.0.1.0 && < 1.1 , pureMD5 >= 2.1.3 && < 2.2 , tasty >= 1.4 && <1.5 , tasty-quickcheck == 0.10.* , tasty-hunit == 0.10.* benchmark bench-md5 default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: bench-md5.hs hs-source-dirs: src-bench build-depends: cryptohash-md5 , base , bytestring , criterion == 1.5.* cryptohash-md5-0.11.101.0/src-bench/0000755000000000000000000000000007346545000014775 5ustar0000000000000000cryptohash-md5-0.11.101.0/src-bench/bench-md5.hs0000644000000000000000000000217407346545000017077 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} import Criterion.Main import qualified Crypto.Hash.MD5 as MD5 import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L benchSize :: Int -> Benchmark benchSize sz = bs `seq` bench msg (whnf MD5.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-md5" [ 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 MD5.hashlazy lbs64x256) , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf MD5.hashlazy lbs64x4096) ] ] cryptohash-md5-0.11.101.0/src-tests/0000755000000000000000000000000007346545000015060 5ustar0000000000000000cryptohash-md5-0.11.101.0/src-tests/test-md5.hs0000644000000000000000000002267207346545000017067 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main (main) where import Data.Bits (xor) import Data.Word (Word64) 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.MD5 as REF -- implementation under test import qualified Crypto.Hash.MD5 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)) [ "d41d8cd9 8f00b204 e9800998 ecf8427e" , "9e107d9d 372bb682 6bd81d35 42a419d6" , "1055d3e6 98d289f2 af866372 5127bd4b" , "90015098 3cd24fb0 d6963f7d 28e17f72" , "8215ef07 96a20bca aae116d3 876c664a" , "03dd8807 a93175fb 062dfb55 dc7d359c" , "7707d6ae 4e027c70 eea2a935 c2296f21" ] ansXLTest :: ByteString ansXLTest = B.filter (/= 0x20) "d3381391 69d50f55 526194c7 90ec0448" katTests :: [TestTree] katTests | length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest, xltest'] | otherwise = error "vectors/answers length mismatch" where makeTest (i, v, r) = testGroup ("vec"++show i) $ [ testCase "one-pass" (r @=? runTest v) , 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-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 ] ++ [ 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 runTest' :: ByteString -> ByteString runTest' = B16.encode . IUT.finalize . IUT.start 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 runTestLazy' :: Int -> ByteString -> ByteString runTestLazy' i = B16.encode . IUT.finalize . IUT.startlazy . 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 runTestLazyU' :: Int -> ByteString -> ByteString runTestLazyU' i = B16.encode . IUT.finalize . IUT.startlazy . 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") xltest' = testGroup "XL-vec'" [ testCase "inc'" (ansXLTest @=? (B16.encode . IUT.finalize . IUT.startlazy) 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 16 0x0b, "Hi There", x"9294727a3638bb1c13f48ef8158bfc9d") , ("Jefe", "what do ya want for nothing?", x"750c783e6ab0b503eaa86e310a5db738") , (rep 16 0xaa, rep 50 0xdd, x"56be34521d144c88dbb8c733f0e8b3f6") , (B.pack [1..25], rep 50 0xcd, x"697eaf0aca3a3aea3a75164746ffaa79") , (rep 16 0x0c, "Test With Truncation", x"56461ef2342edc00f9bab995690efd4c") , (rep 80 0xaa, "Test Using Larger Than Block-Size Key - Hash Key First", x"6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd") , (rep 80 0xaa, "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data", x"6f630fad67cda0ee1fb1f562db3aa53e") ] where x = B16.decodeLenient rep n c = B.replicate n c rfc2202Tests :: [TestTree] 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 'startlazy 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 "start" prop_start , testProperty "hashlazy" prop_hashlazy , testProperty "startlazy" prop_startlazy , testProperty "hashlazyAndLength" prop_hashlazyAndLength , testProperty "hmac" prop_hmac , testProperty "hmaclazy" prop_hmaclazy , testProperty "hmaclazyAndLength" prop_hmaclazyAndLength ] where prop_hash (RandBS bs) = ref_hash bs == IUT.hash bs prop_start (RandBS bs) = ref_hash bs == (IUT.finalize $ IUT.start bs) prop_hashlazy (RandLBS bs) = ref_hashlazy bs == IUT.hashlazy bs prop_hashlazyAndLength (RandLBS bs) = ref_hashlazyAndLength bs == IUT.hashlazyAndLength bs prop_startlazy (RandLBS bs) = ref_hashlazy bs == (IUT.finalize $ IUT.startlazy 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 prop_hmaclazyAndLength (RandBS k) (RandLBS bs) = ref_hmaclazyAndLength k bs == IUT.hmaclazyAndLength k bs ref_hash :: ByteString -> ByteString ref_hash = ref_hashlazy . fromStrict ref_hashlazy :: BL.ByteString -> ByteString ref_hashlazy = REF.md5DigestBytes . REF.md5 ref_hashlazyAndLength :: BL.ByteString -> (ByteString,Word64) ref_hashlazyAndLength x = (ref_hashlazy x, fromIntegral (BL.length x)) -- stolen & adapted from SHA package ref_hmac :: ByteString -> ByteString -> ByteString ref_hmac k m = ref_hash (B.append opad (ref_hash (B.append ipad m))) where opad = B.map (xor 0x5c) k' ipad = B.map (xor 0x36) k' k' = B.append kt pad where kt = if kn > bn then ref_hash k else k pad = B.replicate (bn - ktn) 0 kn = B.length k ktn = B.length kt bn = 64 ref_hmaclazy :: ByteString -> BL.ByteString -> ByteString ref_hmaclazy secret = ref_hmac secret . toStrict ref_hmaclazyAndLength :: ByteString -> BL.ByteString -> (ByteString,Word64) ref_hmaclazyAndLength secret msg = (ref_hmaclazy secret msg, fromIntegral (BL.length msg)) -- toStrict/fromStrict only available with bytestring-0.10 and later toStrict = B.concat . BL.toChunks fromStrict = BL.fromChunks . (:[]) main :: IO () main = defaultMain $ testGroup "cryptohash-md5" [ testGroup "KATs" katTests , testGroup "RFC2202" rfc2202Tests , testGroup "REF" refImplTests ] cryptohash-md5-0.11.101.0/src/0000755000000000000000000000000007346545000013720 5ustar0000000000000000cryptohash-md5-0.11.101.0/src/Compat.hs0000644000000000000000000000114007346545000015473 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} -- | -- Module : Compat -- License : BSD-3 -- Maintainer : Herbert Valerio Riedel -- Stability : stable -- -- Compat layer to reduce code exposure to CPP to a bare minimum -- module Compat (constructBS) where import Foreign.ForeignPtr (ForeignPtr) import Data.Word (Word8) import Data.ByteString.Internal (ByteString (..)) -- | Directly construct a 'ByteString', unsafely constructBS :: ForeignPtr Word8 -> Int -> ByteString #if MIN_VERSION_bytestring(0,11,0) constructBS = BS #else constructBS = \fp -> PS fp 0 #endif cryptohash-md5-0.11.101.0/src/Crypto/Hash/0000755000000000000000000000000007346545000016063 5ustar0000000000000000cryptohash-md5-0.11.101.0/src/Crypto/Hash/MD5.hs0000644000000000000000000002510207346545000017004 0ustar0000000000000000{-# LANGUAGE Trustworthy #-} -- | -- Module : Crypto.Hash.MD5 -- License : BSD-style -- Maintainer : Herbert Valerio Riedel -- Stability : stable -- Portability : unknown -- -- A module containing 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 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.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 , finalizeAndLength -- :: Ctx -> (ByteString,Word64) , start -- :: ByteString -> Ctx , startlazy-- :: L.ByteString -> Ctx -- * 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' -- - 'hashlazyAndLength': create a digest ('init' + 'update' + 'finalizeAndLength') 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 -- -- package is recommended. , hash -- :: ByteString -> ByteString , hashlazy -- :: L.ByteString -> ByteString , hashlazyAndLength -- :: L.ByteString -> (ByteString,Word64) -- ** HMAC-MD5 -- -- | -compatible -- -MD5 digests , hmac -- :: ByteString -> ByteString -> ByteString , hmaclazy -- :: ByteString -> L.ByteString -> ByteString , hmaclazyAndLength -- :: ByteString -> L.ByteString -> (ByteString,Word64) ) 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, mallocByteString) import Data.Bits (xor) import Data.Word import System.IO.Unsafe (unsafeDupablePerformIO) import Compat (constructBS) import Crypto.Hash.MD5.FFI -- | 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 -- keep this synchronised with cbits/md5.h {-# INLINE digestSize #-} digestSize :: Int digestSize = 16 {-# INLINE sizeCtx #-} sizeCtx :: Int sizeCtx = 88 {-# 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 create' #-} -- | Variant of 'create' which allows to return an argument create' :: Int -> (Ptr Word8 -> IO a) -> IO (ByteString,a) create' l f = do fp <- mallocByteString l x <- withForeignPtr fp $ \p -> f p let bs = constructBS fp l return $! x `seq` bs `seq` (bs,x) 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) -- 'safe' call overhead neglible for 16KiB and more c_md5_update :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () c_md5_update pctx pbuf sz | sz < 16384 = c_md5_update_unsafe pctx pbuf sz | otherwise = c_md5_update_safe pctx pbuf sz -- 'safe' call overhead neglible for 4KiB and more c_md5_hash :: Ptr Word8 -> CSize -> Ptr Word8 -> IO () c_md5_hash pbuf sz pout | sz < 4096 = c_md5_hash_unsafe pbuf sz pout | otherwise = c_md5_hash_safe pbuf sz pout 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) finalizeInternalIO' :: Ptr Ctx -> IO (ByteString,Word64) finalizeInternalIO' ptr = create' digestSize (c_md5_finalize_len ptr) {-# NOINLINE init #-} -- | create a new hash context init :: Ctx init = unsafeDoIO $ withCtxNew $ c_md5_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 "MD5.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 "MD5.updates: invalid Ctx" {-# NOINLINE finalize #-} -- | finalize the context into a digest bytestring (16 bytes) finalize :: Ctx -> ByteString finalize ctx | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO | otherwise = error "MD5.finalize: invalid Ctx" {-# NOINLINE finalizeAndLength #-} -- | Variant of 'finalize' also returning length of hashed content -- -- @since 0.11.101.0 finalizeAndLength :: Ctx -> (ByteString,Word64) finalizeAndLength ctx | validCtx ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO' | otherwise = error "SHA256.finalize: invalid Ctx" {-# NOINLINE hash #-} -- | hash a strict bytestring into a digest bytestring (16 bytes) hash :: ByteString -> ByteString -- hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do c_md5_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr hash d = unsafeDoIO $ unsafeUseAsCStringLen d $ \(cs, len) -> create digestSize (c_md5_hash (castPtr cs) (fromIntegral len)) {-# NOINLINE start #-} -- | hash a strict bytestring into a 'Ctx' -- -- @since 0.11.101.0 start :: ByteString -> Ctx start d = unsafeDoIO $ withCtxNew $ \ptr -> do c_md5_init ptr >> updateInternalIO ptr d {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring (16 bytes) hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr {-# NOINLINE hashlazyAndLength #-} -- | Variant of 'hashlazy' which simultaneously computes the hash and length of a lazy bytestring. -- -- @since 0.11.101.0 hashlazyAndLength :: L.ByteString -> (ByteString,Word64) hashlazyAndLength l = unsafeDoIO $ withCtxNewThrow $ \ptr -> c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO' ptr {-# NOINLINE startlazy #-} -- | hash a lazy bytestring into a 'Ctx' -- -- @since 0.11.101.0 startlazy :: L.ByteString -> Ctx startlazy l = unsafeDoIO $ withCtxNew $ \ptr -> do c_md5_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) {-# NOINLINE hmac #-} -- | Compute 16-byte -compatible -- HMAC-Md5 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 16-byte -compatible -- HMAC-MD5 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 -- | Variant of 'hmaclazy' which also returns length of message -- -- @since 0.11.101.0 hmaclazyAndLength :: ByteString -- ^ secret -> L.ByteString -- ^ message -> (ByteString,Word64) -- ^ digest (32 bytes) and length of message hmaclazyAndLength secret msg = (hash (B.append opad htmp), sz' - fromIntegral ipadLen) where (htmp, sz') = hashlazyAndLength (L.append ipad msg) opad = B.map (xor 0x5c) k' ipad = L.fromChunks [B.map (xor 0x36) k'] ipadLen = B.length 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-md5-0.11.101.0/src/Crypto/Hash/MD5/0000755000000000000000000000000007346545000016450 5ustar0000000000000000cryptohash-md5-0.11.101.0/src/Crypto/Hash/MD5/FFI.hs0000644000000000000000000000374107346545000017415 0ustar0000000000000000{-# LANGUAGE CApiFFI #-} {-# LANGUAGE Unsafe #-} -- Ugly hack to workaround https://ghc.haskell.org/trac/ghc/ticket/14452 {-# OPTIONS_GHC -O0 -fdo-lambda-eta-expansion -fcase-merge -fstrictness -fno-omit-interface-pragmas -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -optc-Wall -optc-O3 #-} -- | -- Module : Crypto.Hash.MD5.FFI -- License : BSD-3 -- module Crypto.Hash.MD5.FFI where import Data.ByteString (ByteString) import Data.Word import Foreign.C.Types import Foreign.Ptr -- | MD5 Context -- -- The context data is exactly 88 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 4-element 'Word32' array holding the current work-in-progress digest-value. -- -- Consequently, a MD5 digest as produced by 'hash', 'hashlazy', or 'finalize' is 16 bytes long. newtype Ctx = Ctx ByteString deriving (Eq) foreign import capi unsafe "md5.h hs_cryptohash_md5_init" c_md5_init :: Ptr Ctx -> IO () foreign import capi unsafe "md5.h hs_cryptohash_md5_update" c_md5_update_unsafe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () foreign import capi safe "md5.h hs_cryptohash_md5_update" c_md5_update_safe :: Ptr Ctx -> Ptr Word8 -> CSize -> IO () foreign import capi unsafe "md5.h hs_cryptohash_md5_finalize" c_md5_finalize :: Ptr Ctx -> Ptr Word8 -> IO () foreign import capi unsafe "md5.h hs_cryptohash_md5_finalize" c_md5_finalize_len :: Ptr Ctx -> Ptr Word8 -> IO Word64 foreign import capi unsafe "md5.h hs_cryptohash_md5_hash" c_md5_hash_unsafe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO () foreign import capi safe "md5.h hs_cryptohash_md5_hash" c_md5_hash_safe :: Ptr Word8 -> CSize -> Ptr Word8 -> IO ()