{-# 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
    , ColumnFamily

    -- * Options
    , Config (..)

    -- * Basic Database Manipulations
    , withDB
    , withDBCF
    , put
    , putCF
    , delete
    , deleteCF
    , write
    , get
    , getCF
    , withSnapshot
    , snapshot
    , createSnapshot
    , releaseSnapshot

    -- * Administrative Functions
    , Property (..), getProperty
    , destroy
    , repair
    , approximateSize

    -- * Iteration
    , module Database.RocksDB.Iterator
    ) where

import           Control.Monad             (forM, when, (>=>))
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           UnliftIO
import           UnliftIO.Directory
import           UnliftIO.Foreign
import           UnliftIO.Resource

-- | Properties exposed by RocksDB
data Property = NumFilesAtLevel Int | Stats | SSTables
    deriving (Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show)

data BatchOp = Put !ByteString !ByteString
             | Del !ByteString
             | PutCF !ColumnFamily !ByteString !ByteString
             | DelCF !ColumnFamily !ByteString
             deriving (BatchOp -> BatchOp -> Bool
(BatchOp -> BatchOp -> Bool)
-> (BatchOp -> BatchOp -> Bool) -> Eq BatchOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchOp -> BatchOp -> Bool
$c/= :: BatchOp -> BatchOp -> Bool
== :: BatchOp -> BatchOp -> Bool
$c== :: BatchOp -> BatchOp -> Bool
Eq, Int -> BatchOp -> ShowS
[BatchOp] -> ShowS
BatchOp -> String
(Int -> BatchOp -> ShowS)
-> (BatchOp -> String) -> ([BatchOp] -> ShowS) -> Show BatchOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchOp] -> ShowS
$cshowList :: [BatchOp] -> ShowS
show :: BatchOp -> String
$cshow :: BatchOp -> String
showsPrec :: Int -> BatchOp -> ShowS
$cshowsPrec :: Int -> BatchOp -> ShowS
Show)

-- | Open a database.
--
-- The returned handle should be released with 'close'.
withDB :: MonadUnliftIO m => FilePath -> Config -> (DB -> m a) -> m a
withDB :: String -> Config -> (DB -> m a) -> m a
withDB String
path Config
config DB -> m a
f =
    Config -> (Options -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Config -> (Options -> m a) -> m a
withOptions Config
config ((Options -> m a) -> m a) -> (Options -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Options
opts_ptr ->
    Maybe Snapshot -> (ReadOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe Snapshot -> (ReadOpts -> m a) -> m a
withReadOpts Maybe Snapshot
forall a. Maybe a
Nothing ((ReadOpts -> m a) -> m a) -> (ReadOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ReadOpts
read_opts ->
    (WriteOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WriteOpts -> m a) -> m a
withWriteOpts ((WriteOpts -> m a) -> m a) -> (WriteOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \WriteOpts
write_opts ->
    m DB -> (DB -> m ()) -> (DB -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Options -> ReadOpts -> WriteOpts -> m DB
forall (m :: * -> *).
MonadUnliftIO m =>
Options -> ReadOpts -> WriteOpts -> m DB
create_db Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts) DB -> m ()
forall (m :: * -> *). MonadIO m => DB -> m ()
destroy_db DB -> m a
f
  where
    destroy_db :: DB -> m ()
destroy_db DB
db = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        RocksDB -> IO ()
c_rocksdb_close (RocksDB -> IO ()) -> RocksDB -> IO ()
forall a b. (a -> b) -> a -> b
$ DB -> RocksDB
rocksDB DB
db
    create_db :: Options -> ReadOpts -> WriteOpts -> m DB
create_db Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
createIfMissing Config
config) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Bool -> String -> m ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
path
        String -> (CString -> m DB) -> m DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> m DB) -> m DB) -> (CString -> m DB) -> m DB
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr -> do
            RocksDB
db_ptr <- IO RocksDB -> m RocksDB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RocksDB -> m RocksDB)
-> ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB)
-> m RocksDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"open" ((ErrPtr -> IO RocksDB) -> m RocksDB)
-> (ErrPtr -> IO RocksDB) -> m RocksDB
forall a b. (a -> b) -> a -> b
$
                Options -> CString -> ErrPtr -> IO RocksDB
