diff options
| -rw-r--r-- | deps/blake2.nix | 29 | ||||
| -rw-r--r-- | deps/plebeia.nix | 38 | ||||
| -rw-r--r-- | docs/architecture.org | 282 | ||||
| -rw-r--r-- | flake.nix | 2 | ||||
| -rw-r--r-- | lib/hashing.ml | 53 | ||||
| -rw-r--r-- | lib/management/database.ml | 104 | ||||
| -rw-r--r-- | lib/management/physical.ml | 200 | ||||
| -rw-r--r-- | lib/manipulation.ml | 522 | ||||
| -rw-r--r-- | lib/merkle.ml | 71 | ||||
| -rw-r--r-- | lib/prelude/standard.ml | 3 | ||||
| -rw-r--r-- | lib/relation.ml | 9 | ||||
| -rw-r--r-- | lib/schema.ml | 21 | ||||
| -rw-r--r-- | lib/storable.ml | 56 | ||||
| -rw-r--r-- | test/test_relational_engine.ml | 875 |
14 files changed, 2236 insertions, 29 deletions
diff --git a/deps/blake2.nix b/deps/blake2.nix new file mode 100644 index 0000000..adf902d --- /dev/null +++ b/deps/blake2.nix @@ -0,0 +1,29 @@ +{ lib, ocamlPackages, fetchFromGitLab }: +ocamlPackages.buildDunePackage { + duneVersion = "2"; + useDune2 = true; + + pname = "blake2"; + version = "0.3"; + + minimalOCamlVersion = "4.06"; + + src = fetchFromGitLab { + owner = "nomadic-labs"; + repo = "ocaml-blake2"; + rev = "v0.3"; + sha256 = "sha256-LueEFWNHuTGp/hZNT9sRx3ZhIbGNlSSnqcO9geMzgag="; + }; + + buildInputs = with ocamlPackages; [ ]; + + propagatedBuildInputs = with ocamlPackages; [ ]; + + doCheck = false; + + meta = { + description = "Blake2 cryptographic hash function for OCaml"; + license = lib.licenses.isc; + homepage = "https://gitlab.com/nomadic-labs/ocaml-blake2"; + }; +} diff --git a/deps/plebeia.nix b/deps/plebeia.nix new file mode 100644 index 0000000..559d8bc --- /dev/null +++ b/deps/plebeia.nix @@ -0,0 +1,38 @@ +{ lib, ocamlPackages, fetchFromGitLab, blake2 }: +ocamlPackages.buildDunePackage { + duneVersion = "3"; + + pname = "plebeia"; + version = "2.2.0"; + + minimalOCamlVersion = "4.08"; + + src = fetchFromGitLab { + owner = "dailambda"; + repo = "plebeia"; + rev = "2.2.0"; + sha256 = "sha256-F1/FcCR0gn2kGNps3P4KRrqJlr4skHcuMytIRp4QRac="; + }; + + buildInputs = [ blake2 ] ++ (with ocamlPackages; [ + cstruct + stdint + res + lwt + ]); + + propagatedBuildInputs = [ blake2 ] ++ (with ocamlPackages; [ + cstruct + stdint + res + lwt + ]); + + doCheck = false; + + meta = { + description = "Functional Merkle Patricia tree with disk storage"; + license = lib.licenses.mit; + homepage = "https://github.com/camlspotter/plebeia"; + }; +} diff --git a/docs/architecture.org b/docs/architecture.org new file mode 100644 index 0000000..709fcf2 --- /dev/null +++ b/docs/architecture.org @@ -0,0 +1,282 @@ +#+TITLE: Sakura Architecture + +* Module Organization + +The codebase is organized into focused modules, each with a single +responsibility. This separation enables independent testing, clearer +dependencies, and easier reasoning about the system. + +** Core Types + +- =Schema=: Defines the structure of relations. A schema maps + attribute names to domain names (types), capturing both the shape + and the semantic meaning of each attribute. + +- =Relation=: A relation combines a name, schema, optional merkle tree + of tuple hashes, constraints, cardinality, and metadata for + provenance tracking. The schema is part of the relation's + identity—it's hashed into the relation hash and persisted to + storage. + +- =Tuple=: A tuple is a mapping from attribute names to values. Tuples + can be materialized (concrete values in memory) or non-materialized + (references to be resolved). + +** Computation Modules + +- =Hashing=: Content-addressable hash computation for tuples and + relations. Tuple hashes are computed from sorted attribute + name-value pairs. Relation hashes incorporate the name, schema, and + merkle tree root. + +- =Storable=: Serialization formats for persistence. Each entity type + (tuple, relation, database) has a storable representation that + captures exactly the data needed for reconstruction. + +** Management Layer + +- =Management.Physical=: A functor-based storage abstraction. Any + backend implementing the signature (get, put, exists, transactions) + can be plugged in. The in-memory backend serves development and + testing. + +- =Management.Database=: Database state management. A database holds + its relations directly—not just their hashes—providing an integrated + cache. Mutations produce new database states with updated hashes and + history tracking. + +** Manipulation + +- =Manipulation=: CRUD operations over the storage layer. This module + is a functor parameterized by a storage backend. It handles the + interplay between in-memory relation objects and their persisted + representations, ensuring consistency between the two. + +* Storage Model + +Sakura uses an append-only, content-addressed storage model. Every +object in the database is identified by its cryptographic hash +(SHA-256), and data is never overwritten—only new versions are +appended. This design provides natural deduplication, complete history +preservation, and integrity verification at every level. + +** Content Addressing + +Every entity in Sakura is stored and retrieved by its hash: + +- An *attribute* is a value with its hash. The same value appearing in + multiple tuples is stored once and referenced by hash everywhere + else. + +- A *tuple* is a set of attribute hashes. Its own hash is derived from + the hashes of its constituent attributes. + +- A *relation* maintains a set of tuple hashes. The relation's hash + represents the current state of that set. + +- A *database* holds a map of relation names to their current hashes. + The database hash is computed from this map, forming the root of a + Merkle tree. + +This hierarchical hashing means that any change modifying an +attribute, inserting a tuple, or altering a relation—propagates +upward, producing a new database hash. The chain of database hashes +over time constitutes the complete history of the database. + +** Schema Persistence + +A relation's schema is not merely metadata—it is part of the +relation's identity. The schema is included in the relation hash +computation and persisted alongside the tuple hashes and cardinality. + +When a relation is stored: + +#+begin_example +StoredRelation = { + name: string, + schema: (attribute_name, domain_name) list, + tree_keys: hash list, + cardinality: cardinality +} +#+end_example + +When the relation is loaded from storage, the schema is reconstructed +exactly. This enables: + +- *Schema validation*: Tuples can be validated against the relation's + schema at load time, not just at insertion time. + +- *Query planning*: The schema is available for type checking and + optimization without requiring a separate schema registry. + +- *Time-travel consistency*: Loading a historical relation state + retrieves the schema as it existed at that point in time. + +** Integrated Relation Cache + +The database maintains actual =Relation.t= objects, not just their +hashes. This eliminates the need for a separate cache and ensures +consistency between the database's view of its relations and the +relations themselves. + +When a relation is created or updated: + +1. The =Relation.t= object is constructed with its computed hash +2. The database stores the relation directly in its =relations= map +3. The relation hash is inserted into the database's merkle tree +4. Both the relation and database states are persisted to storage + +Retrieving a relation is a direct map lookup: + +#+begin_src ocaml +let get_relation db name = RelationMap.find_opt name db.relations +#+end_src + +When loading a database from storage, all its relations are loaded +and reconstructed in memory as part of the database load. This +ensures that =load_database= returns a fully operational database +with all relations ready for use. + +** Append-Only Semantics + +Nothing is deleted or modified in place. When a tuple is "updated," +the new version is appended and the relation's hash set is updated to +reference it. The old tuple remains in storage, reachable through +historical database hashes. + +This has practical consequences: + +- *Deduplication*: Identical attribute values share storage. If a + million tuples contain the string "active", that string exists once, + referenced a million times by its hash. + +- *Immutable History*: Any past database state can be reconstructed by + following the Merkle tree from a historical root hash. + +- *Integrity*: Corruption or tampering is detectable—if a stored + object doesn't match its hash, something is wrong. + +** Merkle Tree Structure + +The database forms a Merkle tree where: + +- Leaf nodes are attribute values +- Interior nodes are tuples (referencing attributes) and relations + (referencing tuples) +- The root is the database hash + +This structure enables efficient verification. To prove a tuple +belongs to a relation at a given database state, one needs only the +tuple, its sibling hashes up to the relation, and the path to the +database root—not the entire database. + +* Physical Layer Abstraction + +The physical storage layer is designed as a functor: a module that +accepts any storage backend implementing a common signature. This +means the same relational engine can run against different storage +systems without modification. + +** Backend Requirements + +A storage backend must provide: + +- Key-value storage where keys are hashes and values are serialized objects +- Read operations (potentially with consistency options) +- Write operations (append new objects) +- Transaction support with isolation guarantees + +The abstraction handles the difference between backends that offer +strong consistency (like etcd) and those with eventual consistency +(like DynamoDB), exposing appropriate primitives for dirty reads +versus transactional reads. + +** Pluggable Backends + +Potential backends include: + +- *etcd*: For distributed coordination and strong consistency +- *Redis*: For in-memory speed with optional persistence +- *DynamoDB*: For cloud-native scalability +- *PostgreSQL*: For leveraging existing infrastructure (using it purely as a key-value store) +- *Local filesystem*: For embedded or development use +- *Any key-value store*: The interface is minimal enough to adapt to most systems + +The choice of backend affects performance characteristics and +operational concerns, but not the correctness of the relational +algebra or the integrity guarantees provided by the Merkle structure. + +** Transaction Semantics + +The physical layer must abstract over: + +- *Dirty reads*: Reading potentially uncommitted or stale data, useful + when eventual consistency is acceptable + +- *Transactional reads*: Reading a consistent snapshot, necessary when + operations depend on multiple related values + +- *Atomic writes*: Ensuring that a set of objects is either fully + written or not written at all + +Different backends implement these guarantees differently. The functor +interface normalizes them into a common vocabulary so the relational +engine above can reason about consistency without knowing which +backend is in use. + +* Ephemeral Relations and Generators + +Not all relations are stored. Some are computed on demand. + +** Generator Functions + +An ephemeral relation has a generator: a function that produces tuples +lazily. The relation =less_than_natural=, for instance, generates +pairs (n, m) where n < m from the natural numbers. This relation is +infinite—it cannot be stored—but it can be queried. + +The generator maintains no external state. Given a position (an +integer index into the enumeration), it deterministically produces the +corresponding tuple. This makes ephemeral relations reproducible: +running the same query twice yields the same results. + +** Membership Criteria + +Every relation, stored or ephemeral, has a membership criterion: a +predicate that determines whether a tuple belongs to the relation. +For stored relations, this is typically derived from constraints. For +ephemeral relations, it's the intensional definition—the rule that +characterizes membership rather than an enumeration of members. + +* Provenance and Updatable Views + +When relations are combined through algebraic operations (join, +project, select), the result is an ephemeral relation that tracks +where its attributes came from. + +** Provenance + +Provenance records the source relation of each attribute. If a join +combines =orders= and =customers= on =customer_id=, the resulting +ephemeral relation knows that =order_date= came from =orders= and +=customer_name= came from =customers=. + +This enables updatable views: an update to an attribute in a derived +relation can be traced back to the base relation that owns it and +applied there. The derived relation reflects the change automatically +on next evaluation. + +** Lineage + +Lineage records the operations that produced a relation. It's a tree +describing the algebraic derivation: this relation is a selection over +a projection of a join of these two base relations. + +Lineage enables query optimization (rewriting equivalent expressions) +and provenance queries (understanding how a result was derived). + +* References + +- Codd, E. F. (1979), "Extending the Database Relational Model to Capture More Meaning" +- Merkle, R. (1987), "A Digital Signature Based on a Conventional Encryption Function" +- Buneman, P., Khanna, S., Tan, W. (2001), "Why and Where: A Characterization of Data Provenance" @@ -81,7 +81,7 @@ default = self.packages.${system}.relational_engine; relational_engine = ocamlPackages.buildDunePackage { - pname = "relational_engine"; + pname = "sakura"; version = "0.1.0"; duneVersion = "3"; src = sources.ocaml; 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 diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml index e69de29..b89cdc6 100644 --- a/test/test_relational_engine.ml +++ b/test/test_relational_engine.ml @@ -0,0 +1,875 @@ +(** Tests for the relational engine *) + +open Relational_engine + +(* ============================================================================ + Merkle Tree Tests + ============================================================================ *) + +let%test_unit "merkle: empty tree" = + let tree = Merkle.empty in + assert (Merkle.is_empty tree); + assert (Merkle.size tree = 0); + assert (Merkle.root_hash tree = None) + +let%test_unit "merkle: insert single element" = + let tree = Merkle.empty in + let hash = "abc123" in + let tree = Merkle.insert hash tree in + assert (not (Merkle.is_empty tree)); + assert (Merkle.size tree = 1); + assert (Merkle.member hash tree); + assert (Merkle.root_hash tree <> None) + +let%test_unit "merkle: insert multiple elements" = + let tree = Merkle.empty in + let tree = Merkle.insert "hash1" tree in + let tree = Merkle.insert "hash2" tree in + let tree = Merkle.insert "hash3" tree in + assert (Merkle.size tree = 3); + assert (Merkle.member "hash1" tree); + assert (Merkle.member "hash2" tree); + assert (Merkle.member "hash3" tree); + assert (not (Merkle.member "hash4" tree)) + +let%test_unit "merkle: delete element" = + let tree = Merkle.empty in + let tree = Merkle.insert "hash1" tree in + let tree = Merkle.insert "hash2" tree in + assert (Merkle.size tree = 2); + let tree = Merkle.delete "hash1" tree in + assert (Merkle.size tree = 1); + assert (not (Merkle.member "hash1" tree)); + assert (Merkle.member "hash2" tree) + +let%test_unit "merkle: keys returns all elements" = + let tree = Merkle.empty in + let tree = Merkle.insert "c" tree in + let tree = Merkle.insert "a" tree in + let tree = Merkle.insert "b" tree in + let keys = Merkle.keys tree in + assert (List.length keys = 3); + assert (List.mem "a" keys); + assert (List.mem "b" keys); + assert (List.mem "c" keys) + +let%test_unit "merkle: root hash changes on insert" = + let tree = Merkle.empty in + let tree1 = Merkle.insert "hash1" tree in + let root1 = Merkle.root_hash tree1 in + let tree2 = Merkle.insert "hash2" tree1 in + let root2 = Merkle.root_hash tree2 in + assert (root1 <> root2) + +let%test_unit "merkle: same elements produce same root hash" = + let tree1 = Merkle.empty + |> Merkle.insert "a" + |> Merkle.insert "b" in + let tree2 = Merkle.empty + |> Merkle.insert "b" + |> Merkle.insert "a" in + assert (Merkle.root_hash tree1 = Merkle.root_hash tree2) + +(* ============================================================================ + Physical Storage Tests + ============================================================================ *) + +let%test_unit "storage: create and close" = + match Management.Physical.Memory.create () with + | Error _ -> assert false + | Ok storage -> + Management.Physical.Memory.close storage + +let%test_unit "storage: store and load attribute" = + match Management.Physical.Memory.create () with + | Error _ -> assert false + | Ok storage -> + let value = Obj.magic 42 in + (match Management.Physical.Memory.store_attribute storage value with + | Error _ -> assert false + | Ok hash -> + (match Management.Physical.Memory.load_attribute storage hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded) -> + assert ((Obj.magic loaded : int) = 42))); + Management.Physical.Memory.close storage + +let%test_unit "storage: store and load raw bytes" = + match Management.Physical.Memory.create () with + | Error _ -> assert false + | Ok storage -> + let hash = "test_hash" in + let data = Bytes.of_string "hello world" in + (match Management.Physical.Memory.store_raw storage hash data with + | Error _ -> assert false + | Ok () -> + (match Management.Physical.Memory.load_raw storage hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded) -> + assert (Bytes.equal loaded data))); + Management.Physical.Memory.close storage + +let%test_unit "storage: exists check" = + match Management.Physical.Memory.create () with + | Error _ -> assert false + | Ok storage -> + let hash = "exists_test" in + let data = Bytes.of_string "data" in + (match Management.Physical.Memory.exists storage hash with + | Error _ -> assert false + | Ok exists -> assert (not exists)); + (match Management.Physical.Memory.store_raw storage hash data with + | Error _ -> assert false + | Ok () -> + (match Management.Physical.Memory.exists storage hash with + | Error _ -> assert false + | Ok exists -> assert exists)); + Management.Physical.Memory.close storage + +let%test_unit "storage: transaction commit" = + match Management.Physical.Memory.create () with + | Error _ -> assert false + | Ok storage -> + let result = Management.Physical.Memory.with_transaction storage (fun () -> + let hash = "tx_test" in + let data = Bytes.of_string "tx_data" in + Management.Physical.Memory.store_raw storage hash data + ) in + (match result with + | Error _ -> assert false + | Ok () -> + (match Management.Physical.Memory.exists storage "tx_test" with + | Error _ -> assert false + | Ok exists -> assert exists)); + Management.Physical.Memory.close storage + +(* ============================================================================ + Database Tests + ============================================================================ *) + +let%test_unit "database: create empty" = + let db = Management.Database.empty ~name:"test_db" in + assert (db.name = "test_db"); + assert (Merkle.is_empty db.tree); + assert (Management.Database.RelationMap.is_empty db.relations); + assert (db.history = []) + +let%test_unit "database: add relation" = + let db = Management.Database.empty ~name:"test_db" in + (* Create a minimal relation for testing *) + let relation = Relation.make + ~hash:(Some "rel_hash_1") + ~name:"users" + ~schema:Schema.empty + ~tree:(Some Merkle.empty) + ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) + ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") + in + let db = Management.Database.add_relation db ~relation in + assert (Management.Database.has_relation db "users"); + assert (Management.Database.get_relation_hash db "users" = Some "rel_hash_1"); + assert (not (Management.Database.has_relation db "orders")) + +let%test_unit "database: remove relation" = + let db = Management.Database.empty ~name:"test_db" in + let relation = Relation.make + ~hash:(Some "hash1") + ~name:"users" + ~schema:Schema.empty + ~tree:(Some Merkle.empty) + ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) + ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") + in + let db = Management.Database.add_relation db ~relation in + assert (Management.Database.has_relation db "users"); + let db = Management.Database.remove_relation db ~name:"users" in + assert (not (Management.Database.has_relation db "users")) + +let%test_unit "database: update relation" = + let db = Management.Database.empty ~name:"test_db" in + let relation = Relation.make + ~hash:(Some "hash1") + ~name:"users" + ~schema:Schema.empty + ~tree:(Some Merkle.empty) + ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) + ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") + in + let db = Management.Database.add_relation db ~relation in + let old_db_hash = db.hash in + let updated_relation = { relation with hash = Some "hash2" } in + let db = Management.Database.update_relation db ~relation:updated_relation in + assert (Management.Database.get_relation_hash db "users" = Some "hash2"); + assert (db.hash <> old_db_hash); + assert (List.mem old_db_hash db.history) + +let%test_unit "database: get relation names" = + let db = Management.Database.empty ~name:"test_db" in + let rel1 = Relation.make + ~hash:(Some "h1") + ~name:"users" + ~schema:Schema.empty + ~tree:(Some Merkle.empty) + ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) + ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "users") + in + let rel2 = Relation.make + ~hash:(Some "h2") + ~name:"orders" + ~schema:Schema.empty + ~tree:(Some Merkle.empty) + ~constraints:None + ~cardinality:(Conventions.Cardinality.Finite 0) + ~generator:None + ~membership_criteria:(fun _ -> true) + ~provenance:Relation.Provenance.Undefined + ~lineage:(Relation.Lineage.Base "orders") + in + let db = Management.Database.add_relation db ~relation:rel1 in + let db = Management.Database.add_relation db ~relation:rel2 in + let names = Management.Database.get_relation_names db in + assert (List.length names = 2); + assert (List.mem "users" names); + assert (List.mem "orders" names) + +(* ============================================================================ + Manipulation Tests (using Memory storage) + ============================================================================ *) + +(* Helper to create storage for tests *) +let with_storage f = + match Management.Physical.Memory.create () with + | Error _ -> assert false + | Ok storage -> + let result = f storage in + Management.Physical.Memory.close storage; + result + +let%test_unit "manipulation: create database" = + let db = Manipulation.Memory.create_database ~name:"my_db" in + assert (db.name = "my_db") + +let%test_unit "manipulation: create relation" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "name" "string" + |> Schema.add "age" "integer" in + match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + assert (relation.name = "users"); + assert (relation.schema = schema); + assert (Management.Database.has_relation db "users")) + +let%test_unit "manipulation: create relation already exists" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty in + match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with + | Error _ -> assert false + | Ok (db, _) -> + match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with + | Error (Manipulation.RelationAlreadyExists _) -> () + | _ -> assert false) + +let%test_unit "manipulation: retract relation" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty in + match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with + | Error _ -> assert false + | Ok (db, _) -> + assert (Management.Database.has_relation db "users"); + match Manipulation.Memory.retract_relation storage db ~name:"users" with + | Error _ -> assert false + | Ok db -> + assert (not (Management.Database.has_relation db "users"))) + +let%test_unit "manipulation: create tuple with storage" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "name" "string" in + match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.magic "Alice" } in + let tuple : Tuple.materialized = { relation = "users"; attributes = attrs } in + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (_db, new_relation, _hash) -> + assert (Manipulation.Memory.tuple_count new_relation = 1)) + +let%test_unit "manipulation: create and load tuple" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "value" "integer" in + match Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 } in + let tuple : Tuple.materialized = { relation = "numbers"; attributes = attrs } in + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (_db, _relation, tuple_hash) -> + (* Now load the tuple back from storage *) + match Manipulation.Memory.load_tuple storage tuple_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_tuple) -> + assert (loaded_tuple.relation = "numbers"); + let loaded_value = Tuple.AttributeMap.find "value" loaded_tuple.attributes in + assert ((Obj.magic loaded_value.Attribute.value : int) = 42)) + +let%test_unit "manipulation: create multiple tuples with storage" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "id" "integer" in + match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let make_tuple id = + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id } in + ({ Tuple.relation = "items"; attributes = attrs } : Tuple.materialized) + in + let tuples = [make_tuple 1; make_tuple 2; make_tuple 3] in + match Manipulation.Memory.create_tuples storage db relation tuples with + | Error _ -> assert false + | Ok (_db, new_relation, hashes) -> + assert (Manipulation.Memory.tuple_count new_relation = 3); + assert (List.length hashes = 3)) + +let%test_unit "manipulation: load multiple tuples" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "n" "integer" in + match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let make_tuple n = + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } in + ({ Tuple.relation = "test"; attributes = attrs } : Tuple.materialized) + in + match Manipulation.Memory.create_tuples storage db relation [make_tuple 10; make_tuple 20] with + | Error _ -> assert false + | Ok (_db, _relation, hashes) -> + match Manipulation.Memory.load_tuples storage hashes with + | Error _ -> assert false + | Ok loaded -> + assert (List.length loaded = 2); + let values = List.map (fun t -> + let attr = Tuple.AttributeMap.find "n" t.Tuple.attributes in + (Obj.magic attr.Attribute.value : int) + ) loaded in + assert (List.mem 10 values); + assert (List.mem 20 values)) + +let%test_unit "manipulation: retract tuple" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "value" "integer" in + match Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 } in + let tuple : Tuple.materialized = { relation = "numbers"; attributes = attrs } in + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (db, relation, tuple_hash) -> + assert (Manipulation.Memory.tuple_count relation = 1); + match Manipulation.Memory.retract_tuple storage db relation ~tuple_hash with + | Error _ -> assert false + | Ok (_db, relation) -> + assert (Manipulation.Memory.tuple_count relation = 0); + (* Tuple data still exists in storage (append-only) *) + match Manipulation.Memory.load_tuple storage tuple_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some _) -> () (* Data is still there *)) + +let%test_unit "manipulation: tuple hashes" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty in + match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let make_tuple n = + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } in + ({ Tuple.relation = "test"; attributes = attrs } : Tuple.materialized) + in + match Manipulation.Memory.create_tuples storage db relation [make_tuple 1; make_tuple 2] with + | Error _ -> assert false + | Ok (_db, relation, _) -> + let hashes = Manipulation.Memory.tuple_hashes relation in + assert (List.length hashes = 2)) + +let%test_unit "manipulation: clear relation" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty in + match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let make_tuple n = + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n } in + ({ Tuple.relation = "test"; attributes = attrs } : Tuple.materialized) + in + match Manipulation.Memory.create_tuples storage db relation [make_tuple 1; make_tuple 2; make_tuple 3] with + | Error _ -> assert false + | Ok (db, relation, _) -> + assert (Manipulation.Memory.tuple_count relation = 3); + match Manipulation.Memory.clear_relation storage db relation with + | Error _ -> assert false + | Ok (_db, relation) -> + assert (Manipulation.Memory.tuple_count relation = 0)) + +let%test_unit "manipulation: duplicate tuple rejected" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "x" "integer" in + match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } in + let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } in + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (db, relation, _) -> + (* Try to insert the same tuple again *) + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error (Manipulation.DuplicateTuple _) -> () + | _ -> assert false) + +let%test_unit "manipulation: tuple_exists check" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty in + match Manipulation.Memory.create_relation storage db ~name:"test" ~schema with + | Error _ -> assert false + | Ok (db, relation) -> + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "v" { Attribute.value = Obj.magic 99 } in + let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } in + let tuple_hash = Manipulation.hash_tuple tuple in + assert (not (Manipulation.Memory.tuple_exists relation tuple_hash)); + match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok (_db, relation, hash) -> + assert (hash = tuple_hash); + assert (Manipulation.Memory.tuple_exists relation tuple_hash)) + +let%test_unit "manipulation: hash_tuple deterministic" = + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "a" { Attribute.value = Obj.magic 1 } + |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.magic 2 } in + let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } in + let hash1 = Manipulation.hash_tuple tuple in + let hash2 = Manipulation.hash_tuple tuple in + assert (hash1 = hash2) + +let%test_unit "manipulation: different tuples different hashes" = + let tuple1 : Tuple.materialized = { + relation = "test"; + attributes = Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 1 } + } in + let tuple2 : Tuple.materialized = { + relation = "test"; + attributes = Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 2 } + } in + let hash1 = Manipulation.hash_tuple tuple1 in + let hash2 = Manipulation.hash_tuple tuple2 in + assert (hash1 <> hash2) + +let%test_unit "manipulation: get_relation from database" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "id" "integer" in + match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with + | Error _ -> assert false + | Ok (db, _relation) -> + (* Now get the relation from the database *) + match Manipulation.Memory.get_relation db ~name:"items" with + | None -> assert false + | Some rel -> + assert (rel.name = "items"); + assert (rel.schema = schema)) + +(* ============================================================================ + Schema Persistence Tests + ============================================================================ *) + +let%test_unit "schema: persisted and loaded correctly" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test_db" in + let schema = Schema.empty + |> Schema.add "id" "integer" + |> Schema.add "name" "string" + |> Schema.add "email" "string" in + match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with + | Error _ -> assert false + | Ok (db, _relation) -> + (* Get the relation hash *) + let rel_hash = Option.get (Management.Database.get_relation_hash db "users") in + (* Load the relation from storage *) + match Manipulation.Memory.load_relation storage rel_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_rel) -> + (* Verify schema was persisted and loaded correctly *) + assert (loaded_rel.schema = schema); + assert (List.mem ("id", "integer") loaded_rel.schema); + assert (List.mem ("name", "string") loaded_rel.schema); + assert (List.mem ("email", "string") loaded_rel.schema)) + +(* ============================================================================ + Integration Tests + ============================================================================ *) + +let%test_unit "integration: full workflow with storage" = + with_storage (fun storage -> + (* Create database *) + let db = Manipulation.Memory.create_database ~name:"shop" in + + (* Create products relation *) + let schema = Schema.empty + |> Schema.add "id" "integer" + |> Schema.add "name" "string" + |> Schema.add "price" "integer" in + + let (db, products) = match Manipulation.Memory.create_relation storage db ~name:"products" ~schema with + | Error _ -> assert false + | Ok x -> x + in + + (* Insert some products *) + let make_product id name price = + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id } + |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.magic name } + |> Tuple.AttributeMap.add "price" { Attribute.value = Obj.magic price } in + ({ Tuple.relation = "products"; attributes = attrs } : Tuple.materialized) + in + + let tuples = [ + make_product 1 "Apple" 100; + make_product 2 "Banana" 50; + make_product 3 "Cherry" 200; + ] in + + let (db, products, hashes) = match Manipulation.Memory.create_tuples storage db products tuples with + | Error _ -> assert false + | Ok x -> x + in + + assert (Manipulation.Memory.tuple_count products = 3); + assert (List.length hashes = 3); + + (* Verify we can load all tuples back *) + (match Manipulation.Memory.load_tuples storage hashes with + | Error _ -> assert false + | Ok loaded -> assert (List.length loaded = 3)); + + (* Delete one product *) + let banana_hash = Manipulation.hash_tuple (make_product 2 "Banana" 50) in + let (_db, products) = match Manipulation.Memory.retract_tuple storage db products ~tuple_hash:banana_hash with + | Error _ -> assert false + | Ok x -> x + in + + assert (Manipulation.Memory.tuple_count products = 2); + + (* Verify remaining hashes *) + let remaining_hashes = Manipulation.Memory.tuple_hashes products in + assert (List.length remaining_hashes = 2); + assert (not (List.mem banana_hash remaining_hashes)); + + (* But banana data is still in storage (append-only) *) + match Manipulation.Memory.load_tuple storage banana_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded) -> + let name_attr = Tuple.AttributeMap.find "name" loaded.attributes in + assert ((Obj.magic name_attr.Attribute.value : string) = "Banana")) + +let%test_unit "integration: database history tracking" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"versioned" in + let initial_hash = db.hash in + + let schema = Schema.empty in + let (db, _) = match Manipulation.Memory.create_relation storage db ~name:"rel1" ~schema with + | Error _ -> assert false + | Ok x -> x + in + + (* After first change, initial hash should be in history *) + assert (db.hash <> initial_hash); + (* Note: empty initial hash ("") is not added to history *) + + let hash_after_rel1 = db.hash in + + let (db, _) = match Manipulation.Memory.create_relation storage db ~name:"rel2" ~schema with + | Error _ -> assert false + | Ok x -> x + in + + (* After second change, previous hash should be in history *) + assert (db.hash <> hash_after_rel1); + assert (List.mem hash_after_rel1 db.history)) + +let%test_unit "integration: hash bubbles up correctly" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test" in + let schema = Schema.empty in + + let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with + | Error _ -> assert false + | Ok x -> x + in + + let db_hash_before = db.hash in + let rel_hash_before = relation.hash in + + (* Insert a tuple *) + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } in + let tuple : Tuple.materialized = { relation = "items"; attributes = attrs } in + + let (db, relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok x -> x + in + + (* Relation hash should change *) + assert (relation.hash <> rel_hash_before); + + (* Database hash should change *) + assert (db.hash <> db_hash_before); + + (* Old database hash should be in history *) + assert (List.mem db_hash_before db.history); + + (* Database's merkle tree should contain the new relation hash *) + match relation.hash with + | None -> assert false + | Some rel_hash -> + assert (Merkle.member rel_hash db.tree)) + +(* ============================================================================ + Time-Travel / Branching Tests + ============================================================================ *) + +let%test_unit "branching: load database from historical hash" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test" in + let schema = Schema.empty in + + (* Create relation and add a tuple *) + let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"items" ~schema with + | Error _ -> assert false + | Ok x -> x + in + + let attrs = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 } in + let tuple : Tuple.materialized = { relation = "items"; attributes = attrs } in + + let (db, _relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple with + | Error _ -> assert false + | Ok x -> x + in + + (* Capture hash H1 - database with 1 tuple *) + let h1 = db.hash in + + (* Add another tuple *) + let attrs2 = Tuple.AttributeMap.empty + |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 2 } in + let tuple2 : Tuple.materialized = { relation = "items"; attributes = attrs2 } in + + (* Get relation from database - it's now integrated! *) + let relation = match Manipulation.Memory.get_relation db ~name:"items" with + | None -> assert false + | Some r -> r + in + + let (db, _relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple2 with + | Error _ -> assert false + | Ok x -> x + in + + let h2 = db.hash in + assert (h1 <> h2); + + (* Now load H1 from storage - should get database state with 1 tuple *) + match Manipulation.Memory.load_database storage h1 with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_db) -> + assert (loaded_db.hash = h1); + assert (loaded_db.name = "test"); + (* The relation is now loaded directly in the database *) + match Manipulation.Memory.get_relation loaded_db ~name:"items" with + | None -> assert false + | Some loaded_rel -> + (* Should have 1 tuple *) + assert (Manipulation.Memory.tuple_count loaded_rel = 1)) + +let%test_unit "branching: branch from historical state" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"test" in + let schema = Schema.empty in + + (* Create relation *) + let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"data" ~schema with + | Error _ -> assert false + | Ok x -> x + in + + (* Add tuple A *) + let tuple_a : Tuple.materialized = { + relation = "data"; + attributes = Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "A" } + } in + let (db, relation, _) = match Manipulation.Memory.create_tuple storage db relation tuple_a with + | Error _ -> assert false + | Ok x -> x + in + + (* Capture H1 - state with tuple A *) + let h1 = db.hash in + + (* Continue on main branch: add tuple B *) + let tuple_b : Tuple.materialized = { + relation = "data"; + attributes = Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "B" } + } in + let (db_main, relation_main, _) = match Manipulation.Memory.create_tuple storage db relation tuple_b with + | Error _ -> assert false + | Ok x -> x + in + let h2 = db_main.hash in + + (* Now branch from H1 and add tuple C instead *) + let db_branch = match Manipulation.Memory.load_database storage h1 with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some d) -> d + in + (* Relation is now loaded directly in the database *) + let relation_branch = match Manipulation.Memory.get_relation db_branch ~name:"data" with + | None -> assert false + | Some r -> r + in + + let tuple_c : Tuple.materialized = { + relation = "data"; + attributes = Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "C" } + } in + let (db_branch, _relation_branch, _) = match Manipulation.Memory.create_tuple storage db_branch relation_branch tuple_c with + | Error _ -> assert false + | Ok x -> x + in + let h3 = db_branch.hash in + + (* Verify: H1, H2, H3 are all different *) + assert (h1 <> h2); + assert (h1 <> h3); + assert (h2 <> h3); + + (* H2 (main branch) has tuples A and B *) + assert (Manipulation.Memory.tuple_count relation_main = 2); + + (* H1 is still loadable and unchanged *) + match Manipulation.Memory.load_database storage h1 with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_h1) -> + match Manipulation.Memory.get_relation loaded_h1 ~name:"data" with + | None -> assert false + | Some r -> + assert (Manipulation.Memory.tuple_count r = 1)) + +let%test_unit "branching: full reconstruction from hash" = + with_storage (fun storage -> + let db = Manipulation.Memory.create_database ~name:"shop" in + let schema = Schema.empty in + + (* Create relation *) + let (db, relation) = match Manipulation.Memory.create_relation storage db ~name:"products" ~schema with + | Error _ -> assert false + | Ok x -> x + in + + (* Add products *) + let make_product name = + { Tuple.relation = "products"; + attributes = Tuple.AttributeMap.singleton "name" { Attribute.value = Obj.magic name } } + in + let (db, _relation, _) = match Manipulation.Memory.create_tuples storage db relation + [make_product "Apple"; make_product "Banana"; make_product "Cherry"] with + | Error _ -> assert false + | Ok x -> x + in + + let saved_hash = db.hash in + + (* Now reconstruct everything from just the hash *) + match Manipulation.Memory.load_database storage saved_hash with + | Error _ -> assert false + | Ok None -> assert false + | Ok (Some loaded_db) -> + (* Relation is now loaded directly in the database *) + match Manipulation.Memory.get_relation loaded_db ~name:"products" with + | None -> assert false + | Some loaded_rel -> + (* Get tuple hashes from relation *) + let tuple_hashes = Manipulation.Memory.tuple_hashes loaded_rel in + assert (List.length tuple_hashes = 3); + + (* Load all tuples *) + match Manipulation.Memory.load_tuples storage tuple_hashes with + | Error _ -> assert false + | Ok tuples -> + assert (List.length tuples = 3); + let names = List.map (fun t -> + let attr = Tuple.AttributeMap.find "name" t.Tuple.attributes in + (Obj.magic attr.Attribute.value : string) + ) tuples in + assert (List.mem "Apple" names); + assert (List.mem "Banana" names); + assert (List.mem "Cherry" names)) |