diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## 2.1.3 + + * Correct bug where database was ignoring prefix length config. + + +## 2.1.2 + + * Correct bug when opening database with column families. + + ## 2.1.1 * Expose ColumnFamily type. diff --git a/rocksdb-haskell-jprupp.cabal b/rocksdb-haskell-jprupp.cabal --- a/rocksdb-haskell-jprupp.cabal +++ b/rocksdb-haskell-jprupp.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: e60e134f110b492122b3c20c49c57627b92624316c28c814c9e571fb2ff156b3 +-- hash: 094c0ad3842293bfb0c2b11fda87cf96076e2f497046a7e82023bfd4d96d4e0d name: rocksdb-haskell-jprupp -version: 2.1.2 +version: 2.1.3 synopsis: Haskell bindings for RocksDB description: See README at category: Database, FFI diff --git a/src/Database/RocksDB/Base.hs b/src/Database/RocksDB/Base.hs --- a/src/Database/RocksDB/Base.hs +++ b/src/Database/RocksDB/Base.hs @@ -34,10 +34,6 @@ , getCF , withSnapshot - -- * Filter Policy / Bloom Filter - , BloomFilter - , withBloomFilter - -- * Administrative Functions , Property (..), getProperty , destroy @@ -69,15 +65,6 @@ | PutCF !ColumnFamily !ByteString !ByteString | DelCF !ColumnFamily !ByteString deriving (Eq, Show) - --- | Create a 'BloomFilter' -withBloomFilter :: MonadUnliftIO m => Int -> (BloomFilter -> m a) -> m a -withBloomFilter i = - bracket create_bloom_filter destroy_bloom_filter - where - destroy_bloom_filter = liftIO . c_rocksdb_filterpolicy_destroy - create_bloom_filter = liftIO $ - c_rocksdb_filterpolicy_create_bloom (intToCInt i) -- | Open a database. -- diff --git a/src/Database/RocksDB/C.hs b/src/Database/RocksDB/C.hs --- a/src/Database/RocksDB/C.hs +++ b/src/Database/RocksDB/C.hs @@ -16,11 +16,11 @@ , ReadOpts , WriteOpts , ColumnFamily - , PrefixExtract + , SliceTransform , Snapshot , Iterator , WriteBatch - , BloomFilter + , FilterPolicy , ErrPtr , DBName , CFName @@ -73,10 +73,14 @@ , c_rocksdb_options_set_paranoid_checks , c_rocksdb_options_set_max_open_files , c_rocksdb_options_set_prefix_extractor + , c_rocksdb_options_set_block_based_table_factory + , c_rocksdb_block_based_options_create + , c_rocksdb_block_based_options_set_filter_policy + , c_rocksdb_block_based_options_destroy , c_rocksdb_slicetransform_create_fixed_prefix , c_rocksdb_slicetransform_destroy , c_rocksdb_filterpolicy_destroy - , c_rocksdb_filterpolicy_create_bloom + , c_rocksdb_filterpolicy_create_bloom_full , c_rocksdb_readoptions_create , c_rocksdb_readoptions_destroy , c_rocksdb_readoptions_set_snapshot @@ -93,23 +97,25 @@ data LColumnFamily data LIterator data LOptions +data LBlockBasedOptions data LReadOpts data LSnapshot data LWriteBatch data LWriteOpts -data LBloomFilter -data LPrefixExtract +data LFilterPolicy +data LSliceTransform -type RocksDB = Ptr LRocksDB -type ColumnFamily = Ptr LColumnFamily -type Options = Ptr LOptions -type WriteBatch = Ptr LWriteBatch -type PrefixExtract = Ptr LPrefixExtract -type ReadOpts = Ptr LReadOpts -type WriteOpts = Ptr LWriteOpts -type Snapshot = Ptr LSnapshot -type Iterator = Ptr LIterator -type BloomFilter = Ptr LBloomFilter +type RocksDB = Ptr LRocksDB +type ColumnFamily = Ptr LColumnFamily +type Options = Ptr LOptions +type WriteBatch = Ptr LWriteBatch +type SliceTransform = Ptr LSliceTransform +type ReadOpts = Ptr LReadOpts +type WriteOpts = Ptr LWriteOpts +type Snapshot = Ptr LSnapshot +type Iterator = Ptr LIterator +type FilterPolicy = Ptr LFilterPolicy +type BlockBasedOptions = Ptr LBlockBasedOptions type ErrPtr = Ptr CString type DBName = CString @@ -367,28 +373,49 @@ foreign import ccall safe "rocksdb/c.h rocksdb_options_set_prefix_extractor" c_rocksdb_options_set_prefix_extractor :: Options - -> PrefixExtract + -> SliceTransform -> IO () -- +-- Block-Based Options +-- + +foreign import ccall safe "rocksdb/c.h rocksdb_block_based_options_create" + c_rocksdb_block_based_options_create :: IO BlockBasedOptions + +foreign import ccall safe "rocksdb/c.h rocksdb_block_based_options_destroy" + c_rocksdb_block_based_options_destroy :: BlockBasedOptions + -> IO () + +foreign import ccall safe "rocksdb/c.h rocksdb_block_based_options_set_filter_policy" + c_rocksdb_block_based_options_set_filter_policy :: BlockBasedOptions + -> FilterPolicy + -> IO () + +foreign import ccall safe "rocksdb/c.h rocksdb_options_set_block_based_table_factory" + c_rocksdb_options_set_block_based_table_factory :: Options + -> BlockBasedOptions + -> IO () + +-- -- Prefix Extractor -- foreign import ccall safe "rocksdb/c.h rocksdb_slicetransform_create_fixed_prefix" - c_rocksdb_slicetransform_create_fixed_prefix :: CSize -> IO PrefixExtract + c_rocksdb_slicetransform_create_fixed_prefix :: CSize -> IO SliceTransform foreign import ccall safe "rocksdb/c.h rocksdb_slicetransform_destroy" - c_rocksdb_slicetransform_destroy :: PrefixExtract -> IO () + c_rocksdb_slicetransform_destroy :: SliceTransform -> IO () -- -- Bloom Filter -- foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_destroy" - c_rocksdb_filterpolicy_destroy :: BloomFilter -> IO () + c_rocksdb_filterpolicy_destroy :: FilterPolicy -> IO () -foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_create_bloom" - c_rocksdb_filterpolicy_create_bloom :: CInt -> IO BloomFilter +foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_create_bloom_full" + c_rocksdb_filterpolicy_create_bloom_full :: CInt -> IO FilterPolicy -- -- Read options diff --git a/src/Database/RocksDB/Internal.hs b/src/Database/RocksDB/Internal.hs --- a/src/Database/RocksDB/Internal.hs +++ b/src/Database/RocksDB/Internal.hs @@ -46,6 +46,7 @@ , paranoidChecks :: !Bool , maxFiles :: !(Maybe Int) , prefixLength :: !(Maybe Int) + , bloomFilter :: !Bool } deriving (Eq, Show) instance Default Config where @@ -54,35 +55,50 @@ , paranoidChecks = False , maxFiles = Nothing , prefixLength = Nothing + , bloomFilter = False } withOptions :: MonadUnliftIO m => Config -> (Options -> m a) -> m a withOptions Config {..} f = - bracket create_opts destroy_opts (f . fst) + with_opts $ \opts -> do + liftIO $ do + slice <- bloom + block_opts opts slice + pfx_extract opts + max_files opts + c_rocksdb_options_set_create_if_missing + opts (boolToCBool createIfMissing) + c_rocksdb_options_set_error_if_exists + opts (boolToCBool errorIfExists) + c_rocksdb_options_set_paranoid_checks + opts (boolToCBool paranoidChecks) + f opts where - destroy_opts (opts_ptr, maybe_pfx_extract) = liftIO $ do - c_rocksdb_options_destroy opts_ptr - forM_ maybe_pfx_extract c_rocksdb_slicetransform_destroy - create_opts = liftIO $ do - opts_ptr <- c_rocksdb_options_create - c_rocksdb_options_set_create_if_missing - opts_ptr (boolToCBool createIfMissing) - c_rocksdb_options_set_error_if_exists - opts_ptr (boolToCBool errorIfExists) - c_rocksdb_options_set_paranoid_checks - opts_ptr (boolToCBool paranoidChecks) + with_opts = + bracket + (liftIO c_rocksdb_options_create) + (liftIO . c_rocksdb_options_destroy) + block_opts _ Nothing = return () + block_opts opts (Just slice) = liftIO $ do + block <- c_rocksdb_block_based_options_create + c_rocksdb_block_based_options_set_filter_policy block slice + c_rocksdb_options_set_block_based_table_factory opts block + bloom = + if bloomFilter + then Just <$> c_rocksdb_filterpolicy_create_bloom_full 10 + else return Nothing + pfx_extract opts = + case prefixLength of + Nothing -> return () + Just len -> liftIO $ do + p <- c_rocksdb_slicetransform_create_fixed_prefix + (intToCSize len) + c_rocksdb_options_set_prefix_extractor opts p + max_files opts = case maxFiles of Nothing -> return () - Just n -> c_rocksdb_options_set_max_open_files - opts_ptr - (intToCInt n) - maybe_pfx_extract <- case prefixLength of - Nothing -> return Nothing - Just n -> do - pfx_extract <- c_rocksdb_slicetransform_create_fixed_prefix - (intToCSize n) - return $ Just pfx_extract - return (opts_ptr, maybe_pfx_extract) + Just i -> c_rocksdb_options_set_max_open_files opts (intToCInt i) + withOptionsCF :: MonadUnliftIO m => [Config] -> ([Options] -> m a) -> m a withOptionsCF cfgs f = diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -10,13 +10,20 @@ import Test.Hspec (describe, hspec, it, shouldReturn) import UnliftIO +conf :: Config +conf = def { createIfMissing = True + , errorIfExists = True + , bloomFilter = True + , prefixLength = Just 3 + } + withTestDB :: MonadUnliftIO m => FilePath -> (DB -> m a) -> m a withTestDB path = - withDB path def{createIfMissing = True} + withDB path conf withTestDBCF :: MonadUnliftIO m => FilePath -> [String] -> (DB -> m a) -> m a withTestDBCF path cfs = - withDBCF path def{createIfMissing = True} (map (,def) cfs) + withDBCF path conf (map (,conf) cfs) main :: IO () main = do