c_rocksdb_open Options
opts_ptr CString
path_ptr
            DB -> m DB
forall (m :: * -> *) a. Monad m => a -> m a
return DB :: RocksDB -> [ColumnFamily] -> ReadOpts -> WriteOpts -> DB
DB { rocksDB :: RocksDB
rocksDB = RocksDB
db_ptr
                      , columnFamilies :: [ColumnFamily]
columnFamilies = []
                      , readOpts :: ReadOpts
readOpts = ReadOpts
read_opts
                      , writeOpts :: WriteOpts
writeOpts = WriteOpts
write_opts
                      }

withDBCF :: MonadUnliftIO m
         => FilePath
         -> Config
         -> [(String, Config)]
         -> (DB -> m a)
         -> m a
withDBCF :: String -> Config -> [(String, Config)] -> (DB -> m a) -> m a
withDBCF String
path Config
config [(String, Config)]
cf_cfgs DB -> m a
f =
    Config -> (Options -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Config -> (Options -> m a) -> m a
withOptions Config
config ((Options -> m a) -> m a) -> (Options -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Options
opts_ptr ->
    [Config] -> ([Options] -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
[Config] -> ([Options] -> m a) -> m a
withOptionsCF (((String, Config) -> Config) -> [(String, Config)] -> [Config]
forall a b. (a -> b) -> [a] -> [b]
map (String, Config) -> Config
forall a b. (a, b) -> b
snd [(String, Config)]
cf_cfgs) (([Options] -> m a) -> m a) -> ([Options] -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \[Options]
cf_opts ->
    Maybe Snapshot -> (ReadOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe Snapshot -> (ReadOpts -> m a) -> m a
withReadOpts Maybe Snapshot
forall a. Maybe a
Nothing ((ReadOpts -> m a) -> m a) -> (ReadOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ReadOpts
read_opts ->
    (WriteOpts -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WriteOpts -> m a) -> m a
withWriteOpts ((WriteOpts -> m a) -> m a) -> (WriteOpts -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \WriteOpts
write_opts ->
    [String] -> ([CString] -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
[String] -> ([CString] -> m a) -> m a
withStrings (((String, Config) -> String) -> [(String, Config)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Config) -> String
forall a b. (a, b) -> a
fst [(String, Config)]
cf_cfgs) (([CString] -> m a) -> m a) -> ([CString] -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \[CString]
cf_names ->
    Int -> (ErrPtr -> m a) -> m a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((ErrPtr -> m a) -> m a) -> (ErrPtr -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ErrPtr
cf_names_array ->
    Int -> (Ptr Options -> m a) -> m a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr Options -> m a) -> m a) -> (Ptr Options -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Ptr Options
cf_opts_array ->
    Int -> (Ptr ColumnFamily -> m a) -> m a
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr ColumnFamily -> m a) -> m a)
-> (Ptr ColumnFamily -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Ptr ColumnFamily
cf_ptrs_array ->
        m DB -> (DB -> m ()) -> (DB -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ( Options
-> [CString]
-> ErrPtr
-> [Options]
-> Ptr Options
-> ReadOpts
-> Ptr ColumnFamily
-> WriteOpts
-> m DB
forall (m :: * -> *).
MonadIO m =>
Options
-> [CString]
-> ErrPtr
-> [Options]
-> Ptr Options
-> ReadOpts
-> Ptr ColumnFamily
-> WriteOpts
-> m DB
create_db Options
opts_ptr
                            [CString]
cf_names
                            ErrPtr
cf_names_array
                            [Options]
cf_opts
                            Ptr Options
cf_opts_array
                            ReadOpts
read_opts
                            Ptr ColumnFamily
cf_ptrs_array
                            WriteOpts
write_opts
                ) DB -> m ()
forall (m :: * -> *). MonadIO m => DB -> m ()
destroy_db DB -> m a
f
  where
    create_new :: [CString] -> [Options] -> Options -> ReadOpts -> WriteOpts -> IO DB
create_new [CString]
cf_names [Options]
cf_opts Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts = do
        Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
path
        String -> (CString -> IO DB) -> IO DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO DB) -> IO DB) -> (CString -> IO DB) -> IO DB
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr -> do
            RocksDB
db_ptr <- IO RocksDB -> IO RocksDB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RocksDB -> IO RocksDB)
-> ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB)
-> IO RocksDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"open" ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall a b. (a -> b) -> a -> b
$
                Options -> CString -> ErrPtr -> IO RocksDB
c_rocksdb_open Options
opts_ptr CString
path_ptr
            [ColumnFamily]
cfs <- [(CString, Options)]
-> ((CString, Options) -> IO ColumnFamily) -> IO [ColumnFamily]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([CString] -> [Options] -> [(CString, Options)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CString]
cf_names [Options]
cf_opts) (((CString, Options) -> IO ColumnFamily) -> IO [ColumnFamily])
-> ((CString, Options) -> IO ColumnFamily) -> IO [ColumnFamily]
forall a b. (a -> b) -> a -> b
$ \(CString
n, Options
o) ->
                String -> (ErrPtr -> IO ColumnFamily) -> IO ColumnFamily
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"create_column_family" ((ErrPtr -> IO ColumnFamily) -> IO ColumnFamily)
-> (ErrPtr -> IO ColumnFamily) -> IO ColumnFamily
forall a b. (a -> b) -> a -> b
$
                RocksDB -> Options -> CString -> ErrPtr -> IO ColumnFamily
c_rocksdb_create_column_family
                RocksDB
db_ptr Options
o CString
n
            DB -> IO DB
forall (m :: * -> *) a. Monad m => a -> m a
return DB :: RocksDB -> [ColumnFamily] -> ReadOpts -> WriteOpts -> DB
DB { rocksDB :: RocksDB
rocksDB = RocksDB
db_ptr
                      , columnFamilies :: [ColumnFamily]
columnFamilies = [ColumnFamily]
cfs
                      , readOpts :: ReadOpts
readOpts = ReadOpts
read_opts
                      , writeOpts :: WriteOpts
writeOpts = WriteOpts
write_opts
                      }
    destroy_db :: DB -> m ()
destroy_db DB
db = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        (ColumnFamily -> IO ()) -> [ColumnFamily] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ColumnFamily -> IO ()
c_rocksdb_column_family_handle_destroy (DB -> [ColumnFamily]
columnFamilies DB
db)
        RocksDB -> IO ()
c_rocksdb_close (RocksDB -> IO ()) -> RocksDB -> IO ()
forall a b. (a -> b) -> a -> b
$ DB -> RocksDB
rocksDB DB
db
    create_db :: Options
-> [CString]
-> ErrPtr
-> [Options]
-> Ptr Options
-> ReadOpts
-> Ptr ColumnFamily
-> WriteOpts
-> m DB
create_db Options
opts_ptr
              [CString]
cf_names
              ErrPtr
cf_names_array
              [Options]
cf_opts
              Ptr Options
cf_opts_array
              ReadOpts
read_opts
              Ptr ColumnFamily
cf_ptrs_array
              WriteOpts
write_opts = IO DB -> m DB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DB -> m DB) -> IO DB -> m DB
forall a b. (a -> b) -> a -> b
$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
createIfMissing Config
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
path
        [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> IO [String] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
listDirectory String
path IO Bool -> (Bool -> IO DB) -> IO DB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True -> [CString] -> [Options] -> Options -> ReadOpts -> WriteOpts -> IO DB
create_new [CString]
cf_names [Options]
cf_opts Options
opts_ptr ReadOpts
read_opts WriteOpts
write_opts
            Bool
False -> String -> (CString -> IO DB) -> IO DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO DB) -> IO DB) -> (CString -> IO DB) -> IO DB
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr ->
                String -> (CString -> IO DB) -> IO DB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
"default" ((CString -> IO DB) -> IO DB) -> (CString -> IO DB) -> IO DB
forall a b. (a -> b) -> a -> b
$ \CString
cf_deflt_name -> do
                    ErrPtr -> [CString] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Ptr a -> [a] -> m ()
pokeArray ErrPtr
cf_names_array (CString
cf_deflt_name CString -> [CString] -> [CString]
forall a. a -> [a] -> [a]
: [CString]
cf_names)
                    Ptr Options -> [Options] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Ptr a -> [a] -> m ()
pokeArray Ptr Options
cf_opts_array (Options
opts_ptr Options -> [Options] -> [Options]
forall a. a -> [a] -> [a]
: [Options]
cf_opts)
                    RocksDB
db_ptr <- String -> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"open" ((ErrPtr -> IO RocksDB) -> IO RocksDB)
-> (ErrPtr -> IO RocksDB) -> IO RocksDB
forall a b. (a -> b) -> a -> b
$
                        Options
-> CString
-> CInt
-> ErrPtr
-> Ptr Options
-> Ptr ColumnFamily
-> ErrPtr
-> IO RocksDB
c_rocksdb_open_column_families
                        Options
opts_ptr
                        CString
path_ptr
                        (Int -> CInt
intToCInt ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                        ErrPtr
cf_names_array
                        Ptr Options
cf_opts_array
                        Ptr ColumnFamily
cf_ptrs_array
                    [ColumnFamily]
cfs <- Int -> Ptr ColumnFamily -> IO [ColumnFamily]
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Ptr a -> m [a]
peekArray ([(String, Config)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Config)]
cf_cfgs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ptr ColumnFamily
cf_ptrs_array
                    DB -> IO DB
forall (m :: * -> *) a. Monad m => a -> m a
return DB :: RocksDB -> [ColumnFamily] -> ReadOpts -> WriteOpts -> DB
DB { rocksDB :: RocksDB
rocksDB = RocksDB
db_ptr
                              , columnFamilies :: [ColumnFamily]
columnFamilies = [ColumnFamily] -> [ColumnFamily]
forall a. [a] -> [a]
tail [ColumnFamily]
cfs
                              , readOpts :: ReadOpts
readOpts = ReadOpts
read_opts
                              , writeOpts :: WriteOpts
writeOpts = WriteOpts
write_opts
                              }

-- | Run an action with a snapshot of the database.
-- The 'DB' object is not valid after the action ends.
withSnapshot :: MonadUnliftIO m => DB -> (DB -> m a) -> m a
withSnapshot :: DB -> (DB -> m a) -> m a
withSnapshot DB
db DB -> m a
f =
    m (DB, Snapshot)
-> ((DB, Snapshot) -> m ()) -> ((DB, Snapshot) -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (DB -> m (DB, Snapshot)
forall (m :: * -> *). MonadIO m => DB -> m (DB, Snapshot)
createSnapshot DB
db) (DB, Snapshot) -> m ()
forall (m :: * -> *). MonadIO m => (DB, Snapshot) -> m ()
releaseSnapshot (DB -> m a
f (DB -> m a) -> ((DB, Snapshot) -> DB) -> (DB, Snapshot) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DB, Snapshot) -> DB
forall a b. (a, b) -> a
fst)

-- | The 'DB' snapshot is not valid outside of 'MonadResource'.
snapshot :: (MonadIO m, MonadResource m) => DB -> m DB
snapshot :: DB -> m DB
snapshot DB
db =
    (DB, Snapshot) -> DB
forall a b. (a, b) -> a
fst ((DB, Snapshot) -> DB)
-> ((ReleaseKey, (DB, Snapshot)) -> (DB, Snapshot))
-> (ReleaseKey, (DB, Snapshot))
-> DB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReleaseKey, (DB, Snapshot)) -> (DB, Snapshot)
forall a b. (a, b) -> b
snd ((ReleaseKey, (DB, Snapshot)) -> DB)
-> m (ReleaseKey, (DB, Snapshot)) -> m DB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (DB, Snapshot)
-> ((DB, Snapshot) -> IO ()) -> m (ReleaseKey, (DB, Snapshot))
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (DB -> IO (DB, Snapshot)
forall (m :: * -> *). MonadIO m => DB -> m (DB, Snapshot)
createSnapshot DB
db) (DB, Snapshot) -> IO ()
forall (m :: * -> *). MonadIO m => (DB, Snapshot) -> m ()
releaseSnapshot

-- | Manually create an unmanaged snapshot.
createSnapshot :: MonadIO m => DB -> m (DB, Snapshot)
createSnapshot :: DB -> m (DB, Snapshot)
createSnapshot db :: DB
db@DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr} = IO (DB, Snapshot) -> m (DB, Snapshot)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DB, Snapshot) -> m (DB, Snapshot))
-> IO (DB, Snapshot) -> m (DB, Snapshot)
forall a b. (a -> b) -> a -> b
$ do
    Snapshot
