From db7bd49d1ce3829da25612bc17a1d1e4143b8f96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 2 May 2024 14:58:35 +0100 Subject: [PATCH 1/2] CP-49140: [prep] database: use separate types, not string everywhere MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Currently all of these are strings, but it may change: * table * db_ref * field_name * field * uuid This enables changing the `field` type from `string` and avoiding costly serialization/deserialization when not needed. No functional change. Signed-off-by: Edwin Török --- ocaml/database/db_cache_impl.ml | 2 +- ocaml/database/db_interface.ml | 53 ++++++++++++++++++++------------- ocaml/tests/dune | 1 + ocaml/xapi/dune | 2 +- 4 files changed, 36 insertions(+), 22 deletions(-) diff --git a/ocaml/database/db_cache_impl.ml b/ocaml/database/db_cache_impl.ml index b4f23b0af00..46e4ff84f2f 100644 --- a/ocaml/database/db_cache_impl.ml +++ b/ocaml/database/db_cache_impl.ml @@ -256,7 +256,7 @@ let read_refs t tblname = Table.fold (fun r _ _ acc -> r :: acc) tbl [] (* Return a list of all the refs for which the expression returns true. *) -let find_refs_with_filter_internal db (tblname : string) +let find_refs_with_filter_internal db (tblname : Db_interface.table) (expr : Db_filter_types.expr) = let tbl = TableSet.find tblname (Database.tableset db) in let eval_val row = function diff --git a/ocaml/database/db_interface.ml b/ocaml/database/db_interface.ml index 834c12cd8a1..9e650ac244a 100644 --- a/ocaml/database/db_interface.ml +++ b/ocaml/database/db_interface.ml @@ -23,8 +23,22 @@ module type RPC = sig (** [rpc request] transmits [request] and receives a response *) end +type table = string + +type field_name = string + +type field = string + +type db_ref = string + +type uuid = string + +type regular_fields = (field_name * field) list + +type associated_fields = (field_name * db_ref list) list + (** dictionary of regular fields x dictionary of associated set_ref values *) -type db_record = (string * string) list * (string * string list) list +type db_record = regular_fields * associated_fields (** The client interface to the database *) module type DB_ACCESS = sig @@ -32,65 +46,64 @@ module type DB_ACCESS = sig (** [initialise ()] must be called before any other function in this interface *) - val get_table_from_ref : Db_ref.t -> string -> string option - (** [get_table_from_ref ref] returns [Some tbl] if [ref] is a + val get_table_from_ref : Db_ref.t -> db_ref -> table option + (** [get_table_from_ref ref tbl] returns [Some tbl] if [ref] is a valid reference; None otherwise *) - val is_valid_ref : Db_ref.t -> string -> bool + val is_valid_ref : Db_ref.t -> db_ref -> bool (** [is_valid_ref ref] returns true if [ref] is valid; false otherwise *) - val read_refs : Db_ref.t -> string -> string list + val read_refs : Db_ref.t -> table -> db_ref list (** [read_refs tbl] returns a list of all references in table [tbl] *) val find_refs_with_filter : - Db_ref.t -> string -> Db_filter_types.expr -> string list + Db_ref.t -> table -> Db_filter_types.expr -> db_ref list (** [find_refs_with_filter tbl expr] returns a list of all references to rows which match [expr] *) - val read_field_where : Db_ref.t -> Db_cache_types.where_record -> string list + val read_field_where : Db_ref.t -> Db_cache_types.where_record -> field list (** [read_field_where {tbl,return,where_field,where_value}] returns a list of the [return] fields in table [tbl] where the [where_field] equals [where_value] *) - val db_get_by_uuid : Db_ref.t -> string -> string -> string + val db_get_by_uuid : Db_ref.t -> table -> uuid -> db_ref (** [db_get_by_uuid tbl uuid] returns the single object reference associated with [uuid] *) - val db_get_by_name_label : Db_ref.t -> string -> string -> string list + val db_get_by_name_label : Db_ref.t -> table -> string -> db_ref list (** [db_get_by_name_label tbl label] returns the list of object references associated with [label] *) - val create_row : - Db_ref.t -> string -> (string * string) list -> string -> unit + val create_row : Db_ref.t -> table -> regular_fields -> db_ref -> unit (** [create_row tbl kvpairs ref] create a new row in [tbl] with key [ref] and contents [kvpairs] *) - val delete_row : Db_ref.t -> string -> string -> unit + val delete_row : Db_ref.t -> db_ref -> table -> unit (** [delete_row context tbl ref] deletes row [ref] from table [tbl] *) - val write_field : Db_ref.t -> string -> string -> string -> string -> unit + val write_field : Db_ref.t -> table -> db_ref -> field_name -> field -> unit (** [write_field context tbl ref fld val] changes field [fld] to [val] in row [ref] in table [tbl] *) - val read_field : Db_ref.t -> string -> string -> string -> string + val read_field : Db_ref.t -> table -> db_ref -> field_name -> field (** [read_field context tbl ref fld] returns the value of field [fld] in row [ref] in table [tbl] *) - val read_record : Db_ref.t -> string -> string -> db_record + val read_record : Db_ref.t -> table -> db_ref -> db_record (** [read_record tbl ref] returns [ (field, value) ] * [ (set_ref fieldname * [ ref ]) ] *) val read_records_where : - Db_ref.t -> string -> Db_filter_types.expr -> (string * db_record) list + Db_ref.t -> table -> Db_filter_types.expr -> (db_ref * db_record) list (** [read_records_where tbl expr] returns a list of the values returned by read_record that match the expression *) val process_structured_field : Db_ref.t - -> string * string - -> string - -> string - -> string + -> field_name * field + -> table + -> field_name + -> db_ref -> Db_cache_types.structured_op_t -> unit (** [process_structured_field context kv tbl fld ref op] modifies the diff --git a/ocaml/tests/dune b/ocaml/tests/dune index ce8fe96c195..f2c5cfc5bad 100644 --- a/ocaml/tests/dune +++ b/ocaml/tests/dune @@ -64,6 +64,7 @@ (modules suite_alcotest_server test_client test_valid_ref_list test_vm_group) (libraries alcotest + xapi_database httpsvr tests_common xapi-client diff --git a/ocaml/xapi/dune b/ocaml/xapi/dune index fd539b66dfa..ce462392de6 100644 --- a/ocaml/xapi/dune +++ b/ocaml/xapi/dune @@ -224,7 +224,7 @@ (name xapi_internal_server_only) (modes best) (modules server) - (libraries xapi_internal_minimal http_lib rpclib.core xapi-types xapi-log xapi-stdext-encodings xapi-consts xapi-backtrace xapi-stdext-date rpclib.json) + (libraries xapi_database xapi_internal_minimal http_lib rpclib.core xapi-types xapi-log xapi-stdext-encodings xapi-consts xapi-backtrace xapi-stdext-date rpclib.json) (wrapped false) ) From 483bdcc4094f0f0fb75bb982b89a2679b3886c45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 2 May 2024 17:53:57 +0100 Subject: [PATCH 2/2] CP-49140: [prep]: database: drop unused of_sexp conversions sexp_of is used when saving the schema, but of_sexp is unused. This enables a future commit to store the deserialized value as a pair value, and deserialization (unmarshaling) requires knowing the schema, whereas serialization (marshaling) does not. Thus we couldn't implement a generic `t_of_sexp` function, but with this change we won't have to. No functional change. --- ocaml/database/schema.ml | 31 +++++++++---------------------- 1 file changed, 9 insertions(+), 22 deletions(-) diff --git a/ocaml/database/schema.ml b/ocaml/database/schema.ml index 619cba97552..6577bc7cfc3 100644 --- a/ocaml/database/schema.ml +++ b/ocaml/database/schema.ml @@ -16,7 +16,7 @@ open Sexplib0.Sexp_conv module Type = struct type t = String | Set (** of strings *) | Pairs (** of strings *) - [@@deriving sexp] + [@@deriving sexp_of] exception Error of t * t @@ -38,7 +38,7 @@ module Value = struct | String of string | Set of string list | Pairs of (string * string) list - [@@deriving sexp] + [@@deriving sexp_of] let marshal = function | String x -> @@ -95,7 +95,7 @@ module Column = struct ; issetref: bool (** only so we can special case set refs in the interface *) } - [@@deriving sexp] + [@@deriving sexp_of] let name_of t = t.name end @@ -109,7 +109,7 @@ let values_of_table tbl = Hashtbl.fold (fun _ v vs -> v :: vs) tbl [] module Table = struct type t' = {name: string; columns: Column.t list; persistent: bool} - [@@deriving sexp] + [@@deriving sexp_of] type t = { name: string @@ -133,11 +133,6 @@ module Table = struct let t' = t'_of_t t in sexp_of_t' t' - let t_of_sexp s = - let ({name; columns; persistent} : t') = t'_of_sexp s in - let columns = tabulate columns ~key_fn:Column.name_of in - ({name; columns; persistent} : t) - let find name (t : t) = match Hashtbl.find_opt t.columns name with | Some c -> @@ -157,10 +152,10 @@ module Table = struct end type relationship = OneToMany of string * string * string * string -[@@deriving sexp] +[@@deriving sexp_of] module Database = struct - type t' = {tables: Table.t list} [@@deriving sexp] + type t' = {tables: Table.t list} [@@deriving sexp_of] type t = {tables: (string, Table.t) Hashtbl.t} @@ -180,10 +175,6 @@ module Database = struct let t' = t'_of_t t in sexp_of_t' t' - let t_of_sexp s = - let t' = t'_of_sexp s in - t_of_t' t' - let find name t = match Hashtbl.find_opt t.tables name with | Some tbl -> @@ -197,7 +188,7 @@ module Database = struct end (** indexed by table name, a list of (this field, foreign table, foreign field) *) -type foreign = (string * string * string) list [@@deriving sexp] +type foreign = (string * string * string) list [@@deriving sexp_of] module ForeignMap = struct include Map.Make (struct @@ -206,17 +197,13 @@ module ForeignMap = struct let compare = Stdlib.compare end) - type t' = (string * foreign) list [@@deriving sexp] + type t' = (string * foreign) list [@@deriving sexp_of] type m = foreign t let sexp_of_m t : Sexp.t = let t' = fold (fun key foreign acc -> (key, foreign) :: acc) t [] in sexp_of_t' t' - - let m_of_sexp sexp : m = - let t' = t'_of_sexp sexp in - List.fold_left (fun acc (key, foreign) -> add key foreign acc) empty t' end type t = { @@ -227,7 +214,7 @@ type t = { ; one_to_many: ForeignMap.m ; many_to_many: ForeignMap.m } -[@@deriving sexp] +[@@deriving sexp_of] let database x = x.database