From 3235bcba70e0b9a5e9a8ed0fc18f96ce5c6beb57 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sun, 24 Nov 2024 22:23:32 -0300 Subject: relation building --- bin/main.ml | 26 +---------------------- flake.nix | 13 ++++++++++++ lib/disk.ml | 47 ++++++++++++++++++++++++++---------------- lib/dune | 2 +- lib/relation.ml | 39 +++++++++++++++++++++++++++++++++++ test/test_relational_engine.ml | 4 ++-- 6 files changed, 85 insertions(+), 46 deletions(-) create mode 100644 lib/relation.ml diff --git a/bin/main.ml b/bin/main.ml index 8250c44..4ea66d0 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,28 +1,4 @@ -open Relational_engine.Disk - -let x() = - let command_write1: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837830"; content = "asd"; filename = "trash"} in - let command_write2: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837831"; content = "qwe"; filename = "trash2"} in - let command_write3: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837832"; content = "fgh"; filename = "trash"} in - let command_write4: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837833"; content = "rty"; filename = "trash2"} in - let command_write5: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837834"; content = "jkl"; filename = "trash"} in - let command_read: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "trash"} in - let stream: Executor.history = [{state = Executor._EMPTY_SHA_HASH_; files = Executor.StringMap.empty}] in - let locations: Executor.locations = Executor.StringMap.empty in - let open Relational_engine.Extensions.Result in - let+ (stream, locations) = Command.commit_and_perform stream locations command_write1 in - let+ (stream, locations) = Command.commit_and_perform stream locations command_write2 in - let+ (stream, locations) = Command.commit_and_perform stream locations command_write3 in - let+ (stream, locations) = Command.commit_and_perform stream locations command_write4 in - let+ (stream, locations) = Command.commit_and_perform stream locations command_write5 in - Command.commit_and_perform (List.tl stream) locations command_read - let () = begin - let _ = x() in () + let _ = Relational_engine.Relation.write_and_retrieve() in () end diff --git a/flake.nix b/flake.nix index 7082073..3f1e64f 100644 --- a/flake.nix +++ b/flake.nix @@ -31,6 +31,12 @@ lib = legacyPackages.lib; merklecpp = legacyPackages.callPackage ./deps/merklecpp.nix { }; libressl = legacyPackages.callPackage ./deps/libressl.nix { }; + ppx_xml_conv = ocamlPackages.janePackage { + pname = "ppx_xml_conv"; + hash = "sha256-4U0ZlV8OYXwNUz3bbxf49qovGTI8vyn7L3YJy0AndrM="; + meta.description = "Generate XML conversion functions from records"; + propagatedBuildInputs = [ ocamlPackages.ppxlib ocamlPackages.csvfields ocamlPackages.ppx_conv_func ]; + }; librelational_engine = legacyPackages.callPackage ./deps/relational_engine_lib.nix { libressl = libressl; @@ -94,6 +100,9 @@ ctypes-foreign data-encoding ppx_inline_test + ocamlPackages.ppx_deriving + ocamlPackages.ppx_sexp_conv + ppx_xml_conv ]; strictDeps = true; @@ -165,6 +174,8 @@ legacyPackages.ocamlformat ocamlPackages.ppx_inline_test ocamlPackages.ppx_deriving + ocamlPackages.ppx_sexp_conv + ppx_xml_conv ]; } '' echo "checking dune and ocaml formatting" @@ -250,9 +261,11 @@ ocamlPackages.data-encoding ocamlPackages.ppx_inline_test ocamlPackages.ppx_deriving + ocamlPackages.ppx_sexp_conv legacyPackages.cmake legacyPackages.gcc # legacyPackages.nixfmt-classic + ppx_xml_conv ]; shellHook = '' diff --git a/lib/disk.ml b/lib/disk.ml index b29ea09..f39a8b5 100644 --- a/lib/disk.ml +++ b/lib/disk.ml @@ -134,7 +134,7 @@ module Executor = struct let () = print_endline @@ "OFFSET: " ^ (Int64.to_string offset) in let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash}: Location.t) locations in let commit = {state = compose_new_state files; files} - in Ok (commit, locations) + in Ok ((commit, locations), Some computed_hash) end | Some hash_to_replace -> let update_fun = function @@ -151,7 +151,7 @@ module Executor = struct let () = print_endline @@ "OFFSET: " ^ (Int64.to_string offset) in let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash}: Location.t) locations in let commit = {state = compose_new_state files; files} - in Ok (commit, locations) + in Ok ((commit, locations), Some computed_hash) end | Some _ -> begin match hash_to_replace with @@ -166,9 +166,9 @@ module Executor = struct in let files = StringMap.update filename update_fun files in let commit = {state = compose_new_state files; files} - in Ok (commit, locations) + in Ok ((commit, locations), Some computed_hash) | None -> - Ok (commit, locations) + Ok ((commit, locations), None) end let read ({files; _} as _commit: commit) (locations: locations) ~filename = @@ -177,7 +177,8 @@ module Executor = struct let physical_locations = List.map (fun hash -> StringMap.find hash locations) location_hashes in (* Terrible! Here I read everything opening a new IO every time. We should be able to read with only one call, but changing the offset every time *) let content = List.map (fun ({offset; size; _}: Location.t) -> match FS.read FS.Storage offset size with | Ok x -> x | Error err -> failwith err) physical_locations - in Bytes.concat Bytes.empty @@ List.rev content + in (*Bytes.concat Bytes.empty @@*) + List.rev content end module Startup = struct @@ -206,26 +207,33 @@ module Command = struct Data_encoding.empty (function READ -> Some () | _ -> None) (function () -> READ); - ] + ] + type t = { kind: command_kind; timestamp: float; hash: string; filename: string; + references: string list; (* 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) + (fun {kind; timestamp; hash; filename; references; content} -> (kind, timestamp, hash, filename, references, content)) + (fun (kind, timestamp, hash, filename, references, content) -> {kind; timestamp; hash; filename; references; content}) + Data_encoding.(tup6 command_kind_encoding float string string (list string) string) let parse_command ~data = - let contract_encoding = Data_encoding.(tup4 command_kind_encoding string string string) in + let contract_encoding = Data_encoding.(tup5 command_kind_encoding string string (list 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} + | Some (kind, hash, filename, references, content) -> Ok {kind; timestamp = Unix.time(); hash; filename; references; content} | None -> Error "Failed to parse command" + type return = + | ComputedHash of string + | Read of bytes list + | Nothing + (** 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_and_perform (stream: Executor.history) (locations: Executor.locations) command = @@ -235,15 +243,18 @@ module Command = struct @@ Binary.to_bytes command_encoding command in let+ _ = FS.append FS.Transaction serialized_command in match command.kind with - | WRITE -> + | WRITE -> begin let open Extensions.Result in - let+ (commit, locations) = Executor.write (List.hd stream) locations ~filename:command.filename @@ Bytes.of_string command.content in + let+ ((commit, locations), computed_hash_handle) = Executor.write (List.hd stream) locations ~filename:command.filename @@ Bytes.of_string command.content in let updated_stream = commit::stream in - Ok (updated_stream, locations) + match computed_hash_handle with + | Some computed_hash_handle -> Ok ((updated_stream, locations), ComputedHash computed_hash_handle) + | None -> Ok ((updated_stream, locations), Nothing) + end | READ -> let content = Executor.read (List.hd stream) locations ~filename:command.filename in - print_string "CONTENT: "; - print_endline @@ Bytes.to_string content; - Ok (stream, locations) - | _ -> Ok (stream, locations) + (* print_string "CONTENT: "; *) + (* print_endline @@ Bytes.to_string content; *) + Ok ((stream, locations), Read content) + | _ -> Error "Unimplemented method" end diff --git a/lib/dune b/lib/dune index b5e8596..8ad4a95 100644 --- a/lib/dune +++ b/lib/dune @@ -1,7 +1,7 @@ (library (name relational_engine) (libraries ctypes ctypes-foreign data-encoding) - (preprocess (pps ppx_deriving.show ppx_deriving.ord)) + (preprocess (pps ppx_deriving.show ppx_sexp_conv)) ;; (c_library_flags -lssl -lcrypto -L %{env:LIBRESSL_LIB_PATH=}) ;; (foreign_stubs ;; (language cxx) diff --git a/lib/relation.ml b/lib/relation.ml new file mode 100644 index 0000000..a4e14c4 --- /dev/null +++ b/lib/relation.ml @@ -0,0 +1,39 @@ +open Sexplib0 +open Sexplib0.Sexp_conv +open Ppx_xml_conv +module Protocol = struct + type tuples = string list list + [@@deriving sexp, ] +end + +let write_and_retrieve() = + let open Disk in + let stream: Executor.history = [{state = Executor._EMPTY_SHA_HASH_; files = Executor.StringMap.empty}] in + let locations: Executor.locations = Executor.StringMap.empty in + let open Extensions.Result in + let command_write1: Command.t = + {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Daisy"; filename = "user/first-name"; references = []} in + let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write1 in + let command_write2: Command.t = + {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Blossom"; filename = "user/last-name"; references = [handle]} in + let command_write3: Command.t = + {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Minnie"; filename = "user/first-name"; references = []} in + let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write2 in + let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write3 in + let command_write4: Command.t = + {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Mouse"; filename = "user/last-name"; references = [handle]} in + let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write4 in + let command_write5: Command.t = + {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Billie"; filename = "user/first-name"; references = []} in + let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write5 in + let command_write6: Command.t = + {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Beans"; filename = "user/last-name"; references = [handle]} in + let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write6 in + let command_read1: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user/first-name"; references = []} in + let+ (_, Command.Read first_name) = Command.commit_and_perform (List.tl stream) locations command_read1 in + let command_read2: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user/last-name"; references = []} in + let+ (_, Command.Read last_name) = Command.commit_and_perform (List.tl stream) locations command_read2 in + (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string first_name); *) + (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string last_name); *) + Ok (Sexp.to_string (Protocol.sexp_of_tuples [List.map Bytes.to_string first_name; List.map Bytes.to_string last_name])) + [@@warning "-8"] (* Suppress pattern match incomplete warnings *) diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml index cc9652b..65d03d4 100644 --- a/test/test_relational_engine.ml +++ b/test/test_relational_engine.ml @@ -3,7 +3,7 @@ let%test _ = let open Relational_engine.Disk.Executor in let stream: history = [{state = _EMPTY_SHA_HASH_; files = StringMap.empty}] in let locations: locations = StringMap.empty in - let (new_commit, _) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in + let ((new_commit, _), _) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in let expected_state_hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837830" in new_commit.state = expected_state_hash @@ -11,7 +11,7 @@ let%test _ = let open Relational_engine.Disk.Executor in let stream: history = [{state = _EMPTY_SHA_HASH_; files = StringMap.empty}] in let locations: locations = StringMap.empty in - let (new_commit, new_locations) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in + let ((new_commit, new_locations), _) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in let result_test = let open Relational_engine.Extensions.Option in let+ new_file_content = StringMap.find_opt "trash" new_commit.files in -- cgit v1.2.3