bloomfilter: make the hash salt configurable

Co-authored-by: Wen Kokke <[email protected]>

Author: jorisdral

bloomfilter/bench/bloomfilter-bench.hs

@@ -1,13 +1,11 @@
 module Main where
 
+import           Criterion.Main (bench, bgroup, defaultMain, env, whnf)
 import qualified Data.BloomFilter.Blocked as B.Blocked
 import qualified Data.BloomFilter.Classic as B.Classic
-import           Data.BloomFilter.Hash (Hashable (..), hash64)
-
+import           Data.BloomFilter.Hash (Hashable (..))
 import           Data.Word (Word64)
-import           System.Random
-
-import           Criterion.Main
+import           System.Random (StdGen, newStdGen, uniform)
 
 main :: IO ()
 main =
@@ -42,11 +40,13 @@ main =
 
 constructBloom_classic :: Int -> Double -> StdGen -> B.Classic.Bloom Word64
 constructBloom_classic n fpr g0 =
-    B.Classic.unfold (B.Classic.sizeForFPR fpr n) (nextElement n) (g0, 0)
+  let (!salt, !g1) = uniform g0 in
+    B.Classic.unfold (B.Classic.sizeForFPR fpr n) salt (nextElement n) (g1, 0)
 
 constructBloom_blocked :: Int -> Double -> StdGen -> B.Blocked.Bloom Word64
 constructBloom_blocked n fpr g0 =
