Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

CP-49140: prepare for database optimizations #6181

Draft
wants to merge 2 commits into
base: feature/perf
Choose a base branch
from
Draft

CP-49140: prepare for database optimizations #6181

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
db7bd49
CP-49140: [prep] database: use separate types, not string everywhere
edwintorok May 2, 2024
483bdcc
CP-49140: [prep]: database: drop unused of_sexp conversions
edwintorok May 2, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion ocaml/database/db_cache_impl.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
53 changes: 33 additions & 20 deletions ocaml/database/db_interface.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,74 +23,87 @@ 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
val initialise : unit -> unit
(** [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] *)
Comment on lines +88 to 90
Copy link
Contributor

@contificate contificate Dec 13, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Need to be careful here, the doc comment is actually incorrect.

The correct order is:

val read_field : Db_ref.t -> table -> field_name -> db_ref -> field

See a corresponding DB action:

    and get_enabled ~__context ~self =
      let self = DM_to_String.ref_Observer self in
      let __t = Context.database_of __context in
      let module DB = (val (Xapi_database.Db_cache.get __t) : Xapi_database.Db_interface.DB_ACCESS) in
      String_to_DM.bool (DB.read_field __t "Observer" "enabled" self)


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
Expand Down
31 changes: 9 additions & 22 deletions ocaml/database/schema.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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 ->
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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 ->
Expand All @@ -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}

Expand All @@ -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 ->
Expand All @@ -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
Expand All @@ -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 = {
Expand All @@ -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

Expand Down
1 change: 1 addition & 0 deletions ocaml/tests/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/xapi/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
)

Expand Down
Loading