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

import           Data.ByteString (ByteString)
import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import           Data.Word

import           Foreign
import           Foreign.C
import           Foreign.Marshal.Unsafe

crc32c :: ByteString -> Word32
crc32c :: ByteString -> Word32
crc32c ByteString
bs =
  CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word32) -> CUInt -> Word32
forall a b. (a -> b) -> a -> b
$
    IO CUInt -> CUInt
forall a. IO a -> a
unsafeLocalState (IO CUInt -> CUInt) -> IO CUInt -> CUInt
forall a b. (a -> b) -> a -> b
$
      ByteString -> (CStringLen -> IO CUInt) -> IO CUInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO CUInt) -> IO CUInt)
-> (CStringLen -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
p, Int
l) ->
        Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_value (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)

crc32c_update :: Word32 -> ByteString -> Word32
crc32c_update :: Word32 -> ByteString -> Word32
crc32c_update Word32
hash ByteString
bs =
  CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word32) -> CUInt -> Word32
forall a b. (a -> b) -> a -> b
$
    IO CUInt -> CUInt
forall a. IO a -> a
unsafeLocalState (IO CUInt -> CUInt) -> IO CUInt -> CUInt
forall a b. (a -> b) -> a -> b
$
      ByteString -> (CStringLen -> IO CUInt) -> IO CUInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO CUInt) -> IO CUInt)
-> (CStringLen -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
p, Int
l) ->
        CUInt -> Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_extend (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
hash) (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)

-- FFI: safe or unsafe?
-- All of the FFI here is not-reentrant so we don't have to use safe. However
-- for very large inputs, the calls will take a while and during that time
-- they will block GC and other Haskell threads on the same capability. So
-- for very large inputs we would prefer to use a safe FFI call. But for small
-- inputs, the overhead of a safe FFI call is quite substantial, e.g
-- ~5x for 256 bytes, dropping to only ~10% for 16kb.
--
-- The solution we use here is to use unsafe FFI calls for smaller buffers and
-- safe FFI calls for larger buffers. This bounds the time that these calls
-- can block other threads or GC.

lib_crc32c_extend :: CUInt -> Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_extend :: CUInt -> Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_extend CUInt
hash Ptr CUChar
p CSize
l | CSize
l CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
0x10000 = CUInt -> Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_extend_safe CUInt
hash Ptr CUChar
p CSize
l
                           | Bool
otherwise   = CUInt -> Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_extend_unsafe CUInt
hash Ptr CUChar
p CSize
l

lib_crc32c_value :: Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_value :: Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_value Ptr CUChar
p CSize
l | CSize
l CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
0x10000 = Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_value_safe Ptr CUChar
p CSize
l
                     | Bool
otherwise   = Ptr CUChar -> CSize -> IO CUInt
lib_crc32c_value_unsafe Ptr CUChar
p CSize
l

foreign import ccall unsafe "crc32c/crc32c.h crc32c_extend"
  lib_crc32c_extend_unsafe :: CUInt -> Ptr CUChar -> CSize -> IO CUInt

foreign import ccall safe "crc32c/crc32c.h crc32c_extend"
  lib_crc32c_extend_safe :: CUInt -> Ptr CUChar -> CSize -> IO CUInt

foreign import ccall unsafe "crc32c/crc32c.h crc32c_value"
  lib_crc32c_value_unsafe :: Ptr CUChar -> CSize -> IO CUInt

foreign import ccall safe "crc32c/crc32c.h crc32c_value"
  lib_crc32c_value_safe :: Ptr CUChar -> CSize -> IO CUInt