lsm-tree: make the hash salt for bloom filters configurable

Making the hash salt configurable improves security, because bloom filter hashes
are not cryptographic hashes.

The hash salt can be configured on a session-wide basis only. That is, all bloom
filters for all tables in a single session use the same salt. As a result, batch
lookup performance is not impacted by the salt. The performance currently relies
on being able to compute a hash only once for multiple bloom filters, which is
only possible if the salt for each bloom filter is the same.

For now the user has the responsibility of passing in the same salt each time a
session is restored. We will change this in the next few commits.

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

Author: jorisdral

doc/format-run.md

@@ -140,10 +140,11 @@ It (and remaining fields) are serialised in native byte order.
 The remainder of the header for format 1 consists of:
  1. The hash function count (32bit)
  2. The bit size of the filter (64bit)
+ 3. The hash salt of the filter (64bit)
 
 The fields of the header are serialized in native byte order.
 
-The maximum filter size is 2^48 bits, corresponding to 32 Terabytes.
+The maximum filter size is 2^41 bits, corresponding to 32 Terabytes.
 The family of hash functions to use is implied by the format version.
 
 The filter bit vector itself is organised as a whole number of 64 bit words.

lsm-tree.cabal

@@ -593,6 +593,7 @@ library
     , lsm-tree:control
     , lsm-tree:kmerge
     , primitive               ^>=0.9
+    , random                  ^>=1.0      || ^>=1.1      || ^>=1.2     || ^>=1.3
     , text                    ^>=2.1.1
     , utf8-string             ^>=1.0
     , vector                  ^>=0.13

src/Database/LSMTree.hs

