From 4461a91f87a6196f1fbd9776b50bb1e39b597266 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Tue, 13 Aug 2024 13:07:50 +0200 Subject: [PATCH 1/2] Update to caqti>=2.1.1 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). --- bin/builder_db_app.ml | 14 +++---- bin/migrations/m20210126.ml | 4 +- bin/migrations/m20210218.ml | 8 ++-- bin/migrations/m20210308.ml | 2 +- bin/migrations/m20210531.ml | 4 +- bin/migrations/m20210602.ml | 34 ++++++++-------- bin/migrations/m20210608.ml | 8 ++-- bin/migrations/m20210629.ml | 4 +- bin/migrations/m20210630.ml | 4 +- bin/migrations/m20210706.ml | 4 +- bin/migrations/m20210707a.ml | 2 +- bin/migrations/m20210707b.ml | 4 +- bin/migrations/m20210707c.ml | 8 ++-- bin/migrations/m20210707d.ml | 4 +- bin/migrations/m20210712a.ml | 8 ++-- bin/migrations/m20210712b.ml | 4 +- bin/migrations/m20210712c.ml | 10 ++--- bin/migrations/m20210910.ml | 4 +- bin/migrations/m20211105.ml | 4 +- bin/migrations/m20220509.ml | 8 ++-- bin/migrations/m20230914.ml | 4 +- builder-web.opam | 2 +- db/builder_db.ml | 76 +++++++++++++++++------------------- db/representation.ml | 14 +++---- lib/builder_web.ml | 2 +- 25 files changed, 118 insertions(+), 122 deletions(-) diff --git a/bin/builder_db_app.ml b/bin/builder_db_app.ml index 6a2334e..ac52622 100644 --- a/bin/builder_db_app.ml +++ b/bin/builder_db_app.ml @@ -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 //...: %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) diff --git a/bin/migrations/m20210126.ml b/bin/migrations/m20210126.ml index d413b9c..df2e811 100644 --- a/bin/migrations/m20210126.ml +++ b/bin/migrations/m20210126.ml @@ -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) = diff --git a/bin/migrations/m20210218.ml b/bin/migrations/m20210218.ml index 57384e6..05a974f 100644 --- a/bin/migrations/m20210218.ml +++ b/bin/migrations/m20210218.ml @@ -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 (?, ?, ?, ?, ?, ?) |} diff --git a/bin/migrations/m20210308.ml b/bin/migrations/m20210308.ml index abca0b9..f37ba04 100644 --- a/bin/migrations/m20210308.ml +++ b/bin/migrations/m20210308.ml @@ -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 diff --git a/bin/migrations/m20210531.ml b/bin/migrations/m20210531.ml index 99d3e7a..cfe1797 100644 --- a/bin/migrations/m20210531.ml +++ b/bin/migrations/m20210531.ml @@ -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 *) diff --git a/bin/migrations/m20210602.ml b/bin/migrations/m20210602.ml index 3889d4d..0bed15f 100644 --- a/bin/migrations/m20210602.ml +++ b/bin/migrations/m20210602.ml @@ -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) diff --git a/bin/migrations/m20210608.ml b/bin/migrations/m20210608.ml index ac75c32..48a9535 100644 --- a/bin/migrations/m20210608.ml +++ b/bin/migrations/m20210608.ml @@ -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 (?, ?, ?, ?, ?, ?, ?)" diff --git a/bin/migrations/m20210629.ml b/bin/migrations/m20210629.ml index 2dc2e8d..b9a5736 100644 --- a/bin/migrations/m20210629.ml +++ b/bin/migrations/m20210629.ml @@ -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 (?, ?, ?)" diff --git a/bin/migrations/m20210630.ml b/bin/migrations/m20210630.ml index 555f881..c66af49 100644 --- a/bin/migrations/m20210630.ml +++ b/bin/migrations/m20210630.ml @@ -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 (?, ?, ?)" diff --git a/bin/migrations/m20210706.ml b/bin/migrations/m20210706.ml index 2ee9c7b..a0d07b9 100644 --- a/bin/migrations/m20210706.ml +++ b/bin/migrations/m20210706.ml @@ -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) = diff --git a/bin/migrations/m20210707a.ml b/bin/migrations/m20210707a.ml index d80cfbd..d0c157f 100644 --- a/bin/migrations/m20210707a.ml +++ b/bin/migrations/m20210707a.ml @@ -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' |} diff --git a/bin/migrations/m20210707b.ml b/bin/migrations/m20210707b.ml index 48447d7..ac0a216 100644 --- a/bin/migrations/m20210707b.ml +++ b/bin/migrations/m20210707b.ml @@ -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" diff --git a/bin/migrations/m20210707c.ml b/bin/migrations/m20210707c.ml index 12bc7d3..99bb10b 100644 --- a/bin/migrations/m20210707c.ml +++ b/bin/migrations/m20210707c.ml @@ -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 (?, ?, ?, ?, ?)" diff --git a/bin/migrations/m20210707d.ml b/bin/migrations/m20210707d.ml index c1cd938..df3a7dc 100644 --- a/bin/migrations/m20210707d.ml +++ b/bin/migrations/m20210707d.ml @@ -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" diff --git a/bin/migrations/m20210712a.ml b/bin/migrations/m20210712a.ml index 8409242..902bfcc 100644 --- a/bin/migrations/m20210712a.ml +++ b/bin/migrations/m20210712a.ml @@ -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" diff --git a/bin/migrations/m20210712b.ml b/bin/migrations/m20210712b.ml index 91a4c22..dffe9ec 100644 --- a/bin/migrations/m20210712b.ml +++ b/bin/migrations/m20210712b.ml @@ -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) = diff --git a/bin/migrations/m20210712c.ml b/bin/migrations/m20210712c.ml index 6c36035..c1fc6fd 100644 --- a/bin/migrations/m20210712c.ml +++ b/bin/migrations/m20210712c.ml @@ -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" diff --git a/bin/migrations/m20210910.ml b/bin/migrations/m20210910.ml index 9a0b564..53b39d8 100644 --- a/bin/migrations/m20210910.ml +++ b/bin/migrations/m20210910.ml @@ -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" diff --git a/bin/migrations/m20211105.ml b/bin/migrations/m20211105.ml index 600bc67..2368acc 100644 --- a/bin/migrations/m20211105.ml +++ b/bin/migrations/m20211105.ml @@ -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 = diff --git a/bin/migrations/m20220509.ml b/bin/migrations/m20220509.ml index 1d32490..686854f 100644 --- a/bin/migrations/m20220509.ml +++ b/bin/migrations/m20220509.ml @@ -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" diff --git a/bin/migrations/m20230914.ml b/bin/migrations/m20230914.ml index e1b79db..c4b558c 100644 --- a/bin/migrations/m20230914.ml +++ b/bin/migrations/m20230914.ml @@ -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 diff --git a/builder-web.opam b/builder-web.opam index 756f2f6..f4ae2d0 100644 --- a/builder-web.opam +++ b/builder-web.opam @@ -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" diff --git a/db/builder_db.ml b/db/builder_db.ml index f2950b7..4e10acf 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -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 - uuid - (tup2 - Rep.ptime - Rep.ptime) - (tup2 - execution_result - fpath) - (tup4 - fpath - string - (option (Rep.id `build_artifact)) - (option Rep.cstruct))) + Caqti_type.(t11 + uuid + Rep.ptime + Rep.ptime + execution_result + fpath + fpath + string + (option (Rep.id `build_artifact)) + (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 = diff --git a/db/representation.ml b/db/representation.ml index 1cc1722..c162fe6 100644 --- a/db/representation.ml +++ b/db/representation.ml @@ -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, diff --git a/lib/builder_web.ml b/lib/builder_web.ml index feb596e..54f78a4 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -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 -> From e73f7c5aa37ec65e6788705fcc64be9e5a8388df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Tue, 13 Aug 2024 13:10:29 +0200 Subject: [PATCH 2/2] Set upper bound on tar --- builder-web.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/builder-web.opam b/builder-web.opam index f4ae2d0..4b001cb 100644 --- a/builder-web.opam +++ b/builder-web.opam @@ -46,7 +46,7 @@ depends: [ "uri" "fmt" {>= "0.8.7"} "cmarkit" {>= "0.3.0"} - "tar" + "tar" {< "3.0.0"} "owee" "solo5-elftool" {>= "0.3.0"} "decompress" {>= "1.5.0"}