hyperloglog 0.4.5 → 0.4.6
raw patch · 3 files changed
+182/−4 lines, 3 filesdep +bytestringdep +cpudep −siphashdep ~deepseqdep ~hashabledep ~semigroupoids
Dependencies added: bytestring, cpu
Dependencies removed: siphash
Dependency ranges changed: deepseq, hashable, semigroupoids, vector
Files
- CHANGELOG.markdown +6/−0
- hyperloglog.cabal +10/−4
- src/Crypto/MAC/SipHash.hs +166/−0
CHANGELOG.markdown view
@@ -1,3 +1,9 @@+0.4.6 [2022.04.18]+------------------+* Remove the `siphash` dependency. Because `siphash` no longer builds on+ GHC 9.2+, we instead bundle the code alongside `hyperloglog`. This allows+ `hyperloglog` to build with 9.2.+ 0.4.5 [2021.11.16] ------------------ * Drop support for pre-8.0 versions of GHC.
hyperloglog.cabal view
@@ -1,6 +1,6 @@ name: hyperloglog category: Numeric-version: 0.4.5+version: 0.4.6 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -17,8 +17,8 @@ , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7- , GHC == 9.0.1- , GHC == 9.2.1+ , GHC == 9.0.2+ , GHC == 9.2.2 synopsis: An approximate streaming (constant space) unique object counter description: This package provides an approximate streaming (constant space) unique object counter.@@ -62,7 +62,6 @@ reflection >= 1.3 && < 3, semigroupoids >= 4 && < 6, semigroups >= 0.8.4 && < 1,- siphash >= 1.0.3 && < 2, tagged >= 0.4.5 && < 1, vector >= 0.9 && < 0.13 @@ -75,6 +74,13 @@ Data.HyperLogLog Data.HyperLogLog.Config Data.HyperLogLog.Type++ other-modules:+ Crypto.MAC.SipHash+ -- Only needed for Crypto.MAC.SipHash+ build-depends:+ bytestring >= 0.9 && < 0.12,+ cpu >= 0.1 && < 0.2 ghc-options: -Wall -Wtabs -O2 hs-source-dirs: src
+ src/Crypto/MAC/SipHash.hs view
@@ -0,0 +1,166 @@+-- |+-- Module : Crypto.MAC.SipHash+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : good+--+-- provide the SipHash algorithm.+-- reference: <http://131002.net/siphash/siphash.pdf>+--+-- This is a copy of the code from the @siphash@ library, which is licensed+-- under the 3-Clause BSD License. Unfortunately, @siphash@ no longer compiles+-- on GHC 9.2 or later, and since @siphash@ is deprecated, it is unlikely that+-- it will receive future updates. For the time being, we have opted to+-- internalize the code in the @hyperloglog@ library, as it is relatively+-- self-contained. In the future, we may want to consider offering this code as+-- a standalone library.+{-# LANGUAGE BangPatterns #-}+module Crypto.MAC.SipHash+ ( SipKey(..)+ , SipHash(..)+ , hash+ , hashWith+ ) where++import Data.Word+import Data.Bits+import Data.ByteString.Internal+import Control.Monad++import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable+import System.Endian (fromLE64)+import System.IO.Unsafe (unsafeDupablePerformIO)++-- | SigHash Key+data SipKey = SipKey {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64++-- | Siphash tag value+newtype SipHash = SipHash Word64+ deriving (Show,Eq)++data InternalState = InternalState {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64++-- | produce a siphash with a key and a bytestring.+hash :: SipKey -> ByteString -> SipHash+hash = hashWith 2 4++-- | same as 'hash', except also specifies the number of sipround iterations for compression and digest.+hashWith :: Int -> Int -> SipKey -> ByteString -> SipHash+hashWith c d key (PS ps s fl) = unsafeDupablePerformIO $ withForeignPtr ps (\ptr -> runHash (initSip key) (ptr `plusPtr` s) fl)+ where runHash !st !ptr l+ | l > 7 = fromLE64 `fmap` peek (castPtr ptr) >>= \v -> runHash (process st v) (ptr `plusPtr` 8) (l-8)+ | otherwise = do+ let !lengthBlock = (fromIntegral fl `mod` 256) `unsafeShiftL` 56+ (finish . process st) `fmap` case l of+ 0 -> do return lengthBlock+ 1 -> do v0 <- peekByteOff ptr 0+ return (lengthBlock .|. to64 v0)+ 2 -> do (v0,v1) <- liftM2 (,) (peekByteOff ptr 0) (peekByteOff ptr 1)+ return (lengthBlock+ .|. (to64 v1 `unsafeShiftL` 8)+ .|. to64 v0)+ 3 -> do (v0,v1,v2) <- liftM3 (,,) (peekByteOff ptr 0) (peekByteOff ptr 1) (peekByteOff ptr 2)+ return ( lengthBlock+ .|. (to64 v2 `unsafeShiftL` 16)+ .|. (to64 v1 `unsafeShiftL` 8)+ .|. to64 v0)+ 4 -> do (v0,v1,v2,v3) <- liftM4 (,,,) (peekByteOff ptr 0) (peekByteOff ptr 1) (peekByteOff ptr 2)+ (peekByteOff ptr 3)+ return ( lengthBlock+ .|. (to64 v3 `unsafeShiftL` 24)+ .|. (to64 v2 `unsafeShiftL` 16)+ .|. (to64 v1 `unsafeShiftL` 8)+ .|. to64 v0)+ 5 -> do (v0,v1,v2,v3,v4) <- liftM5 (,,,,) (peekByteOff ptr 0) (peekByteOff ptr 1) (peekByteOff ptr 2)+ (peekByteOff ptr 3) (peekByteOff ptr 4)+ return ( lengthBlock+ .|. (to64 v4 `unsafeShiftL` 32)+ .|. (to64 v3 `unsafeShiftL` 24)+ .|. (to64 v2 `unsafeShiftL` 16)+ .|. (to64 v1 `unsafeShiftL` 8)+ .|. to64 v0)+ 6 -> do v0 <- peekByteOff ptr 0+ v1 <- peekByteOff ptr 1+ v2 <- peekByteOff ptr 2+ v3 <- peekByteOff ptr 3+ v4 <- peekByteOff ptr 4+ v5 <- peekByteOff ptr 5+ return ( lengthBlock+ .|. (to64 v5 `unsafeShiftL` 40)+ .|. (to64 v4 `unsafeShiftL` 32)+ .|. (to64 v3 `unsafeShiftL` 24)+ .|. (to64 v2 `unsafeShiftL` 16)+ .|. (to64 v1 `unsafeShiftL` 8)+ .|. to64 v0)+ 7 -> do v0 <- peekByteOff ptr 0+ v1 <- peekByteOff ptr 1+ v2 <- peekByteOff ptr 2+ v3 <- peekByteOff ptr 3+ v4 <- peekByteOff ptr 4+ v5 <- peekByteOff ptr 5+ v6 <- peekByteOff ptr 6+ return ( lengthBlock+ .|. (to64 v6 `unsafeShiftL` 48)+ .|. (to64 v5 `unsafeShiftL` 40)+ .|. (to64 v4 `unsafeShiftL` 32)+ .|. (to64 v3 `unsafeShiftL` 24)+ .|. (to64 v2 `unsafeShiftL` 16)+ .|. (to64 v1 `unsafeShiftL` 8)+ .|. to64 v0)+ _ -> error "siphash: internal error: cannot happen"++ {-# INLINE to64 #-}+ to64 :: Word8 -> Word64+ to64 = fromIntegral++ {-# INLINE process #-}+ process istate m = newState+ where newState = postInject $! runRoundsCompression $! preInject istate+ preInject (InternalState v0 v1 v2 v3) = InternalState v0 v1 v2 (v3 `xor` m)+ postInject (InternalState v0 v1 v2 v3) = InternalState (v0 `xor` m) v1 v2 v3++ {-# INLINE finish #-}+ finish istate = getDigest $! runRoundsDigest $! preInject istate+ where getDigest (InternalState v0 v1 v2 v3) = SipHash (v0 `xor` v1 `xor` v2 `xor` v3)+ preInject (InternalState v0 v1 v2 v3) = InternalState v0 v1 (v2 `xor` 0xff) v3++ {-# INLINE doRound #-}+ doRound (InternalState v0 v1 v2 v3) =+ let !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+ in InternalState v0''' v1'''' v2''' v3''''++ {-# INLINE runRoundsCompression #-}+ runRoundsCompression st+ | c == 2 = doRound $! doRound st+ | otherwise = loopRounds c st++ {-# INLINE runRoundsDigest #-}+ runRoundsDigest st+ | d == 4 = doRound $! doRound $! doRound $! doRound st+ | otherwise = loopRounds d st++ {-# INLINE loopRounds #-}+ loopRounds 1 !v = doRound v+ loopRounds n !v = loopRounds (n-1) (doRound v)++ {-# INLINE initSip #-}+ initSip (SipKey k0 k1) = InternalState (k0 `xor` 0x736f6d6570736575)+ (k1 `xor` 0x646f72616e646f6d)+ (k0 `xor` 0x6c7967656e657261)+ (k1 `xor` 0x7465646279746573)