{-# LINE 1 "src/Data/Digest/XXHash.hsc" #-}
{-# LANGUAGE CPP             #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Data.Digest.XXHash
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- xxHash C library bindings.
--
-- Variable bitLength implementation corresponds to polkadot-util:
-- https://github.com/polkadot-js/common/tree/master/packages/util-crypto/src/xxhash
--

module Data.Digest.XXHash (xxhash) where

import           Data.ByteString         (ByteString, useAsCStringLen)
import           Data.ByteString.Builder (toLazyByteString, word64LE)
import           Data.ByteString.Lazy    (toStrict)
import           Foreign
import           Foreign.C.String
import           Foreign.C.Types
import           System.IO.Unsafe        (unsafePerformIO)



foreign import ccall unsafe "xxhash.h XXH64"
  c_XXH64 :: CString -> CSize -> CUInt -> IO Word64

xxhash_64 :: CUInt -> ByteString -> Word64
xxhash_64 :: CUInt -> ByteString -> Word64
xxhash_64 CUInt
seed = IO Word64 -> Word64
forall a. IO a -> a
unsafePerformIO (IO Word64 -> Word64)
-> (ByteString -> IO Word64) -> ByteString -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (CStringLen -> IO Word64) -> IO Word64)
-> (CStringLen -> IO Word64) -> ByteString -> IO Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> (CStringLen -> IO Word64) -> IO Word64
forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen
    (\(Ptr CChar
str, Int
len) -> Ptr CChar -> CSize -> CUInt -> IO Word64
c_XXH64 Ptr CChar
str (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) CUInt
seed)

-- | Create the xxhash64 and return the result with the specified 'bitLength'.
xxhash :: Integral bitLength
       => bitLength
       -- ^ Bit lenght of output, will be ceiling to 64 bit.
       -> ByteString
       -- ^ Input data.
       -> ByteString
       -- ^ Output hash.
xxhash :: bitLength -> ByteString -> ByteString
xxhash bitLength
bitLength ByteString
input = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Word64 -> Builder
word64LE (CUInt -> ByteString -> Word64
xxhash_64 CUInt
seed ByteString
input) | CUInt
seed <- [CUInt
0 .. (CUInt
iterations CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
- CUInt
1)]]
  where
    iterations :: CUInt
iterations = Double -> CUInt
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (bitLength -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral bitLength
bitLength Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
64)