aboutsummaryrefslogtreecommitdiffstats
path: root/lib/management
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-09-26 15:30:53 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2026-09-26 15:30:53 -0300
commite32ba6294781691846c3ab19281fe977350b4d0f (patch)
treef38e92ba2fc03e966d7263c7ee2e0b5d7983ebae /lib/management
parentbe375a52da6174dfda5b68617d27e1542cc80499 (diff)
downloadSakura-e32ba6294781691846c3ab19281fe977350b4d0f.tar.gz
Sakura-e32ba6294781691846c3ab19281fe977350b4d0f.zip
preparation cleanup for RNT integration
Diffstat (limited to 'lib/management')
-rw-r--r--lib/management/branch.ml137
-rw-r--r--lib/management/multigroup.ml59
-rw-r--r--lib/management/physical.ml198
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)