-    B.Blocked.unfold (B.Blocked.sizeForFPR fpr n) (nextElement n) (g0, 0)
+  let (!salt, !g1) = uniform g0 in
+    B.Blocked.unfold (B.Blocked.sizeForFPR fpr n) salt (nextElement n) (g1, 0)
 
 {-# INLINE nextElement #-}
 nextElement :: Int -> (StdGen, Int) -> Maybe (Word64, (StdGen, Int))

bloomfilter/examples/spell.hs

@@ -10,7 +10,10 @@ main :: IO ()
 main = do
     files <- getArgs
     dictionary <- readFile "/usr/share/dict/words"
-    let !bloom = B.fromList (B.policyForFPR 0.01) (words dictionary)
+    let !bloom = B.fromList (B.policyForFPR 0.01) bSalt (words dictionary)
     forM_ files $ \file ->
           putStrLn . unlines . filter (`B.notElem` bloom) . words
       =<< readFile file
+
+bSalt :: B.Salt
+bSalt = 4

bloomfilter/src/Data/BloomFilter/Blocked.hs

@@ -16,6 +16,7 @@
 module Data.BloomFilter.Blocked (
     -- * Types
     Hash,
+    Salt,
     Hashable,
 
     -- * Immutable Bloom filters
@@ -64,7 +65,7 @@ module Data.BloomFilter.Blocked (
 
     -- * Low level variants
     Hashes,
-    hashes,
+    hashesWithSalt,
     insertHashes,
     elemHashes,
     -- ** Prefetching
@@ -92,34 +93,35 @@ import           Prelude hiding (elem, notElem)
 -- Example:
 --
 -- @
---filter = create (sizeForBits 16 2) $ \mf -> do
+-- filter = create (sizeForBits 16 2) 4 $ \mf -> do
 --           insert mf \"foo\"
 --           insert mf \"bar\"
 -- @
 --
 -- Note that the result of the setup function is not used.
 create :: BloomSize
+       -> Salt
        -> (forall s. (MBloom s a -> ST s ()))  -- ^ setup function
        -> Bloom a
 {-# INLINE create #-}
-create bloomsize body =
+create bloomsize bloomsalt body =
     runST $ do
-      mb <- new bloomsize
+      mb <- new bloomsize bloomsalt
       body mb
       unsafeFreeze mb
 
 {-# INLINEABLE insert #-}
 -- | Insert a value into a mutable Bloom filter.  Afterwards, a
 -- membership query for the same value is guaranteed to return @True@.
 insert :: Hashable a => MBloom s a -> a -> ST s ()
-insert = \ !mb !x -> insertHashes mb (hashes x)
+insert = \ !mb !x -> insertHashes mb (hashesWithSalt (mbHashSalt mb) x)
 
 {-# INLINE elem #-}
 -- | Query an immutable Bloom filter for membership.  If the value is
 -- present, return @True@.  If the value is not present, there is
 -- /still/ some possibility that @True@ will be returned.
 elem :: Hashable a => a -> Bloom a -> Bool
-elem = \ !x !b -> elemHashes b (hashes x)
+elem = \ !x !b -> elemHashes b (hashesWithSalt (hashSalt b) x)
 
 -- | Same as 'elem' but with the opposite argument order:
 --
@@ -150,12 +152,13 @@ notElem = \x b -> not (x `elem` b)
 unfold :: forall a b.
           Hashable a
        => BloomSize
+       -> Salt
        -> (b -> Maybe (a, b))       -- ^ seeding function
        -> b                         -- ^ initial seed
        -> Bloom a
 {-# INLINE unfold #-}
-unfold bloomsize f k =
-    create bloomsize body
+unfold bloomsize bloomsalt f k =
+    create bloomsize bloomsalt body
   where
     body :: forall s. MBloom s a -> ST s ()
     body mb = loop k
@@ -170,26 +173,29 @@ unfold bloomsize f k =
 -- For example
 --
 -- @
--- filt = fromList (policyForBits 10) [\"foo\", \"bar\", \"quux\"]
+-- filter = fromList (policyForBits 10) 4 [\"foo\", \"bar\", \"quux\"]
 -- @
 fromList :: (Foldable t, Hashable a)
          => BloomPolicy
+         -> Salt
          -> t a -- ^ values to populate with
          -> Bloom a
-fromList policy xs =
-    create bsize (\b -> mapM_ (insert b) xs)
+fromList policy bloomsalt xs =
+    create bsize bloomsalt (\b -> mapM_ (insert b) xs)
   where
     bsize = sizeForPolicy policy (length xs)
 
 {-# SPECIALISE deserialise :: BloomSize
+                           -> Salt
                            -> (MutableByteArray RealWorld -> Int -> Int -> IO ())
                            -> IO (Bloom a) #-}
 deserialise :: PrimMonad m
             => BloomSize
+            -> Salt
             -> (MutableByteArray (PrimState m) -> Int -> Int -> m ())
             -> m (Bloom a)
-deserialise bloomsize fill = do
-    mbloom <- stToPrim $ new bloomsize
+deserialise bloomsize bloomsalt fill = do
+    mbloom <- stToPrim $ new bloomsize bloomsalt
     Internal.deserialise mbloom fill
     stToPrim $ unsafeFreeze mbloom
 
@@ -235,7 +241,7 @@ insertMany bloom key n =
         prepareProbes !i !i_w
           | i_w < 0x0f && i < n = do
               k <- key i
-              let !kh = hashes k
+              let !kh = hashesWithSalt (mbHashSalt bloom) k
               prefetchInsert bloom kh
               P.writePrimArray buf i_w kh
               prepareProbes (i+1) (i_w+1)
@@ -258,7 +264,7 @@ insertMany bloom key n =
           -- (from the read end of the buffer).
           | i < n = do
               k <- key i
-              let !kh = hashes k
+              let !kh = hashesWithSalt (mbHashSalt bloom) k
               prefetchInsert bloom kh
               P.writePrimArray buf i_w kh
               insertProbe

bloomfilter/src/Data/BloomFilter/Blocked/Internal.hs

@@ -8,18 +8,19 @@
 -- the trusted base.
 module Data.BloomFilter.Blocked.Internal (
     -- * Mutable Bloom filters
-    MBloom,
+    MBloom (mbHashSalt),
     new,
     maxSizeBits,
 
     -- * Immutable Bloom filters
-    Bloom,
+    Bloom (hashSalt),
     bloomInvariant,
     size,
 
     -- * Hash-based operations
     Hashes,
-    hashes,
+    Salt,
+    hashesWithSalt,
     insertHashes,
     prefetchInsert,
     elemHashes,
@@ -84,6 +85,7 @@ type MBloom :: Type -> Type -> Type
 data MBloom s a = MBloom {
       mbNumBlocks :: {-# UNPACK #-} !NumBlocks  -- ^ non-zero
     , mbNumHashes :: {-# UNPACK #-} !Int
+    , mbHashSalt  :: {-# UNPACK #-} !Salt
     , mbBitArray  :: {-# UNPACK #-} !(MBitArray s)
     }
 type role MBloom nominal nominal
@@ -100,13 +102,14 @@ instance NFData (MBloom s a) where
 --
 -- The filter size is capped at 'maxSizeBits'.
 --
-new :: BloomSize -> ST s (MBloom s a)
-new BloomSize { sizeBits, sizeHashes } = do
+new :: BloomSize -> Salt -> ST s (MBloom s a)
+new BloomSize { sizeBits, sizeHashes } mbHashSalt = do
     let numBlocks = bitsToBlocks (max 1 (min maxSizeBits sizeBits))
     mbBitArray <- BitArray.new numBlocks
     pure MBloom {
       mbNumBlocks = numBlocks,
       mbNumHashes = max 1 sizeHashes,
+      mbHashSalt,
       mbBitArray
     }
 
@@ -174,6 +177,7 @@ type Bloom :: Type -> Type
 data Bloom a = Bloom {
       numBlocks :: {-# UNPACK #-} !NumBlocks  -- ^ non-zero
     , numHashes :: {-# UNPACK #-} !Int
+    , hashSalt  :: {-# UNPACK #-} !Salt
     , bitArray  :: {-# UNPACK #-} !BitArray
     }
   deriving stock Eq
@@ -239,9 +243,9 @@ prefetchElem Bloom { numBlocks, bitArray } !h =
 --
 -- See also 'formatVersion' for compatibility advice.
 --
-serialise :: Bloom a -> (BloomSize, ByteArray, Int, Int)
+serialise :: Bloom a -> (BloomSize, Salt, ByteArray, Int, Int)
 serialise b@Bloom{bitArray} =
-    (size b, ba, off, len)
+    (size b, hashSalt b, ba, off, len)
   where
     (ba, off, len) = BitArray.serialise bitArray
 
@@ -253,11 +257,12 @@ serialise b@Bloom{bitArray} =
 -- | Create an immutable Bloom filter from a mutable one.  The mutable
 -- filter may be modified afterwards.
 freeze :: MBloom s a -> ST s (Bloom a)
-freeze MBloom { mbNumBlocks, mbNumHashes, mbBitArray } = do
+freeze MBloom { mbNumBlocks, mbNumHashes, mbHashSalt, mbBitArray } = do
     bitArray <- BitArray.freeze mbBitArray
     let !bf = Bloom {
                 numBlocks = mbNumBlocks,
                 numHashes = mbNumHashes,
+                hashSalt  = mbHashSalt,
                 bitArray
               }
     assert (bloomInvariant bf) $ pure bf
@@ -266,23 +271,25 @@ freeze MBloom { mbNumBlocks, mbNumHashes, mbBitArray } = do
 -- mutable filter /must not/ be modified afterwards. For a safer creation
 -- interface, use 'freeze' or 'create'.
 unsafeFreeze :: MBloom s a -> ST s (Bloom a)
-unsafeFreeze MBloom { mbNumBlocks, mbNumHashes, mbBitArray } = do
+unsafeFreeze MBloom { mbNumBlocks, mbNumHashes, mbHashSalt, mbBitArray } = do
     bitArray <- BitArray.unsafeFreeze mbBitArray
     let !bf = Bloom {
                 numBlocks = mbNumBlocks,
                 numHashes = mbNumHashes,
+                hashSalt  = mbHashSalt,
                 bitArray
               }
     assert (bloomInvariant bf) $ pure bf
 
 -- | Copy an immutable Bloom filter to create a mutable one.  There is
 -- no non-copying equivalent.
 thaw :: Bloom a -> ST s (MBloom s a)
-thaw Bloom { numBlocks, numHashes, bitArray } = do
+thaw Bloom { numBlocks, numHashes, hashSalt, bitArray } = do
     mbBitArray <- BitArray.thaw bitArray
     pure MBloom {
       mbNumBlocks = numBlocks,
       mbNumHashes = numHashes,
+      mbHashSalt  = hashSalt,
       mbBitArray
     }
 
@@ -317,9 +324,9 @@ newtype Hashes a = Hashes Hash
   deriving newtype Prim
 type role Hashes nominal
 
-{-# INLINE hashes #-}
-hashes :: Hashable a => a -> Hashes a
-hashes = Hashes . hash64
+{-# INLINE hashesWithSalt #-}
+hashesWithSalt :: Hashable a => Salt -> a -> Hashes a
+hashesWithSalt = \ !salt !x -> Hashes (hashSalt64 salt x)
 
 {-# INLINE blockIxAndBitGen #-}
 -- | The scheme for turning 'Hashes' into block and bit indexes is as follows: