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

Update to caqti>=2.1.1

Browse source 
The tuple type constructors are renamed from tupN to tN. Also, except
for migrations, use the wider tuple types (up to 12 since caqti.2.1.0).
This commit is contained in:
Reynir Björnsson 2024-08-13 13:07:50 +02:00
parent b96c3a0479
commit 4461a91f87
25 changed files with 118 additions and 122 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
bin/builder_db_app.ml
View file

@ -301,7 +301,7 @@ let input_ids =
let main_artifact_hash =
Builder_db.Rep.cstruct ->*
Caqti_type.tup3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@
Caqti_type.t3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@
{|
SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j
WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id
@ -336,10 +336,10 @@ let num_build_artifacts =
Caqti_type.unit ->! Caqti_type.int @@
"SELECT count(*) FROM build_artifact"
let build_artifacts : (unit, string * Uuidm.t * (Fpath.t * Cstruct.t * int64), [ `One | `Zero | `Many ]) Caqti_request.t =
let build_artifacts : (unit, string * Uuidm.t * Fpath.t * Cstruct.t * int64, [ `One | `Zero | `Many ]) Caqti_request.t =
Caqti_type.unit ->*
Caqti_type.(tup3 string Builder_db.Rep.uuid
(tup3 Builder_db.Rep.fpath Builder_db.Rep.cstruct int64))
Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath
Builder_db.Rep.cstruct int64)
@@
{| SELECT job.name, b.uuid, a.filepath, a.sha256, a.size
FROM build_artifact a, build b, job
@ -347,7 +347,7 @@ let build_artifacts : (unit, string * Uuidm.t * (Fpath.t * Cstruct.t * int64), [
let script_and_console : (unit, _, [`One | `Zero | `Many ]) Caqti_request.t =
Caqti_type.unit ->*
Caqti_type.(tup4 string Builder_db.Rep.uuid Builder_db.Rep.fpath Builder_db.Rep.fpath)
Caqti_type.(t4 string Builder_db.Rep.uuid Builder_db.Rep.fpath Builder_db.Rep.fpath)
@@
{| SELECT job.name, b.uuid, b.console, b.script
FROM build b, job
@ -387,7 +387,7 @@ let verify_data_dir () datadir =
| _ -> Logs.err (fun m -> m "path is not of form <job>/<uuid>/...: %a" Fpath.pp path)
in
let* () =
Db.iter_s build_artifacts (fun (_job, _uuid, (_fpath, sha256, size)) ->
Db.iter_s build_artifacts (fun (_job, _uuid, _fpath, sha256, size) ->
progress ();
if not (FpathSet.mem (artifact_path sha256) !files_tracked) then
let abs_path = Fpath.(v datadir // artifact_path sha256) in
@ -557,7 +557,7 @@ module Verify_cache_dir = struct
in
Caqti_type.custom ~encode ~decode
Caqti_type.(
tup4
t4
Builder_db.Rep.uuid
string
(option Builder_db.Rep.cstruct)

4
bin/migrations/m20210126.ml
View file

@ -18,11 +18,11 @@ let all_builds =
"SELECT id FROM build"
let bin_artifact =
Caqti_type.int64 ->* Caqti_type.(tup2 int64 string) @@
Caqti_type.int64 ->* Caqti_type.(t2 int64 string) @@
"SELECT id, filepath FROM build_artifact WHERE build = ? AND filepath LIKE 'bin/%'"
let set_main_binary =
Caqti_type.(tup2 int64 (option string)) ->. Caqti_type.unit @@
Caqti_type.(t2 int64 (option string)) ->. Caqti_type.unit @@
"UPDATE build SET main_binary = $2 WHERE id = $1"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =

8
bin/migrations/m20210218.ml
View file

@ -37,21 +37,21 @@ let new_build_file =
|}
let collect_build_artifact =
Caqti_type.unit ->* Caqti_type.(tup3 int64 (tup3 string string octets) int64) @@
Caqti_type.unit ->* Caqti_type.(t3 int64 (t3 string string octets) int64) @@
"SELECT id, filepath, localpath, sha256, build FROM build_artifact"
let collect_build_file =
Caqti_type.unit ->* Caqti_type.(tup3 int64 (tup3 string string octets) int64) @@
Caqti_type.unit ->* Caqti_type.(t3 int64 (t3 string string octets) int64) @@
"SELECT id, filepath, localpath, sha256, build FROM build_file"
let insert_new_build_artifact =
Caqti_type.(tup3 int64 (tup4 string string octets int64) int64) ->. Caqti_type.unit @@
Caqti_type.(t3 int64 (t4 string string octets int64) int64) ->. Caqti_type.unit @@
{| INSERT INTO new_build_artifact (id, filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?, ?)
|}
let insert_new_build_file =
Caqti_type.(tup3 int64 (tup4 string string octets int64) int64) ->. Caqti_type.unit @@
Caqti_type.(t3 int64 (t4 string string octets int64) int64) ->. Caqti_type.unit @@
{| INSERT INTO new_build_file (id, filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?, ?)
|}

2
bin/migrations/m20210308.ml
View file

@ -3,7 +3,7 @@ module Rep = Builder_db.Rep
open Grej.Infix
let broken_builds =
Caqti_type.unit ->* Caqti_type.tup3 (Rep.id `build) Rep.uuid Caqti_type.string @@
Caqti_type.unit ->* Caqti_type.t3 (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

4
bin/migrations/m20210531.ml
View file

@ -7,11 +7,11 @@ let rollback_doc = "add datadir prefix to build_artifact.localpath"
open Grej.Infix
let build_artifacts =
Caqti_type.unit ->* Caqti_type.tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath @@
Caqti_type.unit ->* Caqti_type.t2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath @@
"SELECT id, localpath FROM build_artifact"
let build_artifact_update_localpath =
Caqti_type.tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath ->. Caqti_type.unit @@
Caqti_type.t2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath ->. Caqti_type.unit @@
"UPDATE build_artifact SET localpath = $2 WHERE id = $1"
(* We are not migrating build_file because it is unused *)

34
bin/migrations/m20210602.ml
View file

@ -54,20 +54,20 @@ let old_build =
let collect_old_build =
Caqti_type.unit ->*
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)))
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 octets string (option string)))
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_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)))
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 octets string (option Builder_db.Rep.untyped_id)))
Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
{| 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)
@ -82,7 +82,7 @@ let rename_build =
"ALTER TABLE new_build RENAME TO build"
let find_main_artifact_id =
Caqti_type.(tup2 Builder_db.Rep.untyped_id string) ->! Builder_db.Rep.untyped_id @@
Caqti_type.(t2 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 =
@ -91,20 +91,20 @@ let find_main_artifact_filepath =
let collect_new_build =
Caqti_type.unit ->*
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)))
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 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_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)))
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 octets string (option string)))
Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
{| 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)

8
bin/migrations/m20210608.ml
View file

@ -34,21 +34,21 @@ let old_user =
let collect_old_user =
Caqti_type.unit ->*
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) @@
Caqti_type.(t4 int64 string (t2 octets octets) (t3 int64 int64 int64)) @@
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p FROM user"
let collect_new_user =
Caqti_type.unit ->*
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) @@
Caqti_type.(t4 int64 string (t2 octets octets) (t4 int64 int64 int64 bool)) @@
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user"
let insert_new_user =
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) ->.
Caqti_type.(t4 int64 string (t2 octets octets) (t4 int64 int64 int64 bool)) ->.
Caqti_type.unit @@
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) VALUES (?, ?, ?, ?, ?, ?, ?, ?)"
let insert_old_user =
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) ->.
Caqti_type.(t4 int64 string (t2 octets octets) (t3 int64 int64 int64)) ->.
Caqti_type.unit @@
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p) VALUES (?, ?, ?, ?, ?, ?, ?)"

4
bin/migrations/m20210629.ml
View file

@ -42,7 +42,7 @@ let latest_successful_build =
let build_artifacts =
Builder_db.Rep.untyped_id ->*
Caqti_type.tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath @@
Caqti_type.t2 Builder_db.Rep.fpath Builder_db.Rep.fpath @@
{| SELECT a.filepath, a.localpath
FROM build_artifact a
WHERE a.build = ?
@ -106,7 +106,7 @@ let insert_tag =
"INSERT INTO tag (tag) VALUES (?)"
let insert_job_tag =
Caqti_type.(tup3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) ->.
Caqti_type.(t3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) ->.
Caqti_type.unit @@
"INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"

4
bin/migrations/m20210630.ml
View file

@ -20,7 +20,7 @@ let latest_successful_build =
let build_artifacts =
Builder_db.Rep.untyped_id ->*
Caqti_type.tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath @@
Caqti_type.t2 Builder_db.Rep.fpath Builder_db.Rep.fpath @@
{| SELECT a.filepath, a.localpath
FROM build_artifact a
WHERE a.build = ?
@ -31,7 +31,7 @@ let insert_tag =
"INSERT INTO tag (tag) VALUES (?)"
let insert_job_tag =
Caqti_type.(tup3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) ->.
Caqti_type.(t3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) ->.
Caqti_type.unit @@
"INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"

4
bin/migrations/m20210706.ml
View file

@ -55,7 +55,7 @@ let drop_input_id_from_build =
let builds =
Caqti_type.unit ->*
Caqti_type.tup4
Caqti_type.t4
Builder_db.Rep.untyped_id
Builder_db.Rep.cstruct
Builder_db.Rep.cstruct
@ -68,7 +68,7 @@ let builds =
|}
let set_input_id =
Caqti_type.tup2 Builder_db.Rep.untyped_id Builder_db.Rep.cstruct ->. Caqti_type.unit @@
Caqti_type.t2 Builder_db.Rep.untyped_id Builder_db.Rep.cstruct ->. Caqti_type.unit @@
"UPDATE build SET input_id = $2 WHERE id = $1"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =

2
bin/migrations/m20210707a.ml
View file

@ -2,7 +2,7 @@ open Grej.Infix
let orb_left_in_builds =
Caqti_type.unit ->*
Caqti_type.tup2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
Caqti_type.t2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
{| SELECT id, localpath FROM build_artifact
WHERE filepath = 'orb.deb' OR filepath = 'orb.txz'
|}

4
bin/migrations/m20210707b.ml
View file

@ -2,7 +2,7 @@ open Grej.Infix
let deb_debug_left_in_builds =
Caqti_type.unit ->*
Caqti_type.tup4 (Builder_db.Rep.id `build_artifact) (Builder_db.Rep.id `build)
Caqti_type.t4 (Builder_db.Rep.id `build_artifact) (Builder_db.Rep.id `build)
Builder_db.Rep.fpath Builder_db.Rep.fpath @@
{| SELECT id, build, localpath, filepath FROM build_artifact
WHERE filepath LIKE '%.deb.debug'
@ -17,7 +17,7 @@ let get_localpath =
"SELECT localpath FROM build_artifact WHERE id = ?"
let update_paths =
Caqti_type.tup3 (Builder_db.Rep.id `build_artifact)
Caqti_type.t3 (Builder_db.Rep.id `build_artifact)
Builder_db.Rep.fpath Builder_db.Rep.fpath ->.
Caqti_type.unit @@
"UPDATE build_artifact SET localpath = $2, filepath = $3 WHERE id = $1"

8
bin/migrations/m20210707c.ml
View file

@ -2,7 +2,7 @@ open Grej.Infix
let all_builds_with_binary : (unit, [`build] Builder_db.Rep.id * [`build_artifact] Builder_db.Rep.id * Fpath.t * Fpath.t, [ `Zero | `One | `Many ]) Caqti_request.t =
Caqti_type.unit ->*
Caqti_type.tup4 (Builder_db.Rep.id `build) (Builder_db.Rep.id `build_artifact)
Caqti_type.t4 (Builder_db.Rep.id `build) (Builder_db.Rep.id `build_artifact)
Builder_db.Rep.fpath Builder_db.Rep.fpath @@
"SELECT b.id, b.main_binary, a.filepath, a.localpath FROM build b, build_artifact a WHERE b.main_binary = a.id AND b.main_binary IS NOT NULL"
@ -11,14 +11,14 @@ let build_not_stripped : ([`build] Builder_db.Rep.id, [`build_artifact] Builder_
"SELECT id FROM build_artifact WHERE build = ? AND filepath LIKE '%.debug'"
let update_paths : ([`build_artifact] Builder_db.Rep.id * Fpath.t * Fpath.t, unit, [ `Zero ]) Caqti_request.t =
Caqti_type.tup3 (Builder_db.Rep.id `build_artifact)
Caqti_type.t3 (Builder_db.Rep.id `build_artifact)
Builder_db.Rep.fpath Builder_db.Rep.fpath ->.
Caqti_type.unit @@
"UPDATE build_artifact SET localpath = $2, filepath = $3 WHERE id = $1"
let add_artifact : ((Fpath.t * Fpath.t * Cstruct.t) * (int64 * [`build] Builder_db.Rep.id), unit, [ `Zero]) Caqti_request.t =
Caqti_type.(tup2 (tup3 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct)
(tup2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->.
Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct)
(t2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->.
Caqti_type.unit @@
"INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)"

4
bin/migrations/m20210707d.ml
View file

@ -2,11 +2,11 @@ open Grej.Infix
let all_build_artifacts_with_dot_slash : (unit, [`build_artifact] Builder_db.Rep.id * Fpath.t, [ `Zero | `One | `Many ]) Caqti_request.t =
Caqti_type.unit ->*
Caqti_type.tup2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
Caqti_type.t2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
"SELECT id, filepath FROM build_artifact WHERE filepath LIKE './%'"
let update_path : ([`build_artifact] Builder_db.Rep.id * Fpath.t, unit, [< `Zero | `One | `Many > `Zero ]) Caqti_request.t =
Caqti_type.tup2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath ->.
Caqti_type.t2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath ->.
Caqti_type.unit @@
"UPDATE build_artifact SET filepath = $2 WHERE id = $1"

8
bin/migrations/m20210712a.ml
View file

@ -40,11 +40,11 @@ let copy_old_build =
let old_build_execution_result =
Caqti_type.unit ->*
Caqti_type.(tup3 (Builder_db.Rep.id (`build : [ `build ])) int (option int)) @@
Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) int (option int)) @@
"SELECT id, result_kind, result_code FROM build"
let update_new_build_execution_result =
Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) int) ->. Caqti_type.unit @@
Caqti_type.(t2 (Builder_db.Rep.id (`build : [ `build ])) int) ->. Caqti_type.unit @@
"UPDATE new_build SET result_code = $2 WHERE id = $1"
let old_build =
@ -83,11 +83,11 @@ let copy_new_build =
let new_build_execution_result =
Caqti_type.unit ->*
Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) int) @@
Caqti_type.(t2 (Builder_db.Rep.id (`build : [ `build ])) int) @@
"SELECT id, result_code FROM build"
let update_old_build_execution_result =
Caqti_type.(tup3 (Builder_db.Rep.id (`build : [ `build ])) int (option int)) ->.
Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) int (option int)) ->.
Caqti_type.unit @@
"UPDATE new_build SET result_kind = $2, result_code = $3 WHERE id = $1"

4
bin/migrations/m20210712b.ml
View file

@ -2,12 +2,12 @@ open Grej.Infix
let all_build_artifacts_like_hashes : (unit, [`build_artifact] Builder_db.Rep.id * Fpath.t, [ `Zero | `One | `Many ]) Caqti_request.t =
Caqti_type.unit ->*
Caqti_type.tup2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
Caqti_type.t2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
"SELECT id, localpath FROM build_artifact WHERE filepath LIKE '%.build-hashes'"
let all_build_artifacts_like_readme : (unit, [`build_artifact] Builder_db.Rep.id * Fpath.t, [ `Zero | `One | `Many ]) Caqti_request.t =
Caqti_type.unit ->*
Caqti_type.tup2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
Caqti_type.t2 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath @@
"SELECT id, localpath FROM build_artifact WHERE filepath LIKE '%README.md'"
let fixup datadir (module Db : Caqti_blocking.CONNECTION) =

10
bin/migrations/m20210712c.ml
View file

@ -95,24 +95,24 @@ let copy_from_new_build =
let old_build_console_script =
Caqti_type.unit ->*
Caqti_type.(tup4 (Builder_db.Rep.id (`build : [ `build ]))
(tup2 string Builder_db.Rep.uuid) Builder_db.Rep.cstruct string) @@
Caqti_type.(t4 (Builder_db.Rep.id (`build : [ `build ]))
(t2 string Builder_db.Rep.uuid) Builder_db.Rep.cstruct string) @@
"SELECT b.id, job.name, b.uuid, b.console, b.script FROM build b, job WHERE b.job = job.id"
let update_new_build_console_script =
Caqti_type.(tup3 (Builder_db.Rep.id (`build : [ `build ]))
Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ]))
Builder_db.Rep.fpath Builder_db.Rep.fpath) ->.
Caqti_type.unit @@
"UPDATE new_build SET console = $2, script = $3 WHERE id = $1"
let new_build_console_script =
Caqti_type.unit ->*
Caqti_type.tup3 (Builder_db.Rep.id (`build : [ `build ]))
Caqti_type.t3 (Builder_db.Rep.id (`build : [ `build ]))
Builder_db.Rep.fpath Builder_db.Rep.fpath @@
"SELECT id, console, script FROM build"
let update_old_build_console_script =
Caqti_type.(tup3 (Builder_db.Rep.id (`build : [ `build ])) Builder_db.Rep.cstruct string) ->.
Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) Builder_db.Rep.cstruct string) ->.
Caqti_type.unit @@
"UPDATE new_build SET console = $2, script = $3 WHERE id = $1"