snap_ptr <- RocksDB -> IO Snapshot
c_rocksdb_create_snapshot RocksDB
db_ptr
    Maybe Snapshot
-> (ReadOpts -> IO (DB, Snapshot)) -> IO (DB, Snapshot)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe Snapshot -> (ReadOpts -> m a) -> m a
withReadOpts (Snapshot -> Maybe Snapshot
forall a. a -> Maybe a
Just Snapshot
snap_ptr) ((ReadOpts -> IO (DB, Snapshot)) -> IO (DB, Snapshot))
-> (ReadOpts -> IO (DB, Snapshot)) -> IO (DB, Snapshot)
forall a b. (a -> b) -> a -> b
$ \ReadOpts
read_opts ->
        (DB, Snapshot) -> IO (DB, Snapshot)
forall (m :: * -> *) a. Monad m => a -> m a
return (DB
db{readOpts :: ReadOpts
readOpts = ReadOpts
read_opts}, Snapshot
snap_ptr)

-- | Function to release an unmanaged snapshot.
releaseSnapshot :: MonadIO m => (DB, Snapshot) -> m ()
releaseSnapshot :: (DB, Snapshot) -> m ()
releaseSnapshot (DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr}, Snapshot
snap_ptr) =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ RocksDB -> Snapshot -> IO ()
c_rocksdb_release_snapshot RocksDB
db_ptr Snapshot
snap_ptr

