LMDB storage

src/dune-project

@@ -12,7 +12,6 @@
 (package (name blake2))
 (package (name blockchain_snark))
 (package (name block_producer))
-(package (name block_storage))
 (package (name block_time))
 (package (name bootstrap_controller))
 (package (name bounded_types))
@@ -82,6 +81,7 @@
 (package (name ledger_proof))
 (package (name libp2p_ipc))
 (package (name linked_tree))
+(package (name lmdb_storage))
 (package (name logger))
 (package (name logproc_lib))
 (package (name merkle_address))

src/lib/lmdb_storage/conv.ml

@@ -0,0 +1,46 @@
+open Core_kernel
+
+let uint32_be =
+  Lmdb.Conv.make
+    ~flags:
+      Lmdb.Conv.Flags.(
+        if Sys.big_endian && Int.equal Sys.int_size 4 then
+          integer_key + integer_dup + dup_fixed
+        else dup_fixed)
+    ~serialise:(fun alloc x ->
+      let a = alloc 4 in
+      Bigstring.set_uint32_be_exn a ~pos:0 x ;
+      a )
+    ~deserialise:(Bigstring.get_uint32_be ~pos:0)
+    ()
+
+let uint8 =
+  Lmdb.Conv.make ~flags:Lmdb.Conv.Flags.dup_fixed
+    ~serialise:(fun alloc x ->
+      let a = alloc 1 in
+      Bigstring.set_uint8_exn a ~pos:0 x ;
+      a )
+    ~deserialise:(Bigstring.get_uint8 ~pos:0)
+    ()
+
+let blake2 =
+  Lmdb.Conv.(
+    make
+      ~serialise:(fun alloc x ->
+        let str = Blake2.to_raw_string x in
+        serialise string alloc str )
+      ~deserialise:(fun s -> deserialise string s |> Blake2.of_raw_string)
+      ())
+
+let bin_prot_conv (t : 'a Bin_prot.Type_class.t) =
+  Lmdb.Conv.(
+    make ~flags:Lmdb.Conv.Flags.dup_fixed
+      ~serialise:(fun alloc x ->
+        let sz = t.writer.size x in
+        let res = alloc sz in
+        let _pos = t.writer.write ~pos:0 res in
+        res )
+      ~deserialise:
+        (let pos_ref = ref 0 in
+         t.reader.read ~pos_ref )
+      ())

src/lib/lmdb_storage/dune

@@ -0,0 +1,15 @@
+(library
+ (name lmdb_storage)
+ (public_name lmdb_storage)
+ (libraries
+   ;; opam libraries
+   lmdb
+   ;; local libraries
+   file_system
+   blake2
+   ;; test deps
+   inline_test_quiet_logs
+   )
+ (inline_tests (flags -verbose -show-counts))
+ (instrumentation (backend bisect_ppx))
+ (preprocess (pps ppx_mina ppx_version ppx_jane ppx_deriving.std ppx_let ppx_deriving_yojson)))