packages feed

rocksdb-haskell-jprupp (empty) → 2.0.0

raw patch · 12 files changed

+1160/−0 lines, 12 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, data-default, directory, hspec, rocksdb-haskell-jprupp, unliftio

Files

+ AUTHORS view
@@ -0,0 +1,10 @@+# The following people, listed in alphabetical order, contributed to the+# rocksdb-haskell library:++Austin Seipp+Alexander Thiemann+Jean-Pierre Rupp+Kim Altintop+Michael Lazarev+Nicolas Trangez+Will Moss
+ CHANGELOG.md view
@@ -0,0 +1,45 @@+## Unreleased++ * Fork into a different project+ * Rewrite most of the code to make it faster and easier to use+ * Remove many features that I don't need or want to maintain+++## 1.0.1++ * Add support for UTF-8 characters in a database's path+++## 1.0.0++ * First version by Serokell+++## 0.3x.0++ * ResourceT is no longer compulsory+++## 0.2.0++ * requires LevelDB v1.7+ * support for filter policy (LevelDB v1.5), either custom or using the built-in+   bloom filter implementation+ * write batch values no longer require a `memcpy` to be early-finalizer-safe+   (introduced in 0.1.1)+++## 0.1.0++ * memory (foreign pointers) is managed through+   [ResourceT](http://hackage.haskell.org/package/resourcet). Note that this+   requires to lift monadic actions inside the `MonadResource` monad, see the+   examples.+ * links against shared library (LevelDB v1.3 or higher)+ * LevelDB 1.3 API fully supported (including custom comparators, excluding+   custom environments)+++## 0.0.x++ * experimental releases
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2011, Kim Altintop+Copyright (c) 2014, Alexander Thiemann+Copyright (c) 2020, Jean-Pierre Rupp++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Kim Altintop nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,2 @@+This library provides Haskell bindings to+[RocksDB](http://rocksdb.org)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rocksdb-haskell-jprupp.cabal view
@@ -0,0 +1,68 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 1a704ba0e05868931aaf7054fde4968c2fdba55b6f67f7d2b2e339c54cf4933d++name:           rocksdb-haskell-jprupp+version:        2.0.0+synopsis:       Haskell bindings for RocksDB+description:    See README at <https://github.com/jprupp/rocksdb-haskell#readme>+category:       Database, FFI+homepage:       https://github.com/jprupp/rocksdb-haskell#readme+bug-reports:    https://github.com/jprupp/rocksdb-haskell/issues+maintainer:     Jean-Pierre Rupp <jprupp@protonmail.ch>+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md+    AUTHORS++source-repository head+  type: git+  location: https://github.com/jprupp/rocksdb-haskell++library+  exposed-modules:+      Database.RocksDB+  other-modules:+      Database.RocksDB.Base+      Database.RocksDB.C+      Database.RocksDB.Internal+      Database.RocksDB.Iterator+      Paths_rocksdb_haskell_jprupp+  hs-source-dirs:+      src+  ghc-options: -Wall+  extra-libraries:+      rocksdb+  build-depends:+      base >=4.9 && <5+    , bytestring+    , data-default+    , directory+    , unliftio+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: tests.hs+  other-modules:+      Paths_rocksdb_haskell_jprupp+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , base >=4.9 && <5+    , bytestring+    , data-default+    , directory+    , hspec+    , rocksdb-haskell-jprupp+    , unliftio+  default-language: Haskell2010
+ src/Database/RocksDB.hs view
@@ -0,0 +1,17 @@+-- |+-- Module      : Database.RocksDB+-- Copyright   : (c) 2012-2013 The leveldb-haskell Authors+--               (c) 2014 The rocksdb-haskell Authors+--               (c) 2020 Jean-Pierre Rupp+-- License     : BSD3+-- Maintainer  : jprupp@protonmail.ch+-- Stability   : experimental+-- Portability : non-portable+--+-- RocksDB Haskell binding.+--+-- The API closely follows the C-API of RocksDB.++module Database.RocksDB (module Base) where++import Database.RocksDB.Base as Base
+ src/Database/RocksDB/Base.hs view
@@ -0,0 +1,254 @@+{-# LANGUAGE LambdaCase      #-}+-- |+-- Module      : Database.RocksDB.Base+-- Copyright   : (c) 2012-2013 The leveldb-haskell Authors+--               (c) 2014-2020 The rocksdb-haskell Authors+-- License     : BSD3+-- Maintainer  : jprupp@protonmail.ch+-- Stability   : experimental+-- Portability : non-portable+--+-- RocksDB Haskell binding.+--+-- The API closely follows the C-API of RocksDB.++module Database.RocksDB.Base+    ( -- * Exported Types+      DB (..)+    , BatchOp (..)+    , Range++    -- * Options+    , Config (..)++    -- * Basic Database Manipulations+    , withDB+    , put+    , delete+    , write+    , get+    , withSnapshot++    -- * Filter Policy / Bloom Filter+    , BloomFilter+    , withBloomFilter++    -- * Administrative Functions+    , Property (..), getProperty+    , destroy+    , repair+    , approximateSize++    -- * Iteration+    , module Database.RocksDB.Iterator+    ) where++import           Control.Monad             ((>=>))+import           Data.ByteString           (ByteString)+import qualified Data.ByteString           as BS+import           Data.ByteString.Internal  (ByteString (..))+import qualified Data.ByteString.Unsafe    as BU+import           Database.RocksDB.C+import           Database.RocksDB.Internal+import           Database.RocksDB.Iterator+import           Foreign+import           Foreign.C.String          (CString, withCString)+import qualified GHC.Foreign               as GHC+import qualified GHC.IO.Encoding           as GHC+import           System.Directory          (createDirectoryIfMissing)+import           UnliftIO++-- | Properties exposed by RocksDB+data Property = NumFilesAtLevel Int | Stats | SSTables+    deriving (Eq, Show)++data BatchOp = Put !ByteString !ByteString+             | Del !ByteString+             | 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.+--+-- The returned handle should be released with 'close'.+withDB :: MonadUnliftIO m => FilePath -> Config -> (DB -> m a) -> m a+withDB path config f =+    withOptions config $ \opts_ptr ->+    withReadOpts Nothing $ \read_opts ->+    withWriteOpts $ \write_opts ->+    bracket (create_db opts_ptr read_opts write_opts) destroy_db f+  where+    destroy_db db = liftIO $+        c_rocksdb_close $ rocksDB db+    create_db opts_ptr read_opts write_opts = liftIO $ do+        createDirectoryIfMissing True path+        withFilePath path $ \path_ptr -> do+            db_ptr <- throwIfErr "open" $+                c_rocksdb_open opts_ptr path_ptr+            return $ DB db_ptr [] read_opts write_opts++-- | Run an action with a 'Snapshot' of the database.+withSnapshot :: MonadUnliftIO m => DB -> (DB -> m a) -> m a+withSnapshot db@DB{rocksDB = db_ptr} f =+    bracket create_snapshot release_snapshot (f . fst)+  where+    release_snapshot = liftIO . c_rocksdb_release_snapshot db_ptr . snd+    create_snapshot = liftIO $ do+        snap_ptr <- c_rocksdb_create_snapshot db_ptr+        withReadOpts (Just snap_ptr) $ \read_opts ->+            return (db{readOpts = read_opts}, snap_ptr)++-- | Get a DB property.+getProperty :: MonadIO m => DB -> Property -> m (Maybe ByteString)+getProperty DB{rocksDB = db_ptr} p = liftIO $+    withCString (prop p) $+    c_rocksdb_property_value db_ptr >=> \case+    val_ptr | val_ptr == nullPtr -> return Nothing+            | otherwise -> do+                  res <- Just <$> BS.packCString val_ptr+                  freeCString val_ptr+                  return res+  where+    prop (NumFilesAtLevel i) = "rocksdb.num-files-at-level" ++ show i+    prop Stats               = "rocksdb.stats"+    prop SSTables            = "rocksdb.sstables"++-- | Destroy the given RocksDB database.+destroy :: MonadIO m => FilePath -> Options -> m ()+destroy path opts_ptr = liftIO $+    withFilePath path $ \path_ptr ->+    throwIfErr "destroy" $ c_rocksdb_destroy_db opts_ptr path_ptr++-- | Repair the given RocksDB database.+repair :: MonadIO m => FilePath -> Options -> m ()+repair path opts_ptr = liftIO $+    withFilePath path $ \path_ptr ->+    throwIfErr "repair" $ c_rocksdb_repair_db opts_ptr path_ptr+++-- TODO: support [Range], like C API does+type Range  = (ByteString, ByteString)++-- | Inspect the approximate sizes of the different levels.+approximateSize :: MonadIO m => DB -> Range -> m Int64+approximateSize DB{rocksDB = db_ptr} (from, to) = liftIO $+    BU.unsafeUseAsCStringLen from $ \(from_ptr, flen) ->+    BU.unsafeUseAsCStringLen to   $ \(to_ptr, tlen)   ->+    withArray [from_ptr]          $ \from_ptrs        ->+    withArray [intToCSize flen]   $ \flen_ptrs        ->+    withArray [to_ptr]            $ \to_ptrs          ->+    withArray [intToCSize tlen]   $ \tlen_ptrs        ->+    allocaArray 1                 $ \size_ptrs        -> do+        c_rocksdb_approximate_sizes db_ptr 1+                                    from_ptrs flen_ptrs+                                    to_ptrs tlen_ptrs+                                    size_ptrs+        fmap head $ peekArray 1 size_ptrs >>= mapM toInt64++    where+        toInt64 = return . fromIntegral++-- | Write a key/value pair.+put :: MonadIO m => DB -> ByteString -> ByteString -> m ()+put DB{rocksDB = db_ptr, writeOpts = write_opts} key value = liftIO $+    BU.unsafeUseAsCStringLen key   $ \(key_ptr, klen) ->+    BU.unsafeUseAsCStringLen value $ \(val_ptr, vlen) ->+        throwIfErr "put"+            $ c_rocksdb_put db_ptr write_opts+                            key_ptr (intToCSize klen)+                            val_ptr (intToCSize vlen)++-- | Read a value by key.+get :: MonadIO m => DB -> ByteString -> m (Maybe ByteString)+get DB{rocksDB = db_ptr, readOpts = read_opts} key = liftIO $+    BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+    alloca                       $ \vlen_ptr -> do+        val_ptr <- throwIfErr "get" $+            c_rocksdb_get db_ptr read_opts key_ptr (intToCSize klen) vlen_ptr+        vlen <- peek vlen_ptr+        if val_ptr == nullPtr+            then return Nothing+            else do+                res' <- Just <$> BS.packCStringLen (val_ptr, cSizeToInt vlen)+                freeCString val_ptr+                return res'++-- | Delete a key/value pair.+delete :: MonadIO m => DB -> ByteString -> m ()+delete DB{rocksDB = db_ptr, writeOpts = write_opts} key = liftIO $+    BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+        throwIfErr "delete"+            $ c_rocksdb_delete db_ptr write_opts key_ptr (intToCSize klen)++-- | Perform a batch mutation.+write :: MonadIO m => DB -> [BatchOp] -> m ()+write DB{rocksDB = db_ptr, writeOpts = write_opts} batch = liftIO $+    bracket+    c_rocksdb_writebatch_create+    c_rocksdb_writebatch_destroy $ \batch_ptr -> do++    mapM_ (batchAdd batch_ptr) batch++    throwIfErr "write" $ c_rocksdb_write db_ptr write_opts batch_ptr++    -- ensure @ByteString@s (and respective shared @CStringLen@s) aren't GC'ed+    -- until here+    mapM_ (liftIO . touch) batch++    where+        batchAdd batch_ptr (Put key val) =+            BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+            BU.unsafeUseAsCStringLen val $ \(val_ptr, vlen) ->+                c_rocksdb_writebatch_put+                batch_ptr+                key_ptr (intToCSize klen)+                val_ptr (intToCSize vlen)++        batchAdd batch_ptr (PutCF cf_ptr key val) =+            BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+            BU.unsafeUseAsCStringLen val $ \(val_ptr, vlen) ->+                c_rocksdb_writebatch_put_cf+                batch_ptr+                cf_ptr+                key_ptr (intToCSize klen)+                val_ptr (intToCSize vlen)++        batchAdd batch_ptr (Del key) =+            BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+                c_rocksdb_writebatch_delete+                batch_ptr+                key_ptr (intToCSize klen)++        batchAdd batch_ptr (DelCF cf_ptr key) =+            BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+                c_rocksdb_writebatch_delete_cf+                batch_ptr+                cf_ptr+                key_ptr (intToCSize klen)+++        touch (Put (PS p _ _) (PS p' _ _)) = do+            touchForeignPtr p+            touchForeignPtr p'++        touch (PutCF _ (PS p _ _) (PS p' _ _)) = do+            touchForeignPtr p+            touchForeignPtr p'++        touch (Del (PS p _ _)) = touchForeignPtr p++        touch (DelCF _ (PS p _ _)) = touchForeignPtr p++-- | Marshal a 'FilePath' (Haskell string) into a `NUL` terminated C string using+-- temporary storage.+withFilePath :: FilePath -> (CString -> IO a) -> IO a+withFilePath = GHC.withCString GHC.utf8
+ src/Database/RocksDB/C.hs view
@@ -0,0 +1,415 @@+{-# LANGUAGE CPP                      #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-- |+-- Module      : Database.RocksDB.C+-- Copyright   : (c) 2012-2020 The rocksdb-haskell Authors+-- License     : BSD3+-- Maintainer  : jprupp@protonmail.ch+-- Stability   : experimental+-- Portability : non-portable+--++module Database.RocksDB.C+    ( RocksDB+    , Options+    , ReadOpts+    , WriteOpts+    , ColumnFamily+    , PrefixExtract+    , Snapshot+    , Iterator+    , WriteBatch+    , BloomFilter+    , ErrPtr+    , DBName+    , CFName+    , Key+    , Val+    , c_rocksdb_open+    , c_rocksdb_open_column_families+    , c_rocksdb_close+    , c_rocksdb_create_column_family+    , c_rocksdb_drop_column_family+    , c_rocksdb_column_family_handle_destroy+    , c_rocksdb_put+    , c_rocksdb_put_cf+    , c_rocksdb_delete+    , c_rocksdb_delete_cf+    , c_rocksdb_write+    , c_rocksdb_get+    , c_rocksdb_get_cf+    , c_rocksdb_multi_get+    , c_rocksdb_multi_get_cf+    , c_rocksdb_create_snapshot+    , c_rocksdb_release_snapshot+    , c_rocksdb_property_value+    , c_rocksdb_approximate_sizes+    , c_rocksdb_destroy_db+    , c_rocksdb_repair_db+    , c_rocksdb_create_iterator+    , c_rocksdb_iter_destroy+    , c_rocksdb_iter_valid+    , c_rocksdb_iter_seek_to_first+    , c_rocksdb_iter_seek_to_last+    , c_rocksdb_iter_seek+    , c_rocksdb_iter_next+    , c_rocksdb_iter_prev+    , c_rocksdb_iter_key+    , c_rocksdb_iter_value+    , c_rocksdb_iter_get_error+    , c_rocksdb_writebatch_create+    , c_rocksdb_writebatch_destroy+    , c_rocksdb_writebatch_clear+    , c_rocksdb_writebatch_put+    , c_rocksdb_writebatch_put_cf+    , c_rocksdb_writebatch_delete+    , c_rocksdb_writebatch_delete_cf+    , c_rocksdb_options_create+    , c_rocksdb_options_destroy+    , c_rocksdb_options_set_create_if_missing+    , c_rocksdb_options_set_error_if_exists+    , c_rocksdb_options_set_paranoid_checks+    , c_rocksdb_options_set_max_open_files+    , c_rocksdb_options_set_prefix_extractor+    , c_rocksdb_slicetransform_create_fixed_prefix+    , c_rocksdb_slicetransform_destroy+    , c_rocksdb_filterpolicy_destroy+    , c_rocksdb_filterpolicy_create_bloom+    , c_rocksdb_readoptions_create+    , c_rocksdb_readoptions_destroy+    , c_rocksdb_readoptions_set_snapshot+    , c_rocksdb_writeoptions_create+    , c_rocksdb_writeoptions_destroy+    , c_rocksdb_free+    ) where++import           Foreign+import           Foreign.C.String+import           Foreign.C.Types++data LRocksDB+data LColumnFamily+data LIterator+data LOptions+data LReadOpts+data LSnapshot+data LWriteBatch+data LWriteOpts+data LBloomFilter+data LPrefixExtract++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 ErrPtr           = Ptr CString+type DBName           = CString+type CFName           = CString+type Key              = CString+type Val              = CString++foreign import ccall unsafe "rocksdb/c.h rocksdb_open"+  c_rocksdb_open :: Options -> DBName -> ErrPtr -> IO RocksDB++foreign import ccall unsafe "rocksdb/c.h rocksdb_open_column_families"+  c_rocksdb_open_column_families :: Options+                                 -> DBName+                                 -> CInt+                                 -> Ptr CFName+                                 -> Ptr Options+                                 -> Ptr ColumnFamily+                                 -> ErrPtr+                                 -> IO RocksDB++foreign import ccall unsafe "rocksdb/c.h rocksdb_close"+  c_rocksdb_close :: RocksDB -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_create_column_family"+  c_rocksdb_create_column_family :: RocksDB+                                 -> Options+                                 -> CFName+                                 -> ErrPtr+                                 -> IO ColumnFamily++foreign import ccall unsafe "rocksdb/c.h rocksdb_drop_column_family"+  c_rocksdb_drop_column_family :: RocksDB+                               -> ColumnFamily+                               -> ErrPtr+                               -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_column_family_handle_destroy"+  c_rocksdb_column_family_handle_destroy :: ColumnFamily -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_put"+  c_rocksdb_put :: RocksDB+                -> WriteOpts+                -> Key -> CSize+                -> Val -> CSize+                -> ErrPtr+                -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_put_cf"+  c_rocksdb_put_cf :: RocksDB+                   -> WriteOpts+                   -> ColumnFamily+                   -> Key -> CSize+                   -> Val -> CSize+                   -> ErrPtr+                   -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_delete"+  c_rocksdb_delete :: RocksDB+                   -> WriteOpts+                   -> Key -> CSize+                   -> ErrPtr+                   -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_delete_cf"+  c_rocksdb_delete_cf :: RocksDB+                      -> WriteOpts+                      -> ColumnFamily+                      -> Key -> CSize+                      -> ErrPtr+                      -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_write"+  c_rocksdb_write :: RocksDB+                  -> WriteOpts+                  -> WriteBatch+                  -> ErrPtr+                  -> IO ()++-- | Returns NULL if not found. A malloc()ed array otherwise.+-- Stores the length of the array in *vallen.+foreign import ccall unsafe "rocksdb/c.h rocksdb_get"+  c_rocksdb_get :: RocksDB+                -> ReadOpts+                -> Key -> CSize+                -> Ptr CSize        -- ^ value length+                -> ErrPtr+                -> IO CString++foreign import ccall unsafe "rocksdb/c.h rocksdb_get_cf"+  c_rocksdb_get_cf :: RocksDB+                   -> ReadOpts+                   -> ColumnFamily+                   -> Key -> CSize+                   -> Ptr CSize        -- ^ value length+                   -> ErrPtr+                   -> IO CString++foreign import ccall unsafe "rocksdb/c.h rocksdb_multi_get"+  c_rocksdb_multi_get :: RocksDB+                      -> ReadOpts+                      -> CSize        -- ^ number of keys+                      -> Ptr CString  -- ^ keys+                      -> Ptr CSize    -- ^ key sizes+                      -> Ptr CString  -- ^ values+                      -> Ptr CSize    -- ^ values sizes+                      -> ErrPtr+                      -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_multi_get_cf"+  c_rocksdb_multi_get_cf :: RocksDB+                         -> ReadOpts+                         -> Ptr ColumnFamily -- ^ column families+                         -> CSize                   -- ^ number of keys+                         -> Ptr CString             -- ^ keys+                         -> Ptr CSize               -- ^ key sizes+                         -> Ptr CString             -- ^ values+                         -> Ptr CSize               -- ^ values sizes+                         -> ErrPtr+                         -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_create_snapshot"+  c_rocksdb_create_snapshot :: RocksDB -> IO Snapshot++foreign import ccall unsafe "rocksdb/c.h rocksdb_release_snapshot"+  c_rocksdb_release_snapshot :: RocksDB -> Snapshot -> IO ()++-- | Returns NULL if property name is unknown. Else returns a pointer to a+-- malloc()-ed null-terminated value.+foreign import ccall unsafe "rocksdb/c.h rocksdb_property_value"+  c_rocksdb_property_value :: RocksDB -> CString -> IO CString++foreign import ccall unsafe "rocksdb/c.h rocksdb_approximate_sizes"+  c_rocksdb_approximate_sizes :: RocksDB+                              -> CInt+                                 -- ^ num ranges+                              -> Ptr CString -> Ptr CSize+                                 -- ^ range start keys (array)+                              -> Ptr CString -> Ptr CSize+                                 -- ^ range limit keys (array)+                              -> Ptr Word64+                                 -- ^ array of approx. sizes of ranges+                              -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_destroy_db"+  c_rocksdb_destroy_db :: Options -> DBName -> ErrPtr -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_repair_db"+  c_rocksdb_repair_db :: Options -> DBName -> ErrPtr -> IO ()+++--+-- Iterator+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_create_iterator"+  c_rocksdb_create_iterator :: RocksDB+                            -> ReadOpts+                            -> IO Iterator++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_destroy"+  c_rocksdb_iter_destroy :: Iterator -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_valid"+  c_rocksdb_iter_valid :: Iterator -> IO CUChar++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_seek_to_first"+  c_rocksdb_iter_seek_to_first :: Iterator -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_seek_to_last"+  c_rocksdb_iter_seek_to_last :: Iterator -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_seek"+  c_rocksdb_iter_seek :: Iterator -> Key -> CSize -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_next"+  c_rocksdb_iter_next :: Iterator -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_prev"+  c_rocksdb_iter_prev :: Iterator -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_key"+  c_rocksdb_iter_key :: Iterator -> Ptr CSize -> IO Key++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_value"+  c_rocksdb_iter_value :: Iterator -> Ptr CSize -> IO Val++foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_get_error"+  c_rocksdb_iter_get_error :: Iterator -> ErrPtr -> IO ()+++--+-- Write batch+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_create"+  c_rocksdb_writebatch_create :: IO WriteBatch++foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_destroy"+  c_rocksdb_writebatch_destroy :: WriteBatch -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_clear"+  c_rocksdb_writebatch_clear :: WriteBatch -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_put"+  c_rocksdb_writebatch_put :: WriteBatch+                           -> Key -> CSize+                           -> Val -> CSize+                           -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_put_cf"+  c_rocksdb_writebatch_put_cf :: WriteBatch+                              -> ColumnFamily+                              -> Key -> CSize+                              -> Val -> CSize+                              -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_delete"+  c_rocksdb_writebatch_delete :: WriteBatch+                              -> Key -> CSize -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_delete_cf"+  c_rocksdb_writebatch_delete_cf :: WriteBatch+                                 -> ColumnFamily+                                 -> Key+                                 -> CSize+                                 -> IO ()++--+-- Options+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_options_create"+  c_rocksdb_options_create :: IO Options++foreign import ccall "rocksdb/c.h rocksdb_options_destroy"+  c_rocksdb_options_destroy :: Options -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_create_if_missing"+  c_rocksdb_options_set_create_if_missing :: Options -> CBool -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_error_if_exists"+  c_rocksdb_options_set_error_if_exists :: Options -> CBool -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_paranoid_checks"+  c_rocksdb_options_set_paranoid_checks :: Options -> CBool -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_max_open_files"+  c_rocksdb_options_set_max_open_files :: Options -> CInt -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_prefix_extractor"+  c_rocksdb_options_set_prefix_extractor :: Options+                                         -> PrefixExtract+                                         -> IO ()++--+-- Prefix Extractor+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_slicetransform_create_fixed_prefix"+  c_rocksdb_slicetransform_create_fixed_prefix :: CSize -> IO PrefixExtract++foreign import ccall unsafe "rocksdb/c.h rocksdb_slicetransform_destroy"+  c_rocksdb_slicetransform_destroy :: PrefixExtract -> IO ()++--+-- Bloom Filter+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_filterpolicy_destroy"+  c_rocksdb_filterpolicy_destroy :: BloomFilter -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_filterpolicy_create_bloom"+  c_rocksdb_filterpolicy_create_bloom :: CInt -> IO BloomFilter++--+-- Read options+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_readoptions_create"+  c_rocksdb_readoptions_create :: IO ReadOpts++foreign import ccall unsafe "rocksdb/c.h rocksdb_readoptions_destroy"+  c_rocksdb_readoptions_destroy :: ReadOpts -> IO ()++foreign import ccall unsafe "rocksdb/c.h rocksdb_readoptions_set_snapshot"+  c_rocksdb_readoptions_set_snapshot :: ReadOpts -> Snapshot -> IO ()+++--+-- Write options+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_writeoptions_create"+  c_rocksdb_writeoptions_create :: IO WriteOpts++foreign import ccall unsafe "rocksdb/c.h rocksdb_writeoptions_destroy"+  c_rocksdb_writeoptions_destroy :: WriteOpts -> IO ()++--+-- Free+--++foreign import ccall unsafe "rocksdb/c.h rocksdb_free"+  c_rocksdb_free :: CString -> IO ()
+ src/Database/RocksDB/Internal.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE RecordWildCards #-}+-- |+-- Module      : Database.RocksDB.Internal+-- Copyright   : (c) 2012-2013 The leveldb-haskell Authors+--               (c) 2014-2020 The rocksdb-haskell Authors+-- License     : BSD3+-- Maintainer  : jprupp@protonmail.ch+-- Stability   : experimental+-- Portability : non-portable+--++module Database.RocksDB.Internal+    ( Config (..)+    , DB (..)++    -- * Smart constructors & extractors+    , withOptions+    , withReadOpts+    , withWriteOpts++    -- * Utilities+    , freeCString+    , throwIfErr+    , cSizeToInt+    , intToCSize+    , intToCInt+    , cIntToInt+    , boolToNum+    ) where++import           Control.Monad+import           Data.Default+import           Database.RocksDB.C+import           UnliftIO+import           UnliftIO.Foreign++data DB = DB { rocksDB        :: !RocksDB+             , columnFamilies :: ![ColumnFamily]+             , readOpts       :: !ReadOpts+             , writeOpts      :: !WriteOpts+             }++data Config = Config { createIfMissing :: !Bool+                     , errorIfExists   :: !Bool+                     , paranoidChecks  :: !Bool+                     , maxFiles        :: !(Maybe Int)+                     , prefixLength    :: !(Maybe Int)+                     } deriving (Eq, Show)++instance Default Config where+    def = Config { createIfMissing  = False+                 , errorIfExists    = False+                 , paranoidChecks   = False+                 , maxFiles         = Nothing+                 , prefixLength     = Nothing+                 }++withOptions :: MonadUnliftIO m => Config -> (Options -> m a) -> m a+withOptions Config {..} f =+    bracket create_opts destroy_opts (f . fst)+  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)+        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)++withReadOpts :: MonadUnliftIO m => Maybe Snapshot -> (ReadOpts -> m a) -> m a+withReadOpts maybe_snap_ptr =+    bracket+    create_read_opts+    (liftIO . c_rocksdb_readoptions_destroy)+  where+    create_read_opts = liftIO $ do+        read_opts_ptr <- c_rocksdb_readoptions_create+        forM_ maybe_snap_ptr $ c_rocksdb_readoptions_set_snapshot read_opts_ptr+        return read_opts_ptr++withWriteOpts :: MonadUnliftIO m => (WriteOpts -> m a) -> m a+withWriteOpts =+    bracket+    (liftIO c_rocksdb_writeoptions_create)+    (liftIO . c_rocksdb_writeoptions_destroy)++freeCString :: CString -> IO ()+freeCString = c_rocksdb_free++throwIfErr :: MonadUnliftIO m => String -> (ErrPtr -> m a) -> m a+throwIfErr s f = alloca $ \err_ptr -> do+    liftIO $ poke err_ptr nullPtr+    res  <- f err_ptr+    erra <- liftIO $ peek err_ptr+    when (erra /= nullPtr) $ do+        err <- liftIO $ peekCString erra+        throwIO $ userError $ s ++ ": " ++ err+    return res++boolToCBool :: Bool -> CBool+boolToCBool True  = 1+boolToCBool False = 0+{-# INLINE boolToCBool #-}++cSizeToInt :: CSize -> Int+cSizeToInt = fromIntegral+{-# INLINE cSizeToInt #-}++intToCSize :: Int -> CSize+intToCSize = fromIntegral+{-# INLINE intToCSize #-}++intToCInt :: Int -> CInt+intToCInt = fromIntegral+{-# INLINE intToCInt #-}++cIntToInt :: CInt -> Int+cIntToInt = fromIntegral+{-# INLINE cIntToInt #-}++boolToNum :: Num b => Bool -> b+boolToNum True  = fromIntegral (1 :: Int)+boolToNum False = fromIntegral (0 :: Int)+{-# INLINE boolToNum #-}
+ src/Database/RocksDB/Iterator.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE LambdaCase #-}+-- |+-- Module      : Database.RocksDB.Iterator+-- Copyright   : (c) 2012-2013 The leveldb-haskell Authors+--               (c) 2014-2020 The rocksdb-haskell Authors+-- License     : BSD3+-- Maintainer  : jprupp@protonmail.ch+-- Stability   : experimental+-- Portability : non-portable+--+-- Iterating over key ranges.+--++module Database.RocksDB.Iterator+    ( Iterator+    , withIter+    , iterEntry+    , iterFirst+    , iterGetError+    , iterKey+    , iterLast+    , iterNext+    , iterPrev+    , iterSeek+    , iterValid+    , iterValue+    ) where++import           Control.Monad             (when)+import           Data.ByteString           (ByteString)+import qualified Data.ByteString           as BS+import qualified Data.ByteString.Char8     as BC+import qualified Data.ByteString.Unsafe    as BU+import           Database.RocksDB.C+import           Database.RocksDB.Internal+import           Foreign+import           Foreign.C.Error           (throwErrnoIfNull)+import           Foreign.C.String          (CString, peekCString)+import           Foreign.C.Types           (CSize)+import           UnliftIO++-- | Create 'Iterator' and use it.+--+-- Note that an 'Iterator' creates a snapshot of the database implicitly, so+-- updates written after the iterator was created are not visible. You may,+-- however, specify an older 'Snapshot' in the 'ReadOptions'.+--+-- Iterator should not be used after computation ends.+withIter :: MonadUnliftIO m => DB -> (Iterator -> m a) -> m a+withIter DB{rocksDB = rocks_db, readOpts = read_opts} =+    bracket create_iterator destroy_iterator+  where+    destroy_iterator = liftIO . c_rocksdb_iter_destroy+    create_iterator = liftIO $+        throwErrnoIfNull "create_iterator" $+        c_rocksdb_create_iterator rocks_db read_opts++-- | An iterator is either positioned at a key/value pair, or not valid. This+-- function returns /true/ iff the iterator is valid.+iterValid :: MonadIO m => Iterator -> m Bool+iterValid iter_ptr = liftIO $ do+    x <- c_rocksdb_iter_valid iter_ptr+    return (x /= 0)++-- | Position at the first key in the source that is at or past target. The+-- iterator is /valid/ after this call iff the source contains an entry that+-- comes at or past target.+iterSeek :: MonadIO m => Iterator -> ByteString -> m ()+iterSeek iter_ptr key = liftIO $+    BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+    c_rocksdb_iter_seek iter_ptr key_ptr (intToCSize klen)++-- | Position at the first key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterFirst :: MonadIO m => Iterator -> m ()+iterFirst = liftIO . c_rocksdb_iter_seek_to_first++-- | Position at the last key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterLast :: MonadIO m => Iterator -> m ()+iterLast = liftIO . c_rocksdb_iter_seek_to_last++-- | Moves to the next entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the last entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterPrev' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterNext :: MonadIO m => Iterator -> m ()+iterNext iter_ptr = liftIO $ do+    valid <- c_rocksdb_iter_valid iter_ptr+    when (valid /= 0) $ c_rocksdb_iter_next iter_ptr++-- | Moves to the previous entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the first entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterNext' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterPrev :: MonadIO m => Iterator -> m ()+iterPrev iter_ptr = liftIO $ do+    valid <- c_rocksdb_iter_valid iter_ptr+    when (valid /= 0) $ c_rocksdb_iter_prev iter_ptr++-- | Return the key for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterKey :: MonadIO m => Iterator -> m (Maybe ByteString)+iterKey = liftIO . flip iterString c_rocksdb_iter_key++-- | Return the value for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterValue :: MonadIO m => Iterator -> m (Maybe ByteString)+iterValue = liftIO . flip iterString c_rocksdb_iter_value++-- | Return the current entry as a pair, if the iterator is currently positioned+-- at an entry, ie. 'iterValid'.+iterEntry :: MonadIO m => Iterator -> m (Maybe (ByteString, ByteString))+iterEntry iter = liftIO $ do+    mkey <- iterKey iter+    mval <- iterValue iter+    return $ (,) <$> mkey <*> mval++-- | Check for errors+--+-- Note that this captures somewhat severe errors such as a corrupted database.+iterGetError :: MonadIO m => Iterator -> m (Maybe ByteString)+iterGetError iter_ptr = liftIO . alloca $ \err_ptr -> do+    poke err_ptr nullPtr+    c_rocksdb_iter_get_error iter_ptr err_ptr+    erra <- peek err_ptr+    if erra == nullPtr+        then return Nothing+        else do+            err <- peekCString erra+            return $ Just (BC.pack err)++--+-- Internal+--++iterString :: Iterator+           -> (Iterator -> Ptr CSize -> IO CString)+           -> IO (Maybe ByteString)+iterString iter_ptr f =+    c_rocksdb_iter_valid iter_ptr >>= \case+        0 -> return Nothing+        _ -> alloca $ \len_ptr ->+            f iter_ptr len_ptr >>= \ptr ->+            if ptr == nullPtr+                then return Nothing+                else do+                    len <- peek len_ptr+                    Just <$> BS.packCStringLen (ptr, cSizeToInt len)
+ test/tests.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE BinaryLiterals    #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Data.Default     (def)+import           Database.RocksDB+import           Test.Hspec       (describe, hspec, it, shouldReturn)+import           UnliftIO++withTestDB :: MonadUnliftIO m => FilePath -> (DB -> m a) -> m a+withTestDB path = withDB path def{createIfMissing = True}++main :: IO ()+main =  do+    hspec $ do+        describe "Database engine" $ do+            it "should put items into the database and retrieve them" $+                withSystemTempDirectory "rocksdb" $ \path ->+                withTestDB path $ \db -> do+                    put db "zzz" "zzz"+                    get db "zzz" `shouldReturn` Just "zzz"