direct-rocksdb 0.0.1 → 0.0.2
raw patch · 10 files changed
+243/−55 lines, 10 filesdep +bytestringdep +directorydep +filepath
Dependencies added: bytestring, directory, filepath, safe-exceptions
Files
- CHANGELOG.md +8/−0
- direct-rocksdb.cabal +15/−1
- src/Database/RocksDB/DB.hs +63/−0
- src/Database/RocksDB/Exceptions.hs +27/−0
- src/Database/RocksDB/Internals.hs +0/−51
- src/Database/RocksDB/Options.hs +30/−0
- src/Database/RocksDB/ReadOptions.hs +31/−0
- src/Database/RocksDB/Utils.hs +19/−0
- src/Database/RocksDB/WriteOptions.hs +29/−0
- test/direct-rocksdb-test.hs +21/−3
CHANGELOG.md view
@@ -1,1 +1,9 @@ # CHANGELOG for direct-rocksdb++## 0.0.2++* Basic put/get is working at a higher level++## 0.0.1++* Initial release, containing only raw C bindings
direct-rocksdb.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: direct-rocksdb-version: 0.0.1+version: 0.0.2 synopsis: Bindings to RocksDB. category: Database stability: alpha@@ -1219,16 +1219,25 @@ library hs-source-dirs: src+ other-extensions: DeriveAnyClass RecordWildCards ScopedTypeVariables ghc-options: -Wall extra-libraries: stdc++ build-depends: base >= 4.10 && < 5+ , bytestring+ , safe-exceptions if os(windows) extra-libraries: rpcrt4 exposed-modules:+ Database.RocksDB.DB+ Database.RocksDB.Exceptions Database.RocksDB.Internals+ Database.RocksDB.Options+ Database.RocksDB.ReadOptions+ Database.RocksDB.Utils+ Database.RocksDB.WriteOptions default-language: Haskell2010 test-suite direct-rocksdb-test@@ -1236,12 +1245,17 @@ main-is: direct-rocksdb-test.hs hs-source-dirs: test+ other-extensions: OverloadedStrings ghc-options: -Wall -threaded -with-rtsopts=-N extra-libraries: stdc++ build-depends: base >= 4.10 && < 5+ , bytestring+ , safe-exceptions , direct-rocksdb+ , directory+ , filepath if os(windows) extra-libraries: rpcrt4
+ src/Database/RocksDB/DB.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Database.RocksDB.DB+ ( openDB+ , putDB+ , getDB+ ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS+import Database.RocksDB.Exceptions+import Database.RocksDB.Internals+import Database.RocksDB.Options+import Foreign+import Foreign.C+import GHC.ForeignPtr++openDB :: Options -> FilePath -> IO (ForeignPtr Rocksdb)+{-# INLINEABLE openDB #-}+openDB opts path = do+ opts_fptr <- marshalOptions opts+ withForeignPtr opts_fptr $ \opts_ptr ->+ withCString path $ \path_ptr -> do+ db_ptr <- withErrorMessagePtr $ c_rocksdb_open opts_ptr path_ptr+ newConcForeignPtr db_ptr $ c_rocksdb_close db_ptr++putDB ::+ ForeignPtr Rocksdb+ -> ForeignPtr RocksdbWriteoptions+ -> BS.ByteString+ -> BS.ByteString+ -> IO ()+{-# INLINEABLE putDB #-}+putDB db_fptr wopts_fptr k_bs v_bs =+ withForeignPtr db_fptr $ \db_ptr ->+ withForeignPtr wopts_fptr $ \wopts_ptr ->+ BS.unsafeUseAsCStringLen k_bs $ \(k_buf, k_len) ->+ BS.unsafeUseAsCStringLen v_bs $ \(v_buf, v_len) ->+ withErrorMessagePtr $+ c_rocksdb_put+ db_ptr+ wopts_ptr+ k_buf+ (fromIntegral k_len)+ v_buf+ (fromIntegral v_len)++getDB ::+ ForeignPtr Rocksdb+ -> ForeignPtr RocksdbReadoptions+ -> BS.ByteString+ -> IO BS.ByteString+{-# INLINEABLE getDB #-}+getDB db_fptr ropts_fptr k_bs =+ withForeignPtr db_fptr $ \db_ptr ->+ withForeignPtr ropts_fptr $ \ropts_ptr ->+ BS.unsafeUseAsCStringLen k_bs $ \(k_buf, k_len) ->+ alloca $ \(v_len_buf :: Ptr CSize) -> do+ v_buf <-+ withErrorMessagePtr $+ c_rocksdb_get db_ptr ropts_ptr k_buf (fromIntegral k_len) v_len_buf+ v_len <- fromIntegral <$> peek v_len_buf+ BS.unsafePackMallocCStringLen (v_buf, v_len)
+ src/Database/RocksDB/Exceptions.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveAnyClass #-}++module Database.RocksDB.Exceptions+ ( RocksDBException(..)+ , withErrorMessagePtr+ ) where++import Control.Exception.Safe+import qualified Data.ByteString as BS+import Foreign+import Foreign.C++newtype RocksDBException = RocksDBException+ { errorMessage :: BS.ByteString+ } deriving (Show, Exception)++withErrorMessagePtr :: (Ptr (Ptr CChar) -> IO r) -> IO r+{-# INLINEABLE withErrorMessagePtr #-}+withErrorMessagePtr cont =+ alloca $ \p -> do+ r <- cont p+ p' <- peek p+ if p' == nullPtr+ then pure r+ else do+ msg <- BS.packCString p'+ throw $ RocksDBException msg
src/Database/RocksDB/Internals.hs view
@@ -590,10 +590,6 @@ c_rocksdb_writebatch_wi_create :: CSize -> CUChar -> IO (Ptr RocksdbWritebatchWi) -foreign import ccall unsafe "rocksdb_writebatch_wi_create_from"- c_rocksdb_writebatch_wi_create_from ::- Ptr CChar -> CSize -> IO (Ptr RocksdbWritebatchWi)- foreign import ccall unsafe "rocksdb_writebatch_wi_destroy" c_rocksdb_writebatch_wi_destroy :: Ptr RocksdbWritebatchWi -> IO () @@ -1271,16 +1267,6 @@ Ptr RocksdbOptions -> Word64 -> IO () foreign import ccall unsafe- "rocksdb_options_set_wal_bytes_per_sync"- c_rocksdb_options_set_wal_bytes_per_sync ::- Ptr RocksdbOptions -> Word64 -> IO ()--foreign import ccall unsafe- "rocksdb_options_set_writable_file_max_buffer_size"- c_rocksdb_options_set_writable_file_max_buffer_size ::- Ptr RocksdbOptions -> Word64 -> IO ()--foreign import ccall unsafe "rocksdb_options_set_allow_concurrent_memtable_write" c_rocksdb_options_set_allow_concurrent_memtable_write :: Ptr RocksdbOptions -> CUChar -> IO ()@@ -1964,15 +1950,6 @@ c_rocksdb_transaction_rollback :: Ptr RocksdbTransaction -> Ptr (Ptr CChar) -> IO () -foreign import ccall unsafe "rocksdb_transaction_set_savepoint"- c_rocksdb_transaction_set_savepoint ::- Ptr RocksdbTransaction -> IO ()--foreign import ccall unsafe- "rocksdb_transaction_rollback_to_savepoint"- c_rocksdb_transaction_rollback_to_savepoint ::- Ptr RocksdbTransaction -> Ptr (Ptr CChar) -> IO ()- foreign import ccall unsafe "rocksdb_transaction_destroy" c_rocksdb_transaction_destroy :: Ptr RocksdbTransaction -> IO () @@ -2093,13 +2070,6 @@ Ptr RocksdbTransaction -> Ptr RocksdbReadoptions -> IO (Ptr RocksdbIterator) -foreign import ccall unsafe- "rocksdb_transaction_create_iterator_cf"- c_rocksdb_transaction_create_iterator_cf ::- Ptr RocksdbTransaction ->- Ptr RocksdbReadoptions ->- Ptr RocksdbColumnFamilyHandle -> IO (Ptr RocksdbIterator)- foreign import ccall unsafe "rocksdb_transactiondb_create_iterator" c_rocksdb_transactiondb_create_iterator :: Ptr RocksdbTransactiondb ->@@ -2119,27 +2089,6 @@ Ptr RocksdbOptions -> Ptr CChar -> Ptr (Ptr CChar) -> IO (Ptr RocksdbOptimistictransactiondb)--foreign import ccall unsafe- "rocksdb_optimistictransactiondb_open_column_families"- c_rocksdb_optimistictransactiondb_open_column_families ::- Ptr RocksdbOptions ->- Ptr CChar ->- CInt ->- Ptr (Ptr CChar) ->- Ptr (Ptr RocksdbOptions) ->- Ptr (Ptr RocksdbColumnFamilyHandle) ->- Ptr (Ptr CChar) -> IO (Ptr RocksdbOptimistictransactiondb)--foreign import ccall unsafe- "rocksdb_optimistictransactiondb_get_base_db"- c_rocksdb_optimistictransactiondb_get_base_db ::- Ptr RocksdbOptimistictransactiondb -> IO (Ptr Rocksdb)--foreign import ccall unsafe- "rocksdb_optimistictransactiondb_close_base_db"- c_rocksdb_optimistictransactiondb_close_base_db ::- Ptr Rocksdb -> IO () foreign import ccall unsafe "rocksdb_optimistictransaction_begin" c_rocksdb_optimistictransaction_begin ::
+ src/Database/RocksDB/Options.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE RecordWildCards #-}++module Database.RocksDB.Options+ ( Options(..)+ , defaultOptions+ , marshalOptions+ ) where++import Database.RocksDB.Internals+import Database.RocksDB.Utils+import Foreign+import GHC.ForeignPtr++data Options = Options+ { totalThreads :: !(Maybe Int)+ , createIfMissing :: !(Maybe Bool)+ }++defaultOptions :: Options+{-# INLINEABLE defaultOptions #-}+defaultOptions = Options {totalThreads = Nothing, createIfMissing = Nothing}++marshalOptions :: Options -> IO (ForeignPtr RocksdbOptions)+{-# INLINEABLE marshalOptions #-}+marshalOptions Options {..} = do+ opts_p <- c_rocksdb_options_create+ setIntOptions totalThreads $c_rocksdb_options_increase_parallelism opts_p+ setBoolOptions createIfMissing $+ c_rocksdb_options_set_create_if_missing opts_p+ newConcForeignPtr opts_p $ c_rocksdb_options_destroy opts_p
+ src/Database/RocksDB/ReadOptions.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE RecordWildCards #-}++module Database.RocksDB.ReadOptions+ ( ReadOptions(..)+ , defaultReadOptions+ , marshalReadOptions+ ) where++import Database.RocksDB.Internals+import Database.RocksDB.Utils+import Foreign+import GHC.ForeignPtr++data ReadOptions = ReadOptions+ { verityChecksums :: !(Maybe Bool)+ , fillCache :: !(Maybe Bool)+ }++defaultReadOptions :: ReadOptions+{-# INLINEABLE defaultReadOptions #-}+defaultReadOptions =+ ReadOptions {verityChecksums = Nothing, fillCache = Nothing}++marshalReadOptions :: ReadOptions -> IO (ForeignPtr RocksdbReadoptions)+{-# INLINEABLE marshalReadOptions #-}+marshalReadOptions ReadOptions {..} = do+ ropts_p <- c_rocksdb_readoptions_create+ setBoolOptions verityChecksums $+ c_rocksdb_readoptions_set_verify_checksums ropts_p+ setBoolOptions fillCache $ c_rocksdb_readoptions_set_fill_cache ropts_p+ newConcForeignPtr ropts_p $ c_rocksdb_readoptions_destroy ropts_p
+ src/Database/RocksDB/Utils.hs view
@@ -0,0 +1,19 @@+module Database.RocksDB.Utils+ ( setIntOptions+ , setBoolOptions+ ) where++import Data.Foldable++setIntOptions :: Integral t => Maybe Int -> (t -> IO ()) -> IO ()+{-# INLINEABLE setIntOptions #-}+setIntOptions field cont = for_ field $ cont . fromIntegral++setBoolOptions :: Integral t => Maybe Bool -> (t -> IO ()) -> IO ()+{-# INLINEABLE setBoolOptions #-}+setBoolOptions field cont =+ for_ field $ \val ->+ cont $+ if val+ then 1+ else 0
+ src/Database/RocksDB/WriteOptions.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE RecordWildCards #-}++module Database.RocksDB.WriteOptions+ ( WriteOptions(..)+ , defaultWriteOptions+ , marshalWriteOptions+ ) where++import Database.RocksDB.Internals+import Database.RocksDB.Utils+import Foreign+import GHC.ForeignPtr++data WriteOptions = WriteOptions+ { sync :: !(Maybe Bool)+ , disableWAL :: !(Maybe Int)+ }++defaultWriteOptions :: WriteOptions+{-# INLINEABLE defaultWriteOptions #-}+defaultWriteOptions = WriteOptions {sync = Nothing, disableWAL = Nothing}++marshalWriteOptions :: WriteOptions -> IO (ForeignPtr RocksdbWriteoptions)+{-# INLINEABLE marshalWriteOptions #-}+marshalWriteOptions WriteOptions {..} = do+ wopts_p <- c_rocksdb_writeoptions_create+ setBoolOptions sync $ c_rocksdb_writeoptions_set_sync wopts_p+ setIntOptions disableWAL $ c_rocksdb_writeoptions_disable_WAL wopts_p+ newConcForeignPtr wopts_p $ c_rocksdb_writeoptions_destroy wopts_p
test/direct-rocksdb-test.hs view
@@ -1,5 +1,23 @@-import Control.Exception-import Database.RocksDB.Internals+{-# LANGUAGE OverloadedStrings #-} +import Control.Exception.Safe+import Database.RocksDB.DB+import Database.RocksDB.Options+import Database.RocksDB.ReadOptions+import Database.RocksDB.WriteOptions+import Foreign+import System.Directory+import System.FilePath+ main :: IO ()-main = bracket c_rocksdb_options_create c_rocksdb_options_destroy print+main = do+ tmp_dir <- getTemporaryDirectory+ let opts = defaultOptions {createIfMissing = Just True}+ db_path = tmp_dir </> "direct-rocksdb-test.rocksdb"+ bracket (openDB opts db_path) finalizeForeignPtr $ \db_fptr ->+ bracket (marshalWriteOptions defaultWriteOptions) finalizeForeignPtr $ \wopts_fptr -> do+ putDB db_fptr wopts_fptr "key" "value"+ bracket (marshalReadOptions defaultReadOptions) finalizeForeignPtr $ \ropts_fptr -> do+ v <- getDB db_fptr ropts_fptr "key"+ print v+ assert (v == "value") $ pure ()