{-# LINE 1 "Data/Digest/CRC32.hsc" #-}
{-# 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



-- | The class of values for which CRC32 may be computed
class CRC32 a where
    -- | Compute CRC32 checksum
    crc32 :: a -> Word32
    crc32 = Word32 -> a -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
crc32Update Word32
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 :: Word32 -> ByteString -> Word32
crc32Update = Word32 -> ByteString -> Word32
crc32_s_update

instance CRC32 L.ByteString where
    crc32Update :: Word32 -> ByteString -> Word32
crc32Update = Word32 -> ByteString -> Word32
crc32_l_update

instance CRC32 [Word8] where
    crc32Update :: Word32 -> [Word8] -> Word32
crc32Update Word32
n = (Word32 -> ByteString -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
crc32Update Word32
n) (ByteString -> Word32)
-> ([Word8] -> ByteString) -> [Word8] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
L.pack


crc32_s_update :: Word32 -> S.ByteString -> Word32
crc32_s_update :: Word32 -> ByteString -> Word32
crc32_s_update Word32
seed ByteString
str
    | ByteString -> Bool
S.null ByteString
str = Word32
seed
    | Bool
otherwise =
        IO Word32 -> Word32
forall a. IO a -> a
U.unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
        ByteString -> (CStringLen -> IO Word32) -> IO Word32
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
str ((CStringLen -> IO Word32) -> IO Word32)
-> (CStringLen -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$
        \(Ptr CChar
buf, Int
len) -> (Word64 -> Word32) -> IO Word64 -> IO Word32
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word64 -> IO Word32) -> IO Word64 -> IO Word32
forall a b. (a -> b) -> a -> b
$
            Word64 -> Ptr Word8 -> Word32 -> IO Word64
crc32_c (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
seed) (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
buf) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

crc32_l_update :: Word32 -> L.ByteString -> Word32
crc32_l_update :: Word32 -> ByteString -> Word32
crc32_l_update = (Word32 -> ByteString -> Word32) -> Word32 -> ByteString -> Word32
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
LI.foldlChunks Word32 -> ByteString -> Word32
crc32_s_update


foreign import ccall unsafe "zlib.h crc32"
    crc32_c :: Word64
{-# LINE 65 "Data/Digest/CRC32.hsc" #-}
            -> Ptr Word8
{-# LINE 66 "Data/Digest/CRC32.hsc" #-}
            -> Word32
{-# LINE 67 "Data/Digest/CRC32.hsc" #-}
            -> IO Word64
{-# LINE 68 "Data/Digest/CRC32.hsc" #-}