@@ -101,6 +101,9 @@ module Database.LSMTree (
   toSnapshotName,
   SnapshotLabel (..),
 
+  -- * Session Configuration #session_configuration#
+  Salt,
+
   -- * Table Configuration #table_configuration#
   TableConfig (
     confMergePolicy,
@@ -242,7 +245,7 @@ import           Database.LSMTree.Internal.Serialise.Class (SerialiseKey (..),
 import           Database.LSMTree.Internal.Snapshot (SnapshotLabel (..))
 import           Database.LSMTree.Internal.Types (BlobRef (..), Cursor (..),
                      ResolveAsFirst (..), ResolveValue (..),
-                     ResolveViaSemigroup (..), Session (..), Table (..),
+                     ResolveViaSemigroup (..), Salt, Session (..), Table (..),
                      resolveAssociativity, resolveCompatibility,
                      resolveValidOutput)
 import           Database.LSMTree.Internal.Unsafe (BlobRefInvalidError (..),
@@ -263,6 +266,7 @@ import           System.FS.API (FsPath, HasFS (..), MountPoint (..), mkFsPath)
 import           System.FS.BlockIO.API (HasBlockIO (..), defaultIOCtxParams)
 import           System.FS.BlockIO.IO (ioHasBlockIO, withIOHasBlockIO)
 import           System.FS.IO (HandleIO, ioHasFS)
+import           System.Random (randomIO)
 
 --------------------------------------------------------------------------------
 -- Usage Notes
@@ -426,6 +430,7 @@ Throws the following exceptions:
     Tracer IO LSMTreeTrace ->
     HasFS IO HandleIO ->
     HasBlockIO IO HandleIO ->
+    Salt ->
     FsPath ->
     (Session IO -> IO a) ->
     IO a
@@ -436,12 +441,14 @@ withSession ::
   Tracer m LSMTreeTrace ->
   HasFS m h ->
   HasBlockIO m h ->
+  -- | The session salt.
+  Salt ->
   -- | The session directory.
   FsPath ->
   (Session m -> m a) ->
   m a
-withSession tracer hasFS hasBlockIO sessionDir action = do
-  Internal.withSession tracer hasFS hasBlockIO sessionDir (action . Session)
+withSession tracer hasFS hasBlockIO sessionSalt sessionDir action = do
+  Internal.withSession tracer hasFS hasBlockIO sessionSalt sessionDir (action . Session)
 
 -- | Variant of 'withSession' that is specialised to 'IO' using the real filesystem.
 withSessionIO ::
@@ -453,8 +460,9 @@ withSessionIO tracer sessionDir action = do
   let mountPoint = MountPoint sessionDir
   let sessionDirFsPath = mkFsPath []
   let hasFS = ioHasFS mountPoint
+  sessionSalt <- randomIO
   withIOHasBlockIO hasFS defaultIOCtxParams $ \hasBlockIO ->
-    withSession tracer hasFS hasBlockIO sessionDirFsPath action
+    withSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath action
 
 {- |
 Open a session from a session directory.
@@ -480,7 +488,7 @@ Throws the following exceptions:
     Tracer IO LSMTreeTrace ->
     HasFS IO HandleIO ->
     HasBlockIO IO HandleIO ->
-    -- \| The session directory.
+    Salt ->
     FsPath ->
     IO (Session IO)
   #-}
@@ -490,26 +498,29 @@ openSession ::
   Tracer m LSMTreeTrace ->
   HasFS m h ->
   HasBlockIO m h ->
+  -- | The session salt.
+  Salt ->
   -- | The session directory.
   FsPath ->
   m (Session m)
-openSession tracer hasFS hasBlockIO sessionDir =
-  Session <$> Internal.openSession tracer hasFS hasBlockIO sessionDir
+openSession tracer hasFS hasBlockIO sessionSalt sessionDir =
+  Session <$> Internal.openSession tracer hasFS hasBlockIO sessionSalt sessionDir
 
 -- | Variant of 'openSession' that is specialised to 'IO' using the real filesystem.
 openSessionIO ::
   Tracer IO LSMTreeTrace ->
-  -- \| The session directory.
+  -- | The session directory.
   FilePath ->
   IO (Session IO)
 openSessionIO tracer sessionDir = do
   let mountPoint = MountPoint sessionDir
   let sessionDirFsPath = mkFsPath []
   let hasFS = ioHasFS mountPoint
+  sessionSalt <- randomIO
   let acquireHasBlockIO = ioHasBlockIO hasFS defaultIOCtxParams
   let releaseHasBlockIO HasBlockIO{close} = close
   bracketOnError acquireHasBlockIO releaseHasBlockIO $ \hasBlockIO ->
-    openSession tracer hasFS hasBlockIO sessionDirFsPath
+    openSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath
 
 {- |
 Close a session.

src/Database/LSMTree/Internal/BloomFilter.hs

@@ -8,6 +8,7 @@ module Database.LSMTree.Internal.BloomFilter (
   -- * Types
   Bloom.Bloom,
   Bloom.MBloom,
+  Bloom.Salt,
 
   -- * Bulk query
   bloomQueries,
@@ -108,17 +109,18 @@ type ResIx = Int -- Result index
 -- number of keys but this is grown if needed (using a doubling strategy).
 --
 bloomQueries ::
-     V.Vector (Bloom SerialisedKey)
+     Bloom.Salt
+  -> V.Vector (Bloom SerialisedKey)
   -> V.Vector SerialisedKey
   -> VP.Vector RunIxKeyIx
-bloomQueries !filters !keys
+bloomQueries !_salt !filters !keys
   | V.null filters || V.null keys = VP.empty
-bloomQueries !filters !keys =
+bloomQueries !salt !filters !keys =
     runST (bloomQueries_loop1 filters' keyhashes)
   where
     filters'  = toFiltersArray filters
     keyhashes = P.generatePrimArray (V.length keys) $ \i ->
-                  Bloom.hashes (V.unsafeIndex keys i)
+                  Bloom.hashesWithSalt salt (V.unsafeIndex keys i)
 
 -- loop over all keys
 bloomQueries_loop1 ::
@@ -220,15 +222,16 @@ bloomFilterVersion = 1 + fromIntegral Bloom.formatVersion
 
 bloomFilterToLBS :: Bloom a -> LBS.ByteString
 bloomFilterToLBS bf =
-    let (size, ba, off, len) = Bloom.serialise bf
-     in header size <> byteArrayToLBS ba off len
+    let (size, salt, ba, off, len) = Bloom.serialise bf
+     in header size salt <> byteArrayToLBS ba off len
   where
-    header Bloom.BloomSize { sizeBits, sizeHashes } =
-        -- creates a single 16 byte chunk
-        B.toLazyByteStringWith (B.safeStrategy 16 B.smallChunkSize) mempty $
+    header Bloom.BloomSize { sizeBits, sizeHashes } salt =
+        -- creates a single 24 byte chunk
+        B.toLazyByteStringWith (B.safeStrategy 24 B.smallChunkSize) mempty $
              B.word32Host bloomFilterVersion
           <> B.word32Host (fromIntegral sizeHashes)
           <> B.word64Host (fromIntegral sizeBits)
+          <> B.word64Host salt
 
     byteArrayToLBS :: P.ByteArray -> Int -> Int -> LBS.ByteString
     byteArrayToLBS ba off len =
@@ -250,11 +253,12 @@ bloomFilterFromFile ::
   -> m (Bloom a)
 bloomFilterFromFile hfs h = do
     header <- rethrowEOFError "Doesn't contain a header" $
-              hGetByteArrayExactly hfs h 16
+              hGetByteArrayExactly hfs h 24
 
     let !version = P.indexByteArray header 0 :: Word32
         !nhashes = P.indexByteArray header 1 :: Word32
         !nbits   = P.indexByteArray header 1 :: Word64
+        !salt    = P.indexByteArray header 2 :: Word64
 
     when (version /= bloomFilterVersion) $ throwFormatError $
       if byteSwap32 version == bloomFilterVersion
@@ -274,6 +278,7 @@ bloomFilterFromFile hfs h = do
           Bloom.sizeBits   = fromIntegral nbits,
           Bloom.sizeHashes = fromIntegral nhashes
         }
+        salt
         (\buf off len ->
             rethrowEOFError "bloom filter file too short" $
               void $ hGetBufExactly hfs

src/Database/LSMTree/Internal/Lookup.hs

@@ -38,6 +38,7 @@ import           Control.RefCount
 import           Database.LSMTree.Internal.BlobRef (WeakBlobRef (..))
 import           Database.LSMTree.Internal.BloomFilter (Bloom, RunIxKeyIx (..),
                      bloomQueries)
+import qualified Database.LSMTree.Internal.BloomFilter as Bloom
 import           Database.LSMTree.Internal.Entry
 import           Database.LSMTree.Internal.Index (Index)
 import qualified Database.LSMTree.Internal.Index as Index (search)
@@ -61,13 +62,14 @@ import           System.FS.BlockIO.API
 -- associated with each 'IOOp'.
 prepLookups ::
      Arena s
+  -> Bloom.Salt
   -> V.Vector (Bloom SerialisedKey)
   -> V.Vector Index
   -> V.Vector (Handle h)
   -> V.Vector SerialisedKey
   -> ST s (VP.Vector RunIxKeyIx, V.Vector (IOOp s h))
-prepLookups arena blooms indexes kopsFiles ks = do
-  let !rkixs = bloomQueries blooms ks
+prepLookups arena salt blooms indexes kopsFiles ks = do
+  let !rkixs = bloomQueries salt blooms ks
   !ioops <- indexSearches arena indexes kopsFiles ks rkixs
   pure (rkixs, ioops)
 
@@ -110,6 +112,7 @@ type LookupAcc m h = V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h)))
        HasBlockIO IO h
     -> ArenaManager RealWorld
     -> ResolveSerialisedValue
+    -> Bloom.Salt
     -> WB.WriteBuffer
     -> Ref (WBB.WriteBufferBlobs IO h)
     -> V.Vector (Ref (Run IO h))
@@ -125,6 +128,7 @@ lookupsIOWithWriteBuffer ::
   => HasBlockIO m h
   -> ArenaManager (PrimState m)
   -> ResolveSerialisedValue
+  -> Bloom.Salt
   -> WB.WriteBuffer
   -> Ref (WBB.WriteBufferBlobs m h)
   -> V.Vector (Ref (Run m h)) -- ^ Runs @rs@
@@ -133,10 +137,10 @@ lookupsIOWithWriteBuffer ::
   -> V.Vector (Handle h) -- ^ The file handles to the key\/value files inside @rs@
   -> V.Vector SerialisedKey
   -> m (LookupAcc m h)
-lookupsIOWithWriteBuffer !hbio !mgr !resolveV !wb !wbblobs !rs !blooms !indexes !kopsFiles !ks =
+lookupsIOWithWriteBuffer !hbio !mgr !resolveV !salt !wb !wbblobs !rs !blooms !indexes !kopsFiles !ks =
     assert precondition $
     withArena mgr $ \arena -> do
-      (rkixs, ioops) <- ST.stToIO $ prepLookups arena blooms indexes kopsFiles ks
+      (rkixs, ioops) <- ST.stToIO $ prepLookups arena salt blooms indexes kopsFiles ks
       ioress <- submitIO hbio ioops
       intraPageLookupsWithWriteBuffer resolveV wb wbblobs rs ks rkixs ioops ioress
   where
@@ -152,6 +156,7 @@ lookupsIOWithWriteBuffer !hbio !mgr !resolveV !wb !wbblobs !rs !blooms !indexes
        HasBlockIO IO h
     -> ArenaManager RealWorld
     -> ResolveSerialisedValue
+    -> Bloom.Salt
     -> V.Vector (Ref (Run IO h))
     -> V.Vector (Bloom SerialisedKey)
     -> V.Vector Index
@@ -168,16 +173,17 @@ lookupsIO ::
   => HasBlockIO m h
   -> ArenaManager (PrimState m)
   -> ResolveSerialisedValue
+  -> Bloom.Salt
   -> V.Vector (Ref (Run m h)) -- ^ Runs @rs@
   -> V.Vector (Bloom SerialisedKey) -- ^ The bloom filters inside @rs@
   -> V.Vector Index -- ^ The indexes inside @rs@
   -> V.Vector (Handle h) -- ^ The file handles to the key\/value files inside @rs@
   -> V.Vector SerialisedKey
   -> m (LookupAcc m h)
-lookupsIO !hbio !mgr !resolveV !rs !blooms !indexes !kopsFiles !ks =
+lookupsIO !hbio !mgr !resolveV !salt !rs !blooms !indexes !kopsFiles !ks =
     assert precondition $
     withArena mgr $ \arena -> do
-      (rkixs, ioops) <- ST.stToIO $ prepLookups arena blooms indexes kopsFiles ks
+      (rkixs, ioops) <- ST.stToIO $ prepLookups arena salt blooms indexes kopsFiles ks
       ioress <- submitIO hbio ioops
       intraPageLookupsOn resolveV (V.map (const Nothing) ks) rs ks rkixs ioops ioress
   where

src/Database/LSMTree/Internal/Merge.hs

@@ -34,6 +34,7 @@ import           Data.Primitive.MutVar
 import           Data.Traversable (for)
 import qualified Data.Vector as V
 import           Database.LSMTree.Internal.BlobRef (RawBlobRef)
+import qualified Database.LSMTree.Internal.BloomFilter as Bloom
 import           Database.LSMTree.Internal.Entry
 import           Database.LSMTree.Internal.Readers (Readers)
 import qualified Database.LSMTree.Internal.Readers as Readers
@@ -153,6 +154,7 @@ instance IsMergeType TreeMergeType where
      IsMergeType t
   => HasFS IO h
   -> HasBlockIO IO h
+  -> Bloom.Salt
   -> RunParams
   -> t
   -> ResolveSerialisedValue
@@ -165,13 +167,14 @@ new ::
      (IsMergeType t, MonadMask m, MonadSTM m, MonadST m)
   => HasFS m h
   -> HasBlockIO m h
+  -> Bloom.Salt
   -> RunParams
   -> t
   -> ResolveSerialisedValue
   -> Run.RunFsPaths
   -> V.Vector (Ref (Run m h))
   -> m (Maybe (Merge t m h))
-new hfs hbio runParams mergeType mergeResolve targetPaths runs = do
+new hfs hbio salt runParams mergeType mergeResolve targetPaths runs = do
     let sources = Readers.FromRun <$> V.toList runs
     mreaders <- Readers.new mergeResolve Readers.NoOffsetKey sources
     -- TODO: Exception safety! If Readers.new fails after already creating some
@@ -180,7 +183,7 @@ new hfs hbio runParams mergeType mergeResolve targetPaths runs = do
     for mreaders $ \mergeReaders -> do
       -- calculate upper bounds based on input runs
       let numEntries = V.foldMap' Run.size runs
-      mergeBuilder <- Builder.new hfs hbio runParams targetPaths numEntries
+      mergeBuilder <- Builder.new hfs hbio salt runParams targetPaths numEntries
       mergeState <- newMutVar $! Merging
       pure Merge {
           mergeIsLastLevel = isLastLevel mergeType