4
bin/migrations/m20210910.ml
View file

@ -2,13 +2,13 @@ open Grej.Infix
let mixups =
Caqti_type.unit ->*
Caqti_type.tup3 (Builder_db.Rep.id (`build : [`build]))
Caqti_type.t3 (Builder_db.Rep.id (`build : [`build]))
Builder_db.Rep.fpath Builder_db.Rep.fpath @@
"SELECT id, console, script FROM build \
WHERE console LIKE '%/script.txt' AND script LIKE '%/console.txt'"
let fixup =
Caqti_type.tup3 (Builder_db.Rep.id (`build : [`build]))
Caqti_type.t3 (Builder_db.Rep.id (`build : [`build]))
Builder_db.Rep.fpath Builder_db.Rep.fpath ->.
Caqti_type.unit @@
"UPDATE build SET console = $2, script = $3 WHERE id = $1"

4
bin/migrations/m20211105.ml
View file

@ -73,11 +73,11 @@ let copy_from_new_build =
|}
let build_id_and_user =
Caqti_type.unit ->* Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) int64) @@
Caqti_type.unit ->* Caqti_type.(t2 (Builder_db.Rep.id (`build : [ `build ])) int64) @@
"SELECT id, user FROM build"
let update_new_build_platform =
Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) string) ->. Caqti_type.unit @@
Caqti_type.(t2 (Builder_db.Rep.id (`build : [ `build ])) string) ->. Caqti_type.unit @@
"UPDATE new_build SET platform = $2 WHERE id = $1"
let drop_build =

