├── CHANGES.md ├── LICENSE ├── Makefile ├── README.md ├── ahrocksdb.opam ├── dune-project ├── ffi ├── bindings │ ├── dune │ ├── rocksdb_bindings.ml │ ├── stubgen.sh │ └── views.ml ├── lib │ ├── config │ │ ├── discover.ml │ │ └── dune │ ├── dune │ └── m.ml ├── structs │ ├── driver.ml │ ├── dune │ └── rocksdb_types.ml └── stubgen │ ├── dune │ └── ffi_stubgen.ml ├── lib ├── dune ├── misc.ml ├── rocksdb.ml ├── rocksdb.mli ├── rocksdb_options.ml └── wrap.ml └── tests ├── dune ├── test.ml ├── test_config_and_open.ml ├── test_iterator.ml ├── test_writes.ml └── utils.ml /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## 0.3.1 2 | 3 | - add explicit dependency on dune-configurator 4 | - update opam file to opam 2 5 | 6 | ## 0.3.0 7 | 8 | - Add max_bytes_for_level_base and max_bytes_for_level_multiplier options. 9 | 10 | ## 0.2.1 11 | 12 | Do not depend on base anymore. 13 | Internal build system fixes. 14 | rresult dependency was missing, thus added 15 | 16 | ## 0.2.0 17 | 18 | Initial release. 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Ahrefs 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: build clean test 2 | 3 | build: 4 | dune build @install 5 | 6 | test: 7 | dune runtest 8 | 9 | install: 10 | dune install 11 | 12 | uninstall: 13 | dune uninstall 14 | 15 | clean: 16 | dune clean 17 | 18 | doc: 19 | dune build @doc 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-ahrocksdb -- a binding to RocksDB 2 | 3 | This is a binding to Facebook's RocksDB. 4 | 5 | Early prototype of this library based on [orocksdb](https://github.com/domsj/orocksdb), we decided to rewrite our own binding to make use of Ctypes's stubs generators instead of the dynamic mode used in orocksdb. 6 | 7 | It is currently based and was tested against RocksDB 5.14fb, and should work with newer versions of this library. 8 | 9 | ## API changes and contributions 10 | 11 | While we do not plan big changes in what is already implemented, we do not guarantee the stability of these APIs. 12 | 13 | Some APIs could definitely use improvements (moving the current configuration system to a builder-like pattern), 14 | and some breakage may or may-not happen. 15 | 16 | Pull requests to improve any parts of the library are however welcome, whether they are related to 17 | tests, binding coverage, or API improvements, feel free to open an issue to discuss changes. 18 | -------------------------------------------------------------------------------- /ahrocksdb.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Ahrefs Pte Ltd " 3 | authors: ["Ahrefs Pte Ltd " "Enguerrand Decorne "] 4 | license: "MIT" 5 | homepage: "https://github.com/ahrefs/ocaml-ahrocksdb" 6 | doc: "https://ahrefs.github.io/ocaml-ahrocksdb/" 7 | dev-repo: "git+https://github.com/ahrefs/ocaml-ahrocksdb.git" 8 | bug-reports: "https://github.com/ahrefs/ocaml-ahrocksdb/issues" 9 | synopsis: "A binding to RocksDB" 10 | depends: [ 11 | "ocaml" {>= "4.06.0"} 12 | "dune" 13 | "dune-configurator" 14 | "ctypes" {>= "0.12.0"} 15 | "astring" 16 | "conf-rocksdb" 17 | "rresult" 18 | "bos" {with-test} 19 | "cryptokit" {with-test} 20 | "alcotest" {with-test} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {pinned} 24 | ["dune" "build" "-p" name "-j" jobs] 25 | ["dune" "runtest"] {with-test} 26 | ] 27 | description: """ 28 | This is a binding to Facebook's RocksDB. 29 | 30 | Early prototype of this library based on [orocksdb](https://github.com/domsj/orocksdb), we decided to rewrite our own binding to make use of Ctypes's stubs generators instead of the dynamic mode used in orocksdb. 31 | 32 | It is currently based and was tested against RocksDB 5.14fb, and should work with newer versions of this library. 33 | 34 | ## API changes and contributions 35 | 36 | While we do not plan big changes in what is already implemented, we do not guarantee the stability of these APIs. 37 | 38 | Some APIs could definitely use improvements (moving the current configuration system to a builder-like pattern), 39 | and some breakage may or may-not happen. 40 | 41 | Pull requests to improve any parts of the library are however welcome, whether they are related to 42 | tests, binding coverage, or API improvements, feel free to open an issue to discuss changes.""" 43 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.3) 2 | (name ahrocksdb) -------------------------------------------------------------------------------- /ffi/bindings/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets structs_stubgen.exe) 3 | (deps structs_stubgen.o) 4 | (action (run %{cc} %{deps} -o %{targets})) 5 | ) 6 | 7 | (rule 8 | (targets t.ml) 9 | (deps structs_stubgen.exe) 10 | (action (with-stdout-to %{targets} (run %{deps} -c))) 11 | ) 12 | 13 | (rule 14 | (deps ../lib/c_flags.txt ../structs/structs_stubgen.c) 15 | (targets structs_stubgen.o) 16 | (action (run ./stubgen.sh)) 17 | ) 18 | 19 | (library 20 | (name rocksdb_bindings) 21 | (public_name ahrocksdb.bindings) 22 | (flags (:standard -w -unused-var-strict)) 23 | (synopsis "Ctypes bindings that describe the librocksdb FFI") 24 | (modules rocksdb_bindings views t) 25 | (libraries rocksdb_types ctypes.stubs ctypes)) 26 | -------------------------------------------------------------------------------- /ffi/bindings/rocksdb_bindings.ml: -------------------------------------------------------------------------------- 1 | module T = Rocksdb_types.Struct_stubs(T) 2 | 3 | module M(F: Cstubs.FOREIGN) = struct 4 | 5 | module V = Views 6 | open V 7 | 8 | let foreign = F.foreign 9 | 10 | module C = struct 11 | include Ctypes 12 | let (@->) = F.(@->) 13 | let returning = F.returning 14 | end 15 | 16 | type t = unit C.ptr 17 | 18 | module Options = struct 19 | 20 | type options = unit C.ptr 21 | let options : options C.typ = C.ptr C.void 22 | 23 | module FilterPolicy = struct 24 | 25 | type t = unit C.ptr 26 | let t : t C.typ = C.ptr C.void 27 | 28 | let create_bloom_full = 29 | foreign ("rocksdb_filterpolicy_create_bloom_full") C.(int @-> returning t) 30 | 31 | let create_bloom = 32 | foreign ("rocksdb_filterpolicy_create_bloom") C.(int @-> returning t) 33 | 34 | let destroy = 35 | foreign ("rocksdb_filterpolicy_destroy") C.(t @-> returning void) 36 | 37 | end 38 | 39 | module Cache = struct 40 | 41 | type t = unit C.ptr 42 | let t : t C.typ = C.ptr C.void 43 | 44 | let create = 45 | foreign ("rocksdb_cache_create_lru") C.(int_to_size_t @-> returning t) 46 | 47 | let destroy = 48 | foreign ("rocksdb_cache_destroy") C.(t @-> returning void) 49 | 50 | let set_capacity = 51 | foreign ("rocksdb_cache_set_capacity") C.(t @-> int_to_size_t @-> returning void) 52 | 53 | let get_usage = 54 | foreign ("rocksdb_cache_get_usage") C.(t @-> returning int_to_size_t) 55 | 56 | let get_pinned_usage = 57 | foreign ("rocksdb_cache_get_pinned_usage") C.(t @-> returning int_to_size_t) 58 | 59 | end 60 | 61 | module Tables = struct 62 | 63 | module BlockBased = struct 64 | 65 | type t = unit C.ptr 66 | let t : t C.typ = C.ptr C.void 67 | 68 | let create = 69 | foreign ("rocksdb_block_based_options_create") C.(void @-> returning t) 70 | 71 | let destroy = 72 | foreign ("rocksdb_block_based_options_destroy") C.(t @-> returning void) 73 | 74 | let set_block_size = 75 | foreign ("rocksdb_block_based_options_set_block_size") C.(t @-> int_to_size_t @-> returning void) 76 | 77 | let set_block_cache = 78 | foreign ("rocksdb_block_based_options_set_block_cache") C.(t @-> Cache.t @-> returning void) 79 | 80 | let set_filter_policy = 81 | foreign ("rocksdb_block_based_options_set_filter_policy") C.(t @-> FilterPolicy.t @-> returning void) 82 | 83 | let set_cache_index_and_filter_blocks = 84 | foreign ("rocksdb_block_based_options_set_cache_index_and_filter_blocks") C.(t @-> bool_to_uchar @-> returning void) 85 | 86 | end 87 | 88 | end 89 | 90 | let create = 91 | foreign ("rocksdb_options_create") C.(void @-> returning options) 92 | 93 | let destroy = 94 | foreign ("rocksdb_options_destroy") C.(options @-> returning void) 95 | 96 | let increase_parallelism = 97 | foreign ("rocksdb_options_increase_parallelism") C.(options @-> int @-> returning void) 98 | 99 | let optimize_for_point_lookup = 100 | foreign ("rocksdb_options_optimize_for_point_lookup") C.(options @-> int_to_uint64 @-> returning void) 101 | 102 | let optimize_level_style_compaction = 103 | foreign ("rocksdb_options_optimize_level_style_compaction") C.(options @-> int_to_uint64 @-> returning void) 104 | 105 | let optimize_universal_style_compaction = 106 | foreign ("rocksdb_options_optimize_universal_style_compaction") C.(options @-> int_to_uint64 @-> returning void) 107 | 108 | let set_optimize_filters_for_hits = 109 | foreign ("rocksdb_options_set_optimize_filters_for_hits") C.(options @-> bool_to_int @-> returning void) 110 | 111 | let set_compression = 112 | foreign "rocksdb_options_set_compression" C.(options @-> compression_view @-> returning void) 113 | 114 | let set_compression_per_level = 115 | foreign "rocksdb_options_set_compression_per_level" C.(options @-> ptr int @-> int_to_size_t @-> returning void) 116 | 117 | let set_error_if_exists = 118 | foreign "rocksdb_options_set_error_if_exists" C.(options @-> bool_to_uchar @-> returning void) 119 | 120 | let set_create_if_missing = 121 | foreign "rocksdb_options_set_create_if_missing" C.(options @-> bool_to_uchar @-> returning void) 122 | 123 | let set_paranoid_checks = 124 | foreign "rocksdb_options_set_paranoid_checks" C.(options @-> bool_to_uchar @-> returning void) 125 | 126 | let set_max_background_flushes = 127 | foreign ("rocksdb_options_set_max_background_flushes") C.(options @-> int @-> returning void) 128 | 129 | let set_disable_auto_compactions = 130 | foreign "rocksdb_options_set_disable_auto_compactions" C.(options @-> bool_to_int @-> returning void) 131 | 132 | let set_level0_file_num_compaction_trigger = 133 | foreign "rocksdb_options_set_level0_file_num_compaction_trigger" C.(options @-> int_to_size_t @-> returning void) 134 | 135 | let set_level0_slowdown_writes_trigger = 136 | foreign "rocksdb_options_set_level0_slowdown_writes_trigger" C.(options @-> int_to_size_t @-> returning void) 137 | 138 | let set_level0_stop_writes_trigger = 139 | foreign "rocksdb_options_set_level0_stop_writes_trigger" C.(options @-> int_to_size_t @-> returning void) 140 | 141 | let set_max_bytes_for_level_base = 142 | foreign "rocksdb_options_set_max_bytes_for_level_base" C.(options @-> int_to_size_t @-> returning void) 143 | 144 | let set_max_bytes_for_level_multiplier = 145 | foreign "rocksdb_options_set_max_bytes_for_level_multiplier" C.(options @-> double @-> returning void) 146 | 147 | let set_write_buffer_size = 148 | foreign "rocksdb_options_set_write_buffer_size" C.(options @-> int_to_size_t @-> returning void) 149 | 150 | let set_max_write_buffer_number = 151 | foreign "rocksdb_options_set_max_write_buffer_number" C.(options @-> int @-> returning void) 152 | 153 | let set_min_write_buffer_number_to_merge = 154 | foreign "rocksdb_options_set_min_write_buffer_number_to_merge" C.(options @-> int @-> returning void) 155 | 156 | let set_memtable_vector_rep = 157 | foreign "rocksdb_options_set_memtable_vector_rep" C.(options @-> returning void) 158 | 159 | let prepare_for_bulk_load = 160 | foreign "rocksdb_options_prepare_for_bulk_load" C.(options @-> returning void) 161 | 162 | let set_target_file_size_base = 163 | foreign "rocksdb_options_set_target_file_size_base" C.(options @-> int_to_uint64 @-> returning void) 164 | 165 | let set_target_file_size_multiplier = 166 | foreign "rocksdb_options_set_target_file_size_multiplier" C.(options @-> int_to_uint64 @-> returning void) 167 | 168 | let set_num_levels = 169 | foreign "rocksdb_options_set_num_levels" C.(options @-> int @-> returning void) 170 | 171 | let set_block_based_table_factory = 172 | foreign "rocksdb_options_set_block_based_table_factory" C.(options @-> Tables.BlockBased.t @-> returning void) 173 | 174 | let set_max_open_files = 175 | foreign "rocksdb_options_set_max_open_files" C.(options @-> int @-> returning void) 176 | 177 | end 178 | 179 | module Rocksdb = struct 180 | 181 | type db = unit C.ptr 182 | let db : db C.typ = C.ptr C.void 183 | 184 | let open_ = 185 | foreign "rocksdb_open" C.(Options.options @-> string @-> ptr string_opt @-> returning db) 186 | 187 | let open_read_only = 188 | foreign "rocksdb_open_for_read_only" C.(Options.options @-> string @-> bool_to_uchar @-> ptr string_opt @-> returning db) 189 | 190 | let open_with_ttl = 191 | foreign "rocksdb_open_with_ttl" C.(Options.options @-> string @-> int @-> ptr string_opt @-> returning db) 192 | 193 | let close = 194 | foreign "rocksdb_close" C.(db @-> returning void) 195 | 196 | module Write_options = struct 197 | 198 | type t = unit C.ptr 199 | let t : t C.typ = C.ptr C.void 200 | 201 | let create = 202 | foreign "rocksdb_writeoptions_create" C.(void @-> returning t) 203 | 204 | let destroy = 205 | foreign "rocksdb_writeoptions_destroy" C.(t @-> returning void) 206 | 207 | let set_sync = 208 | foreign "rocksdb_writeoptions_set_sync" C.(t @-> bool_to_uchar @-> returning void) 209 | 210 | let disable_WAL = 211 | foreign "rocksdb_writeoptions_disable_WAL" C.(t @-> Views.bool_to_int @-> returning void) 212 | 213 | end 214 | 215 | module Flush_options = struct 216 | 217 | type t = unit C.ptr 218 | let t : t C.typ = C.ptr C.void 219 | 220 | let create = 221 | foreign "rocksdb_flushoptions_create" C.(void @-> returning t) 222 | 223 | let destroy = 224 | foreign "rocksdb_flushoptions_destroy" C.(t @-> returning void) 225 | 226 | let wait = 227 | foreign "rocksdb_flushoptions_set_wait" C.(t @-> Views.bool_to_int @-> returning void) 228 | end 229 | 230 | 231 | module Read_options = struct 232 | 233 | type t = unit C.ptr 234 | let t : t C.typ = C.ptr C.void 235 | 236 | let create = 237 | foreign "rocksdb_readoptions_create" C.(void @-> returning t) 238 | 239 | let destroy = 240 | foreign "rocksdb_readoptions_destroy" C.(t @-> returning void) 241 | 242 | let set_verify_checksums = 243 | foreign "rocksdb_readoptions_set_verify_checksums" C.(t @-> bool_to_uchar @-> returning void) 244 | 245 | let set_fill_cache = 246 | foreign "rocksdb_readoptions_set_fill_cache" C.(t @-> bool_to_uchar @-> returning void) 247 | 248 | let set_tailing = 249 | foreign "rocksdb_readoptions_set_tailing" C.(t @-> bool_to_uchar @-> returning void) 250 | 251 | end 252 | 253 | module Batch = struct 254 | 255 | type t = unit C.ptr 256 | let t : t C.typ = C.ptr C.void 257 | 258 | let create = 259 | foreign "rocksdb_writebatch_create" C.(void @-> returning t) 260 | 261 | let destroy = 262 | foreign "rocksdb_writebatch_destroy" C.(t @-> returning void) 263 | 264 | let clear = 265 | foreign "rocksdb_writebatch_clear" C.(t @-> returning void) 266 | 267 | let count = 268 | foreign "rocksdb_writebatch_count" C.(t @-> returning int) 269 | 270 | let put = 271 | foreign "rocksdb_writebatch_put" 272 | C.(t @-> ocaml_string @-> int_to_size_t @-> ocaml_string @-> int_to_size_t @-> returning void) 273 | 274 | end 275 | 276 | module Iterator = struct 277 | 278 | type t = unit C.ptr 279 | let t : t C.typ = C.ptr C.void 280 | 281 | let create = 282 | foreign "rocksdb_create_iterator" C.(db @-> Read_options.t @-> returning t) 283 | 284 | let destroy = 285 | foreign "rocksdb_iter_destroy" C.(t @-> returning void) 286 | 287 | let valid = 288 | foreign "rocksdb_iter_valid" C.(t @-> returning bool_to_uchar) 289 | 290 | let seek_to_first = 291 | foreign "rocksdb_iter_seek_to_first" C.(t @-> returning void) 292 | 293 | let seek_to_last = 294 | foreign "rocksdb_iter_seek_to_last" C.(t @-> returning void) 295 | 296 | let seek = 297 | foreign "rocksdb_iter_seek" C.(t @-> ocaml_string @-> Views.int_to_size_t @-> returning void) 298 | 299 | let next = 300 | foreign "rocksdb_iter_next" C.(t @-> returning void) 301 | 302 | let prev = 303 | foreign "rocksdb_iter_prev" C.(t @-> returning void) 304 | 305 | let key = 306 | foreign "rocksdb_iter_key" C.(t @-> ptr int_to_size_t @-> returning (ptr char)) 307 | 308 | let value = 309 | foreign "rocksdb_iter_value" C.(t @-> ptr int_to_size_t @-> returning (ptr char)) 310 | 311 | end 312 | 313 | let put = 314 | foreign "rocksdb_put" 315 | C.(db @-> Write_options.t @-> ocaml_string @-> int_to_size_t @-> ocaml_string @-> int_to_size_t @-> ptr string_opt @-> returning void) 316 | 317 | let delete = 318 | foreign "rocksdb_delete" 319 | C.(db @-> Write_options.t @-> ocaml_string @-> int_to_size_t @-> ptr string_opt @-> returning void) 320 | 321 | let get = 322 | foreign "rocksdb_get" 323 | C.(db @-> Read_options.t @-> ocaml_string @-> int_to_size_t @-> ptr int_to_size_t @-> ptr string_opt @-> returning (ptr char)) 324 | 325 | let write = 326 | foreign "rocksdb_write" 327 | C.(db @-> Write_options.t @-> Batch.t @-> ptr string_opt @-> returning void) 328 | 329 | let flush = 330 | foreign "rocksdb_flush" 331 | C.(db @-> Flush_options.t @-> ptr string_opt @-> returning void) 332 | 333 | let compact_range = 334 | foreign "rocksdb_compact_range" 335 | C.(db @-> ptr_opt char @-> int @-> ptr_opt char @-> int @-> returning void) 336 | 337 | let property_value = 338 | foreign 339 | "rocksdb_property_value" 340 | C.(db @-> string @-> returning (ptr_opt char)) 341 | 342 | let free = 343 | foreign "rocksdb_free" C.(ptr void @-> returning void) 344 | 345 | end 346 | 347 | module PerfContext = struct 348 | 349 | 350 | type t = unit C.ptr 351 | let t : t C.typ = C.ptr C.void 352 | 353 | let create = 354 | foreign "rocksdb_perfcontext_create" C.(void @-> returning t) 355 | 356 | let reset = 357 | foreign "rocksdb_perfcontext_reset" C.(t @-> returning void) 358 | 359 | let destroy = 360 | foreign "rocksdb_perfcontext_destroy" C.(t @-> returning void) 361 | 362 | module Counters = struct 363 | 364 | type t = int64 365 | let t = Ctypes.int64_t 366 | 367 | include T 368 | 369 | end 370 | 371 | let metric = 372 | foreign "rocksdb_perfcontext_metric" C.(t @-> Counters.t @-> returning int) 373 | 374 | end 375 | end 376 | -------------------------------------------------------------------------------- /ffi/bindings/stubgen.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ocamlfind ocamlc -package ctypes -ccopt `cat ../lib/c_flags.txt` -output-obj ../structs/structs_stubgen.c -o structs_stubgen.o 4 | -------------------------------------------------------------------------------- /ffi/bindings/views.ml: -------------------------------------------------------------------------------- 1 | open Ctypes 2 | 3 | let bool_to_uchar = 4 | let open Unsigned in 5 | view 6 | ~read:(fun u -> u <> UChar.zero) 7 | ~write:(function true -> UChar.one | false -> UChar.zero) 8 | uchar 9 | 10 | let bool_to_int = 11 | view 12 | ~read:(fun u -> u <> 0) 13 | ~write:(function true -> 1 | false -> 0) 14 | int 15 | 16 | let int_of_compression = function 17 | | `No_compression -> 0 18 | | `Snappy -> 1 19 | | `Zlib -> 2 20 | | `Bz2 -> 3 21 | | `Lz4 -> 4 22 | | `Lz4hc -> 5 23 | | `Xpress -> 6 24 | | `Zstd -> 7 25 | 26 | let compression_view = 27 | let read = function 28 | | 0 -> `No_compression 29 | | 1 -> `Snappy 30 | | 2 -> `Zlib 31 | | 3 -> `Bz2 32 | | 4 -> `Lz4 33 | | 5 -> `Lz4hc 34 | | 6 -> `Xpress 35 | | 7 -> `Zstd 36 | | other -> invalid_arg @@ Printf.sprintf "read_compression_view: invalid compression type: %d" other 37 | in 38 | let write = int_of_compression in 39 | Ctypes.view ~read ~write Ctypes.int 40 | 41 | let int_to_uint64 = 42 | let open Unsigned in 43 | view ~write:UInt64.of_int ~read:UInt64.to_int Ctypes.uint64_t 44 | 45 | let int_to_size_t = 46 | let open Unsigned in 47 | view ~write:Size_t.of_int ~read:Size_t.to_int Ctypes.size_t 48 | 49 | let size_t_to_int = 50 | let open Unsigned in 51 | view ~write:Size_t.to_int ~read:Size_t.of_int Ctypes.int 52 | -------------------------------------------------------------------------------- /ffi/lib/config/discover.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | let minimum_rocks_version = "5.14" 4 | 5 | module C = Configurator.V1 6 | 7 | let () = C.main ~name:"librocksdb" begin fun c -> 8 | let link_flags = ["-lrocksdb"] in 9 | 10 | let known_paths = [ 11 | "/usr/local/include/rocksdb"; 12 | "/usr/include/rocksdb"; 13 | ] in 14 | 15 | let include_test = {| 16 | 17 | #include 18 | #include 19 | 20 | int main() { 21 | rocksdb_options_t* opt = rocksdb_options_create(); 22 | rocksdb_options_destroy(opt); 23 | return 0; 24 | }; 25 | 26 | |} 27 | in 28 | 29 | (* version.h includes (but the C api headers don't so c++ is not needed to actually compile the bindings, only to check the version) *) 30 | let c_flag = List.find_opt (fun c_flag -> C.c_test c ~c_flags:["-I" ^ c_flag; "-x"; "c++"] ~link_flags include_test) known_paths in 31 | 32 | match c_flag with 33 | | None -> 34 | 35 | eprintf "failed to find an include path for RocksDB: are development headers installed on your system ?\n"; 36 | eprintf "tested paths: %s\n" (String.concat " " known_paths); 37 | C.die "discover error" 38 | 39 | | Some c_flag -> try 40 | 41 | let version_path = c_flag ^ "/version.h" in 42 | (* too much configurator magic 43 | somehow gcc 12 with -O2 compiles the constant unused strings away and so the object file pattern search fails, printing would have just worked 44 | *) 45 | let assoc = C.C_define.import c ~c_flags:["-O0"; "-x"; "c++"] ~includes:[ version_path ] ["ROCKSDB_MAJOR", Int; "ROCKSDB_MINOR", Int] in 46 | let expect_int name = 47 | match List.assoc_opt name assoc with 48 | | Some (Int i) -> i 49 | | Some _ -> failwith (sprintf "%s is not an int in %s" name version_path) 50 | | None -> failwith (sprintf "could not find %s in %s" name version_path) 51 | in 52 | 53 | let major = expect_int "ROCKSDB_MAJOR" in 54 | let minor = expect_int "ROCKSDB_MINOR" in 55 | let version = sprintf "%d.%d" major minor in 56 | if (String.compare minimum_rocks_version version) > 0 then failwith (sprintf "installed RocksDB installation is too old: found %s, expected %s minimum" version minimum_rocks_version); 57 | 58 | C.Flags.write_sexp "c_flags.sexp" ["-I" ^ c_flag]; 59 | C.Flags.write_sexp "c_library_flags.sexp" link_flags; 60 | C.Flags.write_lines "c_flags.txt" ["-I" ^ c_flag]; 61 | C.Flags.write_lines "c_library_flags.txt" link_flags 62 | 63 | with Failure s -> C.die "failure: %s" s 64 | 65 | end 66 | -------------------------------------------------------------------------------- /ffi/lib/config/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name discover) 3 | (libraries dune-configurator)) 4 | -------------------------------------------------------------------------------- /ffi/lib/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets g.ml) 3 | (deps ../stubgen/ffi_stubgen.exe) 4 | (action (with-stdout-to %{targets} (run %{deps} -ml)))) 5 | 6 | (rule 7 | (targets rocksdb_stubs.c) 8 | (deps ../stubgen/ffi_stubgen.exe) 9 | (action (with-stdout-to %{targets} (run %{deps} -c))) 10 | ) 11 | 12 | (library 13 | (name rocksdb_ffi) 14 | (public_name ahrocksdb.ffi) 15 | (modules g m) 16 | (c_names rocksdb_stubs) 17 | (flags (:standard -w -9-27-32-34)) 18 | (c_library_flags (:include c_library_flags.sexp)) 19 | (c_flags (:include c_flags.sexp) -Wno-discarded-qualifiers) 20 | (libraries ahrocksdb.bindings ctypes.stubs ctypes) 21 | ) 22 | 23 | (rule 24 | (targets c_flags.sexp c_library_flags.sexp c_flags.txt c_library_flags.txt) 25 | (deps (:discover config/discover.exe)) 26 | (action (run %{discover}))) 27 | -------------------------------------------------------------------------------- /ffi/lib/m.ml: -------------------------------------------------------------------------------- 1 | include Rocksdb_bindings.M(G) 2 | -------------------------------------------------------------------------------- /ffi/structs/driver.ml: -------------------------------------------------------------------------------- 1 | let prologue = " 2 | #include 3 | " 4 | 5 | let () = 6 | print_endline prologue; 7 | Cstubs_structs.write_c Format.std_formatter (module Rocksdb_types.Struct_stubs) 8 | -------------------------------------------------------------------------------- /ffi/structs/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets structs_stubgen.c) 3 | (deps driver.exe) 4 | (action (with-stdout-to %{targets} (run %{deps} -c))) 5 | ) 6 | 7 | (executable 8 | (name driver) 9 | (modules driver) 10 | (libraries rocksdb_types ctypes.stubs ctypes) 11 | ) 12 | 13 | (library 14 | (name rocksdb_types) 15 | (public_name ahrocksdb.types) 16 | (modules rocksdb_types) 17 | (libraries ctypes.stubs ctypes) 18 | ) 19 | -------------------------------------------------------------------------------- /ffi/structs/rocksdb_types.ml: -------------------------------------------------------------------------------- 1 | module Struct_stubs(S : Ctypes.TYPE) = struct 2 | 3 | open S 4 | 5 | let user_key_comparison_count = constant "rocksdb_user_key_comparison_count" int64_t 6 | let block_cache_hit_count = constant "rocksdb_block_cache_hit_count" int64_t 7 | let block_read_count = constant "rocksdb_block_read_count" int64_t 8 | let block_read_byte = constant "rocksdb_block_read_byte" int64_t 9 | let block_read_time = constant "rocksdb_block_read_time" int64_t 10 | let block_checksum_time = constant "rocksdb_block_checksum_time" int64_t 11 | let block_decompress_time = constant "rocksdb_block_decompress_time" int64_t 12 | let get_read_bytes = constant "rocksdb_get_read_bytes" int64_t 13 | let multiget_read_bytes = constant "rocksdb_multiget_read_bytes" int64_t 14 | let iter_read_bytes = constant "rocksdb_iter_read_bytes" int64_t 15 | let internal_key_skipped_count = constant "rocksdb_internal_key_skipped_count" int64_t 16 | let internal_delete_skipped_count = constant "rocksdb_internal_delete_skipped_count" int64_t 17 | let internal_recent_skipped_count = constant "rocksdb_internal_recent_skipped_count" int64_t 18 | let internal_merge_count = constant "rocksdb_internal_merge_count" int64_t 19 | let get_snapshot_time = constant "rocksdb_get_snapshot_time" int64_t 20 | let get_from_memtable_time = constant "rocksdb_get_from_memtable_time" int64_t 21 | let get_from_memtable_count = constant "rocksdb_get_from_memtable_count" int64_t 22 | let get_post_process_time = constant "rocksdb_get_post_process_time" int64_t 23 | let get_from_output_files_time = constant "rocksdb_get_from_output_files_time" int64_t 24 | let seek_on_memtable_time = constant "rocksdb_seek_on_memtable_time" int64_t 25 | let seek_on_memtable_count = constant "rocksdb_seek_on_memtable_count" int64_t 26 | let next_on_memtable_count = constant "rocksdb_next_on_memtable_count" int64_t 27 | let prev_on_memtable_count = constant "rocksdb_prev_on_memtable_count" int64_t 28 | let seek_child_seek_time = constant "rocksdb_seek_child_seek_time" int64_t 29 | let seek_child_seek_count = constant "rocksdb_seek_child_seek_count" int64_t 30 | let seek_min_heap_time = constant "rocksdb_seek_min_heap_time" int64_t 31 | let seek_max_heap_time = constant "rocksdb_seek_max_heap_time" int64_t 32 | let seek_internal_seek_time = constant "rocksdb_seek_internal_seek_time" int64_t 33 | let find_next_user_entry_time = constant "rocksdb_find_next_user_entry_time" int64_t 34 | let write_wal_time = constant "rocksdb_write_wal_time" int64_t 35 | let write_memtable_time = constant "rocksdb_write_memtable_time" int64_t 36 | let write_delay_time = constant "rocksdb_write_delay_time" int64_t 37 | let write_pre_and_post_process_time = constant "rocksdb_write_pre_and_post_process_time" int64_t 38 | let db_mutex_lock_nanos = constant "rocksdb_db_mutex_lock_nanos" int64_t 39 | let db_condition_wait_nanos = constant "rocksdb_db_condition_wait_nanos" int64_t 40 | let merge_operator_time_nanos = constant "rocksdb_merge_operator_time_nanos" int64_t 41 | let read_index_block_nanos = constant "rocksdb_read_index_block_nanos" int64_t 42 | let read_filter_block_nanos = constant "rocksdb_read_filter_block_nanos" int64_t 43 | let new_table_block_iter_nanos = constant "rocksdb_new_table_block_iter_nanos" int64_t 44 | let new_table_iterator_nanos = constant "rocksdb_new_table_iterator_nanos" int64_t 45 | let block_seek_nanos = constant "rocksdb_block_seek_nanos" int64_t 46 | let find_table_nanos = constant "rocksdb_find_table_nanos" int64_t 47 | let bloom_memtable_hit_count = constant "rocksdb_bloom_memtable_hit_count" int64_t 48 | let bloom_memtable_miss_count = constant "rocksdb_bloom_memtable_miss_count" int64_t 49 | let bloom_sst_hit_count = constant "rocksdb_bloom_sst_hit_count" int64_t 50 | let bloom_sst_miss_count = constant "rocksdb_bloom_sst_miss_count" int64_t 51 | let key_lock_wait_time = constant "rocksdb_key_lock_wait_time" int64_t 52 | let key_lock_wait_count = constant "rocksdb_key_lock_wait_count" int64_t 53 | let env_new_sequential_file_nanos = constant "rocksdb_env_new_sequential_file_nanos" int64_t 54 | let env_new_random_access_file_nanos = constant "rocksdb_env_new_random_access_file_nanos" int64_t 55 | let env_new_writable_file_nanos = constant "rocksdb_env_new_writable_file_nanos" int64_t 56 | let env_reuse_writable_file_nanos = constant "rocksdb_env_reuse_writable_file_nanos" int64_t 57 | let env_new_random_rw_file_nanos = constant "rocksdb_env_new_random_rw_file_nanos" int64_t 58 | let env_new_directory_nanos = constant "rocksdb_env_new_directory_nanos" int64_t 59 | let env_file_exists_nanos = constant "rocksdb_env_file_exists_nanos" int64_t 60 | let env_get_children_nanos = constant "rocksdb_env_get_children_nanos" int64_t 61 | let env_get_children_file_attributes_nanos = constant "rocksdb_env_get_children_file_attributes_nanos" int64_t 62 | let env_delete_file_nanos = constant "rocksdb_env_delete_file_nanos" int64_t 63 | let env_create_dir_nanos = constant "rocksdb_env_create_dir_nanos" int64_t 64 | let env_create_dir_if_missing_nanos = constant "rocksdb_env_create_dir_if_missing_nanos" int64_t 65 | let env_delete_dir_nanos = constant "rocksdb_env_delete_dir_nanos" int64_t 66 | let env_get_file_size_nanos = constant "rocksdb_env_get_file_size_nanos" int64_t 67 | let env_get_file_modification_time_nanos = constant "rocksdb_env_get_file_modification_time_nanos" int64_t 68 | let env_rename_file_nanos = constant "rocksdb_env_rename_file_nanos" int64_t 69 | let env_link_file_nanos = constant "rocksdb_env_link_file_nanos" int64_t 70 | let env_lock_file_nanos = constant "rocksdb_env_lock_file_nanos" int64_t 71 | let env_unlock_file_nanos = constant "rocksdb_env_unlock_file_nanos" int64_t 72 | let env_new_logger_nanos = constant "rocksdb_env_new_logger_nanos" int64_t 73 | let total_metric_count = constant "rocksdb_total_metric_count" int64_t 74 | 75 | end 76 | -------------------------------------------------------------------------------- /ffi/stubgen/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name ffi_stubgen) 3 | (modules ffi_stubgen) 4 | (libraries rocksdb_bindings ctypes.stubs ctypes) 5 | ) -------------------------------------------------------------------------------- /ffi/stubgen/ffi_stubgen.ml: -------------------------------------------------------------------------------- 1 | let prefix = "rocksdb_stub" 2 | 3 | let prologue = " 4 | #include 5 | " 6 | 7 | let () = 8 | let generate_ml, generate_c = ref false, ref false in 9 | let () = 10 | Arg.(parse [ ("-ml", Set generate_ml, "Generate ML"); 11 | ("-c", Set generate_c, "Generate C") ]) 12 | (fun _ -> failwith "unexpected anonymous argument") 13 | "stubgen [-ml|-c]" 14 | in 15 | match !generate_ml, !generate_c with 16 | | false, false 17 | | true, true -> 18 | failwith "Exactly one of -ml and -c must be specified" 19 | | true, false -> 20 | Cstubs.write_ml Format.std_formatter ~prefix (module Rocksdb_bindings.M) 21 | | false, true -> 22 | print_endline prologue; 23 | Cstubs.write_c Format.std_formatter ~prefix (module Rocksdb_bindings.M) 24 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name rocksdb) 3 | (public_name ahrocksdb) 4 | (flags :standard -w -unerasable-optional-argument) 5 | (libraries ahrocksdb.ffi astring rresult) 6 | ) 7 | -------------------------------------------------------------------------------- /lib/misc.ml: -------------------------------------------------------------------------------- 1 | module Opt = struct 2 | 3 | let iter o f = 4 | match o with 5 | | Some v -> f v 6 | | None -> () 7 | 8 | let get_or ~default = function 9 | | Some value -> value 10 | | None -> Lazy.force default 11 | 12 | let (>>=) = iter 13 | 14 | end 15 | -------------------------------------------------------------------------------- /lib/rocksdb.ml: -------------------------------------------------------------------------------- 1 | module Ffi = Rocksdb_ffi.M 2 | module Rocksdb = Ffi.Rocksdb 3 | 4 | module Options = Rocksdb_options 5 | 6 | open Ctypes 7 | 8 | type error = [ `Msg of string ] 9 | 10 | let msg s = Error (`Msg s) 11 | 12 | type db = { 13 | config: Options.config; 14 | db: Rocksdb.db; 15 | } 16 | 17 | module Desc = struct 18 | 19 | let kind = "rocksdb_db" 20 | type t = db 21 | 22 | end 23 | module W = Wrap.Wrap(Desc) 24 | open W 25 | 26 | type t = W.t 27 | 28 | let close_db t = 29 | match unwrap t (fun { db; _ } -> Ok (Rocksdb.close db)) with 30 | | Ok () -> 31 | t.valid <- false; 32 | Ok () 33 | | Error _ -> msg "trying to close a database handle already closed" 34 | 35 | let with_error_buffer fn = 36 | let errb = allocate string_opt None in 37 | let result = fn errb in 38 | match !@ errb with 39 | | None -> Ok result 40 | | Some err -> msg err 41 | 42 | let open_db ~config ~name = 43 | let options = Options.of_config config in 44 | match with_error_buffer @@ Rocksdb.open_ options name with 45 | | Ok db -> 46 | let t = wrap { db; config; } in 47 | Gc.finalise (fun t -> on_finalise t (fun { db; _ } -> Rocksdb.close db)) t; 48 | Ok t 49 | | Error e -> Error e 50 | 51 | let open_db_read_only ?fail_on_wal:(fail=false) ~config ~name = 52 | let options = Options.of_config config in 53 | match with_error_buffer @@ Rocksdb.open_read_only options name fail with 54 | | Ok db -> 55 | let t = wrap { db; config; } in 56 | Gc.finalise (fun t -> on_finalise t (fun { db; _ } -> Rocksdb.close db)) t; 57 | Ok t 58 | | Error err -> Error err 59 | 60 | let open_db_with_ttl ~config ~name ~ttl = 61 | let options = Options.of_config config in 62 | match with_error_buffer @@ Rocksdb.open_with_ttl options name ttl with 63 | | Ok db -> 64 | let t = wrap { db; config; } in 65 | Gc.finalise (fun t -> on_finalise t (fun { db; _ } -> Rocksdb.close db)) t; 66 | Ok t 67 | | Error err -> Error err 68 | 69 | let put db write_options ~key ~value = 70 | let key_len = String.length key in 71 | let value_len = String.length value in 72 | unwrap db @@ fun { db; _ } -> 73 | Rocksdb.put db write_options (ocaml_string_start key) key_len (ocaml_string_start value) value_len 74 | |> with_error_buffer 75 | 76 | let delete db write_options key = 77 | let key_len = String.length key in 78 | unwrap db @@ fun { db; _ } -> 79 | Rocksdb.delete db write_options (ocaml_string_start key) key_len 80 | |> with_error_buffer 81 | 82 | let get db read_options key = 83 | let key_len = String.length key in 84 | let result_len = allocate Ffi.V.int_to_size_t 0 in 85 | let result = unwrap db @@ fun { db; _ } -> 86 | with_error_buffer @@ Rocksdb.get db read_options (ocaml_string_start key) key_len result_len 87 | in 88 | match result with 89 | | Error err -> Error err 90 | | Ok result_ptr -> 91 | match Ctypes.is_null (to_voidp result_ptr) with 92 | | true -> Ok `Not_found 93 | | false -> 94 | let result = string_from_ptr result_ptr ~length:(!@ result_len) in 95 | Gc.finalise (fun result_ptr -> Rocksdb.free (to_voidp result_ptr)) result_ptr; 96 | Ok (`Found result) 97 | 98 | let flush db flush_options = 99 | unwrap db @@ fun { db; _ } -> 100 | Rocksdb.flush db flush_options 101 | |> with_error_buffer 102 | 103 | let compact_now db = 104 | unwrap db @@ fun { db; _ } -> 105 | Ok (Rocksdb.compact_range db None 0 None 0) 106 | 107 | let stats db = 108 | unwrap db @@ fun { db; _ } -> 109 | match Rocksdb.property_value db "rocksdb.stats" with 110 | | None -> Ok None 111 | | Some stats -> 112 | let string = coerce (ptr char) string stats in 113 | Gc.finalise (fun stats -> Rocksdb.free (to_voidp stats)) stats; 114 | Ok (Some string) 115 | 116 | let get_cache_usage db = 117 | unwrap db @@ fun { config; _ } -> 118 | match config.block_cache with 119 | | Some cache -> Ok (Options.Cache.LRU.get_usage cache) 120 | | None -> msg "get_cache_usage: no cache was set for this database" 121 | 122 | module Batch = struct 123 | 124 | open Rocksdb 125 | 126 | type batch = Batch.t 127 | 128 | let create () = 129 | let t = Batch.create () in 130 | Gc.finalise Batch.destroy t; 131 | t 132 | 133 | let count = Batch.count 134 | 135 | let clear = Batch.clear 136 | 137 | let put batch ~key ~value = 138 | let key_len = String.length key in 139 | let value_len = String.length value in 140 | Batch.put batch (ocaml_string_start key) key_len (ocaml_string_start value) value_len 141 | 142 | let write db write_options batch = 143 | unwrap db @@ fun { db; _ } -> 144 | Rocksdb.write db write_options batch |> with_error_buffer 145 | 146 | let simple_write_batch db write_options elts = 147 | let batch = create () in 148 | List.iter (fun (key, value) -> put batch ~key ~value) elts; 149 | write db write_options batch 150 | 151 | end 152 | 153 | module Iterator = struct 154 | 155 | open Rocksdb 156 | 157 | type iterator = Iterator.t 158 | 159 | let create db read_options = 160 | unwrap db @@ fun { db; _ } -> 161 | let t = Iterator.create db read_options in 162 | Gc.finalise Iterator.destroy t; 163 | Ok t 164 | 165 | let seek t key = 166 | let len = String.length key in 167 | Iterator.seek t (ocaml_string_start key) len 168 | 169 | let next = Iterator.next 170 | 171 | let get_key t = 172 | let result_len = allocate Ffi.V.int_to_size_t 0 in 173 | let result = Iterator.key t result_len in 174 | match Ctypes.is_null (to_voidp result) with 175 | | true -> raise Not_found 176 | | false -> 177 | let result_s = string_from_ptr result ~length:(!@ result_len) in 178 | result_s 179 | 180 | let get_value t = 181 | let result_len = allocate Ffi.V.int_to_size_t 0 in 182 | let result = Iterator.value t result_len in 183 | match Ctypes.is_null (to_voidp result) with 184 | | true -> raise Not_found 185 | | false -> 186 | let result_s = string_from_ptr result ~length:(!@ result_len) in 187 | result_s 188 | 189 | let is_valid = Iterator.valid 190 | 191 | let get t = 192 | if is_valid t then begin 193 | try 194 | let key = get_key t in 195 | let value = get_value t in 196 | Some (key, value) 197 | with 198 | | Not_found -> None 199 | end 200 | else None 201 | 202 | end 203 | 204 | module Perf_context = struct 205 | 206 | type perf_context = Ffi.PerfContext.t 207 | type counter = Ffi.PerfContext.Counters.t 208 | 209 | module Counters = Ffi.PerfContext.Counters 210 | 211 | let create () = 212 | let t = Ffi.PerfContext.create () in 213 | Gc.finalise Ffi.PerfContext.destroy t; 214 | t 215 | 216 | let reset = Ffi.PerfContext.reset 217 | 218 | let metric = Ffi.PerfContext.metric 219 | 220 | end 221 | -------------------------------------------------------------------------------- /lib/rocksdb.mli: -------------------------------------------------------------------------------- 1 | (** A binding to RocksDB 2 | 3 | This library is a binding to Facebook's RocksDB library. 4 | This library attempts to provide a layer on top of Rock's C FFI adapting it as 5 | much as possible to OCaml idioms. 6 | It aims to cover most of the C FFI in the long run, along with tests to ensure 7 | no function is left never called and untested. 8 | 9 | *) 10 | 11 | type error = [ `Msg of string ] 12 | 13 | 14 | module Options : sig 15 | 16 | (** High-level bindings for RocksDB open options 17 | 18 | This module provides a binding to the open options available in Rock's C FFIs. 19 | It provides a type [config] which holds the configuration options for opening a Rocksdb database. 20 | Configuration settings are then mapped to the appropriate FFI calls when the database is opened. 21 | 22 | *) 23 | 24 | module Filter_policy : sig 25 | 26 | (** Filter policy bindings 27 | 28 | This module is used to create a bloom filter to be set in the {!config} type. 29 | More information about the different bloom filter kinds available here: https://github.com/facebook/rocksdb/wiki/RocksDB-Bloom-Filter 30 | *) 31 | 32 | type t 33 | 34 | val create_bloom : bits_per_key:int -> t 35 | val create_bloom_full : bits_per_key:int -> t 36 | 37 | end 38 | 39 | module Cache : sig 40 | 41 | (** Block-caching facilities 42 | 43 | This module is used to instantiate cache objects that can be set in the {!config} type. 44 | See: https://github.com/facebook/rocksdb/wiki/Block-Cache 45 | *) 46 | 47 | type t 48 | 49 | module LRU : sig 50 | 51 | (** [create size] will create a new LRU cache object of size [size] (in bytes) *) 52 | val create : size:int -> t 53 | 54 | end 55 | 56 | end 57 | 58 | module Tables : sig 59 | 60 | type format 61 | 62 | (** Table format facilities bindings 63 | See: https://github.com/facebook/rocksdb/wiki/A-Tutorial-of-RocksDB-SST-formats 64 | *) 65 | 66 | module Block_based : sig 67 | 68 | val create : block_size:int -> format 69 | 70 | end 71 | 72 | end 73 | 74 | (** Write options *) 75 | module Write_options : sig 76 | 77 | type t 78 | 79 | val create : ?disable_wal:bool -> ?sync:bool -> unit -> t 80 | (** [create disable_wal sync] returns a new WriteOptions object to be used to 81 | configure write operations on a RocksDB database. 82 | TODO 83 | *) 84 | 85 | end 86 | 87 | (** Flush options *) 88 | module Flush_options : sig 89 | 90 | type t 91 | 92 | val create : ?wait:bool -> unit -> t 93 | (** [create wait] returns a new FlushOptions object to be used to 94 | configure Flush operations on a RocksDB database. 95 | TODO 96 | *) 97 | 98 | end 99 | 100 | (** Read options *) 101 | module Read_options : sig 102 | 103 | type t 104 | 105 | val create : ?verify_checksums:bool -> ?fill_cache:bool -> ?tailing:bool -> unit -> t 106 | (** [create verify_checksums fill_cache tailing] returns a new ReadOptions object to be used to 107 | configure read operations on a RocksDB database. 108 | TODO 109 | *) 110 | 111 | end 112 | 113 | (** Compression algorithms supported by RocksDB *) 114 | type compression = [ 115 | | `Bz2 116 | | `Lz4 117 | | `Lz4hc 118 | | `No_compression 119 | | `Snappy 120 | | `Xpress 121 | | `Zlib 122 | | `Zstd 123 | ] 124 | 125 | (** RocksDB main configuration record *) 126 | type config = { 127 | parallelism_level : int option; (** Number of background processes used by RocksDB *) 128 | base_compression : compression; (** Compression algorithm used to compact data at base level*) 129 | compression_by_level : compression list; (** Compression algorithm used to compact data in order for each level*) 130 | optimize_filters_for_hits: bool option; 131 | disable_compaction : bool; (** Disable compaction: data will not be compressed, but manual compaction can still be issued *) 132 | max_flush_processes : int option; (** Number of background workers dedicated to flush *) 133 | compaction_trigger : int option; (** Maximum size for a file in level0 to wait for initiating compaction *) 134 | slowdown_writes_trigger : int option; (** TODO *) 135 | stop_writes_trigger : int option; (** TODO *) 136 | memtable_representation : [ `Vector ] option; 137 | num_levels : int option; 138 | write_buffer_size : int option; 139 | max_write_buffer_number : int option; 140 | min_write_buffer_number_to_merge : int option; 141 | target_base_file_size : int option; 142 | max_bytes_for_level_base : int option; 143 | max_bytes_for_level_multiplier : float option; 144 | table_format : Tables.format option; 145 | max_open_files : int option; 146 | create_if_missing : bool; 147 | filter_policy : Filter_policy.t option; 148 | cache_index_and_filter_blocks : bool; 149 | block_cache : Cache.t option; 150 | trace_perf : bool; 151 | bulk_load : bool; 152 | } 153 | 154 | (** default configuration, only compression is set to `Snappy, everything else is None (RocksDB defaults will apply) *) 155 | val default : config 156 | 157 | 158 | end 159 | 160 | (** Opaque database handle *) 161 | type t 162 | 163 | val open_db : config:Options.config -> name:string -> (t, error) result 164 | (** [open_db options name] will return an handle to the database in case 165 | of success or the error returned by RocksDB in case of failure. 166 | [name] is the path to the database. 167 | *) 168 | 169 | val open_db_read_only : ?fail_on_wal:bool -> config:Options.config -> name:string -> (t, error) result 170 | (** [open_db options name] will return a read-only handle to the database in case 171 | of success or the error returned by RocksDB in case of failure. 172 | [name] is the path to the database. 173 | [fail_on_wal] returns an error if write log is not empty 174 | *) 175 | 176 | val open_db_with_ttl : config:Options.config -> name:string -> ttl:int -> (t, error) result 177 | (** [open_db_with_ttl options name ttl] will return an handle to the database in case 178 | of success or the error returned by RocksDB in case of failure. 179 | [name] is the path to the database. 180 | [ttl] Time in seconds after which a key should be removed (best-effort basis, during compaction) 181 | *) 182 | 183 | val put : t -> Options.Write_options.t -> key:string -> value:string -> (unit, error) result 184 | (** [put db write_options key value] will write at key [key] the value [value], on database [db]. 185 | Return unit on success, RocksDB reported error on error. 186 | *) 187 | 188 | val delete : t -> Options.Write_options.t -> string -> (unit, error) result 189 | (** [delete db write_options key] will delete key [key] on database [db]. 190 | Return unit on success, RocksDB reported error on error. 191 | *) 192 | 193 | val get : t -> Options.Read_options.t -> string -> ([ `Not_found | `Found of string ], error) result 194 | (** [get db read_options key] will fetch key [key] on database [db]. 195 | Returns `Ok value if the key is found, `Not_found otherwise, and `Error if a failure occurred. 196 | *) 197 | 198 | val flush : t -> Options.Flush_options.t -> (unit, error) result 199 | (** [flush db flush_options] will flush all pending memtables on database [db]. 200 | Return unit on success, RocksDB reported error on error. 201 | *) 202 | 203 | val compact_now : t -> (unit, error) result 204 | (** [compact_now db] will initiate a compaction on all ranges available in database. This is an asynchronous operation, returning unit once operation is started. *) 205 | 206 | val stats : t -> (string option, error) result 207 | (** [stats db] will return the accumulated stats for this database handle as an optional string form *) 208 | 209 | val get_cache_usage : t -> (int, error) result 210 | 211 | val close_db : t -> (unit, error) result 212 | (** [close db] explicitly closes the db handle. Any further access will raise an error *) 213 | 214 | (** Batch processing 215 | RocksDB allows to batch operations through a dedicated batch object that must be fed to {!write}. 216 | A batch object {!Batch.batch} is a collection of operation to run on a database. (like {!Batch.put} or delete). 217 | *) 218 | module Batch : sig 219 | 220 | (** An opaque batch request must be created through {!create} and executed through {!write} *) 221 | type batch 222 | 223 | (** [create] will create a batch job to be used to batch operation on the database. *) 224 | val create : unit -> batch 225 | 226 | (** [count] number of operations in the batch object *) 227 | val count : batch -> int 228 | 229 | (** clear operations from the batch object *) 230 | val clear : batch -> unit 231 | 232 | (** [put batch key value] will take a [batch] job and stage the writing of the [key] key and [value] value in the batch job. *) 233 | val put : batch -> key:string -> value:string -> unit 234 | 235 | (** [write db write_options batch] takes a [db] handle, some [write_options] and a [batch] job and execute it on the database. *) 236 | val write : t -> Options.Write_options.t -> batch -> (unit, error) result 237 | 238 | (** A simple helper, will take a list of key_value and do a unique batch and write it to the database *) 239 | val simple_write_batch : t -> Options.Write_options.t -> (string * string) list -> (unit, error) result 240 | 241 | end 242 | 243 | module Iterator : sig 244 | 245 | type iterator 246 | 247 | val create : t -> Options.Read_options.t -> (iterator, error) result 248 | 249 | (** [seek iterator prefix] will set the iterator [t] in seek mode, iterating on keys starting by [prefix] *) 250 | val seek : iterator -> string -> unit 251 | 252 | (** [get iterator] will get the current key value pair on iterator [t]. Calling it multiple time in a row with no change of position results in the same pair being returned *) 253 | val get : iterator -> (string * string) option 254 | 255 | (** [next iterator] will set the iterator to the next key in the range. pair on iterator [t]. 256 | Be mindful of the fact that you need to check if the iterator is still valid via {!is_valid}, and that according to RocksDB documentation, in prefix mode, 257 | you should make sure that the key is indeed starting by your prefix as your ending condition while iterating, since after finishing the range, RocksDB might return the next range after it. 258 | See https://github.com/facebook/rocksdb/wiki/Prefix-Seek-API-Changes#transition-to-the-new-usage 259 | *) 260 | val next : iterator -> unit 261 | 262 | val is_valid : iterator -> bool 263 | 264 | end 265 | 266 | module Perf_context : sig 267 | 268 | 269 | (** Perf context counters bindings 270 | See: https://github.com/facebook/rocksdb/wiki/Perf-Context-and-IO-Stats-Context 271 | *) 272 | 273 | type perf_context 274 | type counter 275 | 276 | module Counters : sig 277 | 278 | val user_key_comparison_count : counter 279 | val block_cache_hit_count : counter 280 | val block_read_count : counter 281 | val block_read_byte : counter 282 | val block_read_time : counter 283 | val block_checksum_time : counter 284 | val block_decompress_time : counter 285 | val get_read_bytes : counter 286 | val multiget_read_bytes : counter 287 | val iter_read_bytes : counter 288 | val internal_key_skipped_count : counter 289 | val internal_delete_skipped_count : counter 290 | val internal_recent_skipped_count : counter 291 | val internal_merge_count : counter 292 | val get_snapshot_time : counter 293 | val get_from_memtable_time : counter 294 | val get_from_memtable_count : counter 295 | val get_post_process_time : counter 296 | val get_from_output_files_time : counter 297 | val seek_on_memtable_time : counter 298 | val seek_on_memtable_count : counter 299 | val next_on_memtable_count : counter 300 | val prev_on_memtable_count : counter 301 | val seek_child_seek_time : counter 302 | val seek_child_seek_count : counter 303 | val seek_min_heap_time : counter 304 | val seek_max_heap_time : counter 305 | val seek_internal_seek_time : counter 306 | val find_next_user_entry_time : counter 307 | val write_wal_time : counter 308 | val write_memtable_time : counter 309 | val write_delay_time : counter 310 | val write_pre_and_post_process_time : counter 311 | val db_mutex_lock_nanos : counter 312 | val db_condition_wait_nanos : counter 313 | val merge_operator_time_nanos : counter 314 | val read_index_block_nanos : counter 315 | val read_filter_block_nanos : counter 316 | val new_table_block_iter_nanos : counter 317 | val new_table_iterator_nanos : counter 318 | val block_seek_nanos : counter 319 | val find_table_nanos : counter 320 | val bloom_memtable_hit_count : counter 321 | val bloom_memtable_miss_count : counter 322 | val bloom_sst_hit_count : counter 323 | val bloom_sst_miss_count : counter 324 | val key_lock_wait_time : counter 325 | val key_lock_wait_count : counter 326 | val env_new_sequential_file_nanos : counter 327 | val env_new_random_access_file_nanos : counter 328 | val env_new_writable_file_nanos : counter 329 | val env_reuse_writable_file_nanos : counter 330 | val env_new_random_rw_file_nanos : counter 331 | val env_new_directory_nanos : counter 332 | val env_file_exists_nanos : counter 333 | val env_get_children_nanos : counter 334 | val env_get_children_file_attributes_nanos : counter 335 | val env_delete_file_nanos : counter 336 | val env_create_dir_nanos : counter 337 | val env_create_dir_if_missing_nanos : counter 338 | val env_delete_dir_nanos : counter 339 | val env_get_file_size_nanos : counter 340 | val env_get_file_modification_time_nanos : counter 341 | val env_rename_file_nanos : counter 342 | val env_link_file_nanos : counter 343 | val env_lock_file_nanos : counter 344 | val env_unlock_file_nanos : counter 345 | val env_new_logger_nanos : counter 346 | val total_metric_count : counter 347 | 348 | end 349 | 350 | val create : unit -> perf_context 351 | 352 | 353 | val reset : perf_context -> unit 354 | val metric : perf_context -> counter -> int 355 | 356 | end 357 | -------------------------------------------------------------------------------- /lib/rocksdb_options.ml: -------------------------------------------------------------------------------- 1 | module Ffi = Rocksdb_ffi.M 2 | module Rocksdb = Ffi.Rocksdb 3 | 4 | open Ffi.Options 5 | 6 | module Filter_policy = struct 7 | 8 | type t = FilterPolicy.t 9 | 10 | let create_bloom ~bits_per_key = FilterPolicy.create_bloom bits_per_key 11 | let create_bloom_full ~bits_per_key = FilterPolicy.create_bloom_full bits_per_key 12 | 13 | end 14 | 15 | module Cache = struct 16 | 17 | type t = Cache.t 18 | 19 | module LRU = struct 20 | 21 | let create ~size = Cache.create size 22 | let get_usage t = Cache.get_usage t 23 | 24 | end 25 | 26 | end 27 | 28 | module Tables = struct 29 | 30 | open Tables 31 | 32 | type format = Block_based of BlockBased.t 33 | 34 | module Block_based = struct 35 | 36 | let create ~block_size = 37 | let t = BlockBased.create () in 38 | BlockBased.set_block_size t block_size; 39 | Gc.finalise BlockBased.destroy t; 40 | Block_based t 41 | 42 | let set_filter_policy t filter_policy = BlockBased.set_filter_policy t filter_policy 43 | let set_cache_index_and_filter_blocks t b = BlockBased.set_cache_index_and_filter_blocks t b 44 | let set_block_cache t cache = BlockBased.set_block_cache t cache 45 | 46 | end 47 | 48 | end 49 | 50 | (** Actual configuration handling **) 51 | 52 | 53 | type t = options 54 | 55 | let create () = 56 | let t = create () in 57 | Gc.finalise destroy t; 58 | t 59 | 60 | type compression = [ 61 | | `Bz2 62 | | `Lz4 63 | | `Lz4hc 64 | | `No_compression 65 | | `Snappy 66 | | `Xpress 67 | | `Zlib 68 | | `Zstd 69 | ] 70 | 71 | type config = { 72 | parallelism_level : int option; 73 | base_compression : compression; 74 | compression_by_level : compression list; 75 | optimize_filters_for_hits: bool option; 76 | disable_compaction : bool; 77 | max_flush_processes : int option; 78 | compaction_trigger : int option; 79 | slowdown_writes_trigger : int option; 80 | stop_writes_trigger : int option; 81 | memtable_representation : [ `Vector ] option; 82 | num_levels : int option; 83 | write_buffer_size : int option; 84 | max_write_buffer_number : int option; 85 | min_write_buffer_number_to_merge : int option; 86 | target_base_file_size : int option; 87 | max_bytes_for_level_base : int option; 88 | max_bytes_for_level_multiplier : float option; 89 | table_format : Tables.format option; 90 | max_open_files : int option; 91 | create_if_missing : bool; 92 | filter_policy : Filter_policy.t option; 93 | cache_index_and_filter_blocks : bool; 94 | block_cache : Cache.t option; 95 | trace_perf : bool; 96 | bulk_load : bool; 97 | } 98 | 99 | let of_config { 100 | parallelism_level; 101 | base_compression; 102 | compression_by_level; 103 | optimize_filters_for_hits; 104 | disable_compaction; 105 | max_flush_processes; 106 | compaction_trigger; 107 | slowdown_writes_trigger; 108 | stop_writes_trigger; 109 | memtable_representation; 110 | num_levels; 111 | target_base_file_size; 112 | max_bytes_for_level_base; 113 | max_bytes_for_level_multiplier; 114 | table_format; 115 | write_buffer_size; 116 | max_write_buffer_number; 117 | max_open_files; 118 | min_write_buffer_number_to_merge; 119 | create_if_missing; 120 | filter_policy; 121 | block_cache; 122 | cache_index_and_filter_blocks; 123 | bulk_load; 124 | trace_perf=_; 125 | } = 126 | 127 | let options = create () in 128 | 129 | (* applying options belonging to the RocksDB options object itself *) 130 | 131 | let open Misc.Opt in 132 | 133 | set_create_if_missing options create_if_missing; 134 | set_compression options base_compression; 135 | set_disable_auto_compactions options disable_compaction; 136 | 137 | parallelism_level >>= increase_parallelism options; 138 | optimize_filters_for_hits >>= set_optimize_filters_for_hits options; 139 | max_flush_processes >>= set_max_background_flushes options; 140 | compaction_trigger >>= set_level0_file_num_compaction_trigger options; 141 | slowdown_writes_trigger >>= set_level0_slowdown_writes_trigger options; 142 | stop_writes_trigger >>= set_level0_stop_writes_trigger options; 143 | target_base_file_size >>= set_target_file_size_base options; 144 | max_bytes_for_level_base >>= set_max_bytes_for_level_base options; 145 | max_bytes_for_level_multiplier >>= set_max_bytes_for_level_multiplier options; 146 | num_levels >>= set_num_levels options; 147 | write_buffer_size >>= set_write_buffer_size options; 148 | max_write_buffer_number >>= set_max_write_buffer_number options; 149 | min_write_buffer_number_to_merge >>= set_min_write_buffer_number_to_merge options; 150 | max_open_files >>= set_max_open_files options; 151 | 152 | (match memtable_representation with 153 | | Some `Vector -> set_memtable_vector_rep options; 154 | | _ -> ()); 155 | 156 | (* applying options depending on other objects allocated from within RocksDB *) 157 | 158 | (match table_format with 159 | | Some (Block_based config) -> begin 160 | Tables.Block_based.set_cache_index_and_filter_blocks config cache_index_and_filter_blocks; 161 | filter_policy >>= Tables.Block_based.set_filter_policy config; 162 | block_cache >>= Tables.Block_based.set_block_cache config; 163 | set_block_based_table_factory options config; 164 | end 165 | | None -> ()); 166 | 167 | let len = List.length compression_by_level in 168 | if len > 0 then begin 169 | let ba = Bigarray.Array1.create Bigarray.int Bigarray.c_layout len in 170 | let () = List.iteri (fun i elt -> Bigarray.Array1.set ba i (Ffi.V.int_of_compression elt)) compression_by_level in 171 | set_compression_per_level options (Ctypes.bigarray_start Ctypes.array1 ba) len 172 | end; 173 | 174 | if bulk_load then 175 | prepare_for_bulk_load options; 176 | 177 | options 178 | 179 | let default = { 180 | parallelism_level = None; 181 | base_compression = `No_compression; 182 | compression_by_level = []; 183 | optimize_filters_for_hits = None; 184 | disable_compaction = false; 185 | max_flush_processes = None; 186 | compaction_trigger = None; 187 | slowdown_writes_trigger = None; 188 | stop_writes_trigger = None; 189 | memtable_representation = None; 190 | num_levels = None; 191 | target_base_file_size = None; 192 | max_bytes_for_level_base = None; 193 | max_bytes_for_level_multiplier = None; 194 | table_format = None; 195 | write_buffer_size = None; 196 | max_write_buffer_number = None; 197 | min_write_buffer_number_to_merge = None; 198 | max_open_files = None; 199 | create_if_missing = true; 200 | filter_policy = None; 201 | cache_index_and_filter_blocks = false; 202 | block_cache = None; 203 | bulk_load = false; 204 | trace_perf = false; 205 | } 206 | 207 | module Write_options = struct 208 | 209 | open Ffi.Rocksdb 210 | 211 | type t = Write_options.t 212 | 213 | let create ?disable_wal ?sync () = 214 | let open Misc.Opt in 215 | let t = Write_options.create () in 216 | disable_wal >>= Write_options.disable_WAL t; 217 | sync >>= Write_options.set_sync t; 218 | Gc.finalise Write_options.destroy t; 219 | t 220 | 221 | end 222 | 223 | module Flush_options = struct 224 | 225 | open Ffi.Rocksdb 226 | 227 | type t = Flush_options.t 228 | 229 | let create ?wait () = 230 | let open Misc.Opt in 231 | let t = Flush_options.create () in 232 | wait >>= Flush_options.wait t; 233 | Gc.finalise Flush_options.destroy t; 234 | t 235 | 236 | end 237 | 238 | module Read_options = struct 239 | 240 | open Ffi.Rocksdb 241 | 242 | type t = Read_options.t 243 | 244 | let create ?verify_checksums ?fill_cache ?tailing () = 245 | let open Misc.Opt in 246 | let t = Read_options.create () in 247 | verify_checksums >>= Read_options.set_verify_checksums t; 248 | fill_cache >>= Read_options.set_fill_cache t; 249 | tailing >>= Read_options.set_tailing t; 250 | Gc.finalise Read_options.destroy t; 251 | t 252 | 253 | end 254 | -------------------------------------------------------------------------------- /lib/wrap.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | module type Wrap_t = sig 4 | 5 | type t 6 | val kind : string 7 | 8 | end 9 | 10 | module Wrap (M : Wrap_t) = struct 11 | 12 | type t = { 13 | mutable valid : bool; 14 | content : M.t; 15 | kind : string; 16 | } 17 | 18 | let wrap v = { valid = true; content = v; kind = M.kind; } 19 | 20 | let unwrap t f = 21 | match t with 22 | | { valid = false; kind; _ } -> Error (`Msg (sprintf "trying to access closed %s handle" kind)) 23 | | { valid = true; content; _ } -> f content 24 | 25 | let on_finalise t f = match unwrap t (fun t -> Ok (f t)) with _ -> t.valid <- false 26 | 27 | let (>>=) = Rresult.R.Infix.(>>=) 28 | 29 | end 30 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names test) 3 | (libraries rocksdb astring rresult bos cryptokit alcotest) 4 | ) 5 | 6 | (alias 7 | (name runtest) 8 | (deps test.exe) 9 | (action (run %{deps})) 10 | ) -------------------------------------------------------------------------------- /tests/test.ml: -------------------------------------------------------------------------------- 1 | type error = [ `Msg of string ] 2 | let pp_error ppf = function `Msg x -> Fmt.string ppf x 3 | let error = Alcotest.testable pp_error (=) 4 | let t = Alcotest.(result unit error) 5 | 6 | let check (name, fn) = name, `Quick, (fun () -> Alcotest.check t name (Ok ()) (fn ())) 7 | 8 | let config_and_open_tests = List.map check Test_config_and_open.tests 9 | let writes_tests = List.map check Test_writes.tests 10 | let iterator_tests = List.map check Test_iterator.tests 11 | 12 | let () = 13 | Alcotest.run "RocksDB binding" [ 14 | "config_and_open_tests", config_and_open_tests; 15 | "writes_tests", writes_tests; 16 | "iterator_tests", iterator_tests 17 | ] 18 | (* let test_default_options = *) 19 | (* let open Rocksdb in *) 20 | (* let config = Options.default in *) 21 | (* let _ = Options.create ~config in *) 22 | (* () *) 23 | 24 | (* let test_all_config_setters = *) 25 | (* let open Rocksdb_ffi.M in *) 26 | (* let options = Options.create () in *) 27 | (* Options.increase_parallelism options 4; *) 28 | (* Options.optimize_for_point_lookup options 1; *) 29 | (* Options.optimize_level_style_compaction options 1; *) 30 | (* Options.optimize_universal_style_compaction options 1; *) 31 | (* Options.destroy options; *) 32 | (* () *) 33 | 34 | (* let test_open_err = *) 35 | (* let open Rocksdb in *) 36 | (* let config = Options.default in *) 37 | (* let options = Options.create ~config in *) 38 | (* match open_db ~create:false ~options ~name:"/tmp/ocaml-rocksdb-should-not-exists" with *) 39 | (* | Ok handle -> close_db handle; failwith "handle was opened" *) 40 | (* | Error err -> () *) 41 | 42 | (* let test_open = *) 43 | (* let open Rocksdb in *) 44 | (* let config = Options.default in *) 45 | (* let options = Options.create ~config in *) 46 | (* match open_db ~create:true ~options ~name:"/tmp/rocks_test" with *) 47 | (* | Ok handle -> close_db handle *) 48 | (* | Error err -> failwith err *) 49 | 50 | (* let test_wrd = *) 51 | (* let test _ = *) 52 | (* let open Rocksdb in *) 53 | (* let config = Options.default in *) 54 | (* let options = Options.create ~config in *) 55 | (* open_db ~create:true ~options ~name:"/tmp/rocksrocks" *) 56 | (* >>= fun handle -> *) 57 | (* let key = "llama" in *) 58 | (* let value = "fluffy" in *) 59 | (* put handle ~key ~value *) 60 | (* >>= fun () -> begin *) 61 | (* match get handle key with *) 62 | (* | `Ok value_stored -> if value = value_stored then Ok () else failwith "uh" *) 63 | (* | _ -> failwith "lol" end *) 64 | (* >>= fun () -> *) 65 | (* delete handle key >>= fun () -> begin *) 66 | (* match get handle key with *) 67 | (* | `Error _ *) 68 | (* | `Ok _ -> failwith "uuh" *) 69 | (* | `Not_found -> Ok () *) 70 | (* end *) 71 | (* in *) 72 | (* match test () with *) 73 | (* | Ok () -> () *) 74 | (* | _ -> failwith "fail" *) 75 | 76 | (* let test_options = *) 77 | (* [ *) 78 | (* "Testing default options", `Quick, (fun () -> Alcotest.(check unit) "default options" () test_default_options); *) 79 | (* "Testing options setters bindings", `Quick, (fun () -> Alcotest.(check unit) "all setters" () test_all_config_setters); *) 80 | (* ] *) 81 | 82 | (* let test_open = *) 83 | (* [ *) 84 | (* "Testing simple handle opening with path error", `Quick, (fun () -> Alcotest.(check unit) "open err" () test_open_err); *) 85 | (* "Testing simple handle opening", `Quick, (fun () -> Alcotest.(check unit) "open" () test_open); *) 86 | (* ] *) 87 | 88 | (* let test_wrd = *) 89 | (* [ *) 90 | (* "Testing simple write/read/delete scenario", `Quick, (fun () -> Alcotest.(check unit) "wrd test" () test_wrd); *) 91 | (* ] *) 92 | 93 | (* let () = *) 94 | (* Alcotest.run "ocaml-rocksdb" [ *) 95 | (* "Test default options", test_options; *) 96 | (* "Test open database", test_open; *) 97 | (* "Test simple write read delete", test_wrd; *) 98 | (* ] *) 99 | -------------------------------------------------------------------------------- /tests/test_config_and_open.ml: -------------------------------------------------------------------------------- 1 | open Rresult.R.Infix 2 | open Rocksdb 3 | 4 | let simple_open_default () = 5 | Utils.with_tmp_dir begin fun name -> 6 | open_db ~config:Options.default ~name 7 | (* >>= fun _ -> open_db ~create:false ~options ~name *) 8 | >>= fun _ -> Ok () (* FIXME *) 9 | end 10 | 11 | let open_not_random_setters () = 12 | Utils.with_tmp_dir begin fun name -> 13 | let block_cache = Options.Cache.LRU.create ~size:(10 * 1024 * 1024) in 14 | let filter_policy = Options.Filter_policy.create_bloom_full ~bits_per_key:12 in 15 | let block_based_table = Options.Tables.Block_based.create ~block_size:(64 * 1024 *1024) in 16 | let config = { 17 | Options.default with 18 | Options.base_compression = `Snappy; 19 | max_flush_processes = Some 2; 20 | compaction_trigger = Some 128; 21 | slowdown_writes_trigger = Some 128; 22 | stop_writes_trigger = Some 256; 23 | disable_compaction = false; 24 | parallelism_level = Some 4; 25 | filter_policy = Some filter_policy; 26 | memtable_representation = None; 27 | num_levels = Some 10; 28 | block_cache = Some block_cache; 29 | compression_by_level = [ 30 | `No_compression; 31 | `No_compression; 32 | `No_compression; 33 | `No_compression; 34 | ]; 35 | target_base_file_size = None; 36 | table_format = Some block_based_table; 37 | max_open_files = Some (-1); 38 | } 39 | in 40 | open_db ~config ~name 41 | >>= fun _ -> Ok () 42 | end 43 | 44 | let open_error () = 45 | Utils.with_tmp_dir begin fun name -> 46 | let config = { Options.default with create_if_missing = false } in 47 | match open_db ~config ~name with 48 | | Error _ -> Ok () 49 | | Ok _ -> Error (`Msg "Test_config_and_open.open error failed: open was successful") 50 | end 51 | 52 | let tests = [ 53 | "simple_open_default", simple_open_default; 54 | "open_not_random_setters", open_not_random_setters; 55 | "open_error", open_error; 56 | ] 57 | -------------------------------------------------------------------------------- /tests/test_iterator.ml: -------------------------------------------------------------------------------- 1 | open Rocksdb 2 | open Rresult.R.Infix 3 | open Printf 4 | 5 | let simple_iterator_test () = 6 | Utils.with_tmp_dir begin fun name -> 7 | open_db ~config:Options.default ~name 8 | >>= fun db -> 9 | let write_options = Options.Write_options.create () in 10 | let kvs = Utils.get_random_kvalues 1000 in 11 | List.fold_left begin fun r (key, value) -> 12 | r >>= fun () -> 13 | let key = "prefix" ^ key in 14 | put db write_options ~key ~value 15 | end (Ok ()) kvs 16 | >>= fun () -> 17 | let read_options = Options.Read_options.create () in 18 | Iterator.create db read_options >>= fun it -> 19 | Iterator.seek it "prefix"; 20 | let rec walk acc = 21 | match Iterator.get it with 22 | | Some (key, _) when Astring.String.is_prefix ~affix:"prefix" key -> Iterator.next it; walk (acc + 1) 23 | | _ -> acc 24 | in 25 | let res = walk 0 in 26 | if res = 1000 then Ok () else Error (`Msg (sprintf "simple_iterator_test: got %d keys" res)) 27 | end 28 | 29 | let simple_iterator_test_two_prefixes () = 30 | Utils.with_tmp_dir begin fun name -> 31 | open_db ~config:Options.default ~name 32 | >>= fun db -> 33 | let write_options = Options.Write_options.create () in 34 | let kvs = Utils.get_random_kvalues 1000 in 35 | List.fold_left begin fun r (key, value) -> 36 | r >>= fun () -> 37 | let key = "prefix" ^ key in 38 | let key2 = "pprefix" ^ key in 39 | put db write_options ~key ~value 40 | >>= fun _ -> put db write_options ~key:key2 ~value 41 | end (Ok ()) kvs 42 | >>= fun () -> 43 | let read_options = Options.Read_options.create () in 44 | Iterator.create db read_options >>= fun it -> 45 | Iterator.seek it "prefix"; 46 | let rec walk acc = 47 | match Iterator.get it with 48 | | Some (key, _) when Astring.String.is_prefix ~affix:"prefix" key -> Iterator.next it; walk (acc + 1) 49 | | _ -> acc 50 | in 51 | let res = walk 0 in 52 | if res = 1000 then Ok () else Error (`Msg (sprintf "simple_iterator_test_two_prefixes: got %d keys" res)) 53 | end 54 | 55 | let tests = [ 56 | "simple_iterator_test", simple_iterator_test; 57 | "simple_iterator_test_two_prefixes", simple_iterator_test_two_prefixes; 58 | ] 59 | -------------------------------------------------------------------------------- /tests/test_writes.ml: -------------------------------------------------------------------------------- 1 | open Rresult.R.Infix 2 | open Rocksdb 3 | open Printf 4 | 5 | let write_one () = 6 | Utils.with_tmp_dir begin fun name -> 7 | open_db ~config:Options.default ~name 8 | >>= fun db -> 9 | let write_options = Options.Write_options.create () in 10 | let key = "cyber" in 11 | let value = "llama" in 12 | put db write_options ~key ~value 13 | >>= fun () -> 14 | let read_options = Options.Read_options.create () in 15 | match get db read_options key with 16 | | Ok `Found value' -> if String.equal value value' then Ok () else Error (`Msg (sprintf "Wrong value retrieved: %s expected %s" value' value)) 17 | | Ok `Not_found -> Error (`Msg (sprintf "key %s not found" key)) 18 | | Error err -> Error err 19 | end 20 | 21 | let write_one_ttl () = 22 | Utils.with_tmp_dir begin fun name -> 23 | open_db_with_ttl ~config:Options.default ~name ~ttl:1 24 | >>= fun db -> 25 | print_endline "lol222"; 26 | let write_options = Options.Write_options.create () in 27 | let key = "cyber" in 28 | let value = "llama" in 29 | put db write_options ~key ~value 30 | >>= fun () -> 31 | Unix.sleep 3; 32 | Rocksdb.compact_now db >>= fun () -> 33 | let read_options = Options.Read_options.create () in 34 | match get db read_options key with 35 | | Ok `Found _ -> Error (`Msg "Key was not removed by compaction in TTL mode") 36 | | Ok `Not_found -> Ok () 37 | | Error err -> Error err 38 | end 39 | let update_one () = 40 | Utils.with_tmp_dir begin fun name -> 41 | open_db ~config:Options.default ~name 42 | >>= fun db -> 43 | let write_options = Options.Write_options.create () in 44 | let key = "cyber" in 45 | let value = "llama" in 46 | put db write_options ~key ~value 47 | >>= fun () -> 48 | let value2 = "llama2" in 49 | put db write_options ~key ~value:value2 50 | >>= fun () -> 51 | let read_options = Options.Read_options.create () in 52 | match get db read_options key with 53 | | Ok `Found value' -> if String.equal value2 value' then Ok () else Error (`Msg (sprintf "Wrong value retrieved: %s expected %s" value' value2)) 54 | | Ok `Not_found -> Error (`Msg (sprintf "key %s not found" key)) 55 | | Error err -> Error err 56 | end 57 | 58 | let delete_one () = 59 | Utils.with_tmp_dir begin fun name -> 60 | open_db ~config:Options.default ~name 61 | >>= fun db -> 62 | let write_options = Options.Write_options.create () in 63 | let key = "cyber" in 64 | let value = "llama" in 65 | put db write_options ~key ~value 66 | >>= fun () -> 67 | delete db write_options key 68 | >>= fun () -> 69 | let read_options = Options.Read_options.create () in 70 | match get db read_options key with 71 | | Ok `Found _ -> Error (`Msg "delete_one") 72 | | Ok `Not_found -> Ok () 73 | | Error err -> Error err 74 | end 75 | 76 | let write_one_err () = 77 | Utils.with_tmp_dir begin fun name -> 78 | open_db ~config:Options.default ~name 79 | >>= fun db -> 80 | let write_options = Options.Write_options.create () in 81 | let key = "cyber" in 82 | let value = "llama" in 83 | put db write_options ~key ~value 84 | >>= fun () -> 85 | let read_options = Options.Read_options.create () in 86 | match get db read_options "bad key" with 87 | | Ok `Found _ -> Error (`Msg "write_one_err") 88 | | Ok `Not_found -> Ok () 89 | | Error err -> Error err 90 | end 91 | 92 | let write_batch_many () = 93 | let kvs = Utils.get_random_kvalues 10_000 in 94 | Utils.with_tmp_dir begin fun name -> 95 | open_db ~config:Options.default ~name 96 | >>= fun db -> 97 | let write_options = Options.Write_options.create () in 98 | Batch.simple_write_batch db write_options kvs; 99 | >>= fun () -> 100 | let read_options = Options.Read_options.create () in 101 | List.fold_left begin fun r (key, value) -> 102 | r >>= fun () -> 103 | match get db read_options key with 104 | | Ok `Found value' -> if String.equal value value' then Ok () else Error (`Msg "write_many: bad value") 105 | | Ok `Not_found -> Error (`Msg "write_many") 106 | | Error err -> Error err 107 | end (Ok ()) kvs 108 | end 109 | 110 | let write_many () = 111 | Utils.with_tmp_dir begin fun name -> 112 | open_db ~config:{ Options.default with trace_perf = true; } ~name 113 | >>= fun db -> 114 | let write_options = Options.Write_options.create () in 115 | let kvs = Utils.get_random_kvalues 10_000 in 116 | List.fold_left begin fun r (key, value) -> 117 | r >>= fun () -> 118 | put db write_options ~key ~value 119 | end (Ok ()) kvs 120 | >>= fun () -> 121 | let read_options = Options.Read_options.create () in 122 | Gc.full_major (); 123 | List.fold_left begin fun r (key, value) -> 124 | r >>= fun () -> 125 | match get db read_options key with 126 | | Ok `Found value' -> if String.equal value value' then Ok () else Error (`Msg "write_many: bad value") 127 | | Ok `Not_found -> Error (`Msg "write_many") 128 | | Error err -> Error err 129 | end (Ok ()) kvs 130 | end 131 | 132 | let tests = [ 133 | "write_one", write_one; 134 | "write_one_ttl", write_one_ttl; 135 | "write_one_err", write_one_err; 136 | "write_many", write_many; 137 | "write_batch_many", write_batch_many; 138 | "delete_one", delete_one; 139 | "update_one", update_one; 140 | ] 141 | -------------------------------------------------------------------------------- /tests/utils.ml: -------------------------------------------------------------------------------- 1 | open Bos 2 | 3 | let with_tmp_dir fn = 4 | let result = 5 | OS.Dir.with_tmp "%s" begin fun path () -> 6 | let name = Fpath.to_string path in 7 | fn name 8 | end () 9 | in 10 | match result with 11 | | Ok result -> result 12 | | Error _ -> Error (`Msg "Bos err: OS.Dir.with_tmp") 13 | 14 | let get_random_kvalues n = 15 | let rng = Cryptokit.Random.device_rng "/dev/urandom" in 16 | if n < 0 then failwith "get_random_kvalues"; 17 | let rec aux acc = function 18 | | 0 -> acc 19 | | n -> 20 | let key = Cryptokit.Random.string rng 32 in 21 | let value = Cryptokit.Random.string rng 32 in 22 | aux ((key, value)::acc) (n - 1) 23 | in 24 | aux [] n 25 | --------------------------------------------------------------------------------