Typed database IDs (#47)

Typed database IDs

Reviewed-on: https://git.robur.io/robur/builder-web/pulls/47
Co-Authored-By: Reynir Björnsson <reynir@reynir.dk>
Co-Committed-By: Reynir Björnsson <reynir@reynir.dk>
This commit is contained in:
Reynir Björnsson 2021-07-05 12:45:08 +00:00
parent cc092ca9d8
commit 7c7282894b
10 changed files with 154 additions and 147 deletions

View file

@ -3,7 +3,7 @@ module Rep = Builder_db.Rep
let broken_builds = let broken_builds =
Caqti_request.collect ~oneshot:true Caqti_request.collect ~oneshot:true
Caqti_type.unit 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 {| 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 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 (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 () -> Grej.check_version ~user_version:3L (module Db) >>= fun () ->
Db.rev_collect_list broken_builds () >>= fun broken_builds -> Db.rev_collect_list broken_builds () >>= fun broken_builds ->
Grej.list_iter_result 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" 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; Uuidm.pp uuid job_name Uuidm.pp uuid;
Db.exec Builder_db.Build.remove build) Db.exec Builder_db.Build.remove build)

View file

@ -7,12 +7,12 @@ let rollback_doc = "add datadir prefix to build_artifact.localpath"
let build_artifacts = let build_artifacts =
Caqti_request.collect ~oneshot:true Caqti_request.collect ~oneshot:true
Caqti_type.unit 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" "SELECT id, localpath FROM build_artifact"
let build_artifact_update_localpath = let build_artifact_update_localpath =
Caqti_request.exec ~oneshot:true 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" "UPDATE build_artifact SET localpath = ?2 WHERE id = ?1"
(* We are not migrating build_file because it is unused *) (* We are not migrating build_file because it is unused *)

View file

@ -55,18 +55,18 @@ let old_build =
let collect_old_build = let collect_old_build =
Caqti_request.collect ~oneshot:true Caqti_request.collect ~oneshot:true
Caqti_type.unit 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))) (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, {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job console, script, main_binary, job
FROM build |} FROM build |}
let insert_new_build = let insert_new_build =
Caqti_request.exec ~oneshot:true 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 Builder_db.Rep.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.id) Builder_db.Rep.untyped_id)
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, {| 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) result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |} VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
@ -83,31 +83,31 @@ let rename_build =
let find_main_artifact_id = let find_main_artifact_id =
Caqti_request.find ~oneshot:true Caqti_request.find ~oneshot:true
Caqti_type.(tup2 Builder_db.Rep.id string) Caqti_type.(tup2 Builder_db.Rep.untyped_id string)
Builder_db.Rep.id Builder_db.Rep.untyped_id
"SELECT id FROM build_artifact WHERE build = ?1 AND filepath = ?2" "SELECT id FROM build_artifact WHERE build = ?1 AND filepath = ?2"
let find_main_artifact_filepath = let find_main_artifact_filepath =
Caqti_request.find ~oneshot:true Caqti_request.find ~oneshot:true
Builder_db.Rep.id Builder_db.Rep.untyped_id
Caqti_type.string Caqti_type.string
"SELECT filepath FROM build_artifact WHERE id = ?" "SELECT filepath FROM build_artifact WHERE id = ?"
let collect_new_build = let collect_new_build =
Caqti_request.collect ~oneshot:true Caqti_request.collect ~oneshot:true
Caqti_type.unit 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 Builder_db.Rep.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.id) Builder_db.Rep.untyped_id)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job console, script, main_binary, job
FROM build |} FROM build |}
let insert_old_build = let insert_old_build =
Caqti_request.exec ~oneshot:true 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))) (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, {| 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) result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |} VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}

View file

@ -68,7 +68,7 @@ let old_build =
let insert_from_old_build = let insert_from_old_build =
Caqti_request.exec ~oneshot:true 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, {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console, result_kind, result_code, result_msg, console,
script, main_binary, job, user) script, main_binary, job, user)

View file

