digest-0.0.1.7/0000755000000000000000000000000007346545000011325 5ustar0000000000000000digest-0.0.1.7/CHANGELOG.md0000755000000000000000000000122507346545000013141 0ustar0000000000000000# Changelog ## 0.0.1.7 — 5th March 2023 - Don't use 'pkg-config' to locate zlib on FreeBSD (Thanks to @arrowd): ## 0.0.1.6 — 5th March 2023 - Introduce 'pkg-config' cabal flag (Thanks to @jonathanlking): ## 0.0.1.5 — 24th Jan 2023 - Correct license field in .cabal file (Thanks to @juhp): - Use https for git source repository (Thanks to @felixonmars): ## 0.0.1.4 — 22th Dec 2022 - Use pkgconfig to find zlib (Thanks to @bgamari): digest-0.0.1.7/Data/Digest/0000755000000000000000000000000007346545000013415 5ustar0000000000000000digest-0.0.1.7/Data/Digest/Adler32.hsc0000644000000000000000000000374207346545000015316 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface, FlexibleInstances #-} ------------------------------------------------------------ -- | -- Copyright : (c) 2008 Eugene Kirpichov -- License : BSD-style -- -- Maintainer : ekirpichov@gmail.com -- Stability : experimental -- Portability : portable (H98 + FFI) -- -- Adler32 wrapper -- ------------------------------------------------------------ module Data.Digest.Adler32 ( Adler32, adler32, adler32Update ) where import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Foreign import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as LI import qualified System.IO.Unsafe as U #include "zlib.h" -- | The class of values for which Adler32 may be computed class Adler32 a where -- | Compute Adler32 checksum adler32 :: a -> Word32 adler32 = adler32Update 1 -- | Given the Adler32 checksum of a string, compute Adler32 of its -- concatenation with another string (t.i., incrementally update the -- Adler32 hash value). adler32Update :: Word32 -> a -> Word32 instance Adler32 S.ByteString where adler32Update = adler32_s_update instance Adler32 L.ByteString where adler32Update = adler32_l_update instance Adler32 [Word8] where adler32Update n = (adler32Update n) . L.pack adler32_s_update :: Word32 -> S.ByteString -> Word32 adler32_s_update seed str | S.null str = seed | otherwise = U.unsafePerformIO $ unsafeUseAsCStringLen str $ \(buf, len) -> fmap fromIntegral $ adler32_c (fromIntegral seed) (castPtr buf) (fromIntegral len) adler32_l_update :: Word32 -> L.ByteString -> Word32 adler32_l_update = LI.foldlChunks adler32_s_update foreign import ccall unsafe "zlib.h adler32" adler32_c :: #{type uLong} -> Ptr #{type Bytef} -> #{type uInt} -> IO #{type uLong} digest-0.0.1.7/Data/Digest/CRC32.hsc0000644000000000000000000000363507346545000014677 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface, FlexibleInstances #-} ------------------------------------------------------------ -- | -- Copyright : (c) 2008 Eugene Kirpichov -- License : BSD-style -- -- Maintainer : ekirpichov@gmail.com -- Stability : experimental -- Portability : portable (H98 + FFI) -- -- CRC32 wrapper -- ------------------------------------------------------------ module Data.Digest.CRC32 ( CRC32, crc32, crc32Update ) where import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Foreign import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as LI import qualified System.IO.Unsafe as U #include "zlib.h" -- | The class of values for which CRC32 may be computed class CRC32 a where -- | Compute CRC32 checksum crc32 :: a -> Word32 crc32 = crc32Update 0 -- | Given the CRC32 checksum of a string, compute CRC32 of its -- concatenation with another string (t.i., incrementally update -- the CRC32 hash value) crc32Update :: Word32 -> a -> Word32 instance CRC32 S.ByteString where crc32Update = crc32_s_update instance CRC32 L.ByteString where crc32Update = crc32_l_update instance CRC32 [Word8] where crc32Update n = (crc32Update n) . L.pack crc32_s_update :: Word32 -> S.ByteString -> Word32 crc32_s_update seed str | S.null str = seed | otherwise = U.unsafePerformIO $ unsafeUseAsCStringLen str $ \(buf, len) -> fmap fromIntegral $ crc32_c (fromIntegral seed) (castPtr buf) (fromIntegral len) crc32_l_update :: Word32 -> L.ByteString -> Word32 crc32_l_update = LI.foldlChunks crc32_s_update foreign import ccall unsafe "zlib.h crc32" crc32_c :: #{type uLong} -> Ptr #{type Bytef} -> #{type uInt} -> IO #{type uLong} digest-0.0.1.7/LICENSE0000644000000000000000000000243307346545000012334 0ustar0000000000000000Copyright (c) 2008-2009, Eugene Kirpichov 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. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT OWNER 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. digest-0.0.1.7/Setup.hs0000644000000000000000000000005607346545000012762 0ustar0000000000000000import Distribution.Simple main = defaultMain digest-0.0.1.7/digest.cabal0000644000000000000000000000270007346545000013567 0ustar0000000000000000name: digest version: 0.0.1.7 copyright: (c) 2009 Eugene Kirpichov license: BSD2 license-file: LICENSE author: Eugene Kirpichov maintainer: Eugene Kirpichov category: Cryptography synopsis: Various hashes for bytestrings; CRC32 and Adler32 for now. description: This package provides efficient hash implementations for strict and lazy bytestrings. For now, CRC32 and Adler32 are supported; they are implemented as FFI bindings to efficient code from zlib. stability: provisional build-type: Simple cabal-version: >= 1.10 tested-with: GHC==8.10.7 , GHC==9.0.2 , GHC==9.2.5 , GHC==9.4.3 extra-source-files: testing/trivial-reference.c testing/trivial.expected testing/trivial.hs CHANGELOG.md flag pkg-config default: True manual: True description: Use @pkg-config(1)@ to locate @zlib@ library. source-repository head type: git location: https://github.com/TeofilC/digest library exposed-modules: Data.Digest.CRC32, Data.Digest.Adler32 default-extensions: CPP, ForeignFunctionInterface default-language: Haskell2010 build-depends: base < 5 , bytestring >= 0.9 && < 0.12 includes: zlib.h ghc-options: -Wall if flag(pkg-config) && !os(windows) && !os(freebsd) pkgconfig-depends: zlib else build-depends: zlib digest-0.0.1.7/testing/0000755000000000000000000000000007346545000013002 5ustar0000000000000000digest-0.0.1.7/testing/trivial-reference.c0000755000000000000000000000245107346545000016561 0ustar0000000000000000#include #include typedef uLong HashFunc(uLong seed, const Bytef *buf, uInt len); static void printHash(uLong hash) { printf(" %lu\n", (unsigned long) hash); } static void runTest(const char *label, HashFunc func, uLong seed) { printf("%s\n", label); printHash(func(seed, (const Bytef *)"", 0)); printHash(func(seed, (const Bytef *)"", 0)); printHash(func(seed, (const Bytef *)"\0", 1)); printHash(func(seed, (const Bytef *)"a", 1)); printHash(func(seed, (const Bytef *)"hello", 5)); { int i; unsigned char buffer[300]; for (i = 0; i <= 255; i++) buffer[i] = i; printHash(func(seed, buffer, 256)); } puts(""); } int main(void) { runTest("adler32", adler32, 1); runTest("adler32Update 0", adler32, 0); runTest("adler32Update 1", adler32, 1); runTest("adler32Update 123", adler32, 123); runTest("adler32Update 0xFFF0FFF0", adler32, 0xFFF0FFF0); runTest("crc32", crc32, 0); runTest("crc32Update 0", crc32, 0); runTest("crc32Update 1", crc32, 1); runTest("crc32Update 123", crc32, 123); runTest("crc32Update 0xFFFFFFFF", crc32, 0xFFFFFFFF); return 0; } digest-0.0.1.7/testing/trivial.expected0000755000000000000000000000155707346545000016212 0ustar0000000000000000adler32 1 1 65537 6422626 103547413 2918612865 adler32Update 0 0 0 0 6357089 103219732 2901835648 adler32Update 1 1 1 65537 6422626 103547413 2918612865 adler32Update 123 123 123 8061051 14418140 143524495 671449083 adler32Update 0xFFF0FFF0 4293984240 4293984240 4293918704 6226016 102826515 2884992895 crc32 0 0 3523407757 3904355907 907060870 688229491 crc32Update 0 0 0 3523407757 3904355907 907060870 688229491 crc32Update 1 1 1 2768625435 2679148245 191926070 3879140792 crc32Update 123 123 123 366298937 794826487 3088217944 398094930 crc32Update 0xFFFFFFFF 4294967295 4294967295 4294967295 3310005809 265137764 3681351380 digest-0.0.1.7/testing/trivial.hs0000755000000000000000000000307207346545000015015 0ustar0000000000000000import Data.Digest.Adler32 import Data.Digest.CRC32 import Control.Monad (forM_) import Data.ByteString (ByteString) import Data.ByteString.Char8 (pack) import Data.Word (Word32) import Foreign.ForeignPtr (mallocForeignPtr) import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString.Internal as I -- | Empty 'ByteString' whose pointer is null emptyNull :: ByteString emptyNull = I.PS I.nullForeignPtr 0 0 -- | Empty 'ByteString' whose pointer is not null emptyNotNull :: ByteString emptyNotNull = unsafePerformIO $ do ptr <- mallocForeignPtr return $ I.PS ptr 0 0 testStrings :: [ByteString] testStrings = [ emptyNull , emptyNotNull , pack "\0" , pack "a" , pack "hello" , pack ['\0'..'\255'] ] runTest :: String -> (ByteString -> Word32) -> IO () runTest label func = do putStrLn label forM_ testStrings $ \s -> putStrLn $ " " ++ (show . func) s putStrLn "" main :: IO () main = do runTest "adler32" $ adler32 runTest "adler32Update 0" $ adler32Update 0 runTest "adler32Update 1" $ adler32Update 1 runTest "adler32Update 123" $ adler32Update 123 runTest "adler32Update 0xFFF0FFF0" $ adler32Update 0xFFF0FFF0 runTest "crc32" $ crc32 runTest "crc32Update 0" $ crc32Update 0 runTest "crc32Update 1" $ crc32Update 1 runTest "crc32Update 123" $ crc32Update 123 runTest "crc32Update 0xFFFFFFFF" $ crc32Update 0xFFFFFFFF