8
bin/migrations/m20220509.ml
View file

@ -23,21 +23,21 @@ let new_uuid_rep =
let uuids_byte_encoded_q =
Caqti_type.unit ->*
Caqti_type.tup2 (Builder_db.Rep.id (`build : [`build])) old_uuid_rep @@
Caqti_type.t2 (Builder_db.Rep.id (`build : [`build])) old_uuid_rep @@
"SELECT id, uuid FROM build"
let uuids_hex_encoded_q =
Caqti_type.unit ->*
Caqti_type.tup2 (Builder_db.Rep.id (`build : [`build])) new_uuid_rep @@
Caqti_type.t2 (Builder_db.Rep.id (`build : [`build])) new_uuid_rep @@
"SELECT id, uuid FROM build"
let migrate_q =
Caqti_type.tup2 (Builder_db.Rep.id (`build : [`build])) new_uuid_rep ->.
Caqti_type.t2 (Builder_db.Rep.id (`build : [`build])) new_uuid_rep ->.
Caqti_type.unit @@
"UPDATE build SET uuid = $2 WHERE id = $1"
let rollback_q =
Caqti_type.tup2 (Builder_db.Rep.id (`build : [`build])) old_uuid_rep ->.
Caqti_type.t2 (Builder_db.Rep.id (`build : [`build])) old_uuid_rep ->.
Caqti_type.unit @@
"UPDATE build SET uuid = $2 WHERE id = $1"

4
bin/migrations/m20230914.ml
View file

