aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-03-07 02:40:26 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2026-03-07 02:40:26 -0300
commite9bc4aa3fa0e775acf1978722da1fde1ed8a469d (patch)
treeff78d21ba9a03acae20b15bb2fad2f27bcde75e1 /lib
parentfcd8571577f2b98ffc8fa2b95781ed16982804a9 (diff)
downloadSakura-e9bc4aa3fa0e775acf1978722da1fde1ed8a469d.tar.gz
Sakura-e9bc4aa3fa0e775acf1978722da1fde1ed8a469d.zip
erlang port commands and generated tests
Diffstat (limited to '')
-rw-r--r--lib/hashing.ml53
-rw-r--r--lib/management/database.ml104
-rw-r--r--lib/management/physical.ml200
-rw-r--r--lib/manipulation.ml522
-rw-r--r--lib/merkle.ml71
-rw-r--r--lib/prelude/standard.ml3
-rw-r--r--lib/relation.ml9
-rw-r--r--lib/schema.ml21
-rw-r--r--lib/storable.ml56
9 files changed, 1011 insertions, 28 deletions
diff --git a/lib/hashing.ml b/lib/hashing.ml
new file mode 100644
index 0000000..4709ded
--- /dev/null
+++ b/lib/hashing.ml
@@ -0,0 +1,53 @@
+(** Hash computation for tuples and relations.
+
+ This module provides content-addressable hashing for the relational engine.
+ All hashes are deterministic - the same content always produces the same hash.
+ This enables:
+ - Deduplication of tuples
+ - Merkle tree construction for relations and databases
+ - Time-travel queries (load any historical state by hash) *)
+
+(** Convert bytes to hex string (to avoid null bytes in hash input) *)
+let bytes_to_hex bytes =
+ let len = Bytes.length bytes in
+ let hex = Bytes.create (len * 2) in
+ for i = 0 to len - 1 do
+ let c = Bytes.get_uint8 bytes i in
+ let hi = c lsr 4 in
+ let lo = c land 0xf in
+ Bytes.set hex (i * 2) (Char.chr (if hi < 10 then hi + 48 else hi + 87));
+ Bytes.set hex (i * 2 + 1) (Char.chr (if lo < 10 then lo + 48 else lo + 87));
+ done;
+ Bytes.to_string hex
+
+(** Compute hash for a tuple.
+ The hash is computed from:
+ - The relation name
+ - All attribute names and their marshalled values (sorted by name for determinism) *)
+let hash_tuple (tuple : Tuple.materialized) : Conventions.Hash.t =
+ let sorted_attrs =
+ Tuple.AttributeMap.bindings tuple.attributes
+ |> List.sort (fun (a, _) (b, _) -> String.compare a b)
+ in
+ let content =
+ List.fold_left (fun acc (name, attr) ->
+ (* Marshal the value and hex-encode to avoid null bytes *)
+ let value_bytes = Marshal.to_bytes attr.Attribute.value [Marshal.Closures] in
+ let value_hex = bytes_to_hex value_bytes in
+ acc ^ name ^ ":" ^ value_hex ^ ";"
+ ) (tuple.relation ^ "|") sorted_attrs
+ in
+ Conventions.Hash.hash_text content
+
+(** Compute hash for a relation.
+ The hash is computed from:
+ - The relation name
+ - The schema (attribute names and types)
+ - The merkle tree root hash (representing all tuples) *)
+let hash_relation ~name ~(schema : Schema.t) ~tree : Conventions.Hash.t =
+ let schema_str = Schema.to_string schema in
+ let tree_hash = match Merkle.root_hash tree with
+ | Some h -> h
+ | None -> "empty"
+ in
+ Conventions.Hash.hash_text (name ^ "|" ^ schema_str ^ "|" ^ tree_hash)
diff --git a/lib/management/database.ml b/lib/management/database.ml
index 4fd43f1..1e68402 100644
--- a/lib/management/database.ml
+++ b/lib/management/database.ml
@@ -1,23 +1,97 @@
-module RelationMap = Map.Make (String)
+(** Database state management.
+
+ A database is a collection of relations with:
+ - A merkle tree of relation hashes (for integrity verification)
+ - A map of relation names to their actual Relation.t objects (integrated cache)
+ - A history of previous database hashes (for time-travel queries)
+
+ All mutations produce a new database state with a new hash.
+ The history chain allows reconstruction of any past state. *)
+
+module RelationMap = Map.Make(String)
type t = {
hash : Conventions.Hash.t;
name : Conventions.Name.t;
- tree : unit;
- relations : Relation.t RelationMap.t;
+ tree : Merkle.t;
+ relations : Relation.t RelationMap.t; (* Stores actual relations, not just hashes *)
+ history : Conventions.Hash.t list;
timestamp : float;
}
-let create_database (storage: Physical.Storage.t) ~name =
- let relations =
- RelationMap.of_list [("less_than", Prelude.Standard.less_than_natural)]
+let empty ~name = {
+ hash = "";
+ name;
+ tree = Merkle.empty;
+ relations = RelationMap.empty;
+ history = [];
+ timestamp = Unix.gettimeofday ();
+}
+
+(** Compute database hash from the merkle tree root *)
+let compute_hash db =
+ match Merkle.root_hash db.tree with
+ | Some root -> root
+ | None -> Conventions.Hash.hash_text db.name
+
+(** Update database with new relations map and tree *)
+let update_state db ~relations ~tree =
+ let new_hash =
+ match Merkle.root_hash tree with
+ | Some root -> root
+ | None -> Conventions.Hash.hash_text db.name
in
- let state =
- {
- hash = "";
- name;
- tree = ();
- relations = relations;
- timestamp = Unix.time ();
- }
- in Physical.Storage.write storage
+ let history = if db.hash = "" then db.history else db.hash :: db.history in
+ {
+ hash = new_hash;
+ name = db.name;
+ tree;
+ relations;
+ history;
+ timestamp = Unix.gettimeofday ();
+ }
+
+(** Get a relation by name *)
+let get_relation db name =
+ RelationMap.find_opt name db.relations
+
+(** Get a relation's hash by name *)
+let get_relation_hash db name =
+ match RelationMap.find_opt name db.relations with
+ | None -> None
+ | Some rel -> rel.Relation.hash
+
+let get_relation_names db =
+ RelationMap.fold (fun name _ acc -> name :: acc) db.relations []
+
+let has_relation db name =
+ RelationMap.mem name db.relations
+
+(** Add a relation to the database *)
+let add_relation db ~(relation : Relation.t) =
+ let relation_hash = Option.get relation.hash in
+ let tree = Merkle.insert relation_hash db.tree in
+ let relations = RelationMap.add relation.name relation db.relations in
+ update_state db ~relations ~tree
+
+(** Remove a relation from the database *)
+let remove_relation db ~name =
+ match RelationMap.find_opt name db.relations with
+ | None -> db
+ | Some relation ->
+ let relation_hash = Option.get relation.hash in
+ let tree = Merkle.delete relation_hash db.tree in
+ let relations = RelationMap.remove name db.relations in
+ update_state db ~relations ~tree
+
+(** Update a relation in the database (after tuple insert/delete) *)
+let update_relation db ~(relation : Relation.t) =
+ let name = relation.name in
+ match RelationMap.find_opt name db.relations with
+ | None -> db (* Relation doesn't exist, no-op *)
+ | Some old_relation ->
+ let old_hash = Option.get old_relation.hash in
+ let new_hash = Option.get relation.hash in
+ let tree = db.tree |> Merkle.delete old_hash |> Merkle.insert new_hash in
+ let relations = RelationMap.add name relation db.relations in
+ update_state db ~relations ~tree
diff --git a/lib/management/physical.ml b/lib/management/physical.ml
index 83ccbcc..6063d79 100644
--- a/lib/management/physical.ml
+++ b/lib/management/physical.ml
@@ -1,12 +1,198 @@
-module type STORAGE = sig
- type t
- val write: t -> Conventions.Hash.t
+(** 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
+ type connection
+ type error
+
+ (** Connect to the storage backend *)
+ val connect : unit -> (connection, error) 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, error) result
+
+ (** Store a value at its hash *)
+ val put : connection -> Conventions.Hash.t -> bytes -> (unit, error) result
+
+ (** Check if a hash exists *)
+ val exists : connection -> Conventions.Hash.t -> (bool, error) result
+
+ (** Begin a transaction *)
+ val begin_transaction : connection -> (unit, error) result
+
+ (** Commit a transaction *)
+ val commit : connection -> (unit, error) result
+ (** Rollback a transaction *)
+ val rollback : connection -> (unit, error) result
+
+ (** Batch get multiple values *)
+ val get_many : connection -> Conventions.Hash.t list -> (bytes option list, error) result
+
+ (** Batch put multiple values *)
+ val put_many : connection -> (Conventions.Hash.t * bytes) list -> (unit, error) result
end
-module Storage: STORAGE = struct
+(** Storage operations built on top of a backend *)
+module type S = sig
type t
- let write _ =
- failwith "TODO"
+ type error
+
+ (** Create a storage instance from a backend connection *)
+ val create : unit -> (t, error) 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, error) result
+
+ (** Load an attribute value by hash *)
+ val load_attribute : t -> Conventions.Hash.t -> (Conventions.AbstractValue.t option, error) result
+
+ (** Store raw bytes at a hash *)
+ val store_raw : t -> Conventions.Hash.t -> bytes -> (unit, error) result
+
+ (** Load raw bytes by hash *)
+ val load_raw : t -> Conventions.Hash.t -> (bytes option, error) result
+
+ (** Check if a hash exists *)
+ val exists : t -> Conventions.Hash.t -> (bool, error) result
+
+ (** Execute a function within a transaction *)
+ val with_transaction : t -> (unit -> ('a, error) result) -> ('a, error) result
+end
+
+(** Functor to create storage operations from a backend *)
+module Make (B : BACKEND) : S with type error = B.error = struct
+ type t = B.connection
+ type error = B.error
+
+ let create () = B.connect ()
+
+ 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 error = string = struct
+ type connection = {
+ data : (string, bytes) Hashtbl.t;
+ mutable in_transaction : bool;
+ mutable transaction_buffer : (string * bytes) list;
+ }
+ type error = string
+
+ 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 "Already in transaction"
+ else begin
+ conn.in_transaction <- true;
+ conn.transaction_buffer <- [];
+ Ok ()
+ end
+
+ let commit conn =
+ if not conn.in_transaction then
+ 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 "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
-end \ No newline at end of file
+(** Default in-memory storage for development *)
+module Memory = Make(MemoryBackend)
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index 9b60306..50722a8 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -1 +1,521 @@
-let create_database \ No newline at end of file
+(** Database manipulation operations.
+
+ This module implements the core CRUD operations for the relational engine:
+ - Database creation
+ - Relation creation and deletion
+ - Tuple insertion and deletion
+ - Query operations
+
+ All operations are immutable: they return new database/relation states
+ rather than modifying existing ones. The storage layer handles persistence.
+
+ This is a functor that takes a storage backend, ensuring all tuple data
+ is properly persisted to the content-addressed store. *)
+
+module RelationMap = Management.Database.RelationMap
+
+(** Error types for manipulation operations *)
+type error =
+ | RelationNotFound of string
+ | RelationAlreadyExists of string
+ | TupleNotFound of Conventions.Hash.t
+ | DuplicateTuple of Conventions.Hash.t
+ | ConstraintViolation of string
+ | StorageError of string
+
+(** Result type for operations *)
+type 'a result = ('a, error) Result.t
+
+(** Re-export Schema for convenience *)
+module Schema = Schema
+
+(** Re-export hashing functions for convenience *)
+let hash_tuple = Hashing.hash_tuple
+
+(** Build base provenance for a schema *)
+let build_base_provenance _schema relation_name =
+ Relation.Provenance.Base relation_name
+
+(** Build membership criteria from schema (validates type membership) *)
+let build_membership_criteria _schema : (Tuple.t -> bool) =
+ (* For now, accept all tuples. Full implementation would check domain membership. *)
+ fun _ -> true
+
+(** Functor to create manipulation operations with a storage backend *)
+module Make (Storage : Management.Physical.S) = struct
+ type storage = Storage.t
+
+ (* ============================================================================
+ State Persistence - Store relation and database states
+ ============================================================================ *)
+
+ (** Store a relation state to storage *)
+ let store_relation (storage : storage) (relation : Relation.t) : (unit, error) Result.t =
+ match relation.hash with
+ | None -> Error (StorageError "Relation has no hash")
+ | Some rel_hash ->
+ let tree_keys = match relation.tree with
+ | None -> []
+ | Some tree -> Merkle.keys tree
+ in
+ let stored : Storable.Relation.t = {
+ name = relation.name;
+ schema = relation.schema;
+ tree_keys;
+ cardinality = relation.cardinality;
+ } in
+ match Storage.store_raw storage rel_hash (Storable.Relation.to_bytes stored) with
+ | Error _ -> Error (StorageError "Failed to store relation")
+ | Ok () -> Ok ()
+
+ (** Store a database state to storage *)
+ let store_database (storage : storage) (db : Management.Database.t) : (unit, error) Result.t =
+ if db.hash = "" then
+ Ok () (* Don't store empty/initial database *)
+ else
+ (* Extract relation hashes from the actual relations *)
+ let relation_hashes =
+ Management.Database.RelationMap.fold
+ (fun name rel acc ->
+ match rel.Relation.hash with
+ | Some h -> (name, h) :: acc
+ | None -> acc)
+ db.relations
+ []
+ in
+ let stored : Storable.Database.t = {
+ name = db.name;
+ relations = relation_hashes;
+ tree_keys = Merkle.keys db.tree;
+ history = db.history;
+ timestamp = db.timestamp;
+ } in
+ match Storage.store_raw storage db.hash (Storable.Database.to_bytes stored) with
+ | Error _ -> Error (StorageError "Failed to store database")
+ | Ok () -> Ok ()
+
+ (** Load a relation state from storage by hash *)
+ let load_relation (storage : storage) (rel_hash : Conventions.Hash.t)
+ : (Relation.t option, error) Result.t =
+ match Storage.load_raw storage rel_hash with
+ | Error _ -> Error (StorageError "Failed to load relation")
+ | Ok None -> Ok None
+ | Ok (Some bytes) ->
+ let stored = Storable.Relation.of_bytes bytes in
+ let tree = List.fold_left (fun t h -> Merkle.insert h t) Merkle.empty stored.tree_keys in
+ let relation = Relation.make
+ ~hash:(Some rel_hash)
+ ~name:stored.name
+ ~schema:stored.schema
+ ~tree:(Some tree)
+ ~constraints:None
+ ~cardinality:stored.cardinality
+ ~generator:None
+ ~membership_criteria:(build_membership_criteria stored.schema)
+ ~provenance:(build_base_provenance stored.schema stored.name)
+ ~lineage:(Relation.Lineage.Base stored.name)
+ in
+ Ok (Some relation)
+
+ (** Load a database state from storage by hash.
+ Note: This loads the database structure with relation hashes,
+ but the relations themselves need to be loaded separately. *)
+ let load_database (storage : storage) (db_hash : Conventions.Hash.t)
+ : (Management.Database.t option, error) Result.t =
+ match Storage.load_raw storage db_hash with
+ | Error _ -> Error (StorageError "Failed to load database")
+ | Ok None -> Ok None
+ | Ok (Some bytes) ->
+ let stored = Storable.Database.of_bytes bytes in
+ let tree = List.fold_left (fun t h -> Merkle.insert h t) Merkle.empty stored.tree_keys in
+ (* Load each relation from storage *)
+ let rec load_relations acc = function
+ | [] -> Ok (List.rev acc)
+ | (name, rel_hash) :: rest ->
+ match load_relation storage rel_hash with
+ | Error e -> Error e
+ | Ok None -> Error (StorageError ("Relation not found: " ^ name))
+ | Ok (Some rel) -> load_relations ((name, rel) :: acc) rest
+ in
+ match load_relations [] stored.relations with
+ | Error e -> Error e
+ | Ok relation_list ->
+ let relations = List.fold_left
+ (fun m (name, rel) -> Management.Database.RelationMap.add name rel m)
+ Management.Database.RelationMap.empty
+ relation_list
+ in
+ Ok (Some {
+ Management.Database.hash = db_hash;
+ name = stored.name;
+ tree;
+ relations;
+ history = stored.history;
+ timestamp = stored.timestamp;
+ })
+
+ (* ============================================================================
+ Database Operations
+ ============================================================================ *)
+
+ (** Create a new database with standard domain relations *)
+ let create_database ~name : Management.Database.t =
+ let db = Management.Database.empty ~name in
+ (* Add standard domain relations: integer, natural, string, etc. *)
+ (* For now, just return empty database. Prelude can be added later. *)
+ db
+
+ (** Get database history *)
+ let database_history (db : Management.Database.t) : Conventions.Hash.t list =
+ db.history
+
+ (* ============================================================================
+ Relation Operations
+ ============================================================================ *)
+
+ (** Create a new empty relation with the given schema *)
+ let create_relation
+ (storage : storage)
+ (db : Management.Database.t)
+ ~(name : string)
+ ~(schema : Schema.t)
+ : (Management.Database.t * Relation.t) result =
+ if Management.Database.has_relation db name then
+ Error (RelationAlreadyExists name)
+ else
+ let tree = Merkle.empty in
+ let relation_hash = Hashing.hash_relation ~name ~schema ~tree in
+ let relation = Relation.make
+ ~hash:(Some relation_hash)
+ ~name
+ ~schema
+ ~tree:(Some tree)
+ ~constraints:None
+ ~cardinality:(Conventions.Cardinality.Finite 0)
+ ~generator:None
+ ~membership_criteria:(build_membership_criteria schema)
+ ~provenance:(build_base_provenance schema name)
+ ~lineage:(Relation.Lineage.Base name)
+ in
+ let new_db = Management.Database.add_relation db ~relation in
+ (* Persist relation and database state *)
+ match store_relation storage relation with
+ | Error e -> Error e
+ | Ok () ->
+ match store_database storage new_db with
+ | Error e -> Error e
+ | Ok () -> Ok (new_db, relation)
+
+ (** Create an immutable/generator-based relation *)
+ let create_immutable_relation
+ (storage : storage)
+ (db : Management.Database.t)
+ ~(name : string)
+ ~(schema : Schema.t)
+ ~(generator : Generator.t)
+ ~(membership_criteria : Tuple.t -> bool)
+ ~(cardinality : Conventions.Cardinality.t)
+ : (Management.Database.t * Relation.t) result =
+ if Management.Database.has_relation db name then
+ Error (RelationAlreadyExists name)
+ else
+ let relation_hash = Hashing.hash_relation ~name ~schema ~tree:Merkle.empty in
+ let relation = Relation.make
+ ~hash:(Some relation_hash)
+ ~name
+ ~schema
+ ~tree:None (* No tree for generator-based relations *)
+ ~constraints:None
+ ~cardinality
+ ~generator:(Some generator)
+ ~membership_criteria
+ ~provenance:(build_base_provenance schema name)
+ ~lineage:(Relation.Lineage.Base name)
+ in
+ let new_db = Management.Database.add_relation db ~relation in
+ (* Persist relation and database state *)
+ match store_relation storage relation with
+ | Error e -> Error e
+ | Ok () ->
+ match store_database storage new_db with
+ | Error e -> Error e
+ | Ok () -> Ok (new_db, relation)
+
+ (** Remove a relation from the database *)
+ let retract_relation
+ (storage : storage)
+ (db : Management.Database.t)
+ ~(name : string)
+ : Management.Database.t result =
+ if not (Management.Database.has_relation db name) then
+ Error (RelationNotFound name)
+ else
+ let new_db = Management.Database.remove_relation db ~name in
+ (* Persist database state *)
+ match store_database storage new_db with
+ | Error e -> Error e
+ | Ok () -> Ok new_db
+
+ (** Clear all tuples from a relation (truncate) *)
+ let clear_relation
+ (storage : storage)
+ (db : Management.Database.t)
+ (relation : Relation.t)
+ : (Management.Database.t * Relation.t) result =
+ let name = relation.name in
+ match Management.Database.get_relation db name with
+ | None -> Error (RelationNotFound name)
+ | Some _ ->
+ let new_tree = Merkle.empty in
+ let new_hash = Hashing.hash_relation ~name ~schema:relation.schema ~tree:new_tree in
+ let new_relation = { relation with
+ hash = Some new_hash;
+ tree = Some new_tree;
+ cardinality = Conventions.Cardinality.Finite 0;
+ } in
+ let new_db = Management.Database.update_relation db ~relation:new_relation in
+ (* Persist relation and database state *)
+ match store_relation storage new_relation with
+ | Error e -> Error e
+ | Ok () ->
+ match store_database storage new_db with
+ | Error e -> Error e
+ | Ok () -> Ok (new_db, new_relation)
+
+ (* ============================================================================
+ Tuple Operations - Storage Integrated
+ ============================================================================ *)
+
+ (** Store each attribute value and return map of attr_name -> attr_hash *)
+ let store_attributes
+ (storage : storage)
+ (tuple : Tuple.materialized)
+ : ((string * Conventions.Hash.t) list, error) Result.t =
+ let attrs = Tuple.AttributeMap.bindings tuple.attributes in
+ let rec store_all acc = function
+ | [] -> Ok (List.rev acc)
+ | (name, attr) :: rest ->
+ let value_bytes = Marshal.to_bytes attr.Attribute.value [Marshal.Closures] in
+ let value_hash = Conventions.Hash.hash_text (Hashing.bytes_to_hex value_bytes) in
+ match Storage.store_raw storage value_hash value_bytes with
+ | Error _ -> Error (StorageError ("Failed to store attribute: " ^ name))
+ | Ok () -> store_all ((name, value_hash) :: acc) rest
+ in
+ store_all [] attrs
+
+ (** Insert a tuple into a relation, storing it in the backend *)
+ let create_tuple
+ (storage : storage)
+ (db : Management.Database.t)
+ (relation : Relation.t)
+ (tuple : Tuple.materialized)
+ : (Management.Database.t * Relation.t * Conventions.Hash.t) result =
+ let name = relation.name in
+ match Management.Database.get_relation db name with
+ | None -> Error (RelationNotFound name)
+ | Some _ ->
+ (* Check membership criteria *)
+ if not (relation.membership_criteria (Tuple.Materialized tuple)) then
+ Error (ConstraintViolation "Tuple does not satisfy membership criteria")
+ else
+ (* Compute tuple hash *)
+ let tuple_hash = Hashing.hash_tuple tuple in
+
+ (* Get current tree or create empty one *)
+ let current_tree = match relation.tree with
+ | Some t -> t
+ | None -> Merkle.empty
+ in
+
+ (* Check for duplicate *)
+ if Merkle.member tuple_hash current_tree then
+ Error (DuplicateTuple tuple_hash)
+ else
+ (* Store attribute values in storage *)
+ match store_attributes storage tuple with
+ | Error e -> Error e
+ | Ok attr_hashes ->
+ (* Create stored tuple representation *)
+ let stored_tuple : Storable.Tuple.t = {
+ relation = tuple.relation;
+ attributes = attr_hashes;
+ } in
+
+ (* Store the tuple itself *)
+ let tuple_bytes = Storable.Tuple.to_bytes stored_tuple in
+ (match Storage.store_raw storage tuple_hash tuple_bytes with
+ | Error _ -> Error (StorageError "Failed to store tuple")
+ | Ok () ->
+ (* Insert tuple hash into relation's merkle tree *)
+ let new_tree = Merkle.insert tuple_hash current_tree in
+
+ (* Compute new relation hash *)
+ let new_relation_hash = Hashing.hash_relation ~name ~schema:relation.schema ~tree:new_tree in
+
+ (* Update cardinality *)
+ let new_cardinality = match relation.cardinality with
+ | Conventions.Cardinality.Finite n -> Conventions.Cardinality.Finite (n + 1)
+ | other -> other
+ in
+
+ (* Create updated relation *)
+ let new_relation = { relation with
+ hash = Some new_relation_hash;
+ tree = Some new_tree;
+ cardinality = new_cardinality;
+ } in
+
+ (* Update database with the new relation *)
+ let new_db = Management.Database.update_relation db ~relation:new_relation in
+
+ (* Persist relation and database state *)
+ match store_relation storage new_relation with
+ | Error e -> Error e
+ | Ok () ->
+ match store_database storage new_db with
+ | Error e -> Error e
+ | Ok () -> Ok (new_db, new_relation, tuple_hash))
+
+ (** Insert multiple tuples into a relation *)
+ let create_tuples
+ (storage : storage)
+ (db : Management.Database.t)
+ (relation : Relation.t)
+ (tuples : Tuple.materialized list)
+ : (Management.Database.t * Relation.t * Conventions.Hash.t list) result =
+ let rec insert_all db rel hashes = function
+ | [] -> Ok (db, rel, List.rev hashes)
+ | tuple :: rest ->
+ match create_tuple storage db rel tuple with
+ | Error e -> Error e
+ | Ok (new_db, new_rel, hash) ->
+ insert_all new_db new_rel (hash :: hashes) rest
+ in
+ insert_all db relation [] tuples
+
+ (** Load a tuple from storage by its hash *)
+ let load_tuple
+ (storage : storage)
+ (tuple_hash : Conventions.Hash.t)
+ : (Tuple.materialized option, error) Result.t =
+ match Storage.load_raw storage tuple_hash with
+ | Error _ -> Error (StorageError "Failed to load tuple")
+ | Ok None -> Ok None
+ | Ok (Some tuple_bytes) ->
+ let stored = Storable.Tuple.of_bytes tuple_bytes in
+ (* Load each attribute value *)
+ let rec load_attrs acc = function
+ | [] -> Ok (List.rev acc)
+ | (name, attr_hash) :: rest ->
+ match Storage.load_raw storage attr_hash with
+ | Error _ -> Error (StorageError ("Failed to load attribute: " ^ name))
+ | Ok None -> Error (StorageError ("Attribute not found: " ^ name))
+ | Ok (Some value_bytes) ->
+ let value : Conventions.AbstractValue.t = Marshal.from_bytes value_bytes 0 in
+ let attr : Attribute.materialized = { value } in
+ load_attrs ((name, attr) :: acc) rest
+ in
+ match load_attrs [] stored.attributes with
+ | Error e -> Error e
+ | Ok attrs ->
+ let attributes = List.fold_left
+ (fun m (k, v) -> Tuple.AttributeMap.add k v m)
+ Tuple.AttributeMap.empty
+ attrs
+ in
+ Ok (Some { Tuple.relation = stored.relation; attributes })
+
+ (** Load multiple tuples from storage *)
+ let load_tuples
+ (storage : storage)
+ (hashes : Conventions.Hash.t list)
+ : (Tuple.materialized list, error) Result.t =
+ let rec load_all acc = function
+ | [] -> Ok (List.rev acc)
+ | hash :: rest ->
+ match load_tuple storage hash with
+ | Error e -> Error e
+ | Ok None -> Error (TupleNotFound hash)
+ | Ok (Some tuple) -> load_all (tuple :: acc) rest
+ in
+ load_all [] hashes
+
+ (** Remove a tuple from a relation by its hash *)
+ let retract_tuple
+ (storage : storage)
+ (db : Management.Database.t)
+ (relation : Relation.t)
+ ~(tuple_hash : Conventions.Hash.t)
+ : (Management.Database.t * Relation.t) result =
+ let name = relation.name in
+ match Management.Database.get_relation db name with
+ | None -> Error (RelationNotFound name)
+ | Some _ ->
+ match relation.tree with
+ | None -> Error (TupleNotFound tuple_hash)
+ | Some current_tree ->
+ if not (Merkle.member tuple_hash current_tree) then
+ Error (TupleNotFound tuple_hash)
+ else
+ (* Remove tuple hash from tree *)
+ (* Note: We don't delete from storage - content-addressed storage is append-only.
+ The tuple data remains for historical queries / garbage collection later. *)
+ let new_tree = Merkle.delete tuple_hash current_tree in
+
+ (* Compute new relation hash *)
+ let new_relation_hash = Hashing.hash_relation ~name ~schema:relation.schema ~tree:new_tree in
+
+ (* Update cardinality *)
+ let new_cardinality = match relation.cardinality with
+ | Conventions.Cardinality.Finite n when n > 0 ->
+ Conventions.Cardinality.Finite (n - 1)
+ | other -> other
+ in
+
+ (* Create updated relation *)
+ let new_relation = { relation with
+ hash = Some new_relation_hash;
+ tree = Some new_tree;
+ cardinality = new_cardinality;
+ } in
+
+ (* Update database *)
+ let new_db = Management.Database.update_relation db ~relation:new_relation in
+
+ (* Persist relation and database state *)
+ match store_relation storage new_relation with
+ | Error e -> Error e
+ | Ok () ->
+ match store_database storage new_db with
+ | Error e -> Error e
+ | Ok () -> Ok (new_db, new_relation)
+
+ (* ============================================================================
+ Query Operations
+ ============================================================================ *)
+
+ (** Get all tuple hashes from a relation *)
+ let tuple_hashes (relation : Relation.t) : Conventions.Hash.t list =
+ match relation.tree with
+ | None -> []
+ | Some tree -> Merkle.keys tree
+
+ (** Get relation by name from database *)
+ let get_relation (db : Management.Database.t) ~(name : string) : Relation.t option =
+ Management.Database.get_relation db name
+
+ (** Count tuples in a relation *)
+ let tuple_count (relation : Relation.t) : int =
+ match relation.tree with
+ | None -> 0
+ | Some tree -> Merkle.size tree
+
+ (** Check if a tuple exists in a relation *)
+ let tuple_exists (relation : Relation.t) (tuple_hash : Conventions.Hash.t) : bool =
+ match relation.tree with
+ | None -> false
+ | Some tree -> Merkle.member tuple_hash tree
+end
+
+(** Default instance using in-memory storage for convenience/testing *)
+module Memory = Make(Management.Physical.Memory)
diff --git a/lib/merkle.ml b/lib/merkle.ml
new file mode 100644
index 0000000..e3f68d9
--- /dev/null
+++ b/lib/merkle.ml
@@ -0,0 +1,71 @@
+(** Merkle tree module signature for content-addressed hash sets.
+
+ This is an opaque interface that can be backed by different implementations:
+ - A simple hash set (current placeholder)
+ - A proper radix/patricia merkle tree (e.g., plebeia when OCaml 5 support arrives)
+
+ The tree stores hashes as keys (like a set) and computes a root hash
+ from all contained elements. *)
+
+module type S = sig
+ type t
+
+ (** The empty tree *)
+ val empty : t
+
+ (** Check if tree is empty *)
+ val is_empty : t -> bool
+
+ (** Insert a hash into the tree. Returns a new tree. *)
+ val insert : Conventions.Hash.t -> t -> t
+
+ (** Delete a hash from the tree. Returns a new tree. *)
+ val delete : Conventions.Hash.t -> t -> t
+
+ (** Check if a hash is in the tree *)
+ val member : Conventions.Hash.t -> t -> bool
+
+ (** Get all hashes in the tree *)
+ val keys : t -> Conventions.Hash.t list
+
+ (** Compute the root hash of the tree. None if empty. *)
+ val root_hash : t -> Conventions.Hash.t option
+
+ (** Number of elements in the tree *)
+ val size : t -> int
+end
+
+(** Simple hash set implementation.
+ This is a placeholder until a proper radix-merkle library
+ with OCaml 5 support becomes available. *)
+module HashSet : S = struct
+ module StringSet = Set.Make(String)
+
+ type t = StringSet.t
+
+ let empty = StringSet.empty
+
+ let is_empty = StringSet.is_empty
+
+ let insert hash tree = StringSet.add hash tree
+
+ let delete hash tree = StringSet.remove hash tree
+
+ let member hash tree = StringSet.mem hash tree
+
+ let keys tree = StringSet.elements tree
+
+ let root_hash tree =
+ if StringSet.is_empty tree then
+ None
+ else
+ (* Compute root hash by hashing sorted concatenation of all hashes *)
+ let sorted_hashes = StringSet.elements tree in
+ let concatenated = String.concat "" sorted_hashes in
+ Some (Conventions.Hash.hash_text concatenated)
+
+ let size = StringSet.cardinal
+end
+
+(** Default implementation using HashSet *)
+include HashSet
diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml
index 5099104..5725978 100644
--- a/lib/prelude/standard.ml
+++ b/lib/prelude/standard.ml
@@ -21,9 +21,10 @@ let less_than_natural: Relation.t =
in let right = Tuple.AttributeMap.find "right" materialized.attributes
in left < right
| Tuple.NonMaterialized _non_materialized -> false (* TODO: Handle references later *)
- in Relation.make
+ in Relation.make
~hash: None
~name: "natural_natural_less_than"
+ ~schema: (Schema.empty |> Schema.add "left" "natural" |> Schema.add "right" "natural")
~tree: None
~constraints: None
~cardinality: Conventions.Cardinality.AlephZero
diff --git a/lib/relation.ml b/lib/relation.ml
index 705dcc5..0773c6c 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -1,6 +1,5 @@
-module Tree = struct
- type t = unit (* TODO: Radix Merkle tree here *)
-end
+(** Use the Merkle module for tuple hash storage *)
+module Tree = Merkle
module RelationConstraint = struct
type name = string
@@ -32,6 +31,7 @@ end
type t = {
hash : Conventions.Hash.t option;
name : Conventions.Name.t;
+ schema : Schema.t;
tree : Tree.t option;
constraints : RelationConstraint.t option;
cardinality : Conventions.Cardinality.t;
@@ -41,11 +41,12 @@ type t = {
lineage : Lineage.t;
}
-let make ~hash ~name ~tree ~constraints ~cardinality ~generator
+let make ~hash ~name ~schema ~tree ~constraints ~cardinality ~generator
~membership_criteria ~provenance ~lineage =
{
hash;
name;
+ schema;
tree;
constraints;
cardinality;
diff --git a/lib/schema.ml b/lib/schema.ml
new file mode 100644
index 0000000..e17f7a5
--- /dev/null
+++ b/lib/schema.ml
@@ -0,0 +1,21 @@
+(** Schema: maps attribute names to domain/type names.
+
+ A schema defines the structure of a relation by listing each attribute
+ and its associated domain (type). This is used for:
+ - Hashing relations (schema is part of the relation identity)
+ - Validation (checking tuple membership)
+ - Persistence (storing and loading relations with their structure) *)
+
+type t = (string * string) list
+
+let empty : t = []
+
+let add name domain_name (schema : t) : t =
+ (name, domain_name) :: schema
+
+let attributes (schema : t) =
+ List.map fst schema
+
+let to_string schema =
+ List.map (fun (n, t) -> n ^ ":" ^ t) schema
+ |> String.concat ","
diff --git a/lib/storable.ml b/lib/storable.ml
new file mode 100644
index 0000000..058773c
--- /dev/null
+++ b/lib/storable.ml
@@ -0,0 +1,56 @@
+(** Serialization formats for content-addressed storage.
+
+ These modules define the wire format for persisting relational engine
+ objects to storage. Each type has to_bytes/of_bytes for serialization.
+
+ The stored formats capture only the essential data needed for reconstruction:
+ - Tuple: relation name and attribute hashes
+ - Relation: name, schema, tuple hashes, cardinality
+ - Database: name, relation hashes, merkle tree keys, history *)
+
+(** Stored tuple format for serialization *)
+module Tuple = struct
+ type t = {
+ relation : string;
+ attributes : (string * Conventions.Hash.t) list; (* attr_name -> attr_value_hash *)
+ }
+
+ let to_bytes (st : t) : bytes =
+ Marshal.to_bytes st [Marshal.Closures]
+
+ let of_bytes (b : bytes) : t =
+ Marshal.from_bytes b 0
+end
+
+(** Stored relation format for serialization *)
+module Relation = struct
+ type t = {
+ name : string;
+ schema : Schema.t;
+ tree_keys : Conventions.Hash.t list; (* Merkle tree contents - tuple hashes *)
+ cardinality : Conventions.Cardinality.t;
+ }
+
+ let to_bytes (sr : t) : bytes =
+ Marshal.to_bytes sr [Marshal.Closures]
+
+ let of_bytes (b : bytes) : t =
+ Marshal.from_bytes b 0
+end
+
+(** Stored database format for serialization *)
+module Database = struct
+ type t = {
+ name : string;
+ relations : (string * Conventions.Hash.t) list; (* name -> relation_hash *)
+ tree_keys : Conventions.Hash.t list; (* Merkle tree contents - relation hashes *)
+ history : Conventions.Hash.t list;
+ timestamp : float;
+ }
+
+ let to_bytes (sd : t) : bytes =
+ Marshal.to_bytes sd [Marshal.Closures]
+
+ let of_bytes (b : bytes) : t =
+ Marshal.from_bytes b 0
+end