robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Typed database IDs (#47)

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

4
bin/migrations/m20210308.ml
View file

@ -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)

4
bin/migrations/m20210531.ml
View file

@ -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 *)

26
bin/migrations/m20210602.ml
View file

@ -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 (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}

2
bin/migrations/m20210609.ml
View file

@ -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)

12
bin/migrations/m20210629.ml
View file

@ -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

16
bin/migrations/m20210630.ml
View file

@ -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

111
db/builder_db.ml
View file

@ -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 =

84
db/builder_db.mli
View file

@ -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

14
db/representation.ml
View file

@ -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()"

28
lib/model.mli
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 ->
(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 ->