@ -30,13 +30,13 @@ let job_tag =
let jobs = let jobs =
Caqti_request.collect Caqti_request.collect
Caqti_type.unit Caqti_type.unit
Builder_db.Rep.id Builder_db.Rep.untyped_id
"SELECT id FROM job" "SELECT id FROM job"
let latest_successful_build = let latest_successful_build =
Caqti_request.find_opt Caqti_request.find_opt
Builder_db.Rep.id Builder_db.Rep.untyped_id
Builder_db.Rep.id Builder_db.Rep.untyped_id
{| SELECT b.id {| SELECT b.id
FROM build b FROM build b
WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0 WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
@ -46,7 +46,7 @@ let latest_successful_build =
let build_artifacts = let build_artifacts =
Caqti_request.collect Caqti_request.collect
Builder_db.Rep.id Builder_db.Rep.untyped_id
Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath) Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath)
{| SELECT a.filepath, a.localpath {| SELECT a.filepath, a.localpath
FROM build_artifact a FROM build_artifact a
@ -115,13 +115,13 @@ let insert_tag =
let insert_job_tag = let insert_job_tag =
Caqti_request.exec 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 (?, ?, ?)" "INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"
let find_tag = let find_tag =
Caqti_request.find Caqti_request.find
Caqti_type.string Caqti_type.string
Builder_db.Rep.id Builder_db.Rep.untyped_id
"SELECT id FROM tag where tag = ?" "SELECT id FROM tag where tag = ?"
open Rresult.R.Infix open Rresult.R.Infix

View file

@ -6,13 +6,13 @@ let rollback_doc = "remove readme.md tag"
let jobs = let jobs =
Caqti_request.collect Caqti_request.collect
Caqti_type.unit Caqti_type.unit
Builder_db.Rep.id Builder_db.Rep.untyped_id
"SELECT id FROM job" "SELECT id FROM job"
let latest_successful_build = let latest_successful_build =
Caqti_request.find_opt Caqti_request.find_opt
Builder_db.Rep.id Builder_db.Rep.untyped_id
Builder_db.Rep.id Builder_db.Rep.untyped_id
{| SELECT b.id {| SELECT b.id
FROM build b FROM build b
WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0 WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
@ -22,7 +22,7 @@ let latest_successful_build =
let build_artifacts = let build_artifacts =
Caqti_request.collect Caqti_request.collect
Builder_db.Rep.id Builder_db.Rep.untyped_id
Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath) Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath)
{| SELECT a.filepath, a.localpath {| SELECT a.filepath, a.localpath
FROM build_artifact a FROM build_artifact a
@ -36,23 +36,23 @@ let insert_tag =
let insert_job_tag = let insert_job_tag =
Caqti_request.exec 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 (?, ?, ?)" "INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"
let find_tag = let find_tag =
Caqti_request.find Caqti_request.find
Caqti_type.string Caqti_type.string
Builder_db.Rep.id Builder_db.Rep.untyped_id
"SELECT id FROM tag where tag = ?" "SELECT id FROM tag where tag = ?"
let remove_job_tag = let remove_job_tag =
Caqti_request.exec Caqti_request.exec
Builder_db.Rep.id Builder_db.Rep.untyped_id
"DELETE FROM job_tag where tag = ?" "DELETE FROM job_tag where tag = ?"
let remove_tag = let remove_tag =
Caqti_request.exec Caqti_request.exec
Builder_db.Rep.id Builder_db.Rep.untyped_id
"DELETE FROM tag where id = ?" "DELETE FROM tag where id = ?"
open Rresult.R.Infix open Rresult.R.Infix

View file

@ -6,7 +6,7 @@ let application_id = 1234839235l
(* Please update this when making changes! *) (* Please update this when making changes! *)
let current_version = 11L let current_version = 11L
type id = Rep.id type 'a id = 'a Rep.id
type file = Rep.file = { type file = Rep.file = {
filepath : Fpath.t; filepath : Fpath.t;
@ -15,12 +15,7 @@ type file = Rep.file = {
size : int; size : int;
} }
let last_insert_rowid = let last_insert_rowid = Rep.last_insert_rowid
Caqti_request.find
Caqti_type.unit
id
"SELECT last_insert_rowid()"
let get_application_id = let get_application_id =
Caqti_request.find Caqti_request.find
@ -61,26 +56,26 @@ module Job = struct
let get = let get =
Caqti_request.find Caqti_request.find
id (id `job)
Caqti_type.string Caqti_type.string
"SELECT name FROM job WHERE id = ?" "SELECT name FROM job WHERE id = ?"
let get_id_by_name = let get_id_by_name =
Caqti_request.find_opt Caqti_request.find_opt
Caqti_type.string Caqti_type.string
id (id `job)
"SELECT id FROM job WHERE name = ?" "SELECT id FROM job WHERE name = ?"
let get_all = let get_all =
Caqti_request.collect Caqti_request.collect
Caqti_type.unit Caqti_type.unit
Caqti_type.(tup2 id string) Caqti_type.(tup2 (id `job) string)
"SELECT id, name FROM job ORDER BY name ASC" "SELECT id, name FROM job ORDER BY name ASC"
let get_all_with_section_synopsis = let get_all_with_section_synopsis =
Caqti_request.collect Caqti_request.collect
Caqti_type.unit 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 {| SELECT j.id, j.name, section.value, synopsis.value
FROM job j, tag section_tag, tag synopsis_tag 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 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 = let remove =
Caqti_request.exec Caqti_request.exec
id (id `job)
"DELETE FROM job WHERE id = ?" "DELETE FROM job WHERE id = ?"
end end
@ -117,14 +112,14 @@ module Tag = struct
let get = let get =
Caqti_request.find Caqti_request.find
id (id `tag)
Caqti_type.string Caqti_type.string
"SELECT tag FROM tag WHERE id = ?" "SELECT tag FROM tag WHERE id = ?"
let get_id_by_name = let get_id_by_name =
Caqti_request.find Caqti_request.find
Caqti_type.string Caqti_type.string
id (id `tag)
"SELECT id FROM tag WHERE tag = ?" "SELECT id FROM tag WHERE tag = ?"
let try_add = let try_add =
@ -156,17 +151,17 @@ module Job_tag = struct
let add = let add =
Caqti_request.exec 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)" "INSERT INTO job_tag (tag, value, job) VALUES (?1, ?2, ?3)"
let update = let update =
Caqti_request.exec 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" "UPDATE job_tag SET value = ?2 WHERE tag = ?1 AND job = ?3"
let get_value = let get_value =
Caqti_request.find_opt Caqti_request.find_opt
Caqti_type.(tup2 id id) Caqti_type.(tup2 (id `tag) (id `job))
Caqti_type.string Caqti_type.string
"SELECT value FROM job_tag WHERE tag = ? AND job = ?" "SELECT value FROM job_tag WHERE tag = ? AND job = ?"
end end
@ -195,8 +190,8 @@ module Build_artifact = struct
let get_by_build = let get_by_build =
Caqti_request.find Caqti_request.find
(Caqti_type.tup2 id fpath) (Caqti_type.tup2 (id `build) fpath)
(Caqti_type.tup2 id file) (Caqti_type.tup2 (id `build_artifact) file)
{| SELECT id, filepath, localpath, sha256, size {| SELECT id, filepath, localpath, sha256, size
FROM build_artifact FROM build_artifact
WHERE build = ? AND filepath = ? WHERE build = ? AND filepath = ?
@ -205,7 +200,7 @@ module Build_artifact = struct
let get_by_build_uuid = let get_by_build_uuid =
Caqti_request.find_opt Caqti_request.find_opt
(Caqti_type.tup2 uuid fpath) (Caqti_type.tup2 uuid fpath)
(Caqti_type.tup2 id file) (Caqti_type.tup2 (id `build_artifact) file)
{| SELECT build_artifact.id, build_artifact.filepath, {| SELECT build_artifact.id, build_artifact.filepath,
build_artifact.localpath, build_artifact.sha256, build_artifact.size build_artifact.localpath, build_artifact.sha256, build_artifact.size
FROM build_artifact FROM build_artifact
@ -215,26 +210,26 @@ module Build_artifact = struct
let get_all_by_build = let get_all_by_build =
Caqti_request.collect Caqti_request.collect
id (id `build)
Caqti_type.(tup2 Caqti_type.(tup2
id (id `build_artifact)
file) file)
"SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ?" "SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ?"
let add = let add =
Caqti_request.exec Caqti_request.exec
Caqti_type.(tup2 file id) Caqti_type.(tup2 file (id `build))
"INSERT INTO build_artifact (filepath, localpath, sha256, size, build) "INSERT INTO build_artifact (filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?)" VALUES (?, ?, ?, ?, ?)"
let remove_by_build = let remove_by_build =
Caqti_request.exec Caqti_request.exec
id (id `build)
"DELETE FROM build_artifact WHERE build = ?" "DELETE FROM build_artifact WHERE build = ?"
let remove = let remove =
Caqti_request.exec Caqti_request.exec
id (id `build_artifact)
"DELETE FROM build_artifact WHERE id = ?" "DELETE FROM build_artifact WHERE id = ?"
end end
@ -246,9 +241,9 @@ module Build = struct
result : Builder.execution_result; result : Builder.execution_result;
console : (int * string) list; console : (int * string) list;
script : string; script : string;
main_binary : id option; main_binary : [`build_artifact] id option;
user_id : id; user_id : [`user] id;
job_id : id; job_id : [`job] id;
} }
let t = let t =
@ -264,9 +259,9 @@ module Build = struct
console) console)
(tup2 (tup2
string string
(option Rep.id))) (option (Rep.id `build_artifact))))
id (id `user)
id) (id `job))
in in
let encode { uuid; start; finish; result; console; script; main_binary; user_id; job_id } = 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) Ok ((uuid, (start, finish), (result, console), (script, main_binary)), user_id, job_id)
@ -282,9 +277,9 @@ module Build = struct
start : Ptime.t; start : Ptime.t;
finish : Ptime.t; finish : Ptime.t;
result : Builder.execution_result; result : Builder.execution_result;
main_binary : id option; main_binary : [`build_artifact] id option;
user_id : id; user_id : [`user] id;
job_id : id; job_id : [`job] id;
} }
let t = let t =
@ -296,9 +291,9 @@ module Build = struct
Rep.ptime Rep.ptime
Rep.ptime) Rep.ptime)
execution_result execution_result
(option Rep.id)) (option (Rep.id `build_artifact)))
id (id `user)
id) (id `job))
in in
let encode { uuid; start; finish; result; main_binary; user_id; job_id } = let encode { uuid; start; finish; result; main_binary; user_id; job_id } =
Ok ((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 = let get_opt =
Caqti_request.find_opt Caqti_request.find_opt
Caqti_type.int64 (id `build)
t t
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, result_kind, result_code, result_msg,
@ -353,7 +348,7 @@ module Build = struct
let get_by_uuid = let get_by_uuid =
Caqti_request.find_opt Caqti_request.find_opt
Rep.uuid Rep.uuid
(Caqti_type.tup2 id t) (Caqti_type.tup2 (id `build) t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, result_kind, result_code, result_msg,
console, script, main_binary, user, job console, script, main_binary, user, job
@ -363,8 +358,8 @@ module Build = struct
let get_all = let get_all =
Caqti_request.collect Caqti_request.collect
Caqti_type.int64 (id `job)
(Caqti_type.tup2 id t) (Caqti_type.tup2 (id `build) t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console, result_kind, result_code, result_msg, console,
script, main_binary, user, job script, main_binary, user, job
@ -375,9 +370,9 @@ module Build = struct
let get_all_meta = let get_all_meta =
Caqti_request.collect Caqti_request.collect
Caqti_type.int64 (id `job)
(Caqti_type.tup3 (Caqti_type.tup3
id Meta.t file_opt) (id `build) Meta.t file_opt)
{| SELECT build.id, build.uuid, {| SELECT build.id, build.uuid,
build.start_d, build.start_ps, build.finish_d, build.finish_ps, build.start_d, build.start_ps, build.finish_d, build.finish_ps,
build.result_kind, build.result_code, build.result_msg, build.result_kind, build.result_code, build.result_msg,
@ -392,9 +387,9 @@ module Build = struct
let get_latest = let get_latest =
Caqti_request.find_opt Caqti_request.find_opt
id (id `job)
Caqti_type.(tup3 Caqti_type.(tup3
id (id `build)
Meta.t Meta.t
file_opt) file_opt)
{| SELECT b.id, {| SELECT b.id,
@ -412,8 +407,8 @@ module Build = struct
let get_latest_uuid = let get_latest_uuid =
Caqti_request.find_opt Caqti_request.find_opt
id (id `job)
Caqti_type.(tup2 id Rep.uuid) Caqti_type.(tup2 (id `build) Rep.uuid)
{| SELECT b.id, b.uuid {| SELECT b.id, b.uuid
FROM build b FROM build b
WHERE b.job = ? WHERE b.job = ?
@ -423,7 +418,7 @@ module Build = struct
let get_latest_successful_uuid = let get_latest_successful_uuid =
Caqti_request.find_opt Caqti_request.find_opt
id (id `job)
Rep.uuid Rep.uuid
{| SELECT b.uuid {| SELECT b.uuid
FROM build b FROM build b
@ -434,8 +429,8 @@ module Build = struct
let get_previous_successful = let get_previous_successful =
Caqti_request.find_opt Caqti_request.find_opt
id (id `build)
Caqti_type.(tup2 id Meta.t) Caqti_type.(tup2 (id `build) Meta.t)
{| SELECT b.id, {| SELECT b.id,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_kind, b.result_code, b.result_msg, b.result_kind, b.result_code, b.result_msg,
@ -478,12 +473,12 @@ module Build = struct
let set_main_binary = let set_main_binary =
Caqti_request.exec 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" "UPDATE build SET main_binary = ?2 WHERE id = ?1"
let remove = let remove =
Caqti_request.exec Caqti_request.exec
id (id `build)
"DELETE FROM build WHERE id = ?" "DELETE FROM build WHERE id = ?"
end end
@ -511,7 +506,7 @@ module User = struct
let get_user = let get_user =
Caqti_request.find_opt Caqti_request.find_opt
Caqti_type.string Caqti_type.string
(Caqti_type.tup2 id user_info) (Caqti_type.tup2 (id `user) user_info)
{| SELECT id, username, password_hash, password_salt, {| SELECT id, username, password_hash, password_salt,
scrypt_n, scrypt_r, scrypt_p, restricted scrypt_n, scrypt_r, scrypt_p, restricted
FROM user FROM user
@ -534,7 +529,7 @@ module User = struct
let remove = let remove =
Caqti_request.exec Caqti_request.exec
id (id `user)
"DELETE FROM user WHERE id = ?" "DELETE FROM user WHERE id = ?"
let remove_user = let remove_user =
@ -578,18 +573,18 @@ module Access_list = struct
let get = let get =
Caqti_request.find Caqti_request.find
Caqti_type.(tup2 Rep.id Rep.id) Caqti_type.(tup2 (id `user) (id `job))
Rep.id (id `access_list)
"SELECT id FROM access_list WHERE user = ? AND job = ?" "SELECT id FROM access_list WHERE user = ? AND job = ?"
let add = let add =
Caqti_request.exec Caqti_request.exec
Caqti_type.(tup2 Rep.id Rep.id) Caqti_type.(tup2 (id `user) (id `job))
"INSERT INTO access_list (user, job) VALUES (?, ?)" "INSERT INTO access_list (user, job) VALUES (?, ?)"
let remove = let remove =
Caqti_request.exec 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 = ?" "DELETE FROM access_list WHERE user = ? AND job = ?"
let remove_all_by_username = let remove_all_by_username =

View file

@ -1,5 +1,6 @@
module Rep : sig module Rep : sig
type id type untyped_id
type 'a id
type file = { type file = {
filepath : Fpath.t; filepath : Fpath.t;
localpath : Fpath.t; localpath : Fpath.t;
@ -7,7 +8,8 @@ module Rep : sig
size : int; 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 uuid : Uuidm.t Caqti_type.t
val ptime : Ptime.t Caqti_type.t val ptime : Ptime.t Caqti_type.t
val fpath : Fpath.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 execution_result : Builder.execution_result Caqti_type.t
val console : (int * string) list Caqti_type.t val console : (int * string) list Caqti_type.t
end end
type id = Rep.id type 'a id = 'a Rep.id
type file = Rep.file = { type file = Rep.file = {
filepath : Fpath.t; filepath : Fpath.t;
@ -42,7 +44,7 @@ val set_current_version :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val last_insert_rowid : 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 module Job : sig
val migrate : val migrate :
@ -51,18 +53,18 @@ module Job : sig
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get : val get :
(id, string, [< `Many | `One | `Zero > `One ]) ([`job] id, string, [< `Many | `One | `Zero > `One ])
Caqti_request.t Caqti_request.t
val get_id_by_name : 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 : 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 : 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 : val try_add :
(string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val remove : val remove :
(id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t ([`job] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
end end
module Tag : sig module Tag : sig
@ -71,9 +73,9 @@ module Tag : sig
val rollback : val rollback :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get : 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 : 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 : val try_add :
(string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
end end
@ -84,11 +86,11 @@ module Job_tag : sig
val rollback : val rollback :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val add : 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 : 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 : 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 end
module Build_artifact : sig module Build_artifact : sig
@ -98,21 +100,21 @@ module Build_artifact : sig
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_by_build : val get_by_build :
(id * Fpath.t, id * file, ([`build] id * Fpath.t, [`build_artifact] id * file,
[< `Many | `One | `Zero > `One ]) Caqti_request.t [< `Many | `One | `Zero > `One ]) Caqti_request.t
val get_by_build_uuid : val get_by_build_uuid :
(Uuidm.t * Fpath.t, id * file, (Uuidm.t * Fpath.t, [`build_artifact] id * file,
[< `Many | `One | `Zero > `One `Zero ]) [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t Caqti_request.t
val get_all_by_build : 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 : 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 : 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 : val remove :
(id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t ([`build_artifact] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
end end
module Build : module Build :
@ -124,9 +126,9 @@ sig
result : Builder.execution_result; result : Builder.execution_result;
console : (int * string) list; console : (int * string) list;
script : string; script : string;
main_binary : id option; main_binary : [`build_artifact] id option;
user_id : id; user_id : [`user] id;
job_id : id; job_id : [`job] id;
} }
module Meta : module Meta :
sig sig
@ -135,9 +137,9 @@ sig
start : Ptime.t; start : Ptime.t;
finish : Ptime.t; finish : Ptime.t;
result : Builder.execution_result; result : Builder.execution_result;
main_binary : id option; main_binary : [`build_artifact] id option;
user_id : id; user_id : [`user] id;
job_id : id; job_id : [`job] id;
} }
end end
@ -147,31 +149,31 @@ sig
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_opt : 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 : 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 Caqti_request.t
val get_all : 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 : 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 : 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 Caqti_request.t
val get_latest_uuid : 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 Caqti_request.t
val get_latest_successful_uuid : 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 Caqti_request.t
val get_previous_successful : 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 Caqti_request.t
val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_by_hash : val get_by_hash :
(Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t (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 set_main_binary : ([`build] id * [`build_artifact] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val remove : (id, unit, [< `Many | `One | `Zero > `Zero]) Caqti_request.t val remove : ([`build] id, unit, [< `Many | `One | `Zero > `Zero]) Caqti_request.t
end end
module User : sig module User : sig
@ -180,7 +182,7 @@ module User : sig
val rollback : val rollback :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_user : 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 ]) [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t Caqti_request.t
val get_all : val get_all :
@ -188,7 +190,7 @@ module User : sig
val add : val add :
(Builder_web_auth.scrypt Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ]) (Builder_web_auth.scrypt Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ])
Caqti_request.t 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 : val remove_user :
(string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val update_user : val update_user :
@ -202,11 +204,11 @@ module Access_list : sig
val rollback : val rollback :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get : 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 : 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 : 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 : val remove_all_by_username :
(string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
end end

View file

@ -20,8 +20,11 @@ module Asn = struct
let console_of_cs, console_to_cs = projections_of console let console_of_cs, console_to_cs = projections_of console
end end
type id = int64 type untyped_id = int64
let id = Caqti_type.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 = { type file = {
filepath : Fpath.t; filepath : Fpath.t;
@ -124,3 +127,10 @@ let user_info =
scrypt_r; scrypt_p }); scrypt_r; scrypt_p });
restricted; } in restricted; } in
Caqti_type.custom ~encode ~decode rep 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()"

View file

@ -15,13 +15,13 @@ val build_artifact : Uuidm.t -> Fpath.t -> Caqti_lwt.connection ->
val build_artifact_data : Fpath.t -> Builder_db.file -> val build_artifact_data : Fpath.t -> Builder_db.file ->
(string, [> error ]) result Lwt.t (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 (Builder_db.file list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val build : Uuidm.t -> Caqti_lwt.connection -> 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 ((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 -> 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 -> val build_exists : Uuidm.t -> Caqti_lwt.connection ->
(bool, [> Caqti_error.call_or_retrieve ]) result Lwt.t (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 (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 (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 (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 (Builder_db.file option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val readme : string -> Caqti_lwt.connection -> 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 (string option * (Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
val job_id : string -> Caqti_lwt.connection -> 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 -> 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 -> 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 (string, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val user : string -> Caqti_lwt.connection -> 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 : val add_build :
Fpath.t -> Fpath.t ->
Builder_db.id -> [`user] Builder_db.id ->
(Builder.script_job * Uuidm.t * (int * string) list * Ptime.t * Ptime.t * (Builder.script_job * Uuidm.t * (int * string) list * Ptime.t * Ptime.t *
Builder.execution_result * (Fpath.t * string) list) -> Builder.execution_result * (Fpath.t * string) list) ->
Caqti_lwt.connection -> Caqti_lwt.connection ->