├── .gitignore
├── .travis.yml
├── AUTHORS
├── CHANGELOG.md
├── Dockerfile
├── LICENSE
├── README.md
├── Setup.hs
├── appveyor.yml
├── rocksdb-haskell.cabal
├── src
└── Database
│ ├── RocksDB.hs
│ └── RocksDB
│ ├── Base.hs
│ ├── C.hsc
│ ├── Internal.hs
│ ├── Iterator.hs
│ └── Types.hs
├── stack.yaml
└── tests
└── tests.hs
/.gitignore:
--------------------------------------------------------------------------------
1 | tags
2 | *.o
3 | *.swp
4 | *.a
5 | dist
6 | cabal-dev
7 | *.o
8 | *.hi
9 | *.chi
10 | *.chs.h
11 | .virtualenv
12 | .hsenv
13 | .cabal-sandbox/
14 | cabal.sandbox.config
15 | cabal.config
16 | .stack-work
17 | librocksdb.so
18 | *.liquid
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | os:
2 | - osx
3 | - linux
4 | language: nix
5 | env:
6 | - NIX_PATH=nixpkgs=https://github.com/NixOS/nixpkgs/archive/d535b2df06e0d1e8cd38143a2000deb07fc074f9.tar.gz
7 | cache:
8 | directories:
9 | - "$HOME/.stack"
10 | - "$PWD/.stack-work"
11 |
12 | # Until https://github.com/NixOS/nixpkgs/issues/21200 is fixed
13 | before_install:
14 | - mkdir -p ~/.local/bin
15 | - export PATH=$HOME/.local/bin:$PATH
16 | - sudo mount -o remount,exec,size=4G,mode=755 /run/user || true
17 | - travis_retry curl -L https://www.stackage.org/stack/$TRAVIS_OS_NAME-x86_64 | tar xz --strip-components=1 -C ~/.local/bin
18 |
19 | script:
20 | - stack --nix --no-terminal build --test --no-haddock-deps --jobs=4
21 |
22 | notifications:
23 | email: false
24 | slack:
25 | secure: HRcMUU+/MNGP3TS3Ta61y8ouDh865zJm/iS6tnDWjajsJC1cvQmUKzBJGSfAl7fCCznDJowsX3p33TyQq1Ulb+SKD88Umb5QaTDyINepUhrirUVdkHTn3o61wauib6lpyuSi7c1CjfGe2Oh4nD+z7AidRSBhxUeeJvROMVPNDRMWfz8hxgII/qWdxucpJ2LphqbOlq3KefUdq8Z3VGm5Nu1QhkIZvrzEzPgCbNz+L+reVIGLPlPYEEkxY/zOZeerIgbfHVyxgxXAxx81r5dQbnNH628gmDOHRq98Bgsp1lqCKuf0A8iAWpxE9ru9VTV4AdydR4IMeKnxlXSEuusGDJ9l2VXSA9tN8yoxiLFwedNly6kQOUgQLPjzzXAbafKTjMvyCdFrUmQPmebBdv+l27HCuyLvVqKrydnNFQjhLX8Nfxf1uOCoYrAk67dU+9HKHYvVavuHD1BVwNfi1V5StfiIWNZTOdSmE5fpCfNYlSDiDD+pxMmI/smeFbrzsiZCE4wBW7CFrZ3ENZ2C07Lz88ip7nCrrPzc7RUmVQg5fELquadKMQ5R013S0/pIuSbgc4aQmsxMhabQ8JgOUYTKVX+cx3JTVTVHZ67JE/WA/3y2Hjune3D8rCIbdJ5sj63lts7aQLMUyBMSdahYKjSHgHuaULg2k1UAc90sLyDe3HM=
26 |
--------------------------------------------------------------------------------
/AUTHORS:
--------------------------------------------------------------------------------
1 | # The following people, listed in alphabetical order, contributed to the
2 | # rocksdb-haskell library:
3 |
4 | Austin Seipp
5 | Alexander Thiemann
6 | Kim Altintop
7 | Michael Lazarev
8 | Nicolas Trangez
9 | Will Moss
10 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | ## 1.0.1
2 | * Add support for UTF-8 characters in a database's path
3 |
4 | ## 1.0.0
5 |
6 | * First version by Serokell
7 |
8 | ## 0.3x.0
9 |
10 | * ResourceT is no longer compulsory
11 |
12 |
13 | ## 0.2.0
14 |
15 | * requires LevelDB v1.7
16 | * support for filter policy (LevelDB v1.5), either custom or using the built-in
17 | bloom filter implementation
18 | * write batch values no longer require a `memcpy` to be early-finalizer-safe
19 | (introduced in 0.1.1)
20 |
21 |
22 | ## 0.1.0
23 |
24 | * memory (foreign pointers) is managed through
25 | [ResourceT](http://hackage.haskell.org/package/resourcet). Note that this
26 | requires to lift monadic actions inside the `MonadResource` monad, see the
27 | examples.
28 | * links against shared library (LevelDB v1.3 or higher)
29 | * LevelDB 1.3 API fully supported (including custom comparators, excluding
30 | custom environments)
31 |
32 |
33 | ## 0.0.x
34 |
35 | * experimental releases
36 |
--------------------------------------------------------------------------------
/Dockerfile:
--------------------------------------------------------------------------------
1 | FROM agrafix/ghc7.6
2 | # dependencies
3 | RUN apt-get update -qq
4 | RUN apt-get -y install gcc-4.7 libgflags-dev libsnappy-dev zlib1g-dev libbz2-dev
5 | RUN git clone https://github.com/facebook/rocksdb.git
6 | RUN cd rocksdb && make
7 | RUN cd rocksdb && mv ./librocksdb.a /usr/local/lib
8 | RUN cd rocksdb && cp -R include/ /usr/local/include/
9 |
10 | # now the library itself
11 | RUN mkdir /rocksdb-haskell
12 | ADD . /rocksdb-haskell
13 | WORKDIR rocksdb-haskell
14 | RUN cabal update
15 | RUN cabal install --only-dependencies --enable-tests
16 | RUN cabal configure --enable-tests
17 | RUN cabal build
18 | RUN cabal test
19 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2011, Kim Altintop
2 | Copyright (c) 2014, Alexander Thiemann
3 |
4 | All rights reserved.
5 |
6 | Redistribution and use in source and binary forms, with or without
7 | modification, are permitted provided that the following conditions are met:
8 |
9 | * Redistributions of source code must retain the above copyright
10 | notice, this list of conditions and the following disclaimer.
11 |
12 | * Redistributions in binary form must reproduce the above
13 | copyright notice, this list of conditions and the following
14 | disclaimer in the documentation and/or other materials provided
15 | with the distribution.
16 |
17 | * Neither the name of Kim Altintop nor the names of other
18 | contributors may be used to endorse or promote products derived
19 | from this software without specific prior written permission.
20 |
21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | This library provides Haskell bindings to
2 | [RocksDB](http://rocksdb.org)
3 |
4 | [](https://travis-ci.org/serokell/rocksdb-haskell)
5 | [](https://ci.appveyor.com/project/jagajaga/rocksdb-haskell)
6 |
7 | ## History
8 |
9 | Version 0.1.0:
10 |
11 | * initial release of this fork.
12 |
13 | ## Installation
14 |
15 | Prerequisites:
16 |
17 | * [GHC 8.*](http://www.haskell.org/ghc)
18 | * [Cabal](http://www.haskell.org/cabal), version 1.3 or higher
19 | * [RocksDB](http://rocksdb.org)
20 | * Optional: [Snappy](http://code.google.com/p/snappy),
21 | if compression support is desired
22 |
23 | To install the latest version from hackage:
24 |
25 | ```shell
26 | $ cabal install rocksdb-haskell
27 | ```
28 |
29 | To install from checked-out source:
30 |
31 | ```shell
32 | $ cabal install
33 | ```
34 |
35 | ## Notes
36 |
37 | This library is in very early stage and has seen very limited testing. Comments
38 | and contributions are welcome.
39 |
40 | ## Bugs and Contributing
41 |
42 | Please report issues via http://github.com/serokell/rocksdb-haskell/issues.
43 | Patches are best submitted as pull requests.
44 |
45 | ## License
46 |
47 | BSD 3, see LICENSE file.
48 |
--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 |
--------------------------------------------------------------------------------
/appveyor.yml:
--------------------------------------------------------------------------------
1 | version: 1.0.{build}
2 | image: Visual Studio 2015
3 |
4 | build: off
5 |
6 | environment:
7 | global:
8 | STACK_ROOT: "c:\\sr"
9 |
10 | before_test:
11 | # Install stack
12 | - curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-x86_64
13 | - 7z x stack.zip stack.exe
14 |
15 | # Install rocksdb
16 | - git clone https://github.com/facebook/rocksdb.git --branch v4.13.5
17 | - mkdir rocksdb\build
18 | - cd rocksdb\build
19 | - cmake -G "Visual Studio 14 2015 Win64" -DOPTDBG=1 -DXPRESS=1 ..
20 | - msbuild rocksdb.sln /p:Configuration=Release /m
21 | - cd ..\..
22 | - xcopy rocksdb\build\Release\rocksdb.dll .
23 | test_script:
24 | - stack setup
25 | # No parallelization due to https://github.com/haskell/cabal/issues/4005
26 | - stack --no-terminal build --test --haddock --no-haddock-deps --bench --extra-include-dirs="C:\OpenSSL-Win64\include" --extra-lib-dirs="C:\OpenSSL-Win64" --extra-lib-dirs="C:\projects\rocksdb-haskell\rocksdb\build\Release" --extra-include-dirs="C:\projects\rocksdb-haskell\rocksdb\include"
27 |
28 | artifacts:
29 | - path: rocksdb\build\Release
30 | name: Rocksdb
31 | type: zip
32 |
33 | - path: rocksdb\build\Release\rocksdb.dll
34 | name: rocksdb.dll
35 |
--------------------------------------------------------------------------------
/rocksdb-haskell.cabal:
--------------------------------------------------------------------------------
1 | name: rocksdb-haskell
2 | version: 1.0.1
3 | synopsis: Haskell bindings to RocksDB
4 | homepage: http://github.com/serokell/rocksdb-haskell
5 | bug-reports: http://github.com/serokell/rocksdb-haskell/issues
6 | license: BSD3
7 | license-file: LICENSE
8 | author: Kim Altintop, Alexander Thiemann et.al. (see AUTHORS file)
9 | maintainer: Serokell
10 | copyright: Copyright (c) 2012-2014 The leveldb-haskell Authors, Copyright (c) 2014 The rocksdb-haskell Authors
11 | category: Database, FFI
12 | stability: Experimental
13 | build-type: Simple
14 | cabal-version: >=1.10
15 | tested-with: GHC == 8.0.1
16 | description:
17 | From :
18 | .
19 | RocksDB is an embeddable persistent key-value store for fast storage. RocksDB can also be the foundation for a client-server database but our current focus is on embedded workloads.
20 | .
21 | RocksDB builds on LevelDB to be scalable to run on servers with many CPU cores, to efficiently use fast storage, to support IO-bound, in-memory and write-once workloads, and to be flexible to allow for innovation.
22 | extra-source-files: README.md, AUTHORS
23 |
24 | source-repository head
25 | type: git
26 | location: git://github.com/serokell/rocksdb-haskell.git
27 |
28 | library
29 | exposed-modules: Database.RocksDB
30 | , Database.RocksDB.Base
31 | , Database.RocksDB.C
32 | , Database.RocksDB.Internal
33 | , Database.RocksDB.Iterator
34 | , Database.RocksDB.Types
35 |
36 | default-language: Haskell2010
37 | other-extensions: CPP
38 | , ForeignFunctionInterface
39 | , EmptyDataDecls
40 | , RecordWildCards
41 |
42 | build-depends: base >= 3 && < 5
43 | , binary
44 | , bytestring
45 | , data-default
46 | , directory
47 | , filepath
48 | , resourcet > 0.3.2
49 | , transformers
50 |
51 | ghc-options: -Wall -funbox-strict-fields
52 |
53 | hs-source-dirs: src
54 |
55 | extra-libraries: rocksdb
56 |
57 | test-suite rocksdb-tests
58 | ghc-options: -Wall
59 | main-is: tests.hs
60 | type: exitcode-stdio-1.0
61 | hs-source-dirs: tests
62 | build-depends: base >= 3 && < 5
63 | , rocksdb-haskell
64 | , hspec >= 1.8
65 | , process >= 1.1.0.2
66 | , bytestring >= 0.10.4.0
67 | , data-default
68 | , resourcet
69 | , transformers
70 | , temporary
71 | , hspec-expectations
72 | , QuickCheck
73 | default-language: Haskell2010
74 |
--------------------------------------------------------------------------------
/src/Database/RocksDB.hs:
--------------------------------------------------------------------------------
1 | -- |
2 | -- Module : Database.RocksDB
3 | -- Copyright : (c) 2012-2013 The leveldb-haskell Authors
4 | -- (c) 2014 The rocksdb-haskell Authors
5 | -- License : BSD3
6 | -- Maintainer : mail@agrafix.net
7 | -- Stability : experimental
8 | -- Portability : non-portable
9 | --
10 | -- RocksDB Haskell binding.
11 | --
12 | -- The API closely follows the C-API of RocksDB.
13 | -- For more information, see:
14 |
15 | module Database.RocksDB (module Base) where
16 |
17 | import Database.RocksDB.Base as Base
18 |
--------------------------------------------------------------------------------
/src/Database/RocksDB/Base.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | {-# LANGUAGE TupleSections #-}
3 |
4 | -- |
5 | -- Module : Database.RocksDB.Base
6 | -- Copyright : (c) 2012-2013 The leveldb-haskell Authors
7 | -- (c) 2014 The rocksdb-haskell Authors
8 | -- License : BSD3
9 | -- Maintainer : mail@agrafix.net
10 | -- Stability : experimental
11 | -- Portability : non-portable
12 | --
13 | -- RocksDB Haskell binding.
14 | --
15 | -- The API closely follows the C-API of RocksDB.
16 | -- For more information, see:
17 |
18 | module Database.RocksDB.Base
19 | ( -- * Exported Types
20 | DB
21 | , BatchOp (..)
22 | , Comparator (..)
23 | , Compression (..)
24 | , Options (..)
25 | , ReadOptions (..)
26 | , Snapshot
27 | , WriteBatch
28 | , WriteOptions (..)
29 | , Range
30 |
31 | -- * Defaults
32 | , defaultOptions
33 | , defaultReadOptions
34 | , defaultWriteOptions
35 |
36 | -- * Basic Database Manipulations
37 | , open
38 | , openBracket
39 | , close
40 | , put
41 | , putBinaryVal
42 | , putBinary
43 | , delete
44 | , write
45 | , get
46 | , getBinary
47 | , getBinaryVal
48 | , withSnapshot
49 | , withSnapshotBracket
50 | , createSnapshot
51 | , releaseSnapshot
52 |
53 | -- * Filter Policy / Bloom Filter
54 | , FilterPolicy (..)
55 | , BloomFilter
56 | , createBloomFilter
57 | , releaseBloomFilter
58 | , bloomFilter
59 |
60 | -- * Administrative Functions
61 | , Property (..), getProperty
62 | , destroy
63 | , repair
64 | , approximateSize
65 |
66 | -- * Utility functions to help perform mass writes
67 | , binaryToBS
68 | , bsToBinary
69 |
70 | -- * Iteration
71 | , module Database.RocksDB.Iterator
72 | ) where
73 |
74 | import Control.Applicative ((<$>))
75 | import Control.Exception (bracket, bracketOnError, finally)
76 | import Control.Monad (liftM, when)
77 |
78 | import Control.Monad.IO.Class (MonadIO (liftIO))
79 | import Control.Monad.Trans.Resource (MonadResource (..), ReleaseKey, allocate,
80 | release)
81 | import Data.Binary (Binary)
82 | import qualified Data.Binary as Binary
83 | import Data.ByteString (ByteString)
84 | import Data.ByteString.Internal (ByteString (..))
85 | import qualified Data.ByteString.Lazy as BSL
86 | import Foreign
87 | import Foreign.C.String (CString, withCString)
88 | import System.Directory (createDirectoryIfMissing)
89 |
90 | import Database.RocksDB.C
91 | import Database.RocksDB.Internal
92 | import Database.RocksDB.Iterator
93 | import Database.RocksDB.Types
94 |
95 | import qualified Data.ByteString as BS
96 | import qualified Data.ByteString.Unsafe as BU
97 |
98 | import qualified GHC.Foreign as GHC
99 | import qualified GHC.IO.Encoding as GHC
100 |
101 | -- | Create a 'BloomFilter'
102 | bloomFilter :: MonadResource m => Int -> m BloomFilter
103 | bloomFilter i =
104 | snd <$> allocate (createBloomFilter i)
105 | releaseBloomFilter
106 |
107 | -- | Open a database
108 | --
109 | -- The returned handle will automatically be released when the enclosing
110 | -- 'runResourceT' terminates.
111 | openBracket :: MonadResource m => FilePath -> Options -> m (ReleaseKey, DB)
112 | openBracket path opts = allocate (open path opts) close
113 | {-# INLINE openBracket #-}
114 |
115 | -- | Run an action with a snapshot of the database.
116 | --
117 | -- The snapshot will be released when the action terminates or throws an
118 | -- exception. Note that this function is provided for convenience and does not
119 | -- prevent the 'Snapshot' handle to escape. It will, however, be invalid after
120 | -- this function returns and should not be used anymore.
121 | withSnapshotBracket :: MonadResource m => DB -> (Snapshot -> m a) -> m a
122 | withSnapshotBracket db f = do
123 | (rk, snap) <- createSnapshotBracket db
124 | res <- f snap
125 | release rk
126 | return res
127 |
128 | -- | Create a snapshot of the database.
129 | --
130 | -- The returned 'Snapshot' will be released automatically when the enclosing
131 | -- 'runResourceT' terminates. It is recommended to use 'createSnapshot'' instead
132 | -- and release the resource manually as soon as possible.
133 | -- Can be released early.
134 | createSnapshotBracket :: MonadResource m => DB -> m (ReleaseKey, Snapshot)
135 | createSnapshotBracket db = allocate (createSnapshot db) (releaseSnapshot db)
136 |
137 | -- | Open a database.
138 | --
139 | -- The returned handle should be released with 'close'.
140 | open :: MonadIO m => FilePath -> Options -> m DB
141 | open path opts = liftIO $ bracketOnError initialize finalize mkDB
142 | where
143 | # ifdef mingw32_HOST_OS
144 | initialize =
145 | (, ()) <$> mkOpts opts
146 | finalize (opts', ()) =
147 | freeOpts opts'
148 | # else
149 | initialize = do
150 | opts' <- mkOpts opts
151 | -- With LC_ALL=C, two things happen:
152 | -- * rocksdb can't open a database with unicode in path;
153 | -- * rocksdb can't create a folder properly.
154 | -- So, we create the folder by ourselves, and for thart we
155 | -- need to set the encoding we're going to use. On Linux
156 | -- it's almost always UTC-8.
157 | oldenc <- GHC.getFileSystemEncoding
158 | when (createIfMissing opts) $
159 | GHC.setFileSystemEncoding GHC.utf8
160 | pure (opts', oldenc)
161 | finalize (opts', oldenc) = do
162 | freeOpts opts'
163 | GHC.setFileSystemEncoding oldenc
164 | # endif
165 | mkDB (opts'@(Options' opts_ptr _ _), _) = do
166 | when (createIfMissing opts) $
167 | createDirectoryIfMissing True path
168 | withFilePath path $ \path_ptr ->
169 | liftM (`DB` opts')
170 | $ throwIfErr "open"
171 | $ c_rocksdb_open opts_ptr path_ptr
172 |
173 | -- | Close a database.
174 | --
175 | -- The handle will be invalid after calling this action and should no
176 | -- longer be used.
177 | close :: MonadIO m => DB -> m ()
178 | close (DB db_ptr opts_ptr) = liftIO $
179 | c_rocksdb_close db_ptr `finally` freeOpts opts_ptr
180 |
181 |
182 | -- | Run an action with a 'Snapshot' of the database.
183 | withSnapshot :: MonadIO m => DB -> (Snapshot -> IO a) -> m a
184 | withSnapshot db act = liftIO $
185 | bracket (createSnapshot db) (releaseSnapshot db) act
186 |
187 | -- | Create a snapshot of the database.
188 | --
189 | -- The returned 'Snapshot' should be released with 'releaseSnapshot'.
190 | createSnapshot :: MonadIO m => DB -> m Snapshot
191 | createSnapshot (DB db_ptr _) = liftIO $
192 | Snapshot <$> c_rocksdb_create_snapshot db_ptr
193 |
194 | -- | Release a snapshot.
195 | --
196 | -- The handle will be invalid after calling this action and should no
197 | -- longer be used.
198 | releaseSnapshot :: MonadIO m => DB -> Snapshot -> m ()
199 | releaseSnapshot (DB db_ptr _) (Snapshot snap) = liftIO $
200 | c_rocksdb_release_snapshot db_ptr snap
201 |
202 | -- | Get a DB property.
203 | getProperty :: MonadIO m => DB -> Property -> m (Maybe ByteString)
204 | getProperty (DB db_ptr _) p = liftIO $
205 | withCString (prop p) $ \prop_ptr -> do
206 | val_ptr <- c_rocksdb_property_value db_ptr prop_ptr
207 | if val_ptr == nullPtr
208 | then return Nothing
209 | else do res <- Just <$> BS.packCString val_ptr
210 | freeCString val_ptr
211 | return res
212 | where
213 | prop (NumFilesAtLevel i) = "rocksdb.num-files-at-level" ++ show i
214 | prop Stats = "rocksdb.stats"
215 | prop SSTables = "rocksdb.sstables"
216 |
217 | -- | Destroy the given RocksDB database.
218 | destroy :: MonadIO m => FilePath -> Options -> m ()
219 | destroy path opts = liftIO $ bracket (mkOpts opts) freeOpts destroy'
220 | where
221 | destroy' (Options' opts_ptr _ _) =
222 | withFilePath path $ \path_ptr ->
223 | throwIfErr "destroy" $ c_rocksdb_destroy_db opts_ptr path_ptr
224 |
225 | -- | Repair the given RocksDB database.
226 | repair :: MonadIO m => FilePath -> Options -> m ()
227 | repair path opts = liftIO $ bracket (mkOpts opts) freeOpts repair'
228 | where
229 | repair' (Options' opts_ptr _ _) =
230 | withFilePath path $ \path_ptr ->
231 | throwIfErr "repair" $ c_rocksdb_repair_db opts_ptr path_ptr
232 |
233 |
234 | -- TODO: support [Range], like C API does
235 | type Range = (ByteString, ByteString)
236 |
237 | -- | Inspect the approximate sizes of the different levels.
238 | approximateSize :: MonadIO m => DB -> Range -> m Int64
239 | approximateSize (DB db_ptr _) (from, to) = liftIO $
240 | BU.unsafeUseAsCStringLen from $ \(from_ptr, flen) ->
241 | BU.unsafeUseAsCStringLen to $ \(to_ptr, tlen) ->
242 | withArray [from_ptr] $ \from_ptrs ->
243 | withArray [intToCSize flen] $ \flen_ptrs ->
244 | withArray [to_ptr] $ \to_ptrs ->
245 | withArray [intToCSize tlen] $ \tlen_ptrs ->
246 | allocaArray 1 $ \size_ptrs -> do
247 | c_rocksdb_approximate_sizes db_ptr 1
248 | from_ptrs flen_ptrs
249 | to_ptrs tlen_ptrs
250 | size_ptrs
251 | liftM head $ peekArray 1 size_ptrs >>= mapM toInt64
252 |
253 | where
254 | toInt64 = return . fromIntegral
255 |
256 | putBinaryVal :: (MonadIO m, Binary v) => DB -> WriteOptions -> ByteString -> v -> m ()
257 | putBinaryVal db wopts key val = put db wopts key (binaryToBS val)
258 |
259 | putBinary :: (MonadIO m, Binary k, Binary v) => DB -> WriteOptions -> k -> v -> m ()
260 | putBinary db wopts key val = put db wopts (binaryToBS key) (binaryToBS val)
261 |
262 | -- | Write a key/value pair.
263 | put :: MonadIO m => DB -> WriteOptions -> ByteString -> ByteString -> m ()
264 | put (DB db_ptr _) opts key value = liftIO $ withCWriteOpts opts $ \opts_ptr ->
265 | BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
266 | BU.unsafeUseAsCStringLen value $ \(val_ptr, vlen) ->
267 | throwIfErr "put"
268 | $ c_rocksdb_put db_ptr opts_ptr
269 | key_ptr (intToCSize klen)
270 | val_ptr (intToCSize vlen)
271 |
272 | getBinaryVal :: (Binary v, MonadIO m) => DB -> ReadOptions -> ByteString -> m (Maybe v)
273 | getBinaryVal db ropts key = fmap bsToBinary <$> get db ropts key
274 |
275 | getBinary :: (MonadIO m, Binary k, Binary v) => DB -> ReadOptions -> k -> m (Maybe v)
276 | getBinary db ropts key = fmap bsToBinary <$> get db ropts (binaryToBS key)
277 |
278 | -- | Read a value by key.
279 | get :: MonadIO m => DB -> ReadOptions -> ByteString -> m (Maybe ByteString)
280 | get (DB db_ptr _) opts key = liftIO $ withCReadOpts opts $ \opts_ptr ->
281 | BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
282 | alloca $ \vlen_ptr -> do
283 | val_ptr <- throwIfErr "get" $
284 | c_rocksdb_get db_ptr opts_ptr key_ptr (intToCSize klen) vlen_ptr
285 | vlen <- peek vlen_ptr
286 | if val_ptr == nullPtr
287 | then return Nothing
288 | else do
289 | res' <- Just <$> BS.packCStringLen (val_ptr, cSizeToInt vlen)
290 | freeCString val_ptr
291 | return res'
292 |
293 | -- | Delete a key/value pair.
294 | delete :: MonadIO m => DB -> WriteOptions -> ByteString -> m ()
295 | delete (DB db_ptr _) opts key = liftIO $ withCWriteOpts opts $ \opts_ptr ->
296 | BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
297 | throwIfErr "delete"
298 | $ c_rocksdb_delete db_ptr opts_ptr key_ptr (intToCSize klen)
299 |
300 | -- | Perform a batch mutation.
301 | write :: MonadIO m => DB -> WriteOptions -> WriteBatch -> m ()
302 | write (DB db_ptr _) opts batch = liftIO $ withCWriteOpts opts $ \opts_ptr ->
303 | bracket c_rocksdb_writebatch_create c_rocksdb_writebatch_destroy $ \batch_ptr -> do
304 |
305 | mapM_ (batchAdd batch_ptr) batch
306 |
307 | throwIfErr "write" $ c_rocksdb_write db_ptr opts_ptr batch_ptr
308 |
309 | -- ensure @ByteString@s (and respective shared @CStringLen@s) aren't GC'ed
310 | -- until here
311 | mapM_ (liftIO . touch) batch
312 |
313 | where
314 | batchAdd batch_ptr (Put key val) =
315 | BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
316 | BU.unsafeUseAsCStringLen val $ \(val_ptr, vlen) ->
317 | c_rocksdb_writebatch_put batch_ptr
318 | key_ptr (intToCSize klen)
319 | val_ptr (intToCSize vlen)
320 |
321 | batchAdd batch_ptr (Del key) =
322 | BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
323 | c_rocksdb_writebatch_delete batch_ptr key_ptr (intToCSize klen)
324 |
325 | touch (Put (PS p _ _) (PS p' _ _)) = do
326 | touchForeignPtr p
327 | touchForeignPtr p'
328 |
329 | touch (Del (PS p _ _)) = touchForeignPtr p
330 |
331 | createBloomFilter :: MonadIO m => Int -> m BloomFilter
332 | createBloomFilter i = do
333 | let i' = fromInteger . toInteger $ i
334 | fp_ptr <- liftIO $ c_rocksdb_filterpolicy_create_bloom i'
335 | return $ BloomFilter fp_ptr
336 |
337 | releaseBloomFilter :: MonadIO m => BloomFilter -> m ()
338 | releaseBloomFilter (BloomFilter fp) = liftIO $ c_rocksdb_filterpolicy_destroy fp
339 |
340 | binaryToBS :: Binary v => v -> ByteString
341 | binaryToBS x = BSL.toStrict (Binary.encode x)
342 |
343 | bsToBinary :: Binary v => ByteString -> v
344 | bsToBinary x = Binary.decode (BSL.fromStrict x)
345 |
346 | -- | Marshal a 'FilePath' (Haskell string) into a `NUL` terminated C string using
347 | -- temporary storage.
348 | -- On Linux, UTF-8 is almost always the encoding used.
349 | -- When on Windows, UTF-8 can also be used, although the default for those devices is
350 | -- UTF-16. For a more detailed explanation, please refer to
351 | -- https://msdn.microsoft.com/en-us/library/windows/desktop/dd374081(v=vs.85).aspx.
352 | withFilePath :: FilePath -> (CString -> IO a) -> IO a
353 | withFilePath = GHC.withCString GHC.utf8
354 |
--------------------------------------------------------------------------------
/src/Database/RocksDB/C.hsc:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}
2 | -- |
3 | -- Module : Database.RocksDB.C
4 | -- Copyright : (c) 2012-2013 The rocksdb-haskell Authors
5 | -- License : BSD3
6 | -- Maintainer : kim.altintop@gmail.com
7 | -- Stability : experimental
8 | -- Portability : non-portable
9 | --
10 |
11 | module Database.RocksDB.C where
12 |
13 | import Foreign
14 | import Foreign.C.Types
15 | import Foreign.C.String
16 |
17 | #ifdef mingw32_HOST_OS
18 | #include
19 | #else
20 | #include
21 | #endif
22 |
23 | data RocksDB
24 | data LCache
25 | data LComparator
26 | data LIterator
27 | data LLogger
28 | data LOptions
29 | data LReadOptions
30 | data LSnapshot
31 | data LWriteBatch
32 | data LWriteOptions
33 | data LFilterPolicy
34 |
35 | type RocksDBPtr = Ptr RocksDB
36 | type CachePtr = Ptr LCache
37 | type ComparatorPtr = Ptr LComparator
38 | type IteratorPtr = Ptr LIterator
39 | type LoggerPtr = Ptr LLogger
40 | type OptionsPtr = Ptr LOptions
41 | type ReadOptionsPtr = Ptr LReadOptions
42 | type SnapshotPtr = Ptr LSnapshot
43 | type WriteBatchPtr = Ptr LWriteBatch
44 | type WriteOptionsPtr = Ptr LWriteOptions
45 | type FilterPolicyPtr = Ptr LFilterPolicy
46 |
47 | type DBName = CString
48 | type ErrPtr = Ptr CString
49 | type Key = CString
50 | type Val = CString
51 |
52 | newtype CompressionOpt = CompressionOpt { compressionOpt :: CInt }
53 | deriving (Eq, Show)
54 | #{enum CompressionOpt, CompressionOpt
55 | , noCompression = 0
56 | , snappyCompression = 1
57 | , zlibCompression = 2
58 | , bz2Compression = 3
59 | , lz4Compression = 4
60 | , lz4hcCompression = 5
61 | }
62 |
63 |
64 | foreign import ccall safe "rocksdb\\c.h rocksdb_open"
65 | c_rocksdb_open :: OptionsPtr -> DBName -> ErrPtr -> IO RocksDBPtr
66 |
67 | foreign import ccall safe "rocksdb\\c.h rocksdb_close"
68 | c_rocksdb_close :: RocksDBPtr -> IO ()
69 |
70 |
71 | foreign import ccall safe "rocksdb\\c.h rocksdb_put"
72 | c_rocksdb_put :: RocksDBPtr
73 | -> WriteOptionsPtr
74 | -> Key -> CSize
75 | -> Val -> CSize
76 | -> ErrPtr
77 | -> IO ()
78 |
79 | foreign import ccall safe "rocksdb\\c.h rocksdb_delete"
80 | c_rocksdb_delete :: RocksDBPtr
81 | -> WriteOptionsPtr
82 | -> Key -> CSize
83 | -> ErrPtr
84 | -> IO ()
85 |
86 | foreign import ccall safe "rocksdb\\c.h rocksdb_write"
87 | c_rocksdb_write :: RocksDBPtr
88 | -> WriteOptionsPtr
89 | -> WriteBatchPtr
90 | -> ErrPtr
91 | -> IO ()
92 |
93 | -- | Returns NULL if not found. A malloc()ed array otherwise. Stores the length
94 | -- of the array in *vallen.
95 | foreign import ccall safe "rocksdb\\c.h rocksdb_get"
96 | c_rocksdb_get :: RocksDBPtr
97 | -> ReadOptionsPtr
98 | -> Key -> CSize
99 | -> Ptr CSize -- ^ value length
100 | -> ErrPtr
101 | -> IO CString
102 |
103 | foreign import ccall safe "rocksdb\\c.h rocksdb_create_snapshot"
104 | c_rocksdb_create_snapshot :: RocksDBPtr -> IO SnapshotPtr
105 |
106 | foreign import ccall safe "rocksdb\\c.h rocksdb_release_snapshot"
107 | c_rocksdb_release_snapshot :: RocksDBPtr -> SnapshotPtr -> IO ()
108 |
109 | -- | Returns NULL if property name is unknown. Else returns a pointer to a
110 | -- malloc()-ed null-terminated value.
111 | foreign import ccall safe "rocksdb\\c.h rocksdb_property_value"
112 | c_rocksdb_property_value :: RocksDBPtr -> CString -> IO CString
113 |
114 | foreign import ccall safe "rocksdb\\c.h rocksdb_approximate_sizes"
115 | c_rocksdb_approximate_sizes :: RocksDBPtr
116 | -> CInt -- ^ num ranges
117 | -> Ptr CString -> Ptr CSize -- ^ range start keys (array)
118 | -> Ptr CString -> Ptr CSize -- ^ range limit keys (array)
119 | -> Ptr Word64 -- ^ array of approx. sizes of ranges
120 | -> IO ()
121 |
122 | foreign import ccall safe "rocksdb\\c.h rocksdb_destroy_db"
123 | c_rocksdb_destroy_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()
124 |
125 | foreign import ccall safe "rocksdb\\c.h rocksdb_repair_db"
126 | c_rocksdb_repair_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()
127 |
128 |
129 | --
130 | -- Iterator
131 | --
132 |
133 | foreign import ccall safe "rocksdb\\c.h rocksdb_create_iterator"
134 | c_rocksdb_create_iterator :: RocksDBPtr -> ReadOptionsPtr -> IO IteratorPtr
135 |
136 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_destroy"
137 | c_rocksdb_iter_destroy :: IteratorPtr -> IO ()
138 |
139 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_valid"
140 | c_rocksdb_iter_valid :: IteratorPtr -> IO CUChar
141 |
142 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_seek_to_first"
143 | c_rocksdb_iter_seek_to_first :: IteratorPtr -> IO ()
144 |
145 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_seek_to_last"
146 | c_rocksdb_iter_seek_to_last :: IteratorPtr -> IO ()
147 |
148 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_seek"
149 | c_rocksdb_iter_seek :: IteratorPtr -> Key -> CSize -> IO ()
150 |
151 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_next"
152 | c_rocksdb_iter_next :: IteratorPtr -> IO ()
153 |
154 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_prev"
155 | c_rocksdb_iter_prev :: IteratorPtr -> IO ()
156 |
157 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_key"
158 | c_rocksdb_iter_key :: IteratorPtr -> Ptr CSize -> IO Key
159 |
160 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_value"
161 | c_rocksdb_iter_value :: IteratorPtr -> Ptr CSize -> IO Val
162 |
163 | foreign import ccall safe "rocksdb\\c.h rocksdb_iter_get_error"
164 | c_rocksdb_iter_get_error :: IteratorPtr -> ErrPtr -> IO ()
165 |
166 |
167 | --
168 | -- Write batch
169 | --
170 |
171 | foreign import ccall safe "rocksdb\\c.h rocksdb_writebatch_create"
172 | c_rocksdb_writebatch_create :: IO WriteBatchPtr
173 |
174 | foreign import ccall safe "rocksdb\\c.h rocksdb_writebatch_destroy"
175 | c_rocksdb_writebatch_destroy :: WriteBatchPtr -> IO ()
176 |
177 | foreign import ccall safe "rocksdb\\c.h rocksdb_writebatch_clear"
178 | c_rocksdb_writebatch_clear :: WriteBatchPtr -> IO ()
179 |
180 | foreign import ccall safe "rocksdb\\c.h rocksdb_writebatch_put"
181 | c_rocksdb_writebatch_put :: WriteBatchPtr
182 | -> Key -> CSize
183 | -> Val -> CSize
184 | -> IO ()
185 |
186 | foreign import ccall safe "rocksdb\\c.h rocksdb_writebatch_delete"
187 | c_rocksdb_writebatch_delete :: WriteBatchPtr -> Key -> CSize -> IO ()
188 |
189 | foreign import ccall safe "rocksdb\\c.h rocksdb_writebatch_iterate"
190 | c_rocksdb_writebatch_iterate :: WriteBatchPtr
191 | -> Ptr () -- ^ state
192 | -> FunPtr (Ptr () -> Key -> CSize -> Val -> CSize) -- ^ put
193 | -> FunPtr (Ptr () -> Key -> CSize) -- ^ delete
194 | -> IO ()
195 |
196 |
197 | --
198 | -- Options
199 | --
200 |
201 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_create"
202 | c_rocksdb_options_create :: IO OptionsPtr
203 |
204 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_destroy"
205 | c_rocksdb_options_destroy :: OptionsPtr -> IO ()
206 |
207 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_comparator"
208 | c_rocksdb_options_set_comparator :: OptionsPtr -> ComparatorPtr -> IO ()
209 |
210 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_create_if_missing"
211 | c_rocksdb_options_set_create_if_missing :: OptionsPtr -> CUChar -> IO ()
212 |
213 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_error_if_exists"
214 | c_rocksdb_options_set_error_if_exists :: OptionsPtr -> CUChar -> IO ()
215 |
216 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_paranoid_checks"
217 | c_rocksdb_options_set_paranoid_checks :: OptionsPtr -> CUChar -> IO ()
218 |
219 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_info_log"
220 | c_rocksdb_options_set_info_log :: OptionsPtr -> LoggerPtr -> IO ()
221 |
222 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_write_buffer_size"
223 | c_rocksdb_options_set_write_buffer_size :: OptionsPtr -> CSize -> IO ()
224 |
225 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_max_open_files"
226 | c_rocksdb_options_set_max_open_files :: OptionsPtr -> CInt -> IO ()
227 |
228 | foreign import ccall safe "rocksdb\\c.h rocksdb_options_set_compression"
229 | c_rocksdb_options_set_compression :: OptionsPtr -> CompressionOpt -> IO ()
230 |
231 |
232 | --
233 | -- Comparator
234 | --
235 |
236 | type StatePtr = Ptr ()
237 | type Destructor = StatePtr -> ()
238 | type CompareFun = StatePtr -> CString -> CSize -> CString -> CSize -> IO CInt
239 | type NameFun = StatePtr -> CString
240 |
241 | -- | Make a FunPtr to a user-defined comparator function
242 | foreign import ccall "wrapper" mkCmp :: CompareFun -> IO (FunPtr CompareFun)
243 |
244 | -- | Make a destructor FunPtr
245 | foreign import ccall "wrapper" mkDest :: Destructor -> IO (FunPtr Destructor)
246 |
247 | -- | Make a name FunPtr
248 | foreign import ccall "wrapper" mkName :: NameFun -> IO (FunPtr NameFun)
249 |
250 | foreign import ccall safe "rocksdb\\c.h rocksdb_comparator_create"
251 | c_rocksdb_comparator_create :: StatePtr
252 | -> FunPtr Destructor
253 | -> FunPtr CompareFun
254 | -> FunPtr NameFun
255 | -> IO ComparatorPtr
256 |
257 | foreign import ccall safe "rocksdb\\c.h rocksdb_comparator_destroy"
258 | c_rocksdb_comparator_destroy :: ComparatorPtr -> IO ()
259 |
260 |
261 | --
262 | -- Filter Policy
263 | --
264 |
265 | type CreateFilterFun = StatePtr
266 | -> Ptr CString -- ^ key array
267 | -> Ptr CSize -- ^ key length array
268 | -> CInt -- ^ num keys
269 | -> Ptr CSize -- ^ filter length
270 | -> IO CString -- ^ the filter
271 | type KeyMayMatchFun = StatePtr
272 | -> CString -- ^ key
273 | -> CSize -- ^ key length
274 | -> CString -- ^ filter
275 | -> CSize -- ^ filter length
276 | -> IO CUChar -- ^ whether key is in filter
277 |
278 | -- | Make a FunPtr to a user-defined create_filter function
279 | foreign import ccall "wrapper" mkCF :: CreateFilterFun -> IO (FunPtr CreateFilterFun)
280 |
281 | -- | Make a FunPtr to a user-defined key_may_match function
282 | foreign import ccall "wrapper" mkKMM :: KeyMayMatchFun -> IO (FunPtr KeyMayMatchFun)
283 |
284 | foreign import ccall safe "rocksdb\\c.h rocksdb_filterpolicy_create"
285 | c_rocksdb_filterpolicy_create :: StatePtr
286 | -> FunPtr Destructor
287 | -> FunPtr CreateFilterFun
288 | -> FunPtr KeyMayMatchFun
289 | -> FunPtr NameFun
290 | -> IO FilterPolicyPtr
291 |
292 | foreign import ccall safe "rocksdb\\c.h rocksdb_filterpolicy_destroy"
293 | c_rocksdb_filterpolicy_destroy :: FilterPolicyPtr -> IO ()
294 |
295 | foreign import ccall safe "rocksdb\\c.h rocksdb_filterpolicy_create_bloom"
296 | c_rocksdb_filterpolicy_create_bloom :: CInt -> IO FilterPolicyPtr
297 |
298 | --
299 | -- Read options
300 | --
301 |
302 | foreign import ccall safe "rocksdb\\c.h rocksdb_readoptions_create"
303 | c_rocksdb_readoptions_create :: IO ReadOptionsPtr
304 |
305 | foreign import ccall safe "rocksdb\\c.h rocksdb_readoptions_destroy"
306 | c_rocksdb_readoptions_destroy :: ReadOptionsPtr -> IO ()
307 |
308 | foreign import ccall safe "rocksdb\\c.h rocksdb_readoptions_set_verify_checksums"
309 | c_rocksdb_readoptions_set_verify_checksums :: ReadOptionsPtr -> CUChar -> IO ()
310 |
311 | foreign import ccall safe "rocksdb\\c.h rocksdb_readoptions_set_fill_cache"
312 | c_rocksdb_readoptions_set_fill_cache :: ReadOptionsPtr -> CUChar -> IO ()
313 |
314 | foreign import ccall safe "rocksdb\\c.h rocksdb_readoptions_set_snapshot"
315 | c_rocksdb_readoptions_set_snapshot :: ReadOptionsPtr -> SnapshotPtr -> IO ()
316 |
317 |
318 | --
319 | -- Write options
320 | --
321 |
322 | foreign import ccall safe "rocksdb\\c.h rocksdb_writeoptions_create"
323 | c_rocksdb_writeoptions_create :: IO WriteOptionsPtr
324 |
325 | foreign import ccall safe "rocksdb\\c.h rocksdb_writeoptions_destroy"
326 | c_rocksdb_writeoptions_destroy :: WriteOptionsPtr -> IO ()
327 |
328 | foreign import ccall safe "rocksdb\\c.h rocksdb_writeoptions_set_sync"
329 | c_rocksdb_writeoptions_set_sync :: WriteOptionsPtr -> CUChar -> IO ()
330 |
331 |
332 | --
333 | -- Cache
334 | --
335 |
336 | foreign import ccall safe "rocksdb\\c.h rocksdb_cache_create_lru"
337 | c_rocksdb_cache_create_lru :: CSize -> IO CachePtr
338 |
339 | foreign import ccall safe "rocksdb\\c.h rocksdb_cache_destroy"
340 | c_rocksdb_cache_destroy :: CachePtr -> IO ()
341 |
342 | ----------------------------------------------------------------------------
343 | -- Free
344 | ----------------------------------------------------------------------------
345 |
346 | foreign import ccall safe "rocksdb\\c.h rocksdb_free"
347 | c_rocksdb_free :: CString -> IO ()
348 |
--------------------------------------------------------------------------------
/src/Database/RocksDB/Internal.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE RecordWildCards #-}
2 | -- |
3 | -- Module : Database.RocksDB.Internal
4 | -- Copyright : (c) 2012-2013 The leveldb-haskell Authors
5 | -- (c) 2014 The rocksdb-haskell Authors
6 | -- License : BSD3
7 | -- Maintainer : mail@agrafix.net
8 | -- Stability : experimental
9 | -- Portability : non-portable
10 | --
11 |
12 | module Database.RocksDB.Internal
13 | ( -- * Types
14 | DB (..)
15 | , Comparator'
16 | , FilterPolicy'
17 | , Options' (..)
18 |
19 | -- * "Smart" constructors and deconstructors
20 | , freeCReadOpts
21 | , freeComparator
22 | , freeFilterPolicy
23 | , freeOpts
24 | , freeCString
25 | , mkCReadOpts
26 | , mkComparator
27 | , mkCompareFun
28 | , mkCreateFilterFun
29 | , mkFilterPolicy
30 | , mkKeyMayMatchFun
31 | , mkOpts
32 |
33 | -- * combinators
34 | , withCWriteOpts
35 | , withCReadOpts
36 |
37 | -- * Utilities
38 | , throwIfErr
39 | , cSizeToInt
40 | , intToCSize
41 | , intToCInt
42 | , cIntToInt
43 | , boolToNum
44 | )
45 | where
46 |
47 | import Control.Applicative ((<$>))
48 | import Control.Exception (bracket, onException, throwIO)
49 | import Control.Monad (when)
50 | import Data.ByteString (ByteString)
51 | import Foreign
52 | import Foreign.C.String (CString, peekCString, withCString)
53 | import Foreign.C.Types (CInt, CSize)
54 |
55 | import Database.RocksDB.C
56 | import Database.RocksDB.Types
57 |
58 | import qualified Data.ByteString as BS
59 |
60 |
61 | -- | Database handle
62 | data DB = DB RocksDBPtr Options'
63 |
64 | instance Eq DB where
65 | (DB pt1 _) == (DB pt2 _) = pt1 == pt2
66 |
67 | -- | Internal representation of a 'Comparator'
68 | data Comparator' = Comparator' (FunPtr CompareFun)
69 | (FunPtr Destructor)
70 | (FunPtr NameFun)
71 | ComparatorPtr
72 |
73 | -- | Internal representation of a 'FilterPolicy'
74 | data FilterPolicy' = FilterPolicy' (FunPtr CreateFilterFun)
75 | (FunPtr KeyMayMatchFun)
76 | (FunPtr Destructor)
77 | (FunPtr NameFun)
78 | FilterPolicyPtr
79 |
80 | -- | Internal representation of the 'Options'
81 | data Options' = Options'
82 | { _optsPtr :: !OptionsPtr
83 | , _cachePtr :: !(Maybe CachePtr)
84 | , _comp :: !(Maybe Comparator')
85 | }
86 |
87 |
88 | mkOpts :: Options -> IO Options'
89 | mkOpts Options{..} = do
90 | opts_ptr <- c_rocksdb_options_create
91 |
92 | c_rocksdb_options_set_compression opts_ptr
93 | $ ccompression compression
94 | c_rocksdb_options_set_create_if_missing opts_ptr
95 | $ boolToNum createIfMissing
96 | c_rocksdb_options_set_error_if_exists opts_ptr
97 | $ boolToNum errorIfExists
98 | c_rocksdb_options_set_max_open_files opts_ptr
99 | $ intToCInt maxOpenFiles
100 | c_rocksdb_options_set_paranoid_checks opts_ptr
101 | $ boolToNum paranoidChecks
102 | c_rocksdb_options_set_write_buffer_size opts_ptr
103 | $ intToCSize writeBufferSize
104 |
105 | cmp <- maybeSetCmp opts_ptr comparator
106 |
107 | return (Options' opts_ptr Nothing cmp)
108 |
109 | where
110 | ccompression NoCompression =
111 | noCompression
112 | ccompression SnappyCompression =
113 | snappyCompression
114 | ccompression ZlibCompression =
115 | zlibCompression
116 |
117 | maybeSetCmp :: OptionsPtr -> Maybe Comparator -> IO (Maybe Comparator')
118 | maybeSetCmp opts_ptr (Just mcmp) = Just <$> setcmp opts_ptr mcmp
119 | maybeSetCmp _ Nothing = return Nothing
120 |
121 | setcmp :: OptionsPtr -> Comparator -> IO Comparator'
122 | setcmp opts_ptr (Comparator cmp) = do
123 | cmp'@(Comparator' _ _ _ cmp_ptr) <- mkComparator "user-defined" cmp
124 | c_rocksdb_options_set_comparator opts_ptr cmp_ptr
125 | return cmp'
126 |
127 | freeOpts :: Options' -> IO ()
128 | freeOpts (Options' opts_ptr mcache_ptr mcmp_ptr ) = do
129 | c_rocksdb_options_destroy opts_ptr
130 | maybe (return ()) c_rocksdb_cache_destroy mcache_ptr
131 | maybe (return ()) freeComparator mcmp_ptr
132 |
133 | withCWriteOpts :: WriteOptions -> (WriteOptionsPtr -> IO a) -> IO a
134 | withCWriteOpts WriteOptions{..} = bracket mkCWriteOpts freeCWriteOpts
135 | where
136 | mkCWriteOpts = do
137 | opts_ptr <- c_rocksdb_writeoptions_create
138 | onException
139 | (c_rocksdb_writeoptions_set_sync opts_ptr $ boolToNum sync)
140 | (c_rocksdb_writeoptions_destroy opts_ptr)
141 | return opts_ptr
142 |
143 | freeCWriteOpts = c_rocksdb_writeoptions_destroy
144 |
145 | mkCompareFun :: (ByteString -> ByteString -> Ordering) -> CompareFun
146 | mkCompareFun cmp = cmp'
147 | where
148 | cmp' _ a alen b blen = do
149 | a' <- BS.packCStringLen (a, fromInteger . toInteger $ alen)
150 | b' <- BS.packCStringLen (b, fromInteger . toInteger $ blen)
151 | return $ case cmp a' b' of
152 | EQ -> 0
153 | GT -> 1
154 | LT -> -1
155 |
156 | mkComparator :: String -> (ByteString -> ByteString -> Ordering) -> IO Comparator'
157 | mkComparator name f =
158 | withCString name $ \cs -> do
159 | ccmpfun <- mkCmp . mkCompareFun $ f
160 | cdest <- mkDest $ const ()
161 | cname <- mkName $ const cs
162 | ccmp <- c_rocksdb_comparator_create nullPtr cdest ccmpfun cname
163 | return $ Comparator' ccmpfun cdest cname ccmp
164 |
165 |
166 | freeComparator :: Comparator' -> IO ()
167 | freeComparator (Comparator' ccmpfun cdest cname ccmp) = do
168 | c_rocksdb_comparator_destroy ccmp
169 | freeHaskellFunPtr ccmpfun
170 | freeHaskellFunPtr cdest
171 | freeHaskellFunPtr cname
172 |
173 | mkCreateFilterFun :: ([ByteString] -> ByteString) -> CreateFilterFun
174 | mkCreateFilterFun f = f'
175 | where
176 | f' _ ks ks_lens n_ks flen = do
177 | let n_ks' = fromInteger . toInteger $ n_ks
178 | ks' <- peekArray n_ks' ks
179 | ks_lens' <- peekArray n_ks' ks_lens
180 | keys <- mapM bstr (zip ks' ks_lens')
181 | let res = f keys
182 | poke flen (fromIntegral . BS.length $ res)
183 | BS.useAsCString res $ \cstr -> return cstr
184 |
185 | bstr (x,len) = BS.packCStringLen (x, fromInteger . toInteger $ len)
186 |
187 | mkKeyMayMatchFun :: (ByteString -> ByteString -> Bool) -> KeyMayMatchFun
188 | mkKeyMayMatchFun g = g'
189 | where
190 | g' _ k klen f flen = do
191 | k' <- BS.packCStringLen (k, fromInteger . toInteger $ klen)
192 | f' <- BS.packCStringLen (f, fromInteger . toInteger $ flen)
193 | return . boolToNum $ g k' f'
194 |
195 |
196 | mkFilterPolicy :: FilterPolicy -> IO FilterPolicy'
197 | mkFilterPolicy FilterPolicy{..} =
198 | withCString fpName $ \cs -> do
199 | cname <- mkName $ const cs
200 | cdest <- mkDest $ const ()
201 | ccffun <- mkCF . mkCreateFilterFun $ createFilter
202 | ckmfun <- mkKMM . mkKeyMayMatchFun $ keyMayMatch
203 | cfp <- c_rocksdb_filterpolicy_create nullPtr cdest ccffun ckmfun cname
204 |
205 | return $ FilterPolicy' ccffun ckmfun cdest cname cfp
206 |
207 | freeFilterPolicy :: FilterPolicy' -> IO ()
208 | freeFilterPolicy (FilterPolicy' ccffun ckmfun cdest cname cfp) = do
209 | c_rocksdb_filterpolicy_destroy cfp
210 | freeHaskellFunPtr ccffun
211 | freeHaskellFunPtr ckmfun
212 | freeHaskellFunPtr cdest
213 | freeHaskellFunPtr cname
214 |
215 | mkCReadOpts :: ReadOptions -> IO ReadOptionsPtr
216 | mkCReadOpts ReadOptions{..} = do
217 | opts_ptr <- c_rocksdb_readoptions_create
218 | flip onException (c_rocksdb_readoptions_destroy opts_ptr) $ do
219 | c_rocksdb_readoptions_set_verify_checksums opts_ptr $ boolToNum verifyCheckSums
220 | c_rocksdb_readoptions_set_fill_cache opts_ptr $ boolToNum fillCache
221 |
222 | case useSnapshot of
223 | Just (Snapshot snap_ptr) -> c_rocksdb_readoptions_set_snapshot opts_ptr snap_ptr
224 | Nothing -> return ()
225 |
226 | return opts_ptr
227 |
228 | freeCReadOpts :: ReadOptionsPtr -> IO ()
229 | freeCReadOpts = c_rocksdb_readoptions_destroy
230 |
231 | freeCString :: CString -> IO ()
232 | freeCString = c_rocksdb_free
233 |
234 | withCReadOpts :: ReadOptions -> (ReadOptionsPtr -> IO a) -> IO a
235 | withCReadOpts opts = bracket (mkCReadOpts opts) freeCReadOpts
236 |
237 | throwIfErr :: String -> (ErrPtr -> IO a) -> IO a
238 | throwIfErr s f = alloca $ \err_ptr -> do
239 | poke err_ptr nullPtr
240 | res <- f err_ptr
241 | erra <- peek err_ptr
242 | when (erra /= nullPtr) $ do
243 | err <- peekCString erra
244 | throwIO $ userError $ s ++ ": " ++ err
245 | return res
246 |
247 | cSizeToInt :: CSize -> Int
248 | cSizeToInt = fromIntegral
249 | {-# INLINE cSizeToInt #-}
250 |
251 | intToCSize :: Int -> CSize
252 | intToCSize = fromIntegral
253 | {-# INLINE intToCSize #-}
254 |
255 | intToCInt :: Int -> CInt
256 | intToCInt = fromIntegral
257 | {-# INLINE intToCInt #-}
258 |
259 | cIntToInt :: CInt -> Int
260 | cIntToInt = fromIntegral
261 | {-# INLINE cIntToInt #-}
262 |
263 | boolToNum :: Num b => Bool -> b
264 | boolToNum True = fromIntegral (1 :: Int)
265 | boolToNum False = fromIntegral (0 :: Int)
266 | {-# INLINE boolToNum #-}
267 |
--------------------------------------------------------------------------------
/src/Database/RocksDB/Iterator.hs:
--------------------------------------------------------------------------------
1 | -- |
2 | -- Module : Database.RocksDB.Iterator
3 | -- Copyright : (c) 2012-2013 The leveldb-haskell Authors
4 | -- (c) 2014 The rocksdb-haskell Authors
5 | -- License : BSD3
6 | -- Maintainer : mail@agrafix.net
7 | -- Stability : experimental
8 | -- Portability : non-portable
9 | --
10 | -- Iterating over key ranges.
11 | --
12 |
13 | module Database.RocksDB.Iterator
14 | ( Iterator
15 | , createIter
16 | , iterEntry
17 | , iterFirst
18 | , iterGetError
19 | , iterItems
20 | , iterKey
21 | , iterKeys
22 | , iterLast
23 | , iterNext
24 | , iterPrev
25 | , iterSeek
26 | , iterValid
27 | , iterValue
28 | , iterValues
29 | , mapIter
30 | , releaseIter
31 | , withIter
32 | , withIterator
33 | , iterOpenBracket
34 | , iterOpen
35 | ) where
36 |
37 | import Control.Applicative ((<$>), (<*>))
38 | import Control.Exception (bracket, finally, onException)
39 | import Control.Monad (when)
40 | import Control.Monad.IO.Class (MonadIO (liftIO))
41 | import Control.Monad.Trans.Resource (MonadResource (..), ReleaseKey, allocate,
42 | release)
43 | import Data.ByteString (ByteString)
44 | import Data.Maybe (catMaybes)
45 | import Foreign
46 | import Foreign.C.Error (throwErrnoIfNull)
47 | import Foreign.C.String (CString, peekCString)
48 | import Foreign.C.Types (CSize)
49 |
50 | import Database.RocksDB.C
51 | import Database.RocksDB.Internal
52 | import Database.RocksDB.Types
53 |
54 | import qualified Data.ByteString as BS
55 | import qualified Data.ByteString.Char8 as BC
56 | import qualified Data.ByteString.Unsafe as BU
57 |
58 | -- | Iterator handle
59 | --
60 | -- Note that an 'Iterator' requires external synchronization if it is shared
61 | -- between multiple threads which mutate it's state. See
62 | -- @examples/iterforkio.hs@ for a simple example of how to do that.
63 | data Iterator = Iterator !IteratorPtr !ReadOptionsPtr deriving (Eq)
64 |
65 | -- | Run an action with an Iterator. The iterator will be closed after the
66 | -- action returns or an error is thrown. Thus, the iterator will /not/ be valid
67 | -- after this function terminates.
68 | withIterator :: MonadResource m => DB -> ReadOptions -> (Iterator -> m a) -> m a
69 | withIterator db opts f = do
70 | (rk, iter) <- iterOpenBracket db opts
71 | res <- f iter
72 | release rk
73 | return res
74 |
75 | -- | Create an 'Iterator'.
76 | --
77 | -- The iterator will be released when the enclosing 'runResourceT' terminates.
78 | -- You may consider to use 'iterOpen'' instead and manually release the iterator
79 | -- as soon as it is no longer needed (alternatively, use 'withIterator').
80 | --
81 | -- Note that an 'Iterator' creates a snapshot of the database implicitly, so
82 | -- updates written after the iterator was created are not visible. You may,
83 | -- however, specify an older 'Snapshot' in the 'ReadOptions'.
84 | iterOpen :: MonadResource m => DB -> ReadOptions -> m Iterator
85 | iterOpen db opts = snd <$> iterOpenBracket db opts
86 |
87 | -- | Create an 'Iterator' which can be released early.
88 | iterOpenBracket :: MonadResource m => DB -> ReadOptions -> m (ReleaseKey, Iterator)
89 | iterOpenBracket db opts = allocate (createIter db opts) releaseIter
90 |
91 | -- | Create an 'Iterator'.
92 | --
93 | -- The iterator should be released with 'releaseIter'.
94 | --
95 | -- Note that an 'Iterator' creates a snapshot of the database implicitly, so
96 | -- updates written after the iterator was created are not visible. You may,
97 | -- however, specify an older 'Snapshot' in the 'ReadOptions'.
98 | createIter :: MonadIO m => DB -> ReadOptions -> m Iterator
99 | createIter (DB db_ptr _) opts = liftIO $ do
100 | opts_ptr <- mkCReadOpts opts
101 | flip onException (freeCReadOpts opts_ptr) $ do
102 | iter_ptr <- throwErrnoIfNull "create_iterator" $
103 | c_rocksdb_create_iterator db_ptr opts_ptr
104 | return $ Iterator iter_ptr opts_ptr
105 |
106 | -- | Release an 'Iterator'.
107 | --
108 | -- The handle will be invalid after calling this action and should no
109 | -- longer be used. Calling this function with an already released 'Iterator'
110 | -- will cause a double-free error!
111 | releaseIter :: MonadIO m => Iterator -> m ()
112 | releaseIter (Iterator iter_ptr opts) = liftIO $
113 | c_rocksdb_iter_destroy iter_ptr `finally` freeCReadOpts opts
114 |
115 | -- | Run an action with an 'Iterator'
116 | withIter :: MonadIO m => DB -> ReadOptions -> (Iterator -> IO a) -> m a
117 | withIter db opts = liftIO . bracket (createIter db opts) releaseIter
118 |
119 | -- | An iterator is either positioned at a key/value pair, or not valid. This
120 | -- function returns /true/ iff the iterator is valid.
121 | iterValid :: MonadIO m => Iterator -> m Bool
122 | iterValid (Iterator iter_ptr _) = liftIO $ do
123 | x <- c_rocksdb_iter_valid iter_ptr
124 | return (x /= 0)
125 |
126 | -- | Position at the first key in the source that is at or past target. The
127 | -- iterator is /valid/ after this call iff the source contains an entry that
128 | -- comes at or past target.
129 | iterSeek :: MonadIO m => Iterator -> ByteString -> m ()
130 | iterSeek (Iterator iter_ptr _) key = liftIO $
131 | BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
132 | c_rocksdb_iter_seek iter_ptr key_ptr (intToCSize klen)
133 |
134 | -- | Position at the first key in the source. The iterator is /valid/ after this
135 | -- call iff the source is not empty.
136 | iterFirst :: MonadIO m => Iterator -> m ()
137 | iterFirst (Iterator iter_ptr _) = liftIO $ c_rocksdb_iter_seek_to_first iter_ptr
138 |
139 | -- | Position at the last key in the source. The iterator is /valid/ after this
140 | -- call iff the source is not empty.
141 | iterLast :: MonadIO m => Iterator -> m ()
142 | iterLast (Iterator iter_ptr _) = liftIO $ c_rocksdb_iter_seek_to_last iter_ptr
143 |
144 | -- | Moves to the next entry in the source. After this call, 'iterValid' is
145 | -- /true/ iff the iterator was not positioned at the last entry in the source.
146 | --
147 | -- If the iterator is not valid, this function does nothing. Note that this is a
148 | -- shortcoming of the C API: an 'iterPrev' might still be possible, but we can't
149 | -- determine if we're at the last or first entry.
150 | iterNext :: MonadIO m => Iterator -> m ()
151 | iterNext (Iterator iter_ptr _) = liftIO $ do
152 | valid <- c_rocksdb_iter_valid iter_ptr
153 | when (valid /= 0) $ c_rocksdb_iter_next iter_ptr
154 |
155 | -- | Moves to the previous entry in the source. After this call, 'iterValid' is
156 | -- /true/ iff the iterator was not positioned at the first entry in the source.
157 | --
158 | -- If the iterator is not valid, this function does nothing. Note that this is a
159 | -- shortcoming of the C API: an 'iterNext' might still be possible, but we can't
160 | -- determine if we're at the last or first entry.
161 | iterPrev :: MonadIO m => Iterator -> m ()
162 | iterPrev (Iterator iter_ptr _) = liftIO $ do
163 | valid <- c_rocksdb_iter_valid iter_ptr
164 | when (valid /= 0) $ c_rocksdb_iter_prev iter_ptr
165 |
166 | -- | Return the key for the current entry if the iterator is currently
167 | -- positioned at an entry, ie. 'iterValid'.
168 | iterKey :: MonadIO m => Iterator -> m (Maybe ByteString)
169 | iterKey = liftIO . flip iterString c_rocksdb_iter_key
170 |
171 | -- | Return the value for the current entry if the iterator is currently
172 | -- positioned at an entry, ie. 'iterValid'.
173 | iterValue :: MonadIO m => Iterator -> m (Maybe ByteString)
174 | iterValue = liftIO . flip iterString c_rocksdb_iter_value
175 |
176 | -- | Return the current entry as a pair, if the iterator is currently positioned
177 | -- at an entry, ie. 'iterValid'.
178 | iterEntry :: MonadIO m => Iterator -> m (Maybe (ByteString, ByteString))
179 | iterEntry iter = liftIO $ do
180 | mkey <- iterKey iter
181 | mval <- iterValue iter
182 | return $ (,) <$> mkey <*> mval
183 |
184 | -- | Check for errors
185 | --
186 | -- Note that this captures somewhat severe errors such as a corrupted database.
187 | iterGetError :: MonadIO m => Iterator -> m (Maybe ByteString)
188 | iterGetError (Iterator iter_ptr _) = liftIO $
189 | alloca $ \err_ptr -> do
190 | poke err_ptr nullPtr
191 | c_rocksdb_iter_get_error iter_ptr err_ptr
192 | erra <- peek err_ptr
193 | if erra == nullPtr
194 | then return Nothing
195 | else do
196 | err <- peekCString erra
197 | return . Just . BC.pack $ err
198 |
199 | -- | Map a function over an iterator, advancing the iterator forward and
200 | -- returning the value. The iterator should be put in the right position prior
201 | -- to calling the function.
202 | --
203 | -- Note that this function accumulates the result strictly, ie. it reads all
204 | -- values into memory until the iterator is exhausted. This is most likely not
205 | -- what you want for large ranges. You may consider using conduits instead, for
206 | -- an example see:
207 | mapIter :: MonadIO m => (Iterator -> m a) -> Iterator -> m [a]
208 | mapIter f iter@(Iterator iter_ptr _) = go []
209 | where
210 | go acc = do
211 | valid <- liftIO $ c_rocksdb_iter_valid iter_ptr
212 | if valid == 0
213 | then return acc
214 | else do
215 | val <- f iter
216 | () <- liftIO $ c_rocksdb_iter_next iter_ptr
217 | go (val : acc)
218 |
219 | -- | Return a list of key and value tuples from an iterator. The iterator
220 | -- should be put in the right position prior to calling this with the iterator.
221 | --
222 | -- See strictness remarks on 'mapIter'.
223 | iterItems :: MonadIO m => Iterator -> m [(ByteString, ByteString)]
224 | iterItems iter = catMaybes <$> mapIter iterEntry iter
225 |
226 | -- | Return a list of key from an iterator. The iterator should be put
227 | -- in the right position prior to calling this with the iterator.
228 | --
229 | -- See strictness remarks on 'mapIter'
230 | iterKeys :: MonadIO m => Iterator -> m [ByteString]
231 | iterKeys iter = catMaybes <$> mapIter iterKey iter
232 |
233 | -- | Return a list of values from an iterator. The iterator should be put
234 | -- in the right position prior to calling this with the iterator.
235 | --
236 | -- See strictness remarks on 'mapIter'
237 | iterValues :: MonadIO m => Iterator -> m [ByteString]
238 | iterValues iter = catMaybes <$> mapIter iterValue iter
239 |
240 | --
241 | -- Internal
242 | --
243 |
244 | iterString :: Iterator
245 | -> (IteratorPtr -> Ptr CSize -> IO CString)
246 | -> IO (Maybe ByteString)
247 | iterString (Iterator iter_ptr _) f = do
248 | valid <- c_rocksdb_iter_valid iter_ptr
249 | if valid == 0
250 | then return Nothing
251 | else alloca $ \len_ptr -> do
252 | ptr <- f iter_ptr len_ptr
253 | if ptr == nullPtr
254 | then return Nothing
255 | else do
256 | len <- peek len_ptr
257 | Just <$> BS.packCStringLen (ptr, cSizeToInt len)
258 |
--------------------------------------------------------------------------------
/src/Database/RocksDB/Types.hs:
--------------------------------------------------------------------------------
1 | -- |
2 | -- Module : Database.RocksDB.Types
3 | -- Copyright : (c) 2012-2013 The leveldb-haskell Authors
4 | -- (c) 2014 The rocksdb-haskell Authors
5 | -- License : BSD3
6 | -- Maintainer : mail@agrafix.net
7 | -- Stability : experimental
8 | -- Portability : non-portable
9 | --
10 |
11 | module Database.RocksDB.Types
12 | ( BatchOp (..)
13 | , BloomFilter (..)
14 | , Comparator (..)
15 | , Compression (..)
16 | , FilterPolicy (..)
17 | , Options (..)
18 | , Property (..)
19 | , ReadOptions (..)
20 | , Snapshot (..)
21 | , WriteBatch
22 | , WriteOptions (..)
23 |
24 | , defaultOptions
25 | , defaultReadOptions
26 | , defaultWriteOptions
27 | )
28 | where
29 |
30 | import Data.ByteString (ByteString)
31 | import Data.Default
32 | import Foreign
33 |
34 | import Database.RocksDB.C
35 |
36 | -- | Snapshot handle
37 | newtype Snapshot = Snapshot SnapshotPtr deriving (Eq)
38 |
39 | -- | Compression setting
40 | data Compression
41 | = NoCompression
42 | | SnappyCompression
43 | | ZlibCompression
44 | deriving (Eq, Show)
45 |
46 | -- | User-defined comparator
47 | newtype Comparator = Comparator (ByteString -> ByteString -> Ordering)
48 |
49 | -- | User-defined filter policy
50 | data FilterPolicy = FilterPolicy
51 | { fpName :: String
52 | , createFilter :: [ByteString] -> ByteString
53 | , keyMayMatch :: ByteString -> ByteString -> Bool
54 | }
55 |
56 | -- | Represents the built-in Bloom Filter
57 | newtype BloomFilter = BloomFilter FilterPolicyPtr
58 |
59 | -- | Options when opening a database
60 | data Options = Options
61 | { comparator :: !(Maybe Comparator)
62 | -- ^ Comparator used to defined the order of keys in the table.
63 | --
64 | -- If 'Nothing', the default comparator is used, which uses lexicographic
65 | -- bytes-wise ordering.
66 | --
67 | -- NOTE: the client must ensure that the comparator supplied here has the
68 | -- same name and orders keys /exactly/ the same as the comparator provided
69 | -- to previous open calls on the same DB.
70 | --
71 | -- Default: Nothing
72 | , compression :: !Compression
73 | -- ^ Compress blocks using the specified compression algorithm.
74 | --
75 | -- This parameter can be changed dynamically.
76 | --
77 | -- Default: 'EnableCompression'
78 | , createIfMissing :: !Bool
79 | -- ^ If true, the database will be created if it is missing.
80 | --
81 | -- Default: False
82 | , errorIfExists :: !Bool
83 | -- ^ It true, an error is raised if the database already exists.
84 | --
85 | -- Default: False
86 | , maxOpenFiles :: !Int
87 | -- ^ Number of open files that can be used by the DB.
88 | --
89 | -- You may need to increase this if your database has a large working set
90 | -- (budget one open file per 2MB of working set).
91 | --
92 | -- Default: 1000
93 | , paranoidChecks :: !Bool
94 | -- ^ If true, the implementation will do aggressive checking of the data
95 | -- it is processing and will stop early if it detects any errors.
96 | --
97 | -- This may have unforeseen ramifications: for example, a corruption of
98 | -- one DB entry may cause a large number of entries to become unreadable
99 | -- or for the entire DB to become unopenable.
100 | --
101 | -- Default: False
102 | , writeBufferSize :: !Int
103 | -- ^ Amount of data to build up in memory (backed by an unsorted log on
104 | -- disk) before converting to a sorted on-disk file.
105 | --
106 | -- Larger values increase performance, especially during bulk loads. Up to
107 | -- to write buffers may be held in memory at the same time, so you may
108 | -- with to adjust this parameter to control memory usage. Also, a larger
109 | -- write buffer will result in a longer recovery time the next time the
110 | -- database is opened.
111 | --
112 | -- Default: 4MB
113 | }
114 |
115 | defaultOptions :: Options
116 | defaultOptions = Options
117 | { comparator = Nothing
118 | , compression = SnappyCompression
119 | , createIfMissing = False
120 | , errorIfExists = False
121 | , maxOpenFiles = 1000
122 | , paranoidChecks = False
123 | , writeBufferSize = 4 `shift` 20
124 | }
125 |
126 | instance Default Options where
127 | def = defaultOptions
128 |
129 | -- | Options for write operations
130 | data WriteOptions = WriteOptions
131 | { sync :: !Bool
132 | -- ^ If true, the write will be flushed from the operating system buffer
133 | -- cache (by calling WritableFile::Sync()) before the write is considered
134 | -- complete. If this flag is true, writes will be slower.
135 | --
136 | -- If this flag is false, and the machine crashes, some recent writes may
137 | -- be lost. Note that if it is just the process that crashes (i.e., the
138 | -- machine does not reboot), no writes will be lost even if sync==false.
139 | --
140 | -- In other words, a DB write with sync==false has similar crash semantics
141 | -- as the "write()" system call. A DB write with sync==true has similar
142 | -- crash semantics to a "write()" system call followed by "fsync()".
143 | --
144 | -- Default: False
145 | } deriving (Eq, Show)
146 |
147 | defaultWriteOptions :: WriteOptions
148 | defaultWriteOptions = WriteOptions { sync = False }
149 |
150 | instance Default WriteOptions where
151 | def = defaultWriteOptions
152 |
153 | -- | Options for read operations
154 | data ReadOptions = ReadOptions
155 | { verifyCheckSums :: !Bool
156 | -- ^ If true, all data read from underlying storage will be verified
157 | -- against corresponding checksuyms.
158 | --
159 | -- Default: False
160 | , fillCache :: !Bool
161 | -- ^ Should the data read for this iteration be cached in memory? Callers
162 | -- may with to set this field to false for bulk scans.
163 | --
164 | -- Default: True
165 | , useSnapshot :: !(Maybe Snapshot)
166 | -- ^ If 'Just', read as of the supplied snapshot (which must belong to the
167 | -- DB that is being read and which must not have been released). If
168 | -- 'Nothing', use an implicit snapshot of the state at the beginning of
169 | -- this read operation.
170 | --
171 | -- Default: Nothing
172 | } deriving (Eq)
173 |
174 | defaultReadOptions :: ReadOptions
175 | defaultReadOptions = ReadOptions
176 | { verifyCheckSums = False
177 | , fillCache = True
178 | , useSnapshot = Nothing
179 | }
180 |
181 | instance Default ReadOptions where
182 | def = defaultReadOptions
183 |
184 | type WriteBatch = [BatchOp]
185 |
186 | -- | Batch operation
187 | data BatchOp = Put ByteString ByteString | Del ByteString
188 | deriving (Eq, Show)
189 |
190 | -- | Properties exposed by RocksDB
191 | data Property = NumFilesAtLevel Int | Stats | SSTables
192 | deriving (Eq, Show)
193 |
--------------------------------------------------------------------------------
/stack.yaml:
--------------------------------------------------------------------------------
1 | flags: {}
2 |
3 | extra-package-dbs: []
4 |
5 | packages:
6 | - '.'
7 |
8 | extra-deps:
9 | - QuickCheck-2.10.1 #This is only until a version of 'QuickCheck' that exports
10 | #'UnicodeString' (2.10.1 is the first) is available in LTS.
11 |
12 | resolver: lts-9.14
13 |
14 | nix:
15 | packages: [rocksdb,gmp]
16 |
--------------------------------------------------------------------------------
/tests/tests.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE BinaryLiterals #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Main where
5 |
6 | import Control.Monad.IO.Class (MonadIO (liftIO))
7 | import Control.Monad.Trans.Resource (MonadResource, runResourceT)
8 | import Data.Default (def)
9 | import System.IO.Temp (withSystemTempDirectory)
10 |
11 | import Database.RocksDB (Compression (..), DB, compression,
12 | createIfMissing, defaultOptions, get, open,
13 | put)
14 |
15 | import Test.Hspec (describe, hspec, it, shouldReturn)
16 | import Test.QuickCheck (Arbitrary (..), UnicodeString (..),
17 | generate)
18 |
19 | initializeDB :: MonadResource m => FilePath -> m DB
20 | initializeDB path =
21 | open
22 | path
23 | defaultOptions
24 | {createIfMissing = True, compression = NoCompression}
25 |
26 | main :: IO ()
27 | main = hspec $ do
28 |
29 | describe "Basic DB Functionality" $ do
30 | it "should put items into the database and retrieve them" $ do
31 | runResourceT $ withSystemTempDirectory "rocksdb" $ \path -> do
32 | db <- initializeDB path
33 | put db def "zzz" "zzz"
34 | get db def "zzz"
35 | `shouldReturn` (Just "zzz")
36 |
37 | it "should put items into a database whose filepath has unicode characters and\
38 | \ retrieve them" $ do
39 | runResourceT $ withSystemTempDirectory "rocksdb" $ \path -> do
40 | unicode <- getUnicodeString <$> liftIO (generate arbitrary)
41 | db <- initializeDB $ path ++ unicode
42 | put db def "zzz" "zzz"
43 | get db def "zzz"
44 | `shouldReturn` (Just "zzz")
45 |
--------------------------------------------------------------------------------