-- | Get a DB property.
getProperty :: MonadIO m => DB -> Property -> m (Maybe ByteString)
getProperty :: DB -> Property -> m (Maybe ByteString)
getProperty DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr} Property
p = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
    String
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString (Property -> String
prop Property
p) ((CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
    RocksDB -> CString -> IO CString
c_rocksdb_property_value RocksDB
db_ptr (CString -> IO CString)
-> (CString -> IO (Maybe ByteString))
-> CString
-> IO (Maybe ByteString)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    CString
val_ptr | CString
val_ptr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
            | Bool
otherwise -> do
                  Maybe ByteString
res <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
BS.packCString CString
val_ptr
                  CString -> IO ()
freeCString CString
val_ptr
                  Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
res
  where
    prop :: Property -> String
prop (NumFilesAtLevel Int
i) = String
"rocksdb.num-files-at-level" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
    prop Property
Stats               = String
"rocksdb.stats"
    prop Property
SSTables            = String
"rocksdb.sstables"

-- | Destroy the given RocksDB database.
destroy :: MonadIO m => FilePath -> Options -> m ()
destroy :: String -> Options -> m ()
destroy String
path Options
opts_ptr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr ->
    String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"destroy" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> CString -> ErrPtr -> IO ()
c_rocksdb_destroy_db Options
opts_ptr CString
path_ptr

-- | Repair the given RocksDB database.
repair :: MonadIO m => FilePath -> Options -> m ()
repair :: String -> Options -> m ()
repair String
path Options
opts_ptr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
path_ptr ->
    String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"repair" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> CString -> ErrPtr -> IO ()
c_rocksdb_repair_db Options
opts_ptr CString
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 -> Range -> m Int64
approximateSize DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr} (ByteString
from, ByteString
to) = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO Int64) -> IO Int64
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
from ((CStringLen -> IO Int64) -> IO Int64)
-> (CStringLen -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \(CString
from_ptr, Int
flen) ->
    ByteString -> (CStringLen -> IO Int64) -> IO Int64
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
to   ((CStringLen -> IO Int64) -> IO Int64)
-> (CStringLen -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \(CString
to_ptr, Int
tlen)   ->
    [CString] -> (ErrPtr -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [CString
from_ptr]          ((ErrPtr -> IO Int64) -> IO Int64)
-> (ErrPtr -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \ErrPtr
from_ptrs        ->
    [CSize] -> (Ptr CSize -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [Int -> CSize
intToCSize Int
flen]   ((Ptr CSize -> IO Int64) -> IO Int64)
-> (Ptr CSize -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
flen_ptrs        ->
    [CString] -> (ErrPtr -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [CString
to_ptr]            ((ErrPtr -> IO Int64) -> IO Int64)
-> (ErrPtr -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \ErrPtr
to_ptrs          ->
    [CSize] -> (Ptr CSize -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
[a] -> (Ptr a -> m b) -> m b
withArray [Int -> CSize
intToCSize Int
tlen]   ((Ptr CSize -> IO Int64) -> IO Int64)
-> (Ptr CSize -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
tlen_ptrs        ->
    Int -> (Ptr Word64 -> IO Int64) -> IO Int64
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
Int -> (Ptr a -> m b) -> m b
allocaArray Int
1                 ((Ptr Word64 -> IO Int64) -> IO Int64)
-> (Ptr Word64 -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
size_ptrs        -> do
        RocksDB
-> CInt
-> ErrPtr
-> Ptr CSize
-> ErrPtr
-> Ptr CSize
-> Ptr Word64
-> IO ()
c_rocksdb_approximate_sizes RocksDB
db_ptr CInt
1
                                    ErrPtr
from_ptrs Ptr CSize
flen_ptrs
                                    ErrPtr
to_ptrs Ptr CSize
tlen_ptrs
                                    Ptr Word64
size_ptrs
        ([Int64] -> Int64) -> IO [Int64] -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int64] -> Int64
forall a. [a] -> a
head (IO [Int64] -> IO Int64) -> IO [Int64] -> IO Int64
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word64 -> IO [Word64]
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Ptr a -> m [a]
peekArray Int
1 Ptr Word64
size_ptrs IO [Word64] -> ([Word64] -> IO [Int64]) -> IO [Int64]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word64 -> IO Int64) -> [Word64] -> IO [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word64 -> IO Int64
toInt64

    where
        toInt64 :: Word64 -> IO Int64
toInt64 = Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Int64) -> (Word64 -> Int64) -> Word64 -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Write a key/value pair.
put :: MonadIO m => DB -> ByteString -> ByteString -> m ()
put :: DB -> ByteString -> ByteString -> m ()
put DB
db = DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon DB
db Maybe ColumnFamily
forall a. Maybe a
Nothing

putCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> ByteString -> m ()
putCF :: DB -> ColumnFamily -> ByteString -> ByteString -> m ()
putCF DB
db ColumnFamily
cf = DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon DB
db (ColumnFamily -> Maybe ColumnFamily
forall a. a -> Maybe a
Just ColumnFamily
cf)

putCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon :: DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()
putCommon DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, writeOpts :: DB -> WriteOpts
writeOpts = WriteOpts
write_opts} Maybe ColumnFamily
mcf ByteString
key ByteString
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key   ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
value ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
val_ptr, Int
vlen) ->
        String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"put" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ColumnFamily
mcf of
            Just ColumnFamily
cf -> RocksDB
-> WriteOpts
-> ColumnFamily
-> CString
-> CSize
-> CString
-> CSize
-> ErrPtr
-> IO ()
c_rocksdb_put_cf
                      RocksDB
db_ptr WriteOpts
write_opts ColumnFamily
cf
                      CString
key_ptr (Int -> CSize
intToCSize Int
klen)
                      CString
val_ptr (Int -> CSize
intToCSize Int
vlen)
            Maybe ColumnFamily
Nothing -> RocksDB
-> WriteOpts
-> CString
-> CSize
-> CString
-> CSize
-> ErrPtr
-> IO ()
c_rocksdb_put
                      RocksDB
db_ptr WriteOpts
write_opts
                      CString
key_ptr (Int -> CSize
intToCSize Int
klen)
                      CString
val_ptr (Int -> CSize
intToCSize Int
vlen)

-- | Read a value by key.
get :: MonadIO m => DB -> ByteString -> m (Maybe ByteString)
get :: DB -> ByteString -> m (Maybe ByteString)
get DB
db = DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon DB
db Maybe ColumnFamily
forall a. Maybe a
Nothing

getCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> m (Maybe ByteString)
getCF :: DB -> ColumnFamily -> ByteString -> m (Maybe ByteString)
getCF DB
db ColumnFamily
cf = DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon DB
db (ColumnFamily -> Maybe ColumnFamily
forall a. a -> Maybe a
Just ColumnFamily
cf)

getCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon :: DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)
getCommon DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, readOpts :: DB -> ReadOpts
readOpts = ReadOpts
read_opts} Maybe ColumnFamily
mcf ByteString
key = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
    (Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a b.
(MonadUnliftIO m, Storable a) =>
(Ptr a -> m b) -> m b
alloca                       ((Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
vlen_ptr -> do
        CString
val_ptr <- String -> (ErrPtr -> IO CString) -> IO CString
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"get" ((ErrPtr -> IO CString) -> IO CString)
-> (ErrPtr -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$
            case Maybe ColumnFamily
mcf of
                Just ColumnFamily
cf -> RocksDB
-> ReadOpts
-> ColumnFamily
-> CString
-> CSize
-> Ptr CSize
-> ErrPtr
-> IO CString
c_rocksdb_get_cf
                           RocksDB
db_ptr ReadOpts
read_opts ColumnFamily
cf
                           CString
key_ptr (Int -> CSize
intToCSize Int
klen) Ptr CSize
vlen_ptr
                Maybe ColumnFamily
Nothing -> RocksDB
-> ReadOpts
-> CString
-> CSize
-> Ptr CSize
-> ErrPtr
-> IO CString
c_rocksdb_get
                           RocksDB
db_ptr ReadOpts
read_opts
                           CString
key_ptr (Int -> CSize
intToCSize Int
klen) Ptr CSize
vlen_ptr
        CSize
vlen <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
vlen_ptr
        if CString
val_ptr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
            then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
            else do
                Maybe ByteString
res' <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (CString
val_ptr, CSize -> Int
cSizeToInt CSize
vlen)
                CString -> IO ()
freeCString CString
val_ptr
                Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
res'

delete :: MonadIO m => DB -> ByteString -> m ()
delete :: DB -> ByteString -> m ()
delete DB
db = DB -> Maybe ColumnFamily -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon DB
db Maybe ColumnFamily
forall a. Maybe a
Nothing

deleteCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> m ()
deleteCF :: DB -> ColumnFamily -> ByteString -> m ()
deleteCF DB
db ColumnFamily
cf = DB -> Maybe ColumnFamily -> ByteString -> m ()
forall (m :: * -> *).
MonadIO m =>
DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon DB
db (ColumnFamily -> Maybe ColumnFamily
forall a. a -> Maybe a
Just ColumnFamily
cf)

-- | Delete a key/value pair.
deleteCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon :: DB -> Maybe ColumnFamily -> ByteString -> m ()
deleteCommon DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, writeOpts :: DB -> WriteOpts
writeOpts = WriteOpts
write_opts} Maybe ColumnFamily
mcf ByteString
key = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
    String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"delete" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ColumnFamily
mcf of
    Just ColumnFamily
cf -> RocksDB
-> WriteOpts -> ColumnFamily -> CString -> CSize -> ErrPtr -> IO ()
c_rocksdb_delete_cf RocksDB
db_ptr WriteOpts
write_opts ColumnFamily
cf CString
key_ptr (Int -> CSize
intToCSize Int
klen)
    Maybe ColumnFamily
Nothing -> RocksDB -> WriteOpts -> CString -> CSize -> ErrPtr -> IO ()
c_rocksdb_delete RocksDB
db_ptr WriteOpts
write_opts CString
key_ptr (Int -> CSize
intToCSize Int
klen)

-- | Perform a batch mutation.
write :: MonadIO m => DB -> [BatchOp] -> m ()
write :: DB -> [BatchOp] -> m ()
write DB{rocksDB :: DB -> RocksDB
rocksDB = RocksDB
db_ptr, writeOpts :: DB -> WriteOpts
writeOpts = WriteOpts
write_opts} [BatchOp]
batch = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    IO WriteBatch
-> (WriteBatch -> IO ()) -> (WriteBatch -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    IO WriteBatch
c_rocksdb_writebatch_create
    WriteBatch -> IO ()
c_rocksdb_writebatch_destroy ((WriteBatch -> IO ()) -> IO ()) -> (WriteBatch -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WriteBatch
batch_ptr -> do
        (BatchOp -> IO ()) -> [BatchOp] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WriteBatch -> BatchOp -> IO ()
batchAdd WriteBatch
batch_ptr) [BatchOp]
batch
        String -> (ErrPtr -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (ErrPtr -> m a) -> m a
throwIfErr String
"write" ((ErrPtr -> IO ()) -> IO ()) -> (ErrPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ RocksDB -> WriteOpts -> WriteBatch -> ErrPtr -> IO ()
c_rocksdb_write RocksDB
db_ptr WriteOpts
write_opts WriteBatch
batch_ptr
        -- ensure @ByteString@s (and respective shared @CStringLen@s) aren't
        -- GC'ed until here
        (BatchOp -> IO ()) -> [BatchOp] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> (BatchOp -> IO ()) -> BatchOp -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatchOp -> IO ()
forall (m :: * -> *). MonadIO m => BatchOp -> m ()
touch) [BatchOp]
batch
  where
    batchAdd :: WriteBatch -> BatchOp -> IO ()
batchAdd WriteBatch
batch_ptr (Put ByteString
key ByteString
val) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
val ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
val_ptr, Int
vlen) ->
            WriteBatch -> CString -> CSize -> CString -> CSize -> IO ()
c_rocksdb_writebatch_put
            WriteBatch
batch_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
            CString
val_ptr (Int -> CSize
intToCSize Int
vlen)
    batchAdd WriteBatch
batch_ptr (PutCF ColumnFamily
cf_ptr ByteString
key ByteString
val) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
val ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
val_ptr, Int
vlen) ->
            WriteBatch
-> ColumnFamily -> CString -> CSize -> CString -> CSize -> IO ()
c_rocksdb_writebatch_put_cf
            WriteBatch
batch_ptr
            ColumnFamily
cf_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
            CString
val_ptr (Int -> CSize
intToCSize Int
vlen)
    batchAdd WriteBatch
batch_ptr (Del ByteString
key) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
            WriteBatch -> CString -> CSize -> IO ()
c_rocksdb_writebatch_delete
            WriteBatch
batch_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
    batchAdd WriteBatch
batch_ptr (DelCF ColumnFamily
cf_ptr ByteString
key) =
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
key_ptr, Int
klen) ->
            WriteBatch -> ColumnFamily -> CString -> CSize -> IO ()
c_rocksdb_writebatch_delete_cf
            WriteBatch
batch_ptr
            ColumnFamily
cf_ptr
            CString
key_ptr (Int -> CSize
intToCSize Int
klen)
    touch :: BatchOp -> m ()
touch (Put (PS ForeignPtr Word8
p Int
_ Int
_) (PS ForeignPtr Word8
p' Int
_ Int
_)) = do
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p'
    touch (PutCF ColumnFamily
_ (PS ForeignPtr Word8
p Int
_ Int
_) (PS ForeignPtr Word8
p' Int
_ Int
_)) = do
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p'
    touch (Del (PS ForeignPtr Word8
p Int
_ Int
_)) =
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p
    touch (DelCF ColumnFamily
_ (PS ForeignPtr Word8
p Int
_ Int
_)) =
        ForeignPtr Word8 -> m ()
forall (m :: * -> *) a. MonadIO m => ForeignPtr a -> m ()
touchForeignPtr ForeignPtr Word8
p

withStrings :: MonadUnliftIO m => [String] -> ([CString] -> m a) -> m a
withStrings :: [String] -> ([CString] -> m a) -> m a
withStrings [String]
ss [CString] -> m a
f =
    [CString] -> [String] -> m a
go [] [String]
ss
  where
    go :: [CString] -> [String] -> m a
go [CString]
acc []     = [CString] -> m a
f ([CString] -> [CString]
forall a. [a] -> [a]
reverse [CString]
acc)
    go [CString]
acc (String
x:[String]
xs) = String -> (CString -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (CString -> m a) -> m a
withCString String
x ((CString -> m a) -> m a) -> (CString -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \CString
p -> [CString] -> [String] -> m a
go (CString
pCString -> [CString] -> [CString]
forall a. a -> [a] -> [a]
:[CString]
acc) [String]
xs