Basic storage with C interop (#1)

* writer command design

* dune build with shared core lib

* port c lib project inside ocaml

* os specific dynamic link

* fix project name on flake

* fix: cmake cxx version breaking merklecpp

* finish write to disk and update maps func

* add non atomic commit to transaction graph

* merkle tree binding for generating root hash

* disk module refactor

---------

Co-authored-by: Renan Lopes <renans.l@icloud.com>

1 files changed, 167 insertions, 0 deletions

diff --git a/lib/disk.ml b/lib/disk.ml
new file mode 100644
index 0000000..3c5157b
--- /dev/null
+++ b/lib/disk.ml
@@ -0,0 +1,167 @@
+module type Configuration = sig
+  val base_dir: string
+  val storage: string
+  val transactions: string
+  val assure: unit -> unit
+end
+
+module DevelopmentConfiguration: Configuration = struct
+  let base_dir = "/tmp/relational-engine/"
+  let storage = base_dir ^ "storage/"
+  let transactions = base_dir ^ "transactions/"
+  let assure () =
+    if Sys.file_exists base_dir
+    then Sys.remove base_dir;
+    Sys.mkdir base_dir 0o700;
+    Sys.mkdir storage 0o700;
+    Sys.mkdir transactions 0o700;
+end
+
+module type FileSystem = sig
+  type target =
+    | Storage
+    | Transaction
+  val append: target -> bytes -> (int*int64, string) result
+end
+
+module FileSystem (C: Configuration): FileSystem = struct
+  type target =
+    | Storage
+    | Transaction
+  let target_to_string = function
+    | Storage -> "storage"
+    | Transaction -> "transaction"
+
+  (** [append target content] writes content to file in append only format, returning [content_length * offset_written] *)
+  let append target content =
+    let register channel =
+      let offset_written = Out_channel.length channel in
+      Out_channel.seek channel offset_written;
+      Out_channel.output_bytes channel content;
+      Out_channel.flush channel;
+      Out_channel.close channel;
+      Ok (Bytes.length content, offset_written)
+    in
+    try Out_channel.with_open_bin (target_to_string target) register
+    with _ -> Error (Printf.sprintf "Error on appending to target '%s'" (target_to_string target))
+end
+
+module Executor = struct
+  module StringMap = Map.Make(String)
+  module FS = FileSystem(DevelopmentConfiguration)
+  module Location = struct
+    type t =
+      { offset: int64;
+        size: int;
+        hash: string }
+  end
+  module Hashes = struct
+    type t = string list
+  end
+  type files = Hashes.t StringMap.t
+  type locations = Location.t StringMap.t
+  let _EMPTY_SHA_HASH_ = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
+
+  (** Initializes the virtual file or opens it. *)
+  let init_file (files: Hashes.t StringMap.t) filename: Hashes.t StringMap.t =
+    match StringMap.find_opt filename files with
+    | None -> StringMap.add filename [_EMPTY_SHA_HASH_] files
+    | Some _ -> files
+  let write (files: files) (locations: locations) filename ?hash_to_replace (content: Bytes.t) =
+    let files = init_file files filename in
+    let computed_hash: string = Interop.Sha256.compute_hash content in
+    match StringMap.find_opt computed_hash locations with
+    | None ->
+        begin match hash_to_replace with
+        | None ->
+          begin
+            (* This instead should store a list of list to keep the history *)
+            let files =
+              StringMap.update
+                filename
+                (function Some file_hashes -> Some (computed_hash::file_hashes) | None -> Some [computed_hash])
+                files
+            in
+            let open Extensions.Result in
+            let+ (size, offset) = FS.append Storage content in
+            let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash}: Location.t) locations in
+            Ok (files, locations)
+          end
+        | Some hash_to_replace ->
+           let files = StringMap.update filename (function Some file_hashes -> Some (List.map (fun hash -> if hash = hash_to_replace then computed_hash else hash) file_hashes) | None -> Some [computed_hash]) files in
+           let open Extensions.Result in
+           let+ (size, offset) = FS.append Storage content in
+           let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash}: Location.t) locations in
+           Ok (files, locations)
+        end
+    | Some _ ->
+        begin match hash_to_replace with
+        | Some hash_to_replace ->
+           let files =
+             StringMap.update filename
+               (function
+                | Some file_hashes -> Some (List.map (fun hash -> if hash = hash_to_replace then computed_hash else hash) file_hashes)
+                | None -> Some [computed_hash])
+               files in
+           Ok (files, locations)
+        | None ->
+           Ok (files, locations)
+        end
+end
+
+module Startup = struct
+  let () = DevelopmentConfiguration.assure()
+end
+
+module Command = struct
+  module FS = FileSystem(DevelopmentConfiguration)
+  open Data_encoding
+  type command_kind =
+    | OPEN
+    | WRITE
+    | READ
+  let command_kind_encoding =
+    union [
+      case ~title:"open" (Tag 0)
+        Data_encoding.empty
+        (function OPEN -> Some () | _ -> None)
+        (function () -> OPEN);
+      case ~title:"write" (Tag 1)
+        Data_encoding.empty
+        (function WRITE -> Some () | _ -> None)
+        (function () -> WRITE);
+      case ~title:"read" (Tag 2)
+        Data_encoding.empty
+        (function READ -> Some () | _ -> None)
+        (function () -> READ);
+    ]
+  type t =
+    { kind: command_kind;
+      timestamp: float;
+      hash: string;
+      filename: string;
+      (* branch must be added here later *)
+      content: string }
+  let command_encoding =
+    conv 
+      (fun {kind; timestamp; hash; filename; content} -> (kind, timestamp, hash, filename, content))
+      (fun (kind, timestamp, hash, filename, content) -> {kind; timestamp; hash; filename; content})
+      Data_encoding.(tup5 command_kind_encoding float string string string)
+  
+  let parse_command ~data =
+    let contract_encoding = Data_encoding.(tup4 command_kind_encoding string string string) in
+    match Binary.of_bytes_opt contract_encoding data with
+    | Some (kind, hash, filename, content) -> Ok {kind; timestamp = Unix.time(); hash; filename; content}
+    | None -> Error "Failed to parse command"
+
+  (** TODO: This does not write atomically. If the system crashes while it attempts to write, it will corrupt.
+     Solve this with a temporary file and move later. *)
+  let commit 
+    (* (_files: Filesystem.files) (_locations: Filesystem.locations)  *)
+   command =
+      let open Extensions.Result in
+      let+ serialized_command =
+        Result.map_error (fun _ -> "Failed to serialize command to binary format.")
+        @@ Binary.to_bytes command_encoding command in
+      FS.append FS.Transaction serialized_command
+end