diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-26 15:30:53 -0300 |
|---|---|---|
| committer | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-26 15:30:53 -0300 |
| commit | e32ba6294781691846c3ab19281fe977350b4d0f (patch) | |
| tree | f38e92ba2fc03e966d7263c7ee2e0b5d7983ebae /lib/management | |
| parent | be375a52da6174dfda5b68617d27e1542cc80499 (diff) | |
| download | Sakura-e32ba6294781691846c3ab19281fe977350b4d0f.tar.gz Sakura-e32ba6294781691846c3ab19281fe977350b4d0f.zip | |
preparation cleanup for RNT integration
Diffstat (limited to 'lib/management')
| -rw-r--r-- | lib/management/branch.ml | 137 | ||||
| -rw-r--r-- | lib/management/multigroup.ml | 59 | ||||
| -rw-r--r-- | lib/management/physical.ml | 198 |
3 files changed, 0 insertions, 394 deletions
diff --git a/lib/management/branch.ml b/lib/management/branch.ml deleted file mode 100644 index 1583b9b..0000000 --- a/lib/management/branch.ml +++ /dev/null @@ -1,137 +0,0 @@ -(** Branch registry: named pointers to database tip hashes, plus HEAD tracking. - Stored in the Physical backend under reserved key prefixes: - - "branch:<name>" -> serialized { name; tip } - - "branch_names" -> serialized string list (index for enumeration) - - "head" -> branch name as raw bytes *) - -type t = {name: string; tip: Conventions.Hash.t} -type head = string -type error = string - -let branch_key name = "branch:" ^ name -let head_key = "head" -let names_key = "branch_names" - -module Make (Storage : Physical.S) = struct - module Error = struct - open Condition - - let branch_not_found name = - condition "branch-not-found" "Branch not found" ("name" |=| of_string name) - end - - let load_names storage = - match Storage.load_raw storage names_key with - | Ok (Some bytes) -> (Marshal.from_bytes bytes 0 : string list) - | _ -> [] - - let store_names storage names = - let bytes = Marshal.to_bytes names [] in - ignore (Storage.store_raw storage names_key bytes) - - let create storage ~name ~tip = - let record = {name; tip} in - let bytes = Marshal.to_bytes record [] in - match Storage.store_raw storage (branch_key name) bytes with - | Error e -> Error e - | Ok () -> - let names = load_names storage in - if not (List.mem name names) then store_names storage (name :: names); - Ok () - - let checkout storage branch_name = - let bytes = Bytes.of_string branch_name in - Storage.store_raw storage head_key bytes - - let get_head storage = - match Storage.load_raw storage head_key with - | Ok (Some bytes) -> Ok (Some (Bytes.to_string bytes)) - | Ok None -> Ok None - | Error e -> Error e - - let get_tip storage name = - match Storage.load_raw storage (branch_key name) with - | Ok (Some bytes) -> - let record : t = Marshal.from_bytes bytes 0 in - Ok (Some record.tip) - | Ok None -> Ok None - | Error e -> Error e - - let update_tip storage ~name ~tip = - match Storage.load_raw storage (branch_key name) with - | Ok (Some _) -> - let record = {name; tip} in - let bytes = Marshal.to_bytes record [] in - Storage.store_raw storage (branch_key name) bytes - | Ok None -> Error (Error.branch_not_found name) - | Error e -> Error e - - let list storage = - let names = load_names storage in - let branches = - List.filter_map - (fun name -> match get_tip storage name with Ok (Some tip) -> Some (name, tip) | _ -> None) - names - in - Ok branches - (* - let branch_relation storage : Relation.t = - let schema = - Schema.empty |> Schema.add "name" "string" |> Schema.add "hash" "string" - in - let mk v = { Attribute.value = Obj.repr v } in - let rec generator position = - match position with - | None -> Generator.Error "random access not supported for public:branch" - | Some pos -> ( - match list storage with - | Error _ -> Generator.Done - | Ok branches -> - if pos >= List.length branches then Generator.Done - else - let name, tip = List.nth branches pos in - let short = String.sub tip 0 (min 8 (String.length tip)) in - let attributes = - Tuple.AttributeMap.of_list - [ ("name", mk name); ("hash", mk short) ] - in - Generator.Value - ( Tuple.make_materialized - ~relation:Prelude.Catalog.branch_rel_name ~attributes, - generator )) - in - Relation.make ~hash:None ~name:Prelude.Catalog.branch_rel_name ~schema - ~tree:None ~constraints:None - ~cardinality:Conventions.Cardinality.ConstrainedFinite - ~generator:(Some generator) - ~membership_criteria:(fun _ _ -> true) - ~provenance:(Relation.Provenance.Base Prelude.Catalog.branch_rel_name) - ~lineage:(Relation.Lineage.Base Prelude.Catalog.branch_rel_name) () *) - - (* let head_relation storage : Relation.t = - let schema = Schema.empty |> Schema.add "branch" "string" in - let mk v = { Attribute.value = Obj.repr v } in - let generator position = - match position with - | None -> Generator.Error "random access not supported for public:head" - | Some 0 -> ( - match get_head storage with - | Ok None | Error _ -> Generator.Done - | Ok (Some branch_name) -> - let attributes = - Tuple.AttributeMap.of_list [ ("branch", mk branch_name) ] - in - Generator.Value - ( Tuple.make_materialized - ~relation:Prelude.Catalog.head_rel_name ~attributes, - fun _ -> Generator.Done )) - | Some _ -> Generator.Done - in - Relation.make ~hash:None ~name:Prelude.Catalog.head_rel_name ~schema - ~tree:None ~constraints:None - ~cardinality:Conventions.Cardinality.ConstrainedFinite - ~generator:(Some generator) - ~membership_criteria:(fun _ _ -> true) - ~provenance:(Relation.Provenance.Base Prelude.Catalog.head_rel_name) - ~lineage:(Relation.Lineage.Base Prelude.Catalog.head_rel_name) () *) -end diff --git a/lib/management/multigroup.ml b/lib/management/multigroup.ml deleted file mode 100644 index 2882afa..0000000 --- a/lib/management/multigroup.ml +++ /dev/null @@ -1,59 +0,0 @@ -(** Multigroup root: a lightweight versioned descriptor that maps relation names - to content-addressed relation values. The multigroup object owns the B+ tree - pointer and advances it when relations change. *) - -class multigroup ~name:(init_name : Conventions.Name.t) = - object (_self) - val name : Conventions.Name.t = init_name - val relations : Relation.relation BatMap.String.t = BatMap.String.empty - val timestamp : float = Unix.gettimeofday () - method name = name - method relations = relations - method timestamp = timestamp - - (* TODO: a variant returning (Relation.relation, Condition.t) result *) - method get_relation rel_name = BatMap.String.find_opt rel_name relations - method get_relation_names = BatMap.String.fold (fun n _ acc -> n :: acc) relations [] - method has_relation rel_name = BatMap.String.mem rel_name relations - - method add_relation (rel : Relation.relation) = - {<relations = BatMap.String.add rel#name rel relations>} - - method remove_relation rel_name = {<relations = BatMap.String.remove rel_name relations>} - - method update_relation (rel : Relation.relation) = - if not (BatMap.String.mem rel#name relations) then {<>} - else {<relations = BatMap.String.add rel#name rel relations>} - - method serialize () : Storable.Multigroup.t = - { Storable.Multigroup.name; - relations= - BatMap.String.bindings relations |> List.map snd |> List.map (fun r -> r#serialize ()) } - end - -let deserialize (bytes : bytes) : (multigroup, string) result = - (* Reconstruct a multigroup from its persisted payload. - Only name, schema, and tree_pointer (Merkle root) are restored per - relation. Constraints are not yet round-tripped — see the TODO in - storable.ml for the constraint serialisation plan. *) - try - let stored = Storable.Multigroup.of_bytes bytes in - let db = new multigroup ~name:stored.name in - let db = - List.fold_left - (fun mg rel -> - let relation = - new Relation.stored - ~name:rel.Storable.Relation.name ~schema:rel.schema ~constraints:None - ~cardinality:Conventions.Cardinality.AlephZero ~lineage:None ~provenance:None - ~membership_criteria:(fun _ -> true ) - in - let relation = - if rel.tree_pointer = "" then relation - else relation#set_tree_pointer (Some rel.tree_pointer) - in - mg#add_relation (relation :> Relation.relation) ) - db stored.relations - in - Ok db - with Invalid_argument message -> Error message diff --git a/lib/management/physical.ml b/lib/management/physical.ml deleted file mode 100644 index b896330..0000000 --- a/lib/management/physical.ml +++ /dev/null @@ -1,198 +0,0 @@ -(** Physical storage abstraction. - - This module defines a functor-based storage interface that can be backed by - any key-value store (etcd, Redis, DynamoDB, PostgreSQL, filesystem, etc.). - - All data is content-addressed: keys are hashes, values are serialized - objects. The storage is append-only - objects are never modified, only new - versions are written with new hashes. *) - -(** Backend module signature that any storage driver must implement *) -module type BACKEND = sig - include Configuration.CONFIGURABLE - - type connection - - (** Connect to the storage backend *) - val connect : configuration -> (connection, Condition.t) result - - (** Disconnect from the backend *) - val disconnect : connection -> unit - - (** Get a value by its hash. Returns None if not found. *) - val get : connection -> Conventions.Hash.t -> (bytes option, Condition.t) result - - (** Store a value at its hash *) - val put : connection -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result - - (** Check if a hash exists *) - val exists : connection -> Conventions.Hash.t -> (bool, Condition.t) result - - (** Begin a transaction *) - val begin_transaction : connection -> (unit, Condition.t) result - - (** Commit a transaction *) - val commit : connection -> (unit, Condition.t) result - - (** Rollback a transaction *) - val rollback : connection -> (unit, Condition.t) result - - (** Batch get multiple values *) - val get_many : connection -> Conventions.Hash.t list -> (bytes option list, Condition.t) result - - (** Batch put multiple values *) - val put_many : connection -> (Conventions.Hash.t * bytes) list -> (unit, Condition.t) result -end - -(** Storage operations built on top of a backend *) -module type S = sig - include Configuration.CONFIGURABLE - - type t - - (** Create a storage instance from a backend connection *) - val create : configuration -> (t, Condition.t) result - - (** Close the storage *) - val close : t -> unit - - (** Store an attribute value, returns its hash *) - val store_attribute : t -> Conventions.AbstractValue.t -> (Conventions.Hash.t, Condition.t) result - - (** Load an attribute value by hash *) - val load_attribute : - t -> Conventions.Hash.t -> (Conventions.AbstractValue.t option, Condition.t) result - - (** Store raw bytes at a hash *) - val store_raw : t -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result - - (** Load raw bytes by hash *) - val load_raw : t -> Conventions.Hash.t -> (bytes option, Condition.t) result - - (** Check if a hash exists *) - val exists : t -> Conventions.Hash.t -> (bool, Condition.t) result - - (** Execute a function within a transaction *) - val with_transaction : t -> (unit -> ('a, Condition.t) result) -> ('a, Condition.t) result -end - -(** Functor to create storage operations from a backend *) -module Make (B : BACKEND) : S with type configuration = B.configuration = struct - type configuration = B.configuration - type t = B.connection - - let parse = B.parse - let create config = B.connect config - let close = B.disconnect - - let store_attribute conn value = - let bytes = Marshal.to_bytes value [] in - let hash = Conventions.AbstractValue.hash value in - match B.put conn hash bytes with Ok () -> Ok hash | Error e -> Error e - - let load_attribute conn hash = - match B.get conn hash with - | Ok (Some bytes) -> Ok (Some (Marshal.from_bytes bytes 0)) - | Ok None -> Ok None - | Error e -> Error e - - let store_raw conn hash bytes = B.put conn hash bytes - let load_raw conn hash = B.get conn hash - let exists conn hash = B.exists conn hash - - let with_transaction conn f = - match B.begin_transaction conn with - | Error e -> Error e - | Ok () -> ( - match f () with - | Ok result -> ( match B.commit conn with Ok () -> Ok result | Error e -> Error e ) - | Error e -> - let _ = B.rollback conn in - Error e ) -end - -(** In-memory backend for testing and development *) -module MemoryBackend : BACKEND with type configuration = unit = struct - type configuration = unit - - type connection = - { data: (string, bytes) Hashtbl.t; - mutable in_transaction: bool; - mutable transaction_buffer: (string * bytes) list } - - module Error = struct - open Condition - - (* TODO: more structure *) - let parse_error msg = condition "parse-error" msg empty - - let already_in_transaction = - condition "already-in-transaction" "Already inside a transaction" empty - - let not_in_transaction = condition "not-in-transaction" "Not inside a transaction" empty - end - - let parse sexp = - match sexp with - | Sexplib.Sexp.List [] -> Ok () - | _ -> - Error - (Error.parse_error - (Printf.sprintf "memory backend takes no configuration, got: %s" - (Sexplib.Sexp.to_string sexp) ) ) - - let connect () = Ok {data= Hashtbl.create 1024; in_transaction= false; transaction_buffer= []} - let disconnect _ = () - let get conn hash = Ok (Hashtbl.find_opt conn.data hash) - - let put conn hash value = - if conn.in_transaction then begin - conn.transaction_buffer <- (hash, value) :: conn.transaction_buffer; - Ok () - end - else begin - Hashtbl.replace conn.data hash value; - Ok () - end - - let exists conn hash = Ok (Hashtbl.mem conn.data hash) - - let begin_transaction conn = - if conn.in_transaction then Error Error.already_in_transaction - else begin - conn.in_transaction <- true; - conn.transaction_buffer <- []; - Ok () - end - - let commit conn = - if not conn.in_transaction then Error Error.not_in_transaction - else begin - List.iter (fun (hash, value) -> Hashtbl.replace conn.data hash value) conn.transaction_buffer; - conn.in_transaction <- false; - conn.transaction_buffer <- []; - Ok () - end - - let rollback conn = - if not conn.in_transaction then Error Error.not_in_transaction - else begin - conn.in_transaction <- false; - conn.transaction_buffer <- []; - Ok () - end - - let get_many conn hashes = Ok (List.map (fun h -> Hashtbl.find_opt conn.data h) hashes) - - let put_many conn pairs = - List.iter - (fun (hash, value) -> - if conn.in_transaction then - conn.transaction_buffer <- (hash, value) :: conn.transaction_buffer - else Hashtbl.replace conn.data hash value ) - pairs; - Ok () -end - -(** Default in-memory storage for development *) -module Memory = Make (MemoryBackend) |
