aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2025-11-11 00:00:43 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2025-11-11 00:00:43 -0300
commit3063608df6ff1668f683d9d22c57fea29d728d0d (patch)
tree36be7f6c6d901c5984c045d4ce823bd24c37e9af /lib
parentb5dbdaa989a86477669aac0bf342029e1d2b6028 (diff)
downloadSakura-3063608df6ff1668f683d9d22c57fea29d728d0d.tar.gz
Sakura-3063608df6ff1668f683d9d22c57fea29d728d0d.zip
migrating to erlang to attach to mnesia
Diffstat (limited to 'lib')
-rw-r--r--lib/core_functions.ml25
-rw-r--r--lib/core_types.ml3
-rw-r--r--lib/disk.ml202
-rw-r--r--lib/dune28
-rw-r--r--lib/extensions.ml7
-rw-r--r--lib/interop.ml22
6 files changed, 0 insertions, 287 deletions
diff --git a/lib/core_functions.ml b/lib/core_functions.ml
deleted file mode 100644
index 3d1cd35..0000000
--- a/lib/core_functions.ml
+++ /dev/null
@@ -1,25 +0,0 @@
-(* open Ctypes *)
-
-module Types = Types_generated
-
-module Functions (F : Ctypes.FOREIGN) = struct
- (* open F *)
- open Ctypes_static
- let os_extension =
- if Sys.os_type = "Unix" then
- let ic = Unix.open_process_in "uname" in
- let uname = input_line ic in
- let () = close_in ic in
- if uname = "Darwin" then
- "dylib"
- else "so"
- else "dll"
- let libmerklecpp =
- Dl.dlopen
- ~flags:[RTLD_GLOBAL; RTLD_NOW]
- ~filename:((Sys.getenv "LIBRELATIONAL_ENGINE_LIB_PATH") ^ "/librelational_engine." ^ os_extension)
- let compute_hash = Foreign.foreign ~from:libmerklecpp "compute_hash" (ptr char @-> Ctypes.string @-> returning void)
- let merkle_generate_root = Foreign.foreign ~from:libmerklecpp "merkle_generate_root" (ptr Ctypes.string @-> int @-> ptr char @-> returning void)
- let register_to_merkle = Foreign.foreign ~from:libmerklecpp "register_to_merkle" (Ctypes.string @-> Ctypes.string @-> returning void)
-
-end
diff --git a/lib/core_types.ml b/lib/core_types.ml
deleted file mode 100644
index 45f5720..0000000
--- a/lib/core_types.ml
+++ /dev/null
@@ -1,3 +0,0 @@
-module Types (F : Ctypes.TYPE) = struct
- let hash_size = F.constant "HASH_SIZE" F.int
-end
diff --git a/lib/disk.ml b/lib/disk.ml
deleted file mode 100644
index aa971dd..0000000
--- a/lib/disk.ml
+++ /dev/null
@@ -1,202 +0,0 @@
-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 = { values: string list;
- hash: string }
- type history = t list
- end
- type commit = { state: string; files: Hashes.history StringMap.t }
- type history = commit list
- type locations = Location.t StringMap.t
- let _EMPTY_SHA_HASH_ = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
-
- (** Initializes the virtual file or opens it. *)
- let init_file (files: Hashes.history StringMap.t) filename: Hashes.history StringMap.t =
- match StringMap.find_opt filename files with
- | None ->
- let default: Hashes.t = { values = []; hash = _EMPTY_SHA_HASH_} in
- let new_files = StringMap.add filename [default] files
- in new_files
- | Some _ ->
- files
-
- let compose_new_state files =
- let history = StringMap.to_list files in
- let all_hashes = List.concat
- @@ List.map (fun (_, (history:Hashes.history)) ->
- List.map (fun ({hash; _}: Hashes.t) -> hash) history) history
- in Interop.Merkle.merkle_generate_root all_hashes
-
- let write ({files;_} as commit: commit) (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: Hashes.history) ->
- let {values; _}: Hashes.t = List.hd file_hashes in
- let new_state = Interop.Merkle.merkle_generate_root (computed_hash::values) in
- Some ({values = computed_hash::values; hash = new_state}::file_hashes)
- | None -> Some [{values = [computed_hash]; hash = 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
- let commit = {state = compose_new_state files; files}
- in Ok (commit, locations)
- end
- | Some hash_to_replace ->
- let update_fun = function
- | Some (file_hashes: Hashes.history) ->
- let {values; _}: Hashes.t = List.hd file_hashes in
- let updated_entry = List.map (fun hash -> if hash = hash_to_replace then computed_hash else hash) values in
- let new_entry: Hashes.t = {values = updated_entry; hash = Interop.Merkle.merkle_generate_root updated_entry} in
- Some (new_entry::file_hashes)
- | None -> Some [{values = [computed_hash]; hash = computed_hash}]
- in
- let files = StringMap.update filename update_fun 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
- let commit = {state = compose_new_state files; files}
- in Ok (commit, locations)
- end
- | Some _ ->
- begin match hash_to_replace with
- | Some hash_to_replace ->
- let update_fun = function
- | Some (file_hashes: Hashes.history) ->
- let {values; _}: Hashes.t = List.hd file_hashes in
- let updated_entry = List.map (fun hash -> if hash = hash_to_replace then computed_hash else hash) values in
- let new_entry: Hashes.t = {values = updated_entry; hash = Interop.Merkle.merkle_generate_root updated_entry} in
- Some (new_entry::file_hashes)
- | None -> Some [{values = [computed_hash]; hash = computed_hash}]
- in
- let files = StringMap.update filename update_fun files in
- let commit = {state = compose_new_state files; files}
- in Ok (commit, locations)
- | None ->
- Ok (commit, locations)
- end
-end
-
-module Startup = struct
- (* TODO: Weird behavior with a system error on the dir /tmp/relational-engine opening. Disabling for now *)
- (* 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
diff --git a/lib/dune b/lib/dune
deleted file mode 100644
index 0ef1c18..0000000
--- a/lib/dune
+++ /dev/null
@@ -1,28 +0,0 @@
-(library
- (name relational_engine)
- (libraries ctypes ctypes-foreign data-encoding)
- ;; (c_library_flags -lssl -lcrypto -L %{env:LIBRESSL_LIB_PATH=})
- ;; (foreign_stubs
- ;; (language cxx)
- ;; (names merklecpp_stubs)
- ;; (flags
- ;; (:standard -lssl -lcrypto)
- ;; (-L %{env:LIBRESSL_LIB_PATH=})
- ;; (-I %{env:LIBRESSL_INCLUDE_PATH=})
- ;; (-I %{env:MERKLECPP_INCLUDE_PATH=})))
- (ctypes
- (external_library_name relational_engine)
- (headers
- (include %{env:LIBRELATIONAL_ENGINE_INCLUDE_PATH=}/library.h))
- (build_flags_resolver
- (vendored
- (c_flags -L %{env:LIBRELATIONAL_ENGINE_LIB_PATH=})))
- (type_description
- (instance Types)
- (functor core_types))
- (function_description
- (concurrency unlocked)
- (instance Functions)
- (functor core_functions))
- (generated_types Types_generated)
- (generated_entry_point C)))
diff --git a/lib/extensions.ml b/lib/extensions.ml
deleted file mode 100644
index c128f2a..0000000
--- a/lib/extensions.ml
+++ /dev/null
@@ -1,7 +0,0 @@
-module Option = struct
- let ( let+ ) = Option.bind
-end
-
-module Result = struct
- let ( let+ ) = Result.bind
-end
diff --git a/lib/interop.ml b/lib/interop.ml
deleted file mode 100644
index 28b4fb9..0000000
--- a/lib/interop.ml
+++ /dev/null
@@ -1,22 +0,0 @@
-open Ctypes
-
-module Sha256 = struct
- let compute_hash content =
- let size_with_null_terminator = C.Types.hash_size + 1 in
- let buf = Ctypes.allocate_n char ~count:size_with_null_terminator in
- let () = C.Functions.compute_hash buf (Bytes.to_string content) in
- Ctypes.coerce (ptr char) Ctypes.string buf
-end
-
-module Merkle = struct
- let merkle_generate_root hashes =
- let size_with_null_terminator = C.Types.hash_size + 1 in
- let buf = Ctypes.allocate_n char ~count:size_with_null_terminator in
- let len = List.length hashes in
- let hashes = CArray.of_list string hashes in
- C.Functions.merkle_generate_root (CArray.start hashes) len buf;
- Ctypes.coerce (ptr char) Ctypes.string buf
-
- let register_to_merkle content =
- C.Functions.register_to_merkle "/tmp/relational-engine/tree" content
-end