@ -60,13 +60,13 @@ let copy_old_build_artifact =
|}
let new_build_artifact_paths =
Caqti_type.unit ->* Caqti_type.(tup2 string string) @@
Caqti_type.unit ->* Caqti_type.(t2 string string) @@
{| SELECT localpath, '_artifacts/' || substr(lower(hex(sha256)), 1, 2) || '/' || lower(hex(sha256))
FROM build_artifact
|}
let old_build_artifact_paths =
Caqti_type.unit ->* Caqti_type.(tup2 string string) @@
Caqti_type.unit ->* Caqti_type.(t2 string string) @@
{| SELECT '_artifacts/' || substr(lower(hex(a.sha256)), 1, 2) || '/' || lower(hex(a.sha256)),
j.name || '/' || b.uuid || '/output/' || a.filepath
FROM build_artifact a, job j, build b

2
builder-web.opam
View file

@ -23,7 +23,7 @@ depends: [
"bos"
"hex"
"lwt" {>= "5.7.0"}
"caqti" {>= "1.8.0"}
"caqti" {>= "2.1.1"}
"caqti-lwt"
"caqti-driver-sqlite3"
"pbkdf"

64
db/builder_db.ml
View file

@ -57,7 +57,7 @@ module Job = struct
let get_all_with_section_synopsis =
Caqti_type.unit ->*
Caqti_type.(tup4 (id `job) string (option string) (option string)) @@
Caqti_type.(t4 (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
@ -117,15 +117,15 @@ module Job_tag = struct
"DROP TABLE IF EXISTS job_tag"
let add =
Caqti_type.(tup3 (id `tag) string (id `job)) ->. Caqti_type.unit @@
Caqti_type.(t3 (id `tag) string (id `job)) ->. Caqti_type.unit @@
"INSERT INTO job_tag (tag, value, job) VALUES ($1, $2, $3)"
let update =
Caqti_type.(tup3 (id `tag) string (id `job)) ->. Caqti_type.unit @@
Caqti_type.(t3 (id `tag) string (id `job)) ->. Caqti_type.unit @@
"UPDATE job_tag SET value = $2 WHERE tag = $1 AND job = $3"
let get_value =
Caqti_type.(tup2 (id `tag) (id `job)) ->? Caqti_type.string @@
Caqti_type.(t2 (id `tag) (id `job)) ->? Caqti_type.string @@
"SELECT value FROM job_tag WHERE tag = ? AND job = ?"
let remove_by_job =
@ -159,7 +159,7 @@ module Build_artifact = struct
FROM build_artifact WHERE id = ? |}
let get_by_build_uuid =
Caqti_type.tup2 uuid fpath ->? Caqti_type.tup2 (id `build_artifact) file @@
Caqti_type.t2 uuid fpath ->? Caqti_type.t2 (id `build_artifact) file @@
{| SELECT build_artifact.id, build_artifact.filepath,
build_artifact.sha256, build_artifact.size
FROM build_artifact
@ -168,7 +168,7 @@ module Build_artifact = struct
|}
let get_all_by_build =
id `build ->* Caqti_type.(tup2 (id `build_artifact) file) @@
id `build ->* Caqti_type.(t2 (id `build_artifact) file) @@
"SELECT id, filepath, sha256, size FROM build_artifact WHERE build = ?"
let exists =
@ -176,7 +176,7 @@ module Build_artifact = struct
"SELECT EXISTS(SELECT 1 FROM build_artifact WHERE sha256 = ?)"
let add =
Caqti_type.(tup2 file (id `build)) ->. Caqti_type.unit @@
Caqti_type.(t2 file (id `build)) ->. Caqti_type.unit @@
"INSERT INTO build_artifact (filepath, sha256, size, build) \
VALUES (?, ?, ?, ?)"
@ -231,27 +231,23 @@ module Build = struct
let t =
let rep =
Caqti_type.(tup3
(tup4
Caqti_type.(t11
uuid
(tup2
Rep.ptime
Rep.ptime)
(tup2
Rep.ptime
execution_result
fpath)
(tup4
fpath
fpath
string
(option (Rep.id `build_artifact))
(option Rep.cstruct)))
(option Rep.cstruct)
(id `user)
(id `job))
in
let encode { uuid; start; finish; result; console; script; platform; main_binary; input_id; user_id; job_id } =
Ok ((uuid, (start, finish), (result, console), (script, platform, main_binary, input_id)), user_id, job_id)
Ok (uuid, start, finish, result, console, script, platform, main_binary, input_id, user_id, job_id)
in
let decode ((uuid, (start, finish), (result, console), (script, platform, main_binary, input_id)), user_id, job_id) =
let decode (uuid, start, finish, result, console, script, platform, main_binary, input_id, user_id, job_id) =
Ok { uuid; start; finish; result; console; script; platform; main_binary; input_id; user_id; job_id }
in
Caqti_type.custom ~encode ~decode rep
@ -286,7 +282,7 @@ module Build = struct
"DROP TABLE IF EXISTS build"
let get_by_uuid =
Rep.uuid ->? Caqti_type.tup2 (id `build) t @@
Rep.uuid ->? Caqti_type.t2 (id `build) t @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg,
console, script, platform, main_binary, input_id, user, job
@ -295,7 +291,7 @@ module Build = struct
|}
let get_all =
id `job ->* Caqti_type.tup2 (id `build) t @@
id `job ->* Caqti_type.t2 (id `build) t @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console,
script, platform, main_binary, input_id, user, job
@ -305,7 +301,7 @@ module Build = struct
|}
let get_all_failed =
Caqti_type.(tup3 int int (option string)) ->* Caqti_type.tup2 Caqti_type.string t @@
Caqti_type.(t3 int int (option string)) ->* Caqti_type.t2 Caqti_type.string t @@
{| SELECT job.name, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.console, b.script, b.platform,
b.main_binary, b.input_id, b.user, b.job
@ -318,7 +314,7 @@ module Build = struct
|}
let get_all_artifact_sha =
Caqti_type.(tup2 (id `job) (option string)) ->* Rep.cstruct @@
Caqti_type.(t2 (id `job) (option string)) ->* Rep.cstruct @@
{| SELECT DISTINCT a.sha256
FROM build_artifact a, build b
WHERE b.job = $1 AND b.main_binary = a.id
@ -327,7 +323,7 @@ module Build = struct
|}
let get_failed_builds =
Caqti_type.(tup2 (id `job) (option string)) ->* t @@
Caqti_type.(t2 (id `job) (option string)) ->* t @@
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script,
platform, main_binary, input_id, user, job
@ -339,7 +335,7 @@ module Build = struct
|}
let get_latest_successful_with_binary =
Caqti_type.(tup2 (id `job) string) ->? Caqti_type.tup3 (id `build) t file @@
Caqti_type.(t2 (id `job) string) ->? Caqti_type.t3 (id `build) t file @@
{| SELECT b.id,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.console, b.script,
@ -353,7 +349,7 @@ module Build = struct
|}
let get_builds_older_than =
Caqti_type.(tup3 (id `job) (option string) Rep.ptime) ->* Caqti_type.tup2 (id `build) t @@
Caqti_type.(t3 (id `job) (option string) Rep.ptime) ->* Caqti_type.t2 (id `build) t @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script,
platform, main_binary, input_id, user, job
@ -365,7 +361,7 @@ module Build = struct
|}
let get_builds_excluding_latest_n =
Caqti_type.(tup3 (id `job) (option string) int) ->* Caqti_type.tup2 (id `build) t @@
Caqti_type.(t3 (id `job) (option string) int) ->* Caqti_type.t2 (id `build) t @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script,
platform, main_binary, input_id, user, job
@ -378,7 +374,7 @@ module Build = struct
(* "LIMIT -1 OFFSET n" is all rows except the first n *)
let get_nth_latest_successful =
Caqti_type.(tup3 (id `job) (option string) int) ->? Caqti_type.tup2 (id `build) t @@
Caqti_type.(t3 (id `job) (option string) int) ->? Caqti_type.t2 (id `build) t @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script,
platform, main_binary, input_id, user, job
@ -391,7 +387,7 @@ module Build = struct
|}
let get_latest_successful =
Caqti_type.(tup2 (id `job) (option string)) ->? t @@
Caqti_type.(t2 (id `job) (option string)) ->? t @@
{| SELECT
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.console, b.script,
@ -504,7 +500,7 @@ module Build = struct
|}
let get_with_main_binary_by_hash =
Rep.cstruct ->! Caqti_type.tup2 t file_opt @@
Rep.cstruct ->! Caqti_type.t2 t file_opt @@
{| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.console, b.script,
b.platform, b.main_binary, b.input_id, b.user, b.job,
@ -517,7 +513,7 @@ module Build = struct
|}
let get_with_jobname_by_hash =
Rep.cstruct ->? Caqti_type.tup2 Caqti_type.string t @@
Rep.cstruct ->? Caqti_type.t2 Caqti_type.string t @@
{| SELECT job.name,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg,
@ -531,7 +527,7 @@ module Build = struct
|}
let set_main_binary =
Caqti_type.tup2 (id `build) (id `build_artifact) ->. Caqti_type.unit @@
Caqti_type.t2 (id `build) (id `build_artifact) ->. Caqti_type.unit @@
"UPDATE build SET main_binary = $2 WHERE id = $1"
let remove =
@ -559,7 +555,7 @@ module User = struct
"DROP TABLE IF EXISTS user"
let get_user =
Caqti_type.string ->? Caqti_type.tup2 (id `user) user_info @@
Caqti_type.string ->? Caqti_type.t2 (id `user) user_info @@
{| SELECT id, username, password_hash, password_salt,
scrypt_n, scrypt_r, scrypt_p, restricted
FROM user
@ -613,15 +609,15 @@ module Access_list = struct
"DROP TABLE IF EXISTS access_list"
let get =
Caqti_type.tup2 (id `user) (id `job) ->! id `access_list @@
Caqti_type.t2 (id `user) (id `job) ->! id `access_list @@
"SELECT id FROM access_list WHERE user = ? AND job = ?"
let add =
Caqti_type.tup2 (id `user) (id `job) ->. Caqti_type.unit @@
Caqti_type.t2 (id `user) (id `job) ->. Caqti_type.unit @@
"INSERT INTO access_list (user, job) VALUES (?, ?)"
let remove =
Caqti_type.tup2 (id `user) (id `job) ->. Caqti_type.unit @@
Caqti_type.t2 (id `user) (id `job) ->. Caqti_type.unit @@
"DELETE FROM access_list WHERE user = ? AND job = ?"
let remove_by_job =

14
db/representation.ml
View file

@ -47,7 +47,7 @@ let ptime =
let encode t = Ok (Ptime.Span.to_d_ps (Ptime.to_span t)) in
let decode (d, ps) = Ok (Ptime.v (d, ps))
in
let rep = Caqti_type.(tup2 int int64) in
let rep = Caqti_type.(t2 int int64) in
Caqti_type.custom ~encode ~decode rep
let fpath =
@ -66,10 +66,10 @@ let file =
Ok (filepath, sha256, size) in
let decode (filepath, sha256, size) =
Ok { filepath; sha256; size } in
Caqti_type.custom ~encode ~decode Caqti_type.(tup3 fpath cstruct int)
Caqti_type.custom ~encode ~decode Caqti_type.(t3 fpath cstruct int)
let file_opt =
let rep = Caqti_type.(tup3 (option fpath) (option cstruct) (option int)) in
let rep = Caqti_type.(t3 (option fpath) (option cstruct) (option int)) in
let encode = function
| Some { filepath; sha256; size } ->
Ok (Some filepath, Some sha256, Some size)
@ -108,7 +108,7 @@ let execution_result =
else
Error "bad encoding (unknown number)"
in
let rep = Caqti_type.(tup2 int (option string)) in
let rep = Caqti_type.(t2 int (option string)) in
Caqti_type.custom ~encode ~decode rep
let console =
@ -117,16 +117,16 @@ let console =
Caqti_type.custom ~encode ~decode cstruct
let user_info =
let rep = Caqti_type.(tup4 string cstruct cstruct (tup4 int int int bool)) in
let rep = Caqti_type.(t7 string cstruct cstruct int int int bool) in
let encode { Builder_web_auth.username;
password_hash = `Scrypt (password_hash, password_salt, {
Builder_web_auth.scrypt_n; scrypt_r; scrypt_p
});
restricted; }
=
Ok (username, password_hash, password_salt, (scrypt_n, scrypt_r, scrypt_p, restricted))
Ok (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted)
in
let decode (username, password_hash, password_salt, (scrypt_n, scrypt_r, scrypt_p, restricted)) =
let decode (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) =
Ok { Builder_web_auth.username;
password_hash =
`Scrypt (password_hash, password_salt,

2
lib/builder_web.ml
View file

@ -26,7 +26,7 @@ let init_datadir datadir =
let init dbpath datadir =
Result.bind (init_datadir datadir) @@ fun () ->
Lwt_main.run (
Caqti_lwt.connect
Caqti_lwt_unix.connect
(Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
>>= fun (module Db : Caqti_lwt.CONNECTION) ->
Db.find Builder_db.get_application_id () >>= fun application_id ->