{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash         #-}
{-# LANGUAGE UnliftedFFITypes  #-}

module Data.Digest.CRC32C
  ( CRC32C
  , crc32c
  , crc32cUpdate
  ) where

import qualified Data.ByteString                as BS
import qualified Data.ByteString.Lazy           as BL
import qualified Data.ByteString.Short          as BSS
import           Data.ByteString.Unsafe         (unsafeUseAsCStringLen)
import           Data.Word
import           Foreign.C.Types
import           Foreign.Ptr
import           GHC.Exts                       (ByteArray#)
import           System.IO.Unsafe               (unsafeDupablePerformIO)

#if !MIN_VERSION_bytestring(0, 11, 1)
import qualified Data.ByteString.Short.Internal as BSS
#endif

class CRC32C a where
  -- | Compute CRC32C checksum
  crc32c :: a -> Word32
  crc32c = Word32 -> a -> Word32
forall a. CRC32C a => Word32 -> a -> Word32
crc32cUpdate Word32
0

  -- | Given the CRC32C checksum of a string, compute CRC32C of its
  -- concatenation with another string (t.i., incrementally update
  -- the CRC32C hash value)
  crc32cUpdate :: Word32 -> a -> Word32

instance CRC32C BS.ByteString where
  crc32c :: ByteString -> Word32
crc32c ByteString
bs = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (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
bs ((CStringLen -> IO Word32) -> IO Word32)
-> (CStringLen -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
      Ptr Word8 -> CSize -> IO Word32
crc32c_value (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

  crc32cUpdate :: Word32 -> ByteString -> Word32
crc32cUpdate Word32
cks ByteString
bs = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (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
bs ((CStringLen -> IO Word32) -> IO Word32)
-> (CStringLen -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
      Word32 -> Ptr Word8 -> CSize -> IO Word32
crc32c_extend Word32
cks (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

instance CRC32C BL.ByteString where
  crc32cUpdate :: Word32 -> ByteString -> Word32
crc32cUpdate = (Word32 -> ByteString -> Word32) -> Word32 -> ByteString -> Word32
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
BL.foldlChunks Word32 -> ByteString -> Word32
forall a. CRC32C a => Word32 -> a -> Word32
crc32cUpdate

instance CRC32C [Word8] where
  crc32cUpdate :: Word32 -> [Word8] -> Word32
crc32cUpdate Word32
n = (Word32 -> ByteString -> Word32
forall a. CRC32C a => Word32 -> a -> Word32
crc32cUpdate Word32
n) (ByteString -> Word32)
-> ([Word8] -> ByteString) -> [Word8] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BL.pack

instance CRC32C BSS.ShortByteString where
  crc32c :: ShortByteString -> Word32
crc32c sbs :: ShortByteString
sbs@(BSS.SBS ByteArray#
ba#) = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
    -- Must be unsafe ffi
    ByteArray# -> CSize -> IO Word32
crc32c_value' ByteArray#
ba# (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int
BSS.length ShortByteString
sbs)

  crc32cUpdate :: Word32 -> ShortByteString -> Word32
crc32cUpdate Word32
cks sbs :: ShortByteString
sbs@(BSS.SBS ByteArray#
ba#) = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
    -- Must be unsafe ffi
    Word32 -> ByteArray# -> CSize -> IO Word32
crc32c_extend' Word32
cks ByteArray#
ba# (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Int
BSS.length ShortByteString
sbs)

-------------------------------------------------------------------------------

foreign import ccall unsafe "crc32c/crc32c.h crc32c_value"
  crc32c_value :: Ptr Word8 -> CSize -> IO Word32

foreign import ccall unsafe "crc32c/crc32c.h crc32c_extend"
  crc32c_extend :: Word32 -> Ptr Word8 -> CSize -> IO Word32

foreign import ccall unsafe "crc32c/crc32c.h crc32c_value"
  crc32c_value' :: ByteArray# -> CSize -> IO Word32

foreign import ccall unsafe "crc32c/crc32c.h crc32c_extend"
  crc32c_extend' :: Word32 -> ByteArray# -> CSize -> IO Word32