hashes (empty) → 0.1.0.0
raw patch · 12 files changed
+1556/−0 lines, 12 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, criterion, hashes, memory
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- README.md +8/−0
- bench/Main.hs +98/−0
- hashes.cabal +83/−0
- src/Data/Hash/FNV1.hs +239/−0
- src/Data/Hash/SipHash.hs +245/−0
- src/Data/Hash/Utils.hs +144/−0
- test/Main.hs +22/−0
- test/Test/Data/Hash/FNV1.hs +463/−0
- test/Test/Data/Hash/SipHash.hs +151/−0
- test/Test/Data/Hash/Utils.hs +78/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for the hashes package++## 0.1.0.0 -- 2021-09-29++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2021, Lars Kuhtz <lakuhtz@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,8 @@+Haskell implementation of various non-cryptographic hash functions.++The current version includes++* SipHash+* FNV1 (64 bit and 32 bit)+* FNV1a (64 bit and 32 bit)+
+ bench/Main.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Main+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Main+( main+) where++import Criterion+import Criterion.Main++import qualified Data.ByteArray as BA+import qualified Data.ByteArray.Hash as BA+import qualified Data.ByteString as B+import Data.Word++import GHC.Ptr++import Test.QuickCheck++-- internal modules++import qualified Data.Hash.SipHash as H+import qualified Data.Hash.FNV1 as H++-- -------------------------------------------------------------------------- --+-- Main++main :: IO ()+main = do+ putStrLn "prop_sip"+ quickCheck prop_sip+ putStrLn "prop_fnv1a"+ quickCheck prop_fnv1a+ putStrLn "prop_fnv1aPrimitive"+ quickCheck prop_fnv1aPrimitive+ defaultMain+ [ bgroup "sipHash"+ [ sipBench "memory" (memorySipHash 17 17)+ , sipBench "internal" (H.hashByteString $ H.sipHash24 17 17)+ ]+ , bgroup "fnv1aHash"+ [ fnv1aBench "memory" memoryFnv1a+ , fnv1aBench "internal" (H.hashByteString H.fnv1a_64)+ , fnv1aBench "primitive" primitiveFnv1a+ ]+ ]++-- -------------------------------------------------------------------------- --+-- SipHash++memorySipHash :: BA.ByteArrayAccess p => Word64 -> Word64 -> p -> Word64+memorySipHash w0 w1 x = let BA.SipHash r = BA.sipHash (BA.SipKey w0 w1) x in r+{-# INLINE memorySipHash #-}++prop_sip :: Word64 -> Word64 -> [Word8] -> Property+prop_sip w0 w1 b =+ memorySipHash w0 w1 (B.pack b) === H.hashByteString (H.sipHash24 w0 w1) (B.pack b)++sipBench :: String -> (B.ByteString -> Word64) -> Benchmark+sipBench l f = bgroup l $ go <$> benchStrings+ where+ go i = bench (show (B.length i)) $ whnf f i++benchStrings :: [B.ByteString]+benchStrings = str <$> [0, 1, 5, 67, 300, 2000, 20000]+ where+ str (i :: Int) = B.pack $ fromIntegral <$> [0..i-1]++-- -------------------------------------------------------------------------- --+-- Fvn1Hash++memoryFnv1a :: B.ByteString -> Word64+memoryFnv1a b = let BA.FnvHash64 h = BA.fnv1a_64Hash b in h+{-# INLINE memoryFnv1a #-}++primitiveFnv1a :: B.ByteString -> Word64+primitiveFnv1a = H.hashByteString $ \(Ptr addr) n ->+ fromIntegral <$> H.fnv1a addr n+{-# INLINE primitiveFnv1a #-}++prop_fnv1a :: [Word8] -> Property+prop_fnv1a b = memoryFnv1a (B.pack b) === H.hashByteString H.fnv1a_64 (B.pack b)++prop_fnv1aPrimitive :: [Word8] -> Property+prop_fnv1aPrimitive b = primitiveFnv1a (B.pack b) === H.hashByteString H.fnv1a_64 (B.pack b)++fnv1aBench :: String -> (B.ByteString -> Word64) -> Benchmark+fnv1aBench l f = bgroup l $ go <$> benchStrings+ where+ go i = bench (show (B.length i)) $ whnf f i+
+ hashes.cabal view
@@ -0,0 +1,83 @@+cabal-version: 2.4+name: hashes+version: 0.1.0.0+synopsis: Hash functions+Description: Efficient implementation of non-cryptographic hash functions+homepage: https://github.com/larskuhtz/hs-hashes+bug-reports: https://github.com/larskuhtz/hs-hashes/issues+license: MIT+license-file: LICENSE+author: Lars Kuhtz+maintainer: lakuhtz@gmail.com+copyright: Copyright (c) 2019-2021 Lars Kuhtz <lakuhtz@gmail.com>+category: Data+tested-with:+ GHC==9.0.1+ GHC==8.10.7+ GHC==8.8.4+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/larskuhtz/hs-hashes.git++library+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules:+ Data.Hash.SipHash+ Data.Hash.FNV1+ Data.Hash.Utils+ ghc-options:+ -Wall+ build-depends:+ , base >=4.11 && <5+ , bytestring >=0.10++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options:+ -Wall+ -rtsopts+ -threaded+ -with-rtsopts=-N+ main-is: Main.hs+ other-modules:+ Test.Data.Hash.SipHash+ Test.Data.Hash.FNV1+ Test.Data.Hash.Utils+ build-depends:+ -- internal+ , hashes+ -- external+ , QuickCheck >= 2.13+ , base >=4.11 && <5+ , bytestring >=0.10++benchmark benchmarks+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Main.hs+ default-language: Haskell2010+ ghc-options:+ -Wall+ -rtsopts+ -threaded+ -with-rtsopts=-N+ -mbmi2+ -msse4.2+ build-depends:+ -- internal+ , hashes++ -- external+ , QuickCheck >= 2.13+ , base >=4.10 && <5+ , bytestring >=0.10+ , criterion >= 1.5+ , memory >=0.14+
+ src/Data/Hash/FNV1.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module: Data.Hash.FNV1+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+-- The primitive versions are usually not more efficient than the version with+-- explicit word sizes for the respective host architecture.+--+module Data.Hash.FNV1+(+-- * IO API (64 bit)++ fnv1_64+, fnv1_64_+, fnv1a_64+, fnv1a_64_++-- * 32 bit versions+, fnv1_32+, fnv1_32_+, fnv1a_32+, fnv1a_32_++-- * Primitive (host word size)+, fnv1+, fnv1_+, fnv1Primitive+, fnv1Primitive_++, fnv1a+, fnv1a_+, fnv1aPrimitive+, fnv1aPrimitive_++-- * Utils+, module Data.Hash.Utils++-- * Constants+, fnvPrime+, fnvPrime32+, fnvPrime64++, fnvOffsetBasis+, fnvOffsetBasis32+, fnvOffsetBasis64++) where++import Data.Bits+import Data.Word++import Foreign.Ptr+import Foreign.Storable++import GHC.Exts++import GHC.IO++-- internal modules++import Data.Hash.Utils++-- -------------------------------------------------------------------------- --+-- Constants++fnvPrime32 :: Word32+fnvPrime32 = 0x01000193++fnvPrime64 :: Word64+fnvPrime64 = 0x100000001b3++fnvOffsetBasis32 :: Word32+fnvOffsetBasis32 = 0x811c9dc5++fnvOffsetBasis64 :: Word64+fnvOffsetBasis64 = 0xcbf29ce484222325++fnvPrime :: Word+#if defined(x86_64_HOST_ARCH)+fnvPrime = fromIntegral fnvPrime64+#elif defined(i386_HOST_ARCH)+fnvPrime = fromIntegral fvnPrime32+#else+fnvPrime = error "fnvPrime: unsupported hardware platform"+#endif++fnvOffsetBasis :: Word+#if defined(x86_64_HOST_ARCH)+fnvOffsetBasis = fromIntegral fnvOffsetBasis64+#elif defined(i386_HOST_ARCH)+fnvOffsetBasis = fromIntegral fnvOffsetBasis32+#else+fnvOffsetBasis = error "fnvOffsetBasis: unsupported hardware platform"+#endif++-- -------------------------------------------------------------------------- --+-- FNV1 64 bit++fnv1_64 :: Ptr Word8 -> Int -> IO Word64+fnv1_64 !ptr !n = fnv1_64_ ptr n fnvOffsetBasis64+{-# INLINE fnv1_64 #-}++fnv1_64_ :: Ptr Word8 -> Int -> Word64 -> IO Word64+fnv1_64_ !ptr !n !a = loop a 0+ where+ loop !acc !i+ | i == n = return acc+ | otherwise = do+ !x <- peekByteOff @Word8 ptr i+ loop ((fnvPrime64 * acc) `xor` fromIntegral x) (i + 1)+{-# INLINE fnv1_64_ #-}++-- -------------------------------------------------------------------------- --+-- FNV1a 64 bit++fnv1a_64 :: Ptr Word8 -> Int -> IO Word64+fnv1a_64 !ptr !n = fnv1a_64_ ptr n fnvOffsetBasis64+{-# INLINE fnv1a_64 #-}++fnv1a_64_ :: Ptr Word8 -> Int -> Word64 -> IO Word64+fnv1a_64_ !ptr !n !a = loop a 0+ where+ loop !acc !i+ | i == n = return acc+ | otherwise = do+ !x <- peekByteOff @Word8 ptr i+ loop (fnvPrime64 * (acc `xor` fromIntegral x)) (i + 1)+{-# INLINE fnv1a_64_ #-}++-- -------------------------------------------------------------------------- --+-- FNV1 32 bit++fnv1_32 :: Ptr Word8 -> Int -> IO Word32+fnv1_32 !ptr !n = fnv1_32_ ptr n fnvOffsetBasis32+{-# INLINE fnv1_32 #-}++fnv1_32_ :: Ptr Word8 -> Int -> Word32 -> IO Word32+fnv1_32_ !ptr !n !a = loop a 0+ where+ loop !acc !i+ | i == n = return acc+ | otherwise = do+ !x <- peekByteOff @Word8 ptr i+ loop ((fnvPrime32 * acc) `xor` fromIntegral x) (i + 1)+{-# INLINE fnv1_32_ #-}++-- FNV1a 32 bit++fnv1a_32 :: Ptr Word8 -> Int -> IO Word32+fnv1a_32 !ptr !n = fnv1a_32_ ptr n fnvOffsetBasis32+{-# INLINE fnv1a_32 #-}++fnv1a_32_ :: Ptr Word8 -> Int -> Word32 -> IO Word32+fnv1a_32_ !ptr !n a = loop a 0+ where+ loop !acc !i+ | i == n = return acc+ | otherwise = do+ !x <- peekByteOff @Word8 ptr i+ loop (fnvPrime32 * (acc `xor` fromIntegral x)) (i + 1)+{-# INLINE fnv1a_32_ #-}++-- -------------------------------------------------------------------------- --+-- Primitive (host architecture words)++-- FNV1++fnv1 :: Addr# -> Int -> IO Word+fnv1 addr (I# n) = IO $ \s -> case fnv1Primitive addr n s of+ (# s1, w #) -> (# s1, W# w #)+{-# INlINE fnv1 #-}++fnv1_ :: Addr# -> Int -> Word -> IO Word+fnv1_ addr (I# n) (W# a) = IO $ \s -> case fnv1Primitive_ addr n a s of+ (# s1, w #) -> (# s1, W# w #)+{-# INlINE fnv1_ #-}++fnv1Primitive :: Addr# -> Int# -> State# tok -> (# State# tok, Word# #)+fnv1Primitive !addr !n !tok = fnv1Primitive_ addr n o tok+ where+ !(W# o) = fnvOffsetBasis+{-# INLINE fnv1Primitive #-}++fnv1Primitive_ :: Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)+fnv1Primitive_ !addr !n !a tok = case loop a 0# tok of+ (# tok1, w #) -> (# tok1, w #)+ where+ loop !acc !i !s = case i ==# n of+ 1# -> (# s, acc #)+ _ -> case readWord8OffAddr# addr i s of+ (# s1, w #) -> loop+ ((p `timesWord#` acc) `xor#` w)+ (i +# 1#)+ s1++ !(W# p) = fnvPrime+{-# INLINE fnv1Primitive_ #-}++-- FNV1a++fnv1a :: Addr# -> Int -> IO Word+fnv1a addr (I# n) = IO $ \s -> case fnv1aPrimitive addr n s of+ (# s1, w #) -> (# s1, W# w #)+{-# INlINE fnv1a #-}++fnv1a_ :: Addr# -> Int -> Word -> IO Word+fnv1a_ addr (I# n) (W# a) = IO $ \s -> case fnv1aPrimitive_ addr n a s of+ (# s1, w #) -> (# s1, W# w #)+{-# INlINE fnv1a_ #-}++fnv1aPrimitive :: Addr# -> Int# -> State# tok -> (# State# tok, Word# #)+fnv1aPrimitive !addr !n !tok = fnv1aPrimitive_ addr n o tok+ where+ !(W# o) = fnvOffsetBasis+{-# INLINE fnv1aPrimitive #-}++fnv1aPrimitive_ :: Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)+fnv1aPrimitive_ !addr !n !a tok = case loop a 0# tok of+ (# tok1, w #) -> (# tok1, w #)+ where+ loop !acc !i !s = case i ==# n of+ 1# -> (# s, acc #)+ _ -> case readWord8OffAddr# addr i s of+ (# s1, w #) -> loop+ (p `timesWord#` (acc `xor#` w))+ (i +# 1#)+ s1++ !(W# p) = fnvPrime+{-# INLINE fnv1aPrimitive_ #-}+
+ src/Data/Hash/SipHash.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module: Data.Hash.SipHash+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Data.Hash.SipHash+( sipHash+, sipHash13+, sipHash24+, sipHash48+, sipHashCD++-- * Utils+, module Data.Hash.Utils+) where++import Control.Monad++import Data.Bits+import Data.Function+import Data.Word++import Foreign.Marshal.Utils+import Foreign.Storable++import GHC.Ptr++import Prelude hiding (drop, length, null, splitAt, take)++-- internal modules++import Data.Hash.Utils++-- -------------------------------------------------------------------------- --+-- SipHash++-- | SipHash, with recommended default parameters of c=2 and c=4.+--+-- The first and second argument is the 128 bit key, represented as two 64 bit+-- words.+--+sipHash+ :: Word64+ -> Word64+ -> Ptr Word8+ -> Int+ -> IO Word64+sipHash = sipHash24+{-# INLINE sipHash #-}++-- | SipHash-2-4+--+-- The first and second argument is the 128 bit key, represented as two 64 bit+-- words.+--+sipHash24+ :: Word64+ -> Word64+ -> Ptr Word8+ -> Int+ -> IO Word64+sipHash24 = sipHashInternal rounds2 rounds4+{-# INLINE sipHash24 #-}++-- | SipHash-1-3+--+-- The first and second argument is the 128 bit key, represented as two 64 bit+-- words.+--+sipHash13+ :: Word64+ -> Word64+ -> Ptr Word8+ -> Int+ -> IO Word64+sipHash13 = sipHashInternal rounds1 rounds3+{-# INLINE sipHash13 #-}++-- | SipHash-4-8+--+-- The first and second argument is the 128 bit key, represented as two 64 bit+-- words.+--+sipHash48+ :: Word64+ -> Word64+ -> Ptr Word8+ -> Int+ -> IO Word64+sipHash48 = sipHashInternal rounds4 rounds8+{-# INLINE sipHash48 #-}++-- | Generic SipHash with c rounds per block and d finalization rounds.+--+-- The first and second argument is the 128 bit key, represented as two 64 bit+-- words.+--+sipHashCD+ :: Int+ -> Int+ -> Word64+ -> Word64+ -> Ptr Word8+ -> Int+ -> IO Word64+sipHashCD c d = sipHashInternal (rounds c) (rounds d)+{-# INLINE sipHashCD #-}++-- -------------------------------------------------------------------------- --+-- Generic SipHash++data S = S+ {-# UNPACK #-} !Word64+ {-# UNPACK #-} !Word64+ {-# UNPACK #-} !Word64+ {-# UNPACK #-} !Word64++type Round = Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)++sipHashInternal+ :: Round+ -> Round+ -> Word64+ -> Word64+ -> Ptr Word8+ -> Int+ -> IO Word64+sipHashInternal cRound dRound !k0 !k1 !ptr !len = do++ -- loop+ (S !v0 !v1 !v2 !v3) <- loop i0 i1 i2 i3 (castPtr ptr) len++ -- end+ let (!off, !r) = quotRem len 8+ w <- ptrToWord64 (plusPtr ptr (off * 8)) r+ let !b = shiftL (fromIntegral len) 56 .|. w+ (# !v0', !v1', !v2', !v3' #) = cRound v0 v1 v2 (v3 `xor` b)+ (# !v0'', !v1'', !v2'', !v3'' #) = dRound (v0' `xor` b) v1' (v2' `xor` 0xff) v3'+ return $! v0'' `xor` v1'' `xor` v2'' `xor` v3''++ where++ loop !v0 !v1 !v2 !v3 !p !l+ | l < 8 = return $ S v0 v1 v2 v3+ | otherwise = do+ !m <- peek p+ let (# v0', v1', v2', v3' #) = cRound v0 v1 v2 (v3 `xor` m)+ loop (v0' `xor` m) v1' v2' v3' (plusPtr p 8) (l - 8)++ !i0 = 0x736f6d6570736575 `xor` k0+ !i1 = 0x646f72616e646f6d `xor` k1+ !i2 = 0x6c7967656e657261 `xor` k0+ !i3 = 0x7465646279746573 `xor` k1+ {-# INLINE i0 #-}+ {-# INLINE i1 #-}+ {-# INLINE i2 #-}+ {-# INLINE i3 #-}+{-# INLINE sipHashInternal #-}++ptrToWord64 :: Ptr Word64 -> Int -> IO Word64+ptrToWord64 _ 0 = pure 0+ptrToWord64 !p 1 = fromIntegral <$!> peek @Word8 (castPtr p)+ptrToWord64 !p 2 = fromIntegral <$!> peek @Word16 (castPtr p)+ptrToWord64 !p 4 = fromIntegral <$!> peek @Word32 (castPtr p)+ptrToWord64 !p !i = with @Word64 0 $ \p' -> do+ -- using 'with' within unsafeDupablePerformIO is probably safe because+ -- with uses 'alloca', which guarantees that the memory is released+ -- when computation is abondended before being terminated.+ copyBytes p' p i+ peek p'+{-# INLINE ptrToWord64 #-}++rounds1 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)+rounds1 !v0 !v1 !v2 !v3 = sipRound v0 v1 v2 v3+{-# INLINE rounds1 #-}++rounds2 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)+rounds2 !v0 !v1 !v2 !v3 =+ let (# !v0', !v1', !v2', !v3' #) = sipRound v0 v1 v2 v3+ in sipRound v0' v1' v2' v3'+{-# INLINE rounds2 #-}++rounds3 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)+rounds3 !v0 !v1 !v2 !v3 =+ let (# !v0', !v1', !v2', !v3' #) = sipRound v0 v1 v2 v3+ (# !v0'', !v1'', !v2'', !v3'' #) = sipRound v0' v1' v2' v3'+ in sipRound v0'' v1'' v2'' v3''+{-# INLINE rounds3 #-}++rounds4 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)+rounds4 !v0 !v1 !v2 !v3 =+ let (# !v0', !v1', !v2', !v3' #) = sipRound v0 v1 v2 v3+ (# !v0'', !v1'', !v2'', !v3'' #) = sipRound v0' v1' v2' v3'+ (# !v0''', !v1''', !v2''', !v3''' #) = sipRound v0'' v1'' v2'' v3''+ in sipRound v0''' v1''' v2''' v3'''+{-# INLINE rounds4 #-}++rounds8 :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)+rounds8 !v0 !v1 !v2 !v3 =+ let (# !v0', !v1', !v2', !v3' #) = sipRound v0 v1 v2 v3+ (# !v0'', !v1'', !v2'', !v3'' #) = sipRound v0' v1' v2' v3'+ (# !v0''', !v1''', !v2''', !v3''' #) = sipRound v0'' v1'' v2'' v3''+ (# !v0'''', !v1'''', !v2'''', !v3'''' #) = sipRound v0''' v1''' v2''' v3'''+ (# !v0''''', !v1''''', !v2''''', !v3''''' #) = sipRound v0'''' v1'''' v2'''' v3''''+ (# !v0'''''', !v1'''''', !v2'''''', !v3'''''' #) = sipRound v0''''' v1''''' v2''''' v3'''''+ (# !v0''''''', !v1''''''', !v2''''''', !v3''''''' #) = sipRound v0'''''' v1'''''' v2'''''' v3''''''+ in sipRound v0''''''' v1''''''' v2''''''' v3'''''''+{-# INLINE rounds8 #-}++rounds :: Int -> Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)+rounds 1 !v0 !v1 !v2 !v3 = rounds1 v0 v1 v2 v3+rounds 2 !v0 !v1 !v2 !v3 = rounds2 v0 v1 v2 v3+rounds 3 !v0 !v1 !v2 !v3 = rounds3 v0 v1 v2 v3+rounds 4 !v0 !v1 !v2 !v3 = rounds4 v0 v1 v2 v3+rounds 8 !v0 !v1 !v2 !v3 = rounds8 v0 v1 v2 v3+rounds !c !v0 !v1 !v2 !v3 = case sipRound v0 v1 v2 v3 of+ (# v0', v1', v2', v3' #) -> rounds (c - 1) v0' v1' v2' v3'+{-# INLINE rounds #-}++sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> (# Word64, Word64, Word64, Word64 #)+sipRound !v0 !v1 !v2 !v3 = (# v0''', v1'''', v2''', v3'''' #)+ where+ !v0' = v0 + v1+ !v2' = v2 + v3+ !v1' = v1 `rotateL` 13+ !v3' = v3 `rotateL` 16+ !v1'' = v1' `xor` v0'+ !v3'' = v3' `xor` v2'+ !v0'' = v0' `rotateL` 32+ !v2'' = v2' + v1''+ !v0''' = v0'' + v3''+ !v1''' = v1'' `rotateL` 17+ !v3''' = v3'' `rotateL` 21+ !v1'''' = v1''' `xor` v2''+ !v3'''' = v3''' `xor` v0'''+ !v2''' = v2'' `rotateL` 32+{-# INLINE sipRound #-}+
+ src/Data/Hash/Utils.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module: Data.Hash.Utils+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Data.Hash.Utils+(+-- * Pure API+ hashStorable+, hashStorable_+, hashByteString+, hashByteString_+, hashByteArray+, hashByteArray_+, hashPtr+, hashPtr_++-- * IO API+, hashStorableIO+, hashStorableIO_+, hashByteStringIO+, hashByteStringIO_+, hashByteArrayIO+, hashByteArrayIO_+) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import Data.Word++import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable++import GHC.Exts+import GHC.IO+import Foreign.Marshal.Alloc++-- -------------------------------------------------------------------------- --+-- Pure API++-- Storable++hashStorable :: Storable a => (Ptr Word8 -> Int -> IO b) -> a -> b+hashStorable f = unsafeDupablePerformIO . hashStorableIO f+{-# INLINE hashStorable #-}++hashStorable_ :: Storable a => (Ptr Word8 -> Int -> b -> IO b) -> a -> b -> b+hashStorable_ f a = unsafeDupablePerformIO . hashStorableIO_ f a+{-# INLINE hashStorable_ #-}++-- ByteString++hashByteString :: (Ptr Word8 -> Int -> IO b) -> B.ByteString -> b+hashByteString f = unsafeDupablePerformIO . hashByteStringIO f+{-# INLINE hashByteString #-}++hashByteString_ :: (Ptr Word8 -> Int -> b -> IO b) -> B.ByteString -> b -> b+hashByteString_ f a = unsafeDupablePerformIO . hashByteStringIO_ f a+{-# INLINE hashByteString_ #-}++-- ByteArray++hashByteArray :: (Ptr Word8 -> Int -> IO b) -> ByteArray# -> b+hashByteArray f a# = unsafeDupablePerformIO $! hashByteArrayIO f a#+{-# INLINE hashByteArray #-}++hashByteArray_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> b+hashByteArray_ f a# = unsafeDupablePerformIO . hashByteArrayIO_ f a#+{-# INLINE hashByteArray_ #-}++-- Ptr++hashPtr :: (Ptr Word8 -> Int -> IO b) -> Ptr Word8 -> Int -> b+hashPtr f ptr = unsafeDupablePerformIO . f ptr+{-# INLINE hashPtr #-}++hashPtr_ :: (Ptr Word8 -> Int -> b -> IO b) -> Ptr Word8 -> Int -> b -> b+hashPtr_ f ptr l = unsafeDupablePerformIO . f ptr l+{-# INLINE hashPtr_ #-}++-- -------------------------------------------------------------------------- --+-- IO API++-- Storable++hashStorableIO :: Storable a => (Ptr Word8 -> Int -> IO b) -> a -> IO b+hashStorableIO f a = with a $ \ptr -> f (castPtr ptr) (sizeOf a)+{-# INLINE hashStorableIO #-}++hashStorableIO_ :: Storable a => (Ptr Word8 -> Int -> b -> IO b) -> a -> b -> IO b+hashStorableIO_ f a b = with a $ \ptr -> f (castPtr ptr) (sizeOf a) b+{-# INLINE hashStorableIO_ #-}++-- ByteString++hashByteStringIO :: (Ptr Word8 -> Int -> IO b) -> B.ByteString -> IO b+hashByteStringIO f a = B.unsafeUseAsCStringLen a $ \(!p, !l) -> f (castPtr p) l+{-# INLINE hashByteStringIO #-}++hashByteStringIO_ :: (Ptr Word8 -> Int -> b -> IO b) -> B.ByteString -> b -> IO b+hashByteStringIO_ f a b = B.unsafeUseAsCStringLen a $ \(!p, !l) -> f (castPtr p) l b+{-# INLINE hashByteStringIO_ #-}++-- ByteArray++hashByteArrayIO :: (Ptr Word8 -> Int -> IO b) -> ByteArray# -> IO b+hashByteArrayIO f a# = case isByteArrayPinned# a# of+ -- Pinned ByteArray+ 1# -> f (Ptr (byteArrayContents# a#)) (I# size#)++ -- Unpinned ByteArray, copy content to newly allocated pinned ByteArray+ _ -> allocaBytes (I# size#) $ \ptr@(Ptr addr#) -> IO $ \s0 ->+ case copyByteArrayToAddr# a# 0# addr# size# s0 of+ s1 -> case f ptr (I# size#) of+ IO run -> run s1+ where+ size# = sizeofByteArray# a#+{-# INLINE hashByteArrayIO #-}+++hashByteArrayIO_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> IO b+hashByteArrayIO_ f a# b = case isByteArrayPinned# a# of+ -- Pinned ByteArray+ 1# -> f (Ptr (byteArrayContents# a#)) (I# size#) b++ -- Unpinned ByteArray, copy content to newly allocated pinned ByteArray+ _ -> allocaBytes (I# size#) $ \ptr@(Ptr addr#) -> IO $ \s0 ->+ case copyByteArrayToAddr# a# 0# addr# size# s0 of+ s1 -> case f ptr (I# size#) b of+ IO run -> run s1+ where+ size# = sizeofByteArray# a#+{-# INLINE hashByteArrayIO_ #-}+
+ test/Main.hs view
@@ -0,0 +1,22 @@++-- |+-- Module: Main+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Main+( main+) where++import qualified Test.Data.Hash.FNV1+import qualified Test.Data.Hash.SipHash+import qualified Test.Data.Hash.Utils++main :: IO ()+main = do+ putStrLn "Test.Data.Hash.FNV1.tests: " >> Test.Data.Hash.FNV1.tests+ putStrLn "Test.Data.Hash.SipHash.tests: " >> Test.Data.Hash.SipHash.tests+ putStrLn "Test.Data.Hash.Utils:" >> Test.Data.Hash.Utils.tests+
+ test/Test/Data/Hash/FNV1.hs view
@@ -0,0 +1,463 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Test.Data.Hash.FNV1+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Test.Data.Hash.FNV1+( tests+) where++import Data.Bifunctor+import qualified Data.ByteString as B+import Data.Word++import GHC.Ptr++import Test.QuickCheck++-- internal modules++import Data.Hash.FNV1++-- -------------------------------------------------------------------------- --+-- All tests++tests :: IO ()+tests = quickCheck $ tests64+ && tests32+ && tests64a+ && tests32a+ && testsPrim+ && testsPrima++-- -------------------------------------------------------------------------- --+-- 64 bit FNV1++tests64 :: Bool+tests64 = all test64 testVectors64+ && all testZero64 zeros64++test64 :: (B.ByteString, Word64) -> Bool+test64 (b, r) = hashByteString fnv1_64 b == r++testZero64 :: B.ByteString -> Bool+testZero64 b = hashByteString fnv1_64 b == 0++testVectors64 :: [(B.ByteString, Word64)]+testVectors64 = []++-- | All FNV1 64 bit inputs that result in a hash of 0 up to a length of nine+-- bytes.+--+-- (cf. http://www.isthe.com/chongo/tech/comp/fnv/)+--+zeros64 :: [B.ByteString]+zeros64 = B.pack <$>+ [ [0x92, 0x06, 0x77, 0x4c, 0xe0, 0x2f, 0x89, 0x2a, 0xd2]+ , [0xfb, 0x6c, 0x4f, 0xdb, 0x00, 0x41, 0xdb, 0xc0, 0xfe]+ , [0x9f, 0x72, 0x72, 0x35, 0x80, 0x4b, 0x8d, 0x6b, 0x06]+ , [0x3d, 0x82, 0x76, 0x00, 0x80, 0x7c, 0x52, 0x62, 0x1a]+ , [0x58, 0x21, 0xf5, 0xa2, 0xe1, 0x01, 0x9d, 0x80, 0xe0]+ , [0x52, 0xa1, 0xeb, 0x10, 0xa0, 0xe9, 0x45, 0x96, 0x05]+ , [0xbe, 0x64, 0x8a, 0x14, 0xe1, 0x46, 0x17, 0x18, 0xff]+ , [0x9e, 0x50, 0x1d, 0xf2, 0x41, 0x75, 0x55, 0xac, 0x05]+ , [0xb3, 0x92, 0xa9, 0x6f, 0x80, 0xe4, 0x29, 0xa4, 0x63]+ , [0x82, 0xba, 0xb3, 0x41, 0x81, 0x0f, 0xdb, 0x83, 0x15]+ , [0x92, 0xf4, 0x6e, 0x0e, 0xe1, 0xb9, 0xe5, 0x45, 0x2d]+ , [0x3c, 0xea, 0x57, 0x50, 0x81, 0x67, 0x67, 0x9b, 0xe0]+ , [0x36, 0xe3, 0x96, 0x34, 0xe2, 0x1d, 0x36, 0x00, 0x61]+ , [0xaf, 0xfa, 0xff, 0xee, 0x61, 0xb0, 0x5e, 0xc4, 0x04]+ , [0xd5, 0xc9, 0x88, 0x15, 0x02, 0x2f, 0xd3, 0x38, 0xc2]+ , [0xbc, 0xa7, 0x38, 0x51, 0xe2, 0x2f, 0xb1, 0x1b, 0x22]+ , [0x70, 0xf2, 0x10, 0xba, 0x02, 0x45, 0x37, 0xb3, 0xe8]+ , [0x5b, 0xa3, 0xa0, 0x4e, 0x81, 0xfc, 0x4f, 0x32, 0x5b]+ , [0xcd, 0x50, 0x99, 0x68, 0x22, 0xd4, 0x78, 0x2f, 0xb0]+ , [0xfa, 0xff, 0x0d, 0xfa, 0xe2, 0xf0, 0x43, 0xb4, 0x9a]+ , [0x16, 0x3f, 0xba, 0x47, 0x43, 0x94, 0x44, 0xfe, 0x86]+ , [0x46, 0xe0, 0x03, 0x71, 0xc2, 0x57, 0xf0, 0xbc, 0xda]+ , [0x60, 0x74, 0x4a, 0x52, 0xe3, 0x06, 0x42, 0x36, 0xf2]+ , [0x97, 0x20, 0x3a, 0xf8, 0xa2, 0xf6, 0x8a, 0x62, 0xa6]+ , [0x98, 0xf5, 0xcc, 0xd5, 0x03, 0x32, 0x22, 0x1a, 0xe2]+ , [0x5d, 0xd5, 0x14, 0xe8, 0xe3, 0x43, 0x8b, 0x5a, 0x9e]+ , [0x95, 0xb8, 0x11, 0x62, 0x03, 0x5a, 0xed, 0xd2, 0xcb]+ , [0xf9, 0xcb, 0x23, 0x1d, 0x03, 0x71, 0xc5, 0xca, 0x5c]+ , [0xc3, 0x04, 0x1c, 0x59, 0x82, 0xa5, 0xaa, 0x9b, 0x55]+ , [0x68, 0x10, 0x80, 0x61, 0xa3, 0x5e, 0x72, 0x31, 0x48]+ , [0x43, 0x0a, 0xeb, 0x89, 0xc2, 0xc1, 0x9d, 0xd8, 0x2a]+ , [0x5a, 0xa3, 0xe3, 0x40, 0x23, 0xce, 0x90, 0xbc, 0xa2]+ , [0x27, 0xe1, 0x3f, 0xaa, 0xa3, 0x8f, 0xaf, 0x6a, 0x51]+ , [0x0c, 0x5b, 0xac, 0x36, 0x24, 0x22, 0xa2, 0x7c, 0x24]+ , [0xea, 0xbc, 0xd7, 0x7c, 0x24, 0x49, 0x58, 0x66, 0x57]+ , [0x5a, 0x30, 0x62, 0x51, 0x83, 0x9c, 0x97, 0xc3, 0x75]+ , [0x7a, 0x18, 0x75, 0xd3, 0xc3, 0x88, 0x65, 0x0b, 0x3a]+ , [0x02, 0x38, 0x25, 0x95, 0x25, 0x0b, 0x3b, 0x0c, 0xa8]+ , [0x33, 0x1c, 0xae, 0xdd, 0x83, 0xfc, 0x55, 0xf4, 0x63]+ , [0xcb, 0x87, 0x3d, 0xb9, 0xe5, 0x38, 0x0b, 0xbd, 0xca]+ , [0x3a, 0x25, 0xba, 0x67, 0xa4, 0xc7, 0x49, 0x80, 0xe9]+ , [0x49, 0x14, 0x3b, 0x94, 0x05, 0x63, 0xb5, 0xde, 0xd6]+ , [0x45, 0xfb, 0x0d, 0x28, 0x45, 0x19, 0x66, 0x63, 0x27]+ , [0x92, 0x7a, 0xe5, 0xa6, 0xe5, 0x88, 0xba, 0x55, 0x68]+ , [0xc3, 0x93, 0x7c, 0x11, 0xc4, 0x1a, 0x2f, 0xe0, 0x8b]+ , [0xa1, 0xd8, 0x5e, 0x71, 0xa5, 0x6a, 0x96, 0x5e, 0x64]+ , [0x77, 0x7b, 0xd7, 0x7d, 0x05, 0xdc, 0x73, 0x64, 0xc3]+ , [0x3d, 0x3f, 0xd4, 0xd6, 0xa6, 0x71, 0xb2, 0x9d, 0x65]+ , [0x8d, 0x45, 0x9e, 0xd0, 0x27, 0x66, 0xb4, 0x46, 0x34]+ , [0xf1, 0xda, 0x16, 0xa1, 0x85, 0xfe, 0x43, 0xa7, 0x30]+ , [0x97, 0x6b, 0x02, 0xe3, 0x66, 0x10, 0x3d, 0x6e, 0xab]+ , [0x84, 0x2b, 0xd9, 0x13, 0xa7, 0x25, 0x5a, 0x8a, 0x22]+ , [0x0c, 0x2b, 0x2f, 0xd2, 0x28, 0x3a, 0x91, 0xdf, 0x95]+ , [0x1c, 0x01, 0xed, 0xaa, 0x47, 0x2f, 0x64, 0x6a, 0x8b]+ , [0x71, 0x66, 0x6f, 0x98, 0x47, 0x74, 0x48, 0xeb, 0x39]+ , [0x2b, 0xb3, 0x61, 0xde, 0xe8, 0x6c, 0x33, 0xfd, 0x32]+ , [0xc5, 0x33, 0x7e, 0xc3, 0x87, 0x9c, 0x0c, 0x24, 0x4b]+ , [0xb7, 0x44, 0xea, 0x2c, 0xa8, 0x59, 0xbc, 0xfc, 0xc5]+ , [0xb2, 0x8c, 0x40, 0x98, 0x67, 0x46, 0x6f, 0xce, 0x35]+ , [0x04, 0x34, 0x61, 0xb3, 0x87, 0xd4, 0xe5, 0x1a, 0x7f]+ , [0x20, 0xba, 0x15, 0x17, 0xe8, 0xdd, 0xd9, 0xf6, 0x19]+ , [0x36, 0xc4, 0xd3, 0xef, 0x88, 0x53, 0x6e, 0x86, 0x56]+ , [0x32, 0x55, 0xce, 0xf0, 0x48, 0x73, 0xaf, 0x8d, 0x9d]+ , [0x18, 0x3c, 0xd8, 0x70, 0x08, 0x71, 0x6a, 0x47, 0xa3]+ , [0xa8, 0xad, 0xfb, 0x29, 0xa8, 0xe4, 0x8e, 0x82, 0xc4]+ , [0x47, 0x47, 0xbf, 0x58, 0x08, 0x7f, 0xab, 0xbc, 0x34]+ , [0x8f, 0x68, 0x71, 0x3a, 0xe9, 0x56, 0x8f, 0xd0, 0x0f]+ , [0x64, 0x5e, 0xdc, 0x14, 0x88, 0x93, 0x8d, 0xb4, 0x35]+ , [0xb4, 0x33, 0xd0, 0x6d, 0x48, 0xbb, 0x3a, 0x5d, 0x3d]+ , [0x22, 0xe4, 0x4d, 0x0a, 0x48, 0xbd, 0x95, 0x1e, 0x8e]+ , [0x78, 0x6e, 0x06, 0x7d, 0x48, 0xce, 0xdb, 0x12, 0x33]+ , [0x7e, 0x1f, 0x4d, 0x02, 0x48, 0xf8, 0xd2, 0xa5, 0xc2]+ , [0x90, 0x6b, 0x26, 0x4e, 0xc7, 0xef, 0x12, 0xf2, 0x20]+ , [0x90, 0x10, 0xa8, 0x21, 0x09, 0x16, 0x22, 0x57, 0xbc]+ , [0x5b, 0x1a, 0x8c, 0xbc, 0x09, 0x2c, 0xa4, 0x2d, 0x9c]+ , [0x2c, 0x1a, 0x6e, 0x44, 0xa9, 0x7d, 0x98, 0xe0, 0x39]+ , [0x8a, 0x2b, 0x35, 0xab, 0x49, 0x97, 0xd5, 0xf7, 0xbc]+ , [0x29, 0xbc, 0x62, 0x5e, 0x0a, 0x4e, 0x9e, 0x34, 0x40]+ , [0xe7, 0xe6, 0xc7, 0x00, 0xaa, 0xd3, 0x26, 0x5a, 0x4a]+ , [0x7e, 0x65, 0xe5, 0x51, 0x2b, 0x66, 0xe8, 0xb5, 0xb2]+ , [0x2b, 0xd7, 0xcf, 0x6a, 0x6a, 0x6f, 0xb4, 0x56, 0xc9]+ , [0x33, 0x51, 0x09, 0xaf, 0xab, 0x42, 0x80, 0x8b, 0x07]+ , [0xd1, 0x78, 0x30, 0x6b, 0xc9, 0x9c, 0xaf, 0x1f, 0xd4]+ , [0xc6, 0x00, 0xf9, 0xbf, 0x4b, 0x38, 0xf0, 0x00, 0xc6]+ , [0xa1, 0x81, 0x99, 0x9a, 0xc9, 0xf2, 0x8e, 0x4c, 0x6f]+ , [0xb3, 0xd1, 0x6c, 0x57, 0x2c, 0x62, 0x3c, 0xb0, 0x5c]+ , [0xc7, 0x50, 0xc1, 0x4d, 0xec, 0xde, 0x91, 0xe8, 0xfd]+ , [0x54, 0x51, 0xfe, 0xaa, 0xec, 0xe9, 0x6b, 0xf2, 0xa2]+ , [0x5d, 0xdc, 0x27, 0xf3, 0x4b, 0xc8, 0xb0, 0x9a, 0xc9]+ , [0xd2, 0x4d, 0xe1, 0x77, 0x8c, 0x0a, 0x8f, 0x2d, 0x44]+ , [0xce, 0xe4, 0xe5, 0x80, 0xca, 0x8a, 0x07, 0xdc, 0x67]+ , [0x0f, 0xd0, 0x8f, 0x67, 0xca, 0x9f, 0x94, 0xa5, 0x86]+ , [0x89, 0xe9, 0xed, 0xdd, 0xed, 0x84, 0x84, 0x50, 0x26]+ , [0x76, 0xf5, 0xbe, 0x03, 0xac, 0x82, 0x5a, 0x09, 0x26]+ , [0xf8, 0x71, 0x02, 0xca, 0x6c, 0x6d, 0xa5, 0xae, 0xfc]+ , [0xe8, 0xcb, 0x80, 0x56, 0xad, 0x00, 0xa0, 0xd1, 0xd2]+ , [0x88, 0x89, 0x0c, 0xdd, 0x0c, 0xcf, 0xb2, 0x5d, 0xd7]+ , [0x69, 0xad, 0x8f, 0xdb, 0x0d, 0x03, 0x8a, 0xca, 0x37]+ , [0x96, 0x58, 0x24, 0x93, 0xcb, 0xbf, 0xd7, 0xf1, 0xfe]+ , [0xee, 0xb1, 0xf6, 0xd2, 0x6d, 0x9b, 0x46, 0x7d, 0x3f]+ , [0xde, 0x64, 0x18, 0xd6, 0x2e, 0x86, 0x5b, 0x3c, 0x0c]+ , [0x24, 0x05, 0x66, 0xe4, 0x0d, 0xf1, 0xc8, 0xb1, 0xd3]+ , [0x77, 0xd7, 0x5f, 0x5f, 0xef, 0x81, 0x2d, 0xb3, 0x37]+ , [0x58, 0x53, 0xf5, 0xb5, 0x2e, 0xec, 0x51, 0xfe, 0x25]+ , [0xba, 0x65, 0x2a, 0x3b, 0x8e, 0xc6, 0xbb, 0xa8, 0xb6]+ , [0xe5, 0x81, 0x4f, 0x09, 0xf0, 0x0c, 0xec, 0xf9, 0xfa]+ , [0x50, 0x5b, 0xe8, 0xf9, 0xf0, 0x6a, 0x47, 0xb4, 0x64]+ , [0xd3, 0x0e, 0xf4, 0xc7, 0x6e, 0xd9, 0x60, 0x31, 0xb5]+ , [0x58, 0xe4, 0x4a, 0x3c, 0xcd, 0x97, 0xd6, 0xfd, 0x84]+ , [0x6f, 0x82, 0xaa, 0xca, 0x2f, 0xe7, 0x1a, 0x8d, 0xb1]+ , [0x8f, 0x50, 0xec, 0x2f, 0x2f, 0xe7, 0x30, 0x4c, 0xdb]+ , [0xf0, 0x3b, 0x01, 0xdb, 0x6f, 0x33, 0xdb, 0x82, 0x41]+ , [0x13, 0x3c, 0x71, 0xe4, 0x8f, 0x75, 0x46, 0x48, 0x8f]+ , [0x2f, 0xa5, 0xa5, 0x41, 0xcd, 0xf5, 0xb4, 0xc6, 0x45]+ , [0x8b, 0x1a, 0x4c, 0x12, 0x30, 0x38, 0xc3, 0x61, 0x08]+ , [0x6f, 0x9c, 0x5c, 0x3f, 0x8f, 0xd6, 0x47, 0x70, 0xf7]+ , [0xc1, 0x0e, 0x16, 0x18, 0x50, 0x1b, 0x47, 0x48, 0xf8]+ , [0x2b, 0x94, 0x3f, 0xad, 0x30, 0xad, 0x5e, 0xc4, 0x85]+ , [0x5f, 0x55, 0x92, 0xc6, 0xce, 0xb9, 0xf5, 0x05, 0x08]+ , [0x42, 0x8e, 0x3a, 0xbb, 0xf1, 0xbd, 0x08, 0x09, 0x25]+ , [0x28, 0x84, 0xf5, 0x2b, 0xce, 0xf1, 0x3e, 0x47, 0x41]+ , [0x25, 0xd1, 0x2c, 0xbf, 0x90, 0x5c, 0x71, 0x24, 0x85]+ , [0xd0, 0x25, 0x3d, 0xf3, 0x90, 0x64, 0x67, 0xae, 0xf9]+ , [0xc5, 0x1d, 0xe5, 0x36, 0x11, 0xa9, 0x7b, 0x4d, 0xe0]+ , [0x88, 0xc2, 0x24, 0xda, 0x50, 0xf9, 0x55, 0x03, 0xdc]+ , [0xff, 0x54, 0x4f, 0x75, 0xcf, 0x6d, 0xbb, 0xc4, 0x4b]+ , [0x9e, 0x49, 0xc2, 0x63, 0x11, 0xd7, 0xb0, 0x74, 0x25]+ , [0xac, 0xb1, 0x42, 0x65, 0xcf, 0x7d, 0x84, 0x0e, 0x37]+ , [0x05, 0xa5, 0x28, 0x18, 0x11, 0xe3, 0x0d, 0x6a, 0xaa]+ , [0x03, 0x8d, 0x11, 0xce, 0xf2, 0x6f, 0x0e, 0x0a, 0xcf]+ , [0xbf, 0xd6, 0x88, 0x3d, 0x51, 0x75, 0x18, 0x67, 0x0e]+ , [0x69, 0xa2, 0xdd, 0x69, 0xcf, 0xe4, 0x94, 0x5e, 0xe3]+ , [0xe4, 0x62, 0x0b, 0x95, 0xb1, 0x58, 0xa1, 0xd4, 0x25]+ , [0xc0, 0x75, 0xc6, 0xec, 0x51, 0x9e, 0xd4, 0xc7, 0x4c]+ , [0x83, 0x9d, 0xb3, 0x97, 0x32, 0x54, 0x9b, 0x04, 0xec]+ , [0x9a, 0x7f, 0x71, 0x94, 0x32, 0xcf, 0xbb, 0x97, 0x38]+ , [0x7a, 0x4f, 0xe4, 0x60, 0x13, 0x93, 0xfd, 0x7d, 0x50]+ , [0x76, 0x48, 0x71, 0xf5, 0x52, 0x2f, 0xcb, 0xf7, 0xe2]+ , [0xda, 0x0e, 0x88, 0x1f, 0x13, 0xba, 0xd5, 0xa7, 0x2f]+ , [0x2a, 0xbe, 0xca, 0xe7, 0x33, 0x12, 0x4e, 0x33, 0x26]+ , [0x79, 0xce, 0x5e, 0xee, 0x92, 0x27, 0x5d, 0xc7, 0x17]+ , [0x36, 0x91, 0x77, 0xd3, 0x72, 0x5a, 0xde, 0x9f, 0x0b]+ , [0x3a, 0x33, 0xcd, 0x8d, 0x52, 0x7a, 0xb8, 0x2a, 0xd8]+ , [0x25, 0x66, 0xec, 0xc3, 0x52, 0x8b, 0xd0, 0x13, 0x4f]+ , [0xde, 0xd7, 0xa1, 0x1f, 0xb2, 0x58, 0x65, 0xd8, 0xd7]+ , [0x8a, 0xe5, 0xcb, 0x54, 0x33, 0xb0, 0xde, 0x92, 0x42]+ , [0x71, 0x49, 0x0a, 0xbb, 0x33, 0xd8, 0x35, 0xb3, 0x59]+ , [0x03, 0x36, 0x3b, 0x64, 0xf4, 0x98, 0x4b, 0x21, 0x99]+ , [0x8c, 0xf5, 0x50, 0x02, 0xd2, 0x10, 0xdb, 0x86, 0x1d]+ , [0xc3, 0x4f, 0xcf, 0x6e, 0x93, 0x4e, 0xb5, 0xd8, 0xb4]+ , [0x2a, 0xfb, 0x95, 0x75, 0x73, 0x8c, 0x85, 0x76, 0x82]+ , [0x35, 0xc0, 0x2a, 0x8b, 0xf5, 0x56, 0x45, 0x66, 0x45]+ , [0x68, 0x2a, 0x76, 0x44, 0x73, 0xcf, 0x31, 0x3a, 0x8e]+ , [0x98, 0x4c, 0xa0, 0x05, 0x93, 0x9a, 0xcf, 0x65, 0xa1]+ , [0xa5, 0x3e, 0x3b, 0xf8, 0x94, 0x0e, 0x6e, 0x74, 0x73]+ , [0x4b, 0x75, 0x16, 0xe9, 0x35, 0x47, 0xe2, 0xaf, 0x21]+ , [0x3c, 0x84, 0xfb, 0xee, 0xf6, 0x10, 0x6c, 0x09, 0x3f]+ , [0x45, 0x52, 0x87, 0x53, 0x74, 0x7c, 0x1b, 0x2c, 0xa1]+ , [0xa0, 0x8b, 0x28, 0xe0, 0xd3, 0x34, 0xbe, 0x90, 0xcb]+ , [0x67, 0x57, 0x50, 0xd0, 0x16, 0x3c, 0x23, 0xaf, 0xe1]+ , [0xa8, 0xa6, 0x4d, 0x44, 0x16, 0x52, 0x57, 0xba, 0x95]+ , [0x9e, 0x0c, 0xbe, 0x6a, 0x75, 0x1d, 0x3f, 0x6c, 0x20]+ , [0x14, 0x1b, 0x43, 0x7a, 0xb5, 0x4e, 0x40, 0x88, 0xb0]+ , [0x68, 0x3b, 0xbd, 0xd6, 0xf7, 0xae, 0xd7, 0xf9, 0x28]+ , [0xab, 0xc0, 0x61, 0xa3, 0x76, 0x20, 0xb8, 0xf7, 0x3b]+ , [0x05, 0xe8, 0x00, 0x91, 0xb5, 0xdd, 0xbe, 0x7e, 0xaf]+ , [0x14, 0xdd, 0x60, 0xa4, 0x96, 0x19, 0x04, 0x05, 0x16]+ , [0x7e, 0xe5, 0x14, 0xcd, 0x76, 0x87, 0x03, 0x4c, 0x2d]+ , [0x07, 0xf0, 0x09, 0x29, 0x18, 0x7d, 0x7d, 0xfe, 0x8a]+ , [0xb9, 0xb4, 0xa5, 0xc6, 0x37, 0x99, 0xfd, 0x49, 0xff]+ , [0xd2, 0xdd, 0x5a, 0x63, 0x37, 0xe4, 0x08, 0x8e, 0xd4]+ , [0xa2, 0x0b, 0xf2, 0x5e, 0x76, 0xfd, 0x65, 0x2c, 0x80]+ , [0xc8, 0xd7, 0xdf, 0xba, 0x37, 0xe8, 0xd9, 0x2b, 0x0c]+ , [0x6e, 0x40, 0x03, 0xeb, 0x37, 0xea, 0xeb, 0xa6, 0x93]+ , [0x27, 0xf9, 0x53, 0x0f, 0x37, 0xfc, 0x0e, 0x28, 0x60]+ , [0xc2, 0x72, 0x49, 0x23, 0xd5, 0xce, 0x7e, 0xbb, 0xef]+ , [0x3e, 0x11, 0xd8, 0x6b, 0xb6, 0xe9, 0x30, 0x2f, 0xab]+ , [0x0e, 0xdd, 0xb7, 0xd7, 0x19, 0x45, 0x86, 0xd7, 0x79]+ , [0xa3, 0xf7, 0x21, 0x85, 0x97, 0x07, 0x7d, 0xe1, 0x4b]+ , [0x4e, 0x76, 0x21, 0xee, 0x19, 0x67, 0x54, 0x55, 0x23]+ , [0x0f, 0x19, 0x18, 0xda, 0x38, 0x60, 0x1c, 0x0b, 0x9c]+ , [0xa4, 0x91, 0x5d, 0x2c, 0x77, 0x7f, 0xb4, 0xcb, 0xc6]+ , [0xc1, 0xb7, 0xee, 0x41, 0x19, 0x7a, 0x60, 0x4d, 0x7e]+ , [0x88, 0x47, 0x7b, 0x0c, 0xd6, 0x4c, 0xe0, 0xc1, 0x20]+ , [0x73, 0x88, 0xeb, 0x4f, 0xd6, 0x53, 0x4f, 0x7c, 0x6a]+ , [0xf4, 0x5a, 0xe5, 0xb3, 0xf9, 0xcf, 0x96, 0x88, 0x8f]+ , [0xba, 0x5c, 0xb1, 0x28, 0x58, 0x2f, 0x33, 0x16, 0xcc]+ , [0x04, 0xcd, 0x1f, 0xc8, 0x1a, 0x7a, 0x20, 0xf1, 0xd0]+ , [0x5f, 0x2c, 0x1c, 0x63, 0xb8, 0x48, 0x83, 0x82, 0xa4]+ , [0x22, 0xf5, 0xed, 0xa6, 0x98, 0x51, 0xeb, 0xa3, 0xf8]+ , [0xf8, 0x6b, 0x6d, 0x33, 0xfa, 0x65, 0x24, 0xbd, 0x5c]+ , [0x10, 0x3b, 0xb6, 0xae, 0xd7, 0x86, 0x73, 0x25, 0xd3]+ , [0x52, 0x31, 0x6c, 0x5a, 0x79, 0x03, 0xbe, 0x55, 0x95]+ , [0xaf, 0xc9, 0xab, 0x5e, 0x1b, 0x54, 0xde, 0x1d, 0x84]+ , [0xc2, 0xed, 0xf4, 0x36, 0x79, 0x77, 0x81, 0x0d, 0xee]+ , [0x36, 0xf5, 0xdb, 0xeb, 0xd8, 0x30, 0xd9, 0x69, 0xf6]+ , [0x43, 0x84, 0x92, 0xb9, 0x79, 0x90, 0x66, 0xa4, 0xe6]+ , [0x7d, 0xe9, 0x4d, 0x0e, 0x1b, 0xda, 0x69, 0xeb, 0x57]+ , [0x2d, 0x03, 0x20, 0x62, 0xfb, 0x3b, 0x6e, 0x88, 0x65]+ , [0xe5, 0x69, 0xec, 0xd2, 0x79, 0xbe, 0xd8, 0xaa, 0x8e]+ , [0xac, 0x26, 0x0a, 0xdd, 0xfb, 0x68, 0x43, 0x1f, 0x6d]+ , [0x3c, 0x96, 0xc1, 0xbe, 0x3a, 0xbe, 0x22, 0xae, 0x76]+ , [0xde, 0x73, 0x09, 0xf1, 0x1c, 0x39, 0x67, 0x8a, 0x0c]+ , [0x56, 0x2e, 0x5f, 0x2c, 0x3a, 0xfd, 0x30, 0x40, 0x7d]+ , [0x68, 0x57, 0xce, 0x1c, 0x59, 0xe0, 0xe0, 0xeb, 0x04]+ , [0xdf, 0xf7, 0xe6, 0x75, 0x1c, 0x66, 0x88, 0x86, 0x90]+ , [0xfd, 0xaf, 0xf5, 0x8b, 0x5a, 0x06, 0xae, 0x0b, 0x40]+ , [0x4e, 0xcf, 0xa7, 0xe9, 0x1c, 0x93, 0xaf, 0x36, 0xa8]+ , [0x56, 0xdc, 0x13, 0xcf, 0xfc, 0x12, 0x88, 0xbb, 0xb8]+ , [0x1f, 0x5f, 0xc2, 0xb2, 0x3b, 0x75, 0xfb, 0x7c, 0x92]+ , [0x4e, 0x9c, 0xbb, 0xba, 0x5a, 0x74, 0xe3, 0xa4, 0xe1]+ , [0x0b, 0xa0, 0xc8, 0xc5, 0x1d, 0x99, 0x06, 0x87, 0x5e]+ , [0xff, 0xef, 0xb0, 0x25, 0x1d, 0xf4, 0x9d, 0xdf, 0xdb]+ , [0x09, 0x67, 0xcb, 0x8f, 0x7c, 0x13, 0x3c, 0x75, 0x97]+ , [0x05, 0xbf, 0xfe, 0x4d, 0xfd, 0xd2, 0x6e, 0x61, 0x64]+ , [0xa4, 0xd7, 0x4b, 0x6d, 0x3d, 0x2a, 0xbb, 0xee, 0x4c]+ , [0xb9, 0x8c, 0x01, 0xcb, 0x5b, 0xf2, 0x50, 0x15, 0xf0]+ , [0x31, 0x45, 0x17, 0x91, 0x1e, 0xa3, 0x7f, 0x25, 0x52]+ , [0x10, 0x6c, 0x0c, 0x98, 0xdb, 0x0f, 0x9b, 0x1e, 0x88]+ , [0x06, 0xec, 0xcc, 0xb6, 0x9b, 0xda, 0xa2, 0x3a, 0x16]+ , [0x23, 0x66, 0x38, 0x19, 0x7c, 0xac, 0x80, 0xd3, 0x78]+ , [0xb8, 0xf3, 0xd7, 0x98, 0xbc, 0x11, 0x60, 0x0f, 0xbf]+ , [0x27, 0x24, 0x2d, 0xa8, 0xdb, 0xc2, 0x99, 0x28, 0x65]+ , [0x64, 0x61, 0x39, 0xc2, 0xbc, 0x79, 0xb5, 0xb1, 0xa6]+ , [0xdf, 0xff, 0x2a, 0x12, 0x5c, 0xfb, 0x42, 0x6d, 0x01]+ , [0xaf, 0x1d, 0xea, 0x4e, 0xff, 0x0d, 0x46, 0x95, 0x5e]+ , [0x2a, 0xb0, 0xc6, 0x54, 0x9c, 0xe9, 0x98, 0x43, 0xe1]+ , [0x7c, 0xe5, 0x9e, 0x74, 0x7d, 0xc8, 0x44, 0xef, 0x9e]+ , [0x56, 0x14, 0xd1, 0x31, 0xdc, 0xce, 0x77, 0x17, 0xc3]+ , [0xed, 0x6b, 0x65, 0x68, 0x3f, 0x05, 0x36, 0x41, 0x9b]+ , [0x2f, 0xd2, 0x24, 0x7e, 0xdd, 0x19, 0x4f, 0x91, 0x72]+ , [0xc8, 0x96, 0xf0, 0x54, 0x9d, 0x92, 0x5b, 0xcc, 0xb1]+ , [0x47, 0x5d, 0x76, 0x63, 0xbe, 0x17, 0x24, 0xad, 0xd4]+ , [0x4f, 0x88, 0x0b, 0x03, 0x9e, 0x4a, 0x48, 0xee, 0x14]+ , [0x26, 0xec, 0x1b, 0x56, 0x5e, 0xb8, 0x5d, 0x5e, 0x39]+ , [0xc3, 0xa8, 0x2d, 0x1a, 0x5e, 0xfc, 0xb7, 0x81, 0x49]+ , [0x14, 0x3a, 0x3b, 0x0b, 0xbe, 0xe7, 0xb2, 0x4d, 0x75]+ , [0x27, 0xa0, 0xf4, 0x22, 0xdf, 0xb5, 0xb6, 0x5e, 0x4a]+ ]++-- -------------------------------------------------------------------------- --+-- 64 bit FNV1a++tests64a :: Bool+tests64a = all test64a testVectors64a+ && all testZero64a zeros64a++test64a :: (B.ByteString, Word64) -> Bool+test64a (b, r) = hashByteString fnv1a_64 b == r++testZero64a :: B.ByteString -> Bool+testZero64a b = hashByteString fnv1a_64 b == 0++testVectors64a :: [(B.ByteString, Word64)]+testVectors64a = []++-- | All FNV1a 64 bit inputs that result in a hash of 0 up to a length of eight+-- bytes.+--+-- (cf. http://www.isthe.com/chongo/tech/comp/fnv/)+--+zeros64a :: [B.ByteString]+zeros64a = B.pack <$>+ [ [0xd5, 0x6b, 0xb9, 0x53, 0x42, 0x87, 0x08, 0x36]+ ]++-- -------------------------------------------------------------------------- --+-- 32 bit FNV1++tests32 :: Bool+tests32 = all test32 testVectors32+ && all testZero32 zeros32+ && testZero32 zero32ff++test32 :: (B.ByteString, Word32) -> Bool+test32 (b, r) = hashByteString fnv1_32 b == r++testVectors32 :: [(B.ByteString, Word32)]+testVectors32 = []++testZero32 :: B.ByteString -> Bool+testZero32 b = hashByteString fnv1_32 b == 0++-- | Two out of 254 inputs of up to 5 bytes length that result in a+-- fnv1 32 bit hash of 0.+--+-- (cf. http://www.isthe.com/chongo/tech/comp/fnv/)+--+zeros32 :: [B.ByteString]+zeros32 = B.pack <$>+ [ [0x01, 0x47, 0x6c, 0x10, 0xf3]+ , [0xfd, 0x45, 0x41, 0x08, 0xa0]+ ]++-- | The shortest set of consecutive 0xff octets for which the 32-bit FNV-1 hash+-- is 0.+--+-- (cf. http://www.isthe.com/chongo/tech/comp/fnv/)+--+zero32ff :: B.ByteString+zero32ff = B.replicate 428876705 0xff++-- -------------------------------------------------------------------------- --+-- 32 bit FNV1a++tests32a :: Bool+tests32a = all test32a testVectors32a+ && all testZero32a zeros32a+ && testZero32a zero32ffa++test32a :: (B.ByteString, Word32) -> Bool+test32a (b, r) = hashByteString fnv1a_32 b == r++testVectors32a :: [(B.ByteString, Word32)]+testVectors32a = []++testZero32a :: B.ByteString -> Bool+testZero32a b = hashByteString fnv1a_32 b == 0++-- | All FNV1a 32 bit inputs that result in a hash of 0 up to a length of four+-- bytes.+--+-- (cf. http://www.isthe.com/chongo/tech/comp/fnv/)+--+zeros32a :: [B.ByteString]+zeros32a = B.pack <$>+ [ [0xcc, 0x24, 0x31, 0xc4]+ , [0xe0, 0x4d, 0x9f, 0xcb]+ ]++zero32ffa :: B.ByteString+zero32ffa = B.replicate 3039744951 0xff++-- -------------------------------------------------------------------------- --+-- Primitive FNV1++primitiveFnv1 :: B.ByteString -> Word+primitiveFnv1 = hashByteString $ \(Ptr addr) n ->+ fromIntegral <$> fnv1 addr n+{-# INLINE primitiveFnv1 #-}++testsPrim :: Bool+testsPrim = all testPrim testVectorsPrim+ && all testZeroPrim zerosPrim++testPrim :: (B.ByteString, Word) -> Bool+testPrim (b, r) = primitiveFnv1 b == r++testZeroPrim :: B.ByteString -> Bool+testZeroPrim b = primitiveFnv1 b == 0++testVectorsPrim :: [(B.ByteString, Word)]+#if defined(x86_64_HOST_ARCH)+testVectorsPrim = second fromIntegral <$> testVectors64+#elif defined(i386_HOST_ARCH)+testVectorsPrim = second fromIntegral <$> testVectors32+#else+testVectorsPrim = error "testVectorsPrim: unsupported hardware platform"+#endif++zerosPrim :: [B.ByteString]+#if defined(x86_64_HOST_ARCH)+zerosPrim = zeros64+#elif defined(i386_HOST_ARCH)+zerosPrim = zeros32+#else+zerosPrim = error "zerosPrim: unsupported hardware platform"+#endif++-- -------------------------------------------------------------------------- --+-- Primitive FNV1a++primitiveFnv1a :: B.ByteString -> Word+primitiveFnv1a = hashByteString $ \(Ptr addr) n ->+ fromIntegral <$> fnv1a addr n+{-# INLINE primitiveFnv1a #-}++testsPrima :: Bool+testsPrima = all testPrima testVectorsPrima+ && all testZeroPrima zerosPrima++testPrima :: (B.ByteString, Word) -> Bool+testPrima (b, r) = primitiveFnv1a b == r++testZeroPrima :: B.ByteString -> Bool+testZeroPrima b = primitiveFnv1a b == 0++testVectorsPrima :: [(B.ByteString, Word)]+#if defined(x86_64_HOST_ARCH)+testVectorsPrima = second fromIntegral <$> testVectors64a+#elif defined(i386_HOST_ARCH)+testVectorsPrima = second fromIntegral <$> testVectors32a+#endif++zerosPrima :: [B.ByteString]+#if defined(x86_64_HOST_ARCH)+zerosPrima = zeros64a+#elif defined(i386_HOST_ARCH)+zerosPrima = zeros32a+#endif+
+ test/Test/Data/Hash/SipHash.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Test.Data.Hash.SipHash+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Test.Data.Hash.SipHash+( tests+) where++import qualified Data.ByteString as B++import Foreign++import System.IO.Unsafe++import Test.QuickCheck++-- internal modules++import Data.Hash.SipHash++-- -------------------------------------------------------------------------- --+-- Utils++bytesToWord64:: [Word8] -> Word64+bytesToWord64 l = unsafePerformIO $+ B.useAsCStringLen (B.pack l) $ \(b, _) -> peek @Word64 (castPtr b)++-- -------------------------------------------------------------------------- --+-- Tests++-- internal sip hash implementation+tests :: IO ()+tests = quickCheck $ all test [0..63]++test :: Int -> Bool+test i = hashByteString (uncurry sipHash24 testKey) (testInput i) == (testVectors !! i)++-- -------------------------------------------------------------------------- --+-- Test Vectors from https://svn.grid.pub.ro/svn/bhyve-save-restore/trunk/sys/crypto/siphash/siphash_test.c++{-+/*-+ * Test Vectors from the SipHash reference C implementation:+ *+ * Written in 2012 by+ * Jean-Philippe Aumasson <jeanphilippe.aumasson@gmail.com>+ * Daniel J. Bernstein <djb@cr.yp.to>+ *+ * Adjusted by Andre Oppermann <andre@freebsd.org> to use function calls in+ * line with other hash implementations.+ *+ * To the extent possible under law, the author(s) have dedicated all copyright+ * and related and neighboring rights to this software to the public domain+ * worldwide. This software is distributed without any warranty.+ *+ * You should have received a copy of the CC0 Public Domain Dedication along with+ * this software. If not, see <http://creativecommons.org/publicdomain/zero/1.0/>.+ *+ * SipHash-2-4 output with+ * k = 00 01 02 ...+ * and+ * in = (empty string)+ * in = 00 (1 byte)+ * in = 00 01 (2 bytes)+ * in = 00 01 02 (3 bytes)+ * ...+ * in = 00 01 02 ... 3e (63 bytes)+ */+-}++testKey :: (Word64, Word64)+testKey = (bytesToWord64 [0..7], bytesToWord64 [8..15])++testInput :: Int -> B.ByteString+testInput i = B.pack $ fromIntegral <$> [0..i-1]++testVectors :: [Word64]+testVectors = bytesToWord64 <$>+ [ [ 0x31, 0x0e, 0x0e, 0xdd, 0x47, 0xdb, 0x6f, 0x72 ]+ , [ 0xfd, 0x67, 0xdc, 0x93, 0xc5, 0x39, 0xf8, 0x74 ]+ , [ 0x5a, 0x4f, 0xa9, 0xd9, 0x09, 0x80, 0x6c, 0x0d ]+ , [ 0x2d, 0x7e, 0xfb, 0xd7, 0x96, 0x66, 0x67, 0x85 ]+ , [ 0xb7, 0x87, 0x71, 0x27, 0xe0, 0x94, 0x27, 0xcf ]+ , [ 0x8d, 0xa6, 0x99, 0xcd, 0x64, 0x55, 0x76, 0x18 ]+ , [ 0xce, 0xe3, 0xfe, 0x58, 0x6e, 0x46, 0xc9, 0xcb ]+ , [ 0x37, 0xd1, 0x01, 0x8b, 0xf5, 0x00, 0x02, 0xab ]+ , [ 0x62, 0x24, 0x93, 0x9a, 0x79, 0xf5, 0xf5, 0x93 ]+ , [ 0xb0, 0xe4, 0xa9, 0x0b, 0xdf, 0x82, 0x00, 0x9e ]+ , [ 0xf3, 0xb9, 0xdd, 0x94, 0xc5, 0xbb, 0x5d, 0x7a ]+ , [ 0xa7, 0xad, 0x6b, 0x22, 0x46, 0x2f, 0xb3, 0xf4 ]+ , [ 0xfb, 0xe5, 0x0e, 0x86, 0xbc, 0x8f, 0x1e, 0x75 ]+ , [ 0x90, 0x3d, 0x84, 0xc0, 0x27, 0x56, 0xea, 0x14 ]+ , [ 0xee, 0xf2, 0x7a, 0x8e, 0x90, 0xca, 0x23, 0xf7 ]+ , [ 0xe5, 0x45, 0xbe, 0x49, 0x61, 0xca, 0x29, 0xa1 ]+ , [ 0xdb, 0x9b, 0xc2, 0x57, 0x7f, 0xcc, 0x2a, 0x3f ]+ , [ 0x94, 0x47, 0xbe, 0x2c, 0xf5, 0xe9, 0x9a, 0x69 ]+ , [ 0x9c, 0xd3, 0x8d, 0x96, 0xf0, 0xb3, 0xc1, 0x4b ]+ , [ 0xbd, 0x61, 0x79, 0xa7, 0x1d, 0xc9, 0x6d, 0xbb ]+ , [ 0x98, 0xee, 0xa2, 0x1a, 0xf2, 0x5c, 0xd6, 0xbe ]+ , [ 0xc7, 0x67, 0x3b, 0x2e, 0xb0, 0xcb, 0xf2, 0xd0 ]+ , [ 0x88, 0x3e, 0xa3, 0xe3, 0x95, 0x67, 0x53, 0x93 ]+ , [ 0xc8, 0xce, 0x5c, 0xcd, 0x8c, 0x03, 0x0c, 0xa8 ]+ , [ 0x94, 0xaf, 0x49, 0xf6, 0xc6, 0x50, 0xad, 0xb8 ]+ , [ 0xea, 0xb8, 0x85, 0x8a, 0xde, 0x92, 0xe1, 0xbc ]+ , [ 0xf3, 0x15, 0xbb, 0x5b, 0xb8, 0x35, 0xd8, 0x17 ]+ , [ 0xad, 0xcf, 0x6b, 0x07, 0x63, 0x61, 0x2e, 0x2f ]+ , [ 0xa5, 0xc9, 0x1d, 0xa7, 0xac, 0xaa, 0x4d, 0xde ]+ , [ 0x71, 0x65, 0x95, 0x87, 0x66, 0x50, 0xa2, 0xa6 ]+ , [ 0x28, 0xef, 0x49, 0x5c, 0x53, 0xa3, 0x87, 0xad ]+ , [ 0x42, 0xc3, 0x41, 0xd8, 0xfa, 0x92, 0xd8, 0x32 ]+ , [ 0xce, 0x7c, 0xf2, 0x72, 0x2f, 0x51, 0x27, 0x71 ]+ , [ 0xe3, 0x78, 0x59, 0xf9, 0x46, 0x23, 0xf3, 0xa7 ]+ , [ 0x38, 0x12, 0x05, 0xbb, 0x1a, 0xb0, 0xe0, 0x12 ]+ , [ 0xae, 0x97, 0xa1, 0x0f, 0xd4, 0x34, 0xe0, 0x15 ]+ , [ 0xb4, 0xa3, 0x15, 0x08, 0xbe, 0xff, 0x4d, 0x31 ]+ , [ 0x81, 0x39, 0x62, 0x29, 0xf0, 0x90, 0x79, 0x02 ]+ , [ 0x4d, 0x0c, 0xf4, 0x9e, 0xe5, 0xd4, 0xdc, 0xca ]+ , [ 0x5c, 0x73, 0x33, 0x6a, 0x76, 0xd8, 0xbf, 0x9a ]+ , [ 0xd0, 0xa7, 0x04, 0x53, 0x6b, 0xa9, 0x3e, 0x0e ]+ , [ 0x92, 0x59, 0x58, 0xfc, 0xd6, 0x42, 0x0c, 0xad ]+ , [ 0xa9, 0x15, 0xc2, 0x9b, 0xc8, 0x06, 0x73, 0x18 ]+ , [ 0x95, 0x2b, 0x79, 0xf3, 0xbc, 0x0a, 0xa6, 0xd4 ]+ , [ 0xf2, 0x1d, 0xf2, 0xe4, 0x1d, 0x45, 0x35, 0xf9 ]+ , [ 0x87, 0x57, 0x75, 0x19, 0x04, 0x8f, 0x53, 0xa9 ]+ , [ 0x10, 0xa5, 0x6c, 0xf5, 0xdf, 0xcd, 0x9a, 0xdb ]+ , [ 0xeb, 0x75, 0x09, 0x5c, 0xcd, 0x98, 0x6c, 0xd0 ]+ , [ 0x51, 0xa9, 0xcb, 0x9e, 0xcb, 0xa3, 0x12, 0xe6 ]+ , [ 0x96, 0xaf, 0xad, 0xfc, 0x2c, 0xe6, 0x66, 0xc7 ]+ , [ 0x72, 0xfe, 0x52, 0x97, 0x5a, 0x43, 0x64, 0xee ]+ , [ 0x5a, 0x16, 0x45, 0xb2, 0x76, 0xd5, 0x92, 0xa1 ]+ , [ 0xb2, 0x74, 0xcb, 0x8e, 0xbf, 0x87, 0x87, 0x0a ]+ , [ 0x6f, 0x9b, 0xb4, 0x20, 0x3d, 0xe7, 0xb3, 0x81 ]+ , [ 0xea, 0xec, 0xb2, 0xa3, 0x0b, 0x22, 0xa8, 0x7f ]+ , [ 0x99, 0x24, 0xa4, 0x3c, 0xc1, 0x31, 0x57, 0x24 ]+ , [ 0xbd, 0x83, 0x8d, 0x3a, 0xaf, 0xbf, 0x8d, 0xb7 ]+ , [ 0x0b, 0x1a, 0x2a, 0x32, 0x65, 0xd5, 0x1a, 0xea ]+ , [ 0x13, 0x50, 0x79, 0xa3, 0x23, 0x1c, 0xe6, 0x60 ]+ , [ 0x93, 0x2b, 0x28, 0x46, 0xe4, 0xd7, 0x06, 0x66 ]+ , [ 0xe1, 0x91, 0x5f, 0x5c, 0xb1, 0xec, 0xa4, 0x6c ]+ , [ 0xf3, 0x25, 0x96, 0x5c, 0xa1, 0x6d, 0x62, 0x9f ]+ , [ 0x57, 0x5f, 0xf2, 0x8e, 0x60, 0x38, 0x1b, 0xe5 ]+ , [ 0x72, 0x45, 0x06, 0xeb, 0x4c, 0x32, 0x8a, 0x95 ]+ ]
+ test/Test/Data/Hash/Utils.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module: Test.Data.Hash.Utils+-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>+-- License: MIT+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Test.Data.Hash.Utils+( tests+) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B++import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable++import GHC.Exts+import GHC.IO+import GHC.Word++import Test.QuickCheck++-- internal modules++import Data.Hash.Utils++-- -------------------------------------------------------------------------- --+--++tests :: IO ()+tests = do+ putStrLn "prop_hashByteString"+ quickCheck prop_hashByteString+ putStrLn "prop_hashStorable"+ quickCheck prop_hashStorable+ putStrLn "prop_hashPtr"+ quickCheck prop_hashPtr+ putStrLn "prop_hashByteArray"+ quickCheck prop_hashByteArray++ptrToList :: Ptr Word8 -> Int -> IO [Word8]+ptrToList = flip peekArray++prop_hashStorable :: Word64 -> Property+prop_hashStorable b = hashStorable (\ptr _ -> peek (castPtr ptr)) b === b++prop_hashPtr :: [Word8] -> Property+prop_hashPtr b = unsafeDupablePerformIO $+ B.unsafeUseAsCStringLen (B.pack b) $ \(ptr, len) -> do+ return $ hashPtr ptrToList (castPtr ptr) len === b++prop_hashByteString :: [Word8] -> Property+prop_hashByteString b = hashByteString ptrToList (B.pack b) === b++prop_hashByteArray :: [Word8] -> Property+prop_hashByteArray bytes = unsafeDupablePerformIO $ IO $ \s0 ->+ case newPinnedByteArray# size s0 of+ (# s1, a# #) ->+ case copyToArray 0# bytes a# s1 of+ s2 -> case unsafeFreezeByteArray# a# s2 of+ (# s3, b# #) ->+ let r = hashByteArray ptrToList b# === bytes+ in (# s3, r #)+ where+ !(I# size) = length bytes++ copyToArray _ [] _ s = s+ copyToArray i ((W8# h):t) a s = case writeWord8Array# a i h s of+ s' -> copyToArray (i +# 1#) t a s'