From 7c7282894be9c72f3ddeda32c2bc77b333075dee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Mon, 5 Jul 2021 12:45:08 +0000 Subject: [PATCH] Typed database IDs (#47) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Typed database IDs Reviewed-on: https://git.robur.io/robur/builder-web/pulls/47 Co-Authored-By: Reynir Björnsson Co-Committed-By: Reynir Björnsson --- bin/migrations/m20210308.ml | 4 +- bin/migrations/m20210531.ml | 4 +- bin/migrations/m20210602.ml | 26 ++++----- bin/migrations/m20210609.ml | 2 +- bin/migrations/m20210629.ml | 12 ++-- bin/migrations/m20210630.ml | 16 +++--- db/builder_db.ml | 111 +++++++++++++++++------------------- db/builder_db.mli | 84 ++++++++++++++------------- db/representation.ml | 14 ++++- lib/model.mli | 28 ++++----- 10 files changed, 154 insertions(+), 147 deletions(-) diff --git a/bin/migrations/m20210308.ml b/bin/migrations/m20210308.ml index b712b0d..bc24cbc 100644 --- a/bin/migrations/m20210308.ml +++ b/bin/migrations/m20210308.ml @@ -3,7 +3,7 @@ module Rep = Builder_db.Rep let broken_builds = Caqti_request.collect ~oneshot:true Caqti_type.unit - (Caqti_type.tup3 Rep.id Rep.uuid Caqti_type.string) + (Caqti_type.tup3 (Rep.id `build) Rep.uuid Caqti_type.string) {| SELECT b.id, b.uuid, job.name FROM build b, job WHERE result_kind = 0 AND result_code = 0 AND main_binary IS NOT NULL AND job.id = b.job AND (SELECT COUNT( * ) FROM build_artifact a @@ -15,7 +15,7 @@ let fixup _datadir (module Db : Caqti_blocking.CONNECTION) = Grej.check_version ~user_version:3L (module Db) >>= fun () -> Db.rev_collect_list broken_builds () >>= fun broken_builds -> Grej.list_iter_result - (fun ((build, uuid, job_name) : Rep.id * Uuidm.t * string) -> + (fun ((build, uuid, job_name) : [`build] Rep.id * Uuidm.t * string) -> Format.printf "Removing job %a.\nPlease clean up data files in /var/db/builder-web/%s/%a\n" Uuidm.pp uuid job_name Uuidm.pp uuid; Db.exec Builder_db.Build.remove build) diff --git a/bin/migrations/m20210531.ml b/bin/migrations/m20210531.ml index da5255c..6c334c3 100644 --- a/bin/migrations/m20210531.ml +++ b/bin/migrations/m20210531.ml @@ -7,12 +7,12 @@ let rollback_doc = "add datadir prefix to build_artifact.localpath" let build_artifacts = Caqti_request.collect ~oneshot:true Caqti_type.unit - Caqti_type.(tup2 Builder_db.Rep.id Builder_db.Rep.fpath) + Caqti_type.(tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath) "SELECT id, localpath FROM build_artifact" let build_artifact_update_localpath = Caqti_request.exec ~oneshot:true - Caqti_type.(tup2 Builder_db.Rep.id Builder_db.Rep.fpath) + Caqti_type.(tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath) "UPDATE build_artifact SET localpath = ?2 WHERE id = ?1" (* We are not migrating build_file because it is unused *) diff --git a/bin/migrations/m20210602.ml b/bin/migrations/m20210602.ml index f5689e6..c2c0be1 100644 --- a/bin/migrations/m20210602.ml +++ b/bin/migrations/m20210602.ml @@ -55,18 +55,18 @@ let old_build = let collect_old_build = Caqti_request.collect ~oneshot:true Caqti_type.unit - Caqti_type.(tup3 Builder_db.Rep.id + Caqti_type.(tup3 Builder_db.Rep.untyped_id (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string))) - Builder_db.Rep.id) + Builder_db.Rep.untyped_id) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, job FROM build |} let insert_new_build = Caqti_request.exec ~oneshot:true - Caqti_type.(tup3 Builder_db.Rep.id - (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.id))) - Builder_db.Rep.id) + Caqti_type.(tup3 Builder_db.Rep.untyped_id + (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.untyped_id))) + Builder_db.Rep.untyped_id) {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, job) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |} @@ -83,31 +83,31 @@ let rename_build = let find_main_artifact_id = Caqti_request.find ~oneshot:true - Caqti_type.(tup2 Builder_db.Rep.id string) - Builder_db.Rep.id + Caqti_type.(tup2 Builder_db.Rep.untyped_id string) + Builder_db.Rep.untyped_id "SELECT id FROM build_artifact WHERE build = ?1 AND filepath = ?2" let find_main_artifact_filepath = Caqti_request.find ~oneshot:true - Builder_db.Rep.id + Builder_db.Rep.untyped_id Caqti_type.string "SELECT filepath FROM build_artifact WHERE id = ?" let collect_new_build = Caqti_request.collect ~oneshot:true Caqti_type.unit - Caqti_type.(tup3 Builder_db.Rep.id - (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.id))) - Builder_db.Rep.id) + Caqti_type.(tup3 Builder_db.Rep.untyped_id + (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.untyped_id))) + Builder_db.Rep.untyped_id) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, job FROM build |} let insert_old_build = Caqti_request.exec ~oneshot:true - Caqti_type.(tup3 Builder_db.Rep.id + Caqti_type.(tup3 Builder_db.Rep.untyped_id (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string))) - Builder_db.Rep.id) + Builder_db.Rep.untyped_id) {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, job) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |} diff --git a/bin/migrations/m20210609.ml b/bin/migrations/m20210609.ml index 594231b..0fcfd8d 100644 --- a/bin/migrations/m20210609.ml +++ b/bin/migrations/m20210609.ml @@ -68,7 +68,7 @@ let old_build = let insert_from_old_build = Caqti_request.exec ~oneshot:true - Builder_db.Rep.id + (Builder_db.Rep.id (`user : [`user])) {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, job, user) diff --git a/bin/migrations/m20210629.ml b/bin/migrations/m20210629.ml index 695ae07..110e1d0 100644 --- a/bin/migrations/m20210629.ml +++ b/bin/migrations/m20210629.ml @@ -30,13 +30,13 @@ let job_tag = let jobs = Caqti_request.collect Caqti_type.unit - Builder_db.Rep.id + Builder_db.Rep.untyped_id "SELECT id FROM job" let latest_successful_build = Caqti_request.find_opt - Builder_db.Rep.id - Builder_db.Rep.id + Builder_db.Rep.untyped_id + Builder_db.Rep.untyped_id {| SELECT b.id FROM build b WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0 @@ -46,7 +46,7 @@ let latest_successful_build = let build_artifacts = Caqti_request.collect - Builder_db.Rep.id + Builder_db.Rep.untyped_id Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath) {| SELECT a.filepath, a.localpath FROM build_artifact a @@ -115,13 +115,13 @@ let insert_tag = let insert_job_tag = Caqti_request.exec - Caqti_type.(tup3 Builder_db.Rep.id string Builder_db.Rep.id) + Caqti_type.(tup3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) "INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)" let find_tag = Caqti_request.find Caqti_type.string - Builder_db.Rep.id + Builder_db.Rep.untyped_id "SELECT id FROM tag where tag = ?" open Rresult.R.Infix diff --git a/bin/migrations/m20210630.ml b/bin/migrations/m20210630.ml index f60f58f..cf16dd6 100644 --- a/bin/migrations/m20210630.ml +++ b/bin/migrations/m20210630.ml @@ -6,13 +6,13 @@ let rollback_doc = "remove readme.md tag" let jobs = Caqti_request.collect Caqti_type.unit - Builder_db.Rep.id + Builder_db.Rep.untyped_id "SELECT id FROM job" let latest_successful_build = Caqti_request.find_opt - Builder_db.Rep.id - Builder_db.Rep.id + Builder_db.Rep.untyped_id + Builder_db.Rep.untyped_id {| SELECT b.id FROM build b WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0 @@ -22,7 +22,7 @@ let latest_successful_build = let build_artifacts = Caqti_request.collect - Builder_db.Rep.id + Builder_db.Rep.untyped_id Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath) {| SELECT a.filepath, a.localpath FROM build_artifact a @@ -36,23 +36,23 @@ let insert_tag = let insert_job_tag = Caqti_request.exec - Caqti_type.(tup3 Builder_db.Rep.id string Builder_db.Rep.id) + Caqti_type.(tup3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) "INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)" let find_tag = Caqti_request.find Caqti_type.string - Builder_db.Rep.id + Builder_db.Rep.untyped_id "SELECT id FROM tag where tag = ?" let remove_job_tag = Caqti_request.exec - Builder_db.Rep.id + Builder_db.Rep.untyped_id "DELETE FROM job_tag where tag = ?" let remove_tag = Caqti_request.exec - Builder_db.Rep.id + Builder_db.Rep.untyped_id "DELETE FROM tag where id = ?" open Rresult.R.Infix diff --git a/db/builder_db.ml b/db/builder_db.ml index 180369c..257e165 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -6,7 +6,7 @@ let application_id = 1234839235l (* Please update this when making changes! *) let current_version = 11L -type id = Rep.id +type 'a id = 'a Rep.id type file = Rep.file = { filepath : Fpath.t; @@ -15,12 +15,7 @@ type file = Rep.file = { size : int; } -let last_insert_rowid = - Caqti_request.find - Caqti_type.unit - id - "SELECT last_insert_rowid()" - +let last_insert_rowid = Rep.last_insert_rowid let get_application_id = Caqti_request.find @@ -61,26 +56,26 @@ module Job = struct let get = Caqti_request.find - id + (id `job) Caqti_type.string "SELECT name FROM job WHERE id = ?" let get_id_by_name = Caqti_request.find_opt Caqti_type.string - id + (id `job) "SELECT id FROM job WHERE name = ?" let get_all = Caqti_request.collect Caqti_type.unit - Caqti_type.(tup2 id string) + Caqti_type.(tup2 (id `job) string) "SELECT id, name FROM job ORDER BY name ASC" let get_all_with_section_synopsis = Caqti_request.collect Caqti_type.unit - Caqti_type.(tup4 id string (option string) (option string)) + Caqti_type.(tup4 (id `job) string (option string) (option string)) {| SELECT j.id, j.name, section.value, synopsis.value FROM job j, tag section_tag, tag synopsis_tag LEFT JOIN job_tag section ON section.job = j.id AND section.tag = section_tag.id @@ -96,7 +91,7 @@ module Job = struct let remove = Caqti_request.exec - id + (id `job) "DELETE FROM job WHERE id = ?" end @@ -117,14 +112,14 @@ module Tag = struct let get = Caqti_request.find - id + (id `tag) Caqti_type.string "SELECT tag FROM tag WHERE id = ?" let get_id_by_name = Caqti_request.find Caqti_type.string - id + (id `tag) "SELECT id FROM tag WHERE tag = ?" let try_add = @@ -156,17 +151,17 @@ module Job_tag = struct let add = Caqti_request.exec - Caqti_type.(tup3 id string id) + Caqti_type.(tup3 (id `tag) string (id `job)) "INSERT INTO job_tag (tag, value, job) VALUES (?1, ?2, ?3)" let update = Caqti_request.exec - Caqti_type.(tup3 id string id) + Caqti_type.(tup3 (id `tag) string (id `job)) "UPDATE job_tag SET value = ?2 WHERE tag = ?1 AND job = ?3" let get_value = Caqti_request.find_opt - Caqti_type.(tup2 id id) + Caqti_type.(tup2 (id `tag) (id `job)) Caqti_type.string "SELECT value FROM job_tag WHERE tag = ? AND job = ?" end @@ -195,8 +190,8 @@ module Build_artifact = struct let get_by_build = Caqti_request.find - (Caqti_type.tup2 id fpath) - (Caqti_type.tup2 id file) + (Caqti_type.tup2 (id `build) fpath) + (Caqti_type.tup2 (id `build_artifact) file) {| SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ? AND filepath = ? @@ -205,7 +200,7 @@ module Build_artifact = struct let get_by_build_uuid = Caqti_request.find_opt (Caqti_type.tup2 uuid fpath) - (Caqti_type.tup2 id file) + (Caqti_type.tup2 (id `build_artifact) file) {| SELECT build_artifact.id, build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size FROM build_artifact @@ -215,26 +210,26 @@ module Build_artifact = struct let get_all_by_build = Caqti_request.collect - id + (id `build) Caqti_type.(tup2 - id + (id `build_artifact) file) "SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ?" let add = Caqti_request.exec - Caqti_type.(tup2 file id) + Caqti_type.(tup2 file (id `build)) "INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)" let remove_by_build = Caqti_request.exec - id + (id `build) "DELETE FROM build_artifact WHERE build = ?" let remove = Caqti_request.exec - id + (id `build_artifact) "DELETE FROM build_artifact WHERE id = ?" end @@ -246,9 +241,9 @@ module Build = struct result : Builder.execution_result; console : (int * string) list; script : string; - main_binary : id option; - user_id : id; - job_id : id; + main_binary : [`build_artifact] id option; + user_id : [`user] id; + job_id : [`job] id; } let t = @@ -264,9 +259,9 @@ module Build = struct console) (tup2 string - (option Rep.id))) - id - id) + (option (Rep.id `build_artifact)))) + (id `user) + (id `job)) in let encode { uuid; start; finish; result; console; script; main_binary; user_id; job_id } = Ok ((uuid, (start, finish), (result, console), (script, main_binary)), user_id, job_id) @@ -282,9 +277,9 @@ module Build = struct start : Ptime.t; finish : Ptime.t; result : Builder.execution_result; - main_binary : id option; - user_id : id; - job_id : id; + main_binary : [`build_artifact] id option; + user_id : [`user] id; + job_id : [`job] id; } let t = @@ -296,9 +291,9 @@ module Build = struct Rep.ptime Rep.ptime) execution_result - (option Rep.id)) - id - id) + (option (Rep.id `build_artifact))) + (id `user) + (id `job)) in let encode { uuid; start; finish; result; main_binary; user_id; job_id } = Ok ((uuid, (start, finish), result, main_binary), user_id, job_id) @@ -341,7 +336,7 @@ module Build = struct let get_opt = Caqti_request.find_opt - Caqti_type.int64 + (id `build) t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, @@ -353,7 +348,7 @@ module Build = struct let get_by_uuid = Caqti_request.find_opt Rep.uuid - (Caqti_type.tup2 id t) + (Caqti_type.tup2 (id `build) t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, user, job @@ -363,8 +358,8 @@ module Build = struct let get_all = Caqti_request.collect - Caqti_type.int64 - (Caqti_type.tup2 id t) + (id `job) + (Caqti_type.tup2 (id `build) t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, user, job @@ -375,9 +370,9 @@ module Build = struct let get_all_meta = Caqti_request.collect - Caqti_type.int64 + (id `job) (Caqti_type.tup3 - id Meta.t file_opt) + (id `build) Meta.t file_opt) {| SELECT build.id, build.uuid, build.start_d, build.start_ps, build.finish_d, build.finish_ps, build.result_kind, build.result_code, build.result_msg, @@ -392,9 +387,9 @@ module Build = struct let get_latest = Caqti_request.find_opt - id + (id `job) Caqti_type.(tup3 - id + (id `build) Meta.t file_opt) {| SELECT b.id, @@ -412,8 +407,8 @@ module Build = struct let get_latest_uuid = Caqti_request.find_opt - id - Caqti_type.(tup2 id Rep.uuid) + (id `job) + Caqti_type.(tup2 (id `build) Rep.uuid) {| SELECT b.id, b.uuid FROM build b WHERE b.job = ? @@ -423,7 +418,7 @@ module Build = struct let get_latest_successful_uuid = Caqti_request.find_opt - id + (id `job) Rep.uuid {| SELECT b.uuid FROM build b @@ -434,8 +429,8 @@ module Build = struct let get_previous_successful = Caqti_request.find_opt - id - Caqti_type.(tup2 id Meta.t) + (id `build) + Caqti_type.(tup2 (id `build) Meta.t) {| SELECT b.id, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_kind, b.result_code, b.result_msg, @@ -478,12 +473,12 @@ module Build = struct let set_main_binary = Caqti_request.exec - (Caqti_type.tup2 id id) + (Caqti_type.tup2 (id `build) (id `build_artifact)) "UPDATE build SET main_binary = ?2 WHERE id = ?1" let remove = Caqti_request.exec - id + (id `build) "DELETE FROM build WHERE id = ?" end @@ -511,7 +506,7 @@ module User = struct let get_user = Caqti_request.find_opt Caqti_type.string - (Caqti_type.tup2 id user_info) + (Caqti_type.tup2 (id `user) user_info) {| SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user @@ -534,7 +529,7 @@ module User = struct let remove = Caqti_request.exec - id + (id `user) "DELETE FROM user WHERE id = ?" let remove_user = @@ -578,18 +573,18 @@ module Access_list = struct let get = Caqti_request.find - Caqti_type.(tup2 Rep.id Rep.id) - Rep.id + Caqti_type.(tup2 (id `user) (id `job)) + (id `access_list) "SELECT id FROM access_list WHERE user = ? AND job = ?" let add = Caqti_request.exec - Caqti_type.(tup2 Rep.id Rep.id) + Caqti_type.(tup2 (id `user) (id `job)) "INSERT INTO access_list (user, job) VALUES (?, ?)" let remove = Caqti_request.exec - Caqti_type.(tup2 Rep.id Rep.id) + Caqti_type.(tup2 (id `user) (id `job)) "DELETE FROM access_list WHERE user = ? AND job = ?" let remove_all_by_username = diff --git a/db/builder_db.mli b/db/builder_db.mli index 70973e0..d893d48 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -1,5 +1,6 @@ module Rep : sig - type id + type untyped_id + type 'a id type file = { filepath : Fpath.t; localpath : Fpath.t; @@ -7,7 +8,8 @@ module Rep : sig size : int; } - val id : id Caqti_type.t + val untyped_id : untyped_id Caqti_type.t + val id : 'a -> 'a id Caqti_type.t val uuid : Uuidm.t Caqti_type.t val ptime : Ptime.t Caqti_type.t val fpath : Fpath.t Caqti_type.t @@ -16,7 +18,7 @@ module Rep : sig val execution_result : Builder.execution_result Caqti_type.t val console : (int * string) list Caqti_type.t end -type id = Rep.id +type 'a id = 'a Rep.id type file = Rep.file = { filepath : Fpath.t; @@ -42,7 +44,7 @@ val set_current_version : (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val last_insert_rowid : - (unit, id, [< `Many | `One | `Zero > `One ]) Caqti_request.t + (unit, 'a id, [< `Many | `One | `Zero > `One ]) Caqti_request.t module Job : sig val migrate : @@ -51,18 +53,18 @@ module Job : sig (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get : - (id, string, [< `Many | `One | `Zero > `One ]) + ([`job] id, string, [< `Many | `One | `Zero > `One ]) Caqti_request.t val get_id_by_name : - (string, id, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t + (string, [`job] id, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_all : - (unit, id * string, [ `Many | `One | `Zero ]) Caqti_request.t + (unit, [`job] id * string, [ `Many | `One | `Zero ]) Caqti_request.t val get_all_with_section_synopsis : - (unit, id * string * string option * string option, [ `Many | `One | `Zero ]) Caqti_request.t + (unit, [`job] id * string * string option * string option, [ `Many | `One | `Zero ]) Caqti_request.t val try_add : (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove : - (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + ([`job] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t end module Tag : sig @@ -71,9 +73,9 @@ module Tag : sig val rollback : (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get : - (id, string, [< `Many | `One | `Zero > `One ]) Caqti_request.t + ([`tag] id, string, [< `Many | `One | `Zero > `One ]) Caqti_request.t val get_id_by_name : - (string, id, [< `Many | `One | `Zero > `One ]) Caqti_request.t + (string, [`tag] id, [< `Many | `One | `Zero > `One ]) Caqti_request.t val try_add : (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t end @@ -84,11 +86,11 @@ module Job_tag : sig val rollback : (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val add : - (id * string * id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + ([`tag] id * string * [`job] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val update : - (id * string * id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + ([`tag] id * string * [`job] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_value : - (id * id, string, [< `Many | `One | `Zero > `Zero `One ]) Caqti_request.t + ([`tag] id * [`job] id, string, [< `Many | `One | `Zero > `Zero `One ]) Caqti_request.t end module Build_artifact : sig @@ -98,21 +100,21 @@ module Build_artifact : sig (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_by_build : - (id * Fpath.t, id * file, + ([`build] id * Fpath.t, [`build_artifact] id * file, [< `Many | `One | `Zero > `One ]) Caqti_request.t val get_by_build_uuid : - (Uuidm.t * Fpath.t, id * file, + (Uuidm.t * Fpath.t, [`build_artifact] id * file, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_all_by_build : - (id, id * file, [ `Many | `One | `Zero ]) Caqti_request.t + ([`build] id, [`build_artifact] id * file, [ `Many | `One | `Zero ]) Caqti_request.t val add : - (file * id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + (file * [`build] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove_by_build : - (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + ([`build] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove : - (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + ([`build_artifact] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t end module Build : @@ -124,9 +126,9 @@ sig result : Builder.execution_result; console : (int * string) list; script : string; - main_binary : id option; - user_id : id; - job_id : id; + main_binary : [`build_artifact] id option; + user_id : [`user] id; + job_id : [`job] id; } module Meta : sig @@ -135,9 +137,9 @@ sig start : Ptime.t; finish : Ptime.t; result : Builder.execution_result; - main_binary : id option; - user_id : id; - job_id : id; + main_binary : [`build_artifact] id option; + user_id : [`user] id; + job_id : [`job] id; } end @@ -147,31 +149,31 @@ sig (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_opt : - (id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t + ([`build] id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_by_uuid : - (Uuidm.t, id * t, [< `Many | `One | `Zero > `One `Zero ]) + (Uuidm.t, [`build] id * t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_all : - (id, id * t, [ `Many | `One | `Zero ]) Caqti_request.t + ([`job] id, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t val get_all_meta : - (id, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t + ([`job] id, [`build] id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t val get_latest : - (id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ]) + ([`job] id, [`build] id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_latest_uuid : - (id, id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) + ([`job] id, [`build] id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_latest_successful_uuid : - (id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) + ([`job] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_previous_successful : - (id, id * Meta.t, [< `Many | `One | `Zero > `One `Zero ]) + ([`build] id, [`build] id * Meta.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_by_hash : (Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t - val set_main_binary : (id * id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t - val remove : (id, unit, [< `Many | `One | `Zero > `Zero]) Caqti_request.t + val set_main_binary : ([`build] id * [`build_artifact] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + val remove : ([`build] id, unit, [< `Many | `One | `Zero > `Zero]) Caqti_request.t end module User : sig @@ -180,7 +182,7 @@ module User : sig val rollback : (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_user : - (string, id * Builder_web_auth.scrypt Builder_web_auth.user_info, + (string, [`user] id * Builder_web_auth.scrypt Builder_web_auth.user_info, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_all : @@ -188,7 +190,7 @@ module User : sig val add : (Builder_web_auth.scrypt Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t - val remove : (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + val remove : ([`user] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove_user : (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val update_user : @@ -202,11 +204,11 @@ module Access_list : sig val rollback : (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get : - (id * id, id, [< `Many | `One | `Zero > `One ]) Caqti_request.t + ([`user] id * [`job] id, [`access_list] id, [< `Many | `One | `Zero > `One ]) Caqti_request.t val add : - (id * id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + ([`user] id * [`job] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove : - (id * id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t + ([`user] id * [`job] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove_all_by_username : (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t end diff --git a/db/representation.ml b/db/representation.ml index dc59122..39cdd6f 100644 --- a/db/representation.ml +++ b/db/representation.ml @@ -20,8 +20,11 @@ module Asn = struct let console_of_cs, console_to_cs = projections_of console end -type id = int64 -let id = Caqti_type.int64 +type untyped_id = int64 +let untyped_id = Caqti_type.int64 +type 'a id = untyped_id +let id (_ : 'a) : 'a id Caqti_type.t = untyped_id +let any_id : 'a id Caqti_type.t = untyped_id type file = { filepath : Fpath.t; @@ -124,3 +127,10 @@ let user_info = scrypt_r; scrypt_p }); restricted; } in Caqti_type.custom ~encode ~decode rep + +(* this doesn't really belong in this module, but we need access to the type of [id] *) +let last_insert_rowid = + Caqti_request.find + Caqti_type.unit + any_id + "SELECT last_insert_rowid()" diff --git a/lib/model.mli b/lib/model.mli index 735ed7c..13d8adc 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -15,13 +15,13 @@ val build_artifact : Uuidm.t -> Fpath.t -> Caqti_lwt.connection -> val build_artifact_data : Fpath.t -> Builder_db.file -> (string, [> error ]) result Lwt.t -val build_artifacts : Builder_db.id -> Caqti_lwt.connection -> +val build_artifacts : [`build] Builder_db.id -> Caqti_lwt.connection -> (Builder_db.file list, [> Caqti_error.call_or_retrieve ]) result Lwt.t val build : Uuidm.t -> Caqti_lwt.connection -> - (Builder_db.id * Builder_db.Build.t, [> error ]) result Lwt.t + ([`build] Builder_db.id * Builder_db.Build.t, [> error ]) result Lwt.t -val build_meta : Builder_db.id -> Caqti_lwt.connection -> +val build_meta : [`job] Builder_db.id -> Caqti_lwt.connection -> ((Builder_db.Build.Meta.t * Builder_db.file option) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t val build_hash : Cstruct.t -> Caqti_lwt.connection -> @@ -30,16 +30,16 @@ val build_hash : Cstruct.t -> Caqti_lwt.connection -> val build_exists : Uuidm.t -> Caqti_lwt.connection -> (bool, [> Caqti_error.call_or_retrieve ]) result Lwt.t -val latest_build_uuid : Builder_db.id -> Caqti_lwt.connection -> +val latest_build_uuid : [`job] Builder_db.id -> Caqti_lwt.connection -> (Uuidm.t, [> error ]) result Lwt.t -val latest_successful_build_uuid : Builder_db.id -> Caqti_lwt.connection -> +val latest_successful_build_uuid : [`job] Builder_db.id -> Caqti_lwt.connection -> (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t -val previous_successful_build : Builder_db.id -> Caqti_lwt.connection -> +val previous_successful_build : [`build] Builder_db.id -> Caqti_lwt.connection -> (Builder_db.Build.Meta.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t -val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection -> +val main_binary : [`build] Builder_db.id -> Fpath.t option -> Caqti_lwt.connection -> (Builder_db.file option, [> Caqti_error.call_or_retrieve ]) result Lwt.t val readme : string -> Caqti_lwt.connection -> @@ -49,25 +49,25 @@ val job_and_readme : string -> Caqti_lwt.connection -> (string option * (Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t val job_id : string -> Caqti_lwt.connection -> - (Builder_db.id option, [> Caqti_error.call_or_retrieve ]) result Lwt.t + ([`job] Builder_db.id option, [> Caqti_error.call_or_retrieve ]) result Lwt.t val jobs : Caqti_lwt.connection -> - ((Builder_db.id * string) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t + (([`job] Builder_db.id * string) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t val jobs_with_section_synopsis : Caqti_lwt.connection -> - ((Builder_db.id * string * string option * string option) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t + (([`job] Builder_db.id * string * string option * string option) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t -val job_name : Builder_db.id -> Caqti_lwt.connection -> +val job_name : [`job] Builder_db.id -> Caqti_lwt.connection -> (string, [> Caqti_error.call_or_retrieve ]) result Lwt.t val user : string -> Caqti_lwt.connection -> - ((Builder_db.id * Builder_web_auth.scrypt Builder_web_auth.user_info) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t + (([`user] Builder_db.id * Builder_web_auth.scrypt Builder_web_auth.user_info) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t -val authorized : Builder_db.id -> string -> Caqti_lwt.connection -> (unit, [> Caqti_error.call_or_retrieve | `Msg of string ]) result Lwt.t +val authorized : [`user] Builder_db.id -> string -> Caqti_lwt.connection -> (unit, [> Caqti_error.call_or_retrieve | `Msg of string ]) result Lwt.t val add_build : Fpath.t -> - Builder_db.id -> + [`user] Builder_db.id -> (Builder.script_job * Uuidm.t * (int * string) list * Ptime.t * Ptime.t * Builder.execution_result * (Fpath.t * string) list) -> Caqti_lwt.connection ->