diff --git a/bin/migrations/builder_migrations.ml b/bin/migrations/builder_migrations.ml index 8ae15d2..d55f328 100644 --- a/bin/migrations/builder_migrations.ml +++ b/bin/migrations/builder_migrations.ml @@ -145,6 +145,16 @@ let r20210608 = Cmdliner.Term.(const do_database_action $ const M20210608.rollback $ setup_log $ datadir), Cmdliner.Term.info ~doc "rollback-2021-06-08" +let m20210609 = + let doc = "add user column to build" in + Cmdliner.Term.(const do_database_action $ const M20210609.migrate $ setup_log $ datadir), + Cmdliner.Term.info ~doc "migrate-2021-06-09" + +let r20210609 = + let doc = "remove user column to build" in + Cmdliner.Term.(const do_database_action $ const M20210609.rollback $ setup_log $ datadir), + Cmdliner.Term.info ~doc "rollback-2021-06-09" + let help_cmd = let topic = let doc = "Migration to get help on" in @@ -172,5 +182,6 @@ let () = m20210531; r20210531; m20210602; r20210602; m20210608; r20210608; + m20210609; r20210609; ] |> Cmdliner.Term.exit diff --git a/bin/migrations/m20210602.ml b/bin/migrations/m20210602.ml index 8db709d..afc4722 100644 --- a/bin/migrations/m20210602.ml +++ b/bin/migrations/m20210602.ml @@ -1,5 +1,9 @@ let old_version = 4L and new_version = 5L +let idx_build_job_start = + Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)" + let new_build = Caqti_request.exec Caqti_type.unit @@ -121,6 +125,7 @@ let migrate _ (module Db : Caqti_blocking.CONNECTION) = builds >>= fun () -> Db.exec drop_build () >>= fun () -> Db.exec rename_build () >>= fun () -> + Db.exec idx_build_job_start () >>= fun () -> Db.exec (Grej.set_version new_version) () @@ -140,4 +145,5 @@ let rollback _ (module Db : Caqti_blocking.CONNECTION) = builds >>= fun () -> Db.exec drop_build () >>= fun () -> Db.exec rename_build () >>= fun () -> + Db.exec idx_build_job_start () >>= fun () -> Db.exec (Grej.set_version old_version) () diff --git a/bin/migrations/m20210609.ml b/bin/migrations/m20210609.ml new file mode 100644 index 0000000..f649c12 --- /dev/null +++ b/bin/migrations/m20210609.ml @@ -0,0 +1,119 @@ +let new_version = 7L and old_version = 6L + +let idx_build_job_start = + Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)" + +let nologin_user = + Caqti_request.exec + Caqti_type.unit + "INSERT INTO user (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) \ + VALUES ('nologin', '', '', 16384, 8, 1, true)" + +let remove_nologin_user = + Caqti_request.exec + Caqti_type.unit + "DELETE FROM user WHERE username = 'nologin'" + +let new_build = + Caqti_request.exec + Caqti_type.unit + {| CREATE TABLE new_build ( + id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + uuid VARCHAR(36) NOT NULL UNIQUE, + start_d INTEGER NOT NULL, + start_ps INTEGER NOT NULL, + finish_d INTEGER NOT NULL, + finish_ps INTEGER NOT NULL, + result_kind TINYINT NOT NULL, + result_code INTEGER, + result_msg TEXT, + console BLOB NOT NULL, + script TEXT NOT NULL, + main_binary INTEGER, + user INTEGER NOT NULL, + job INTEGER NOT NULL, + + FOREIGN KEY(main_binary) REFERENCES build_artifact(id), + FOREIGN KEY(job) REFERENCES job(id), + FOREIGN KEY(user) REFERENCES user(id) + ) + |} + +let old_build = + Caqti_request.exec + Caqti_type.unit + {| CREATE TABLE new_build ( + id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + uuid VARCHAR(36) NOT NULL UNIQUE, + start_d INTEGER NOT NULL, + start_ps INTEGER NOT NULL, + finish_d INTEGER NOT NULL, + finish_ps INTEGER NOT NULL, + result_kind TINYINT NOT NULL, + result_code INTEGER, + result_msg TEXT, + console BLOB NOT NULL, + script TEXT NOT NULL, + main_binary INTEGER, + job INTEGER NOT NULL, + + FOREIGN KEY(main_binary) REFERENCES build_artifact(id), + FOREIGN KEY(job) REFERENCES job(id) + ) + |} + +let insert_from_old_build = + Caqti_request.exec ~oneshot:true + Builder_db.Rep.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, user) + 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_from_new_build = + Caqti_request.exec ~oneshot:true + 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) + 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 drop_build = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + "DROP TABLE build" + +let rename_build = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + "ALTER TABLE new_build RENAME TO build" + +open Rresult.R.Infix + +let migrate _datadir (module Db : Caqti_blocking.CONNECTION) = + Grej.check_version ~user_version:old_version (module Db) >>= fun () -> + Db.exec nologin_user () >>= fun () -> + Db.find Builder_db.last_insert_rowid () >>= fun user_id -> + Db.exec new_build () >>= fun () -> + Db.exec insert_from_old_build user_id >>= fun () -> + Db.exec drop_build () >>= fun () -> + Db.exec rename_build () >>= fun () -> + Db.exec idx_build_job_start () >>= fun () -> + Db.exec (Grej.set_version new_version) () + +let rollback _datadir (module Db : Caqti_blocking.CONNECTION) = + Grej.check_version ~user_version:new_version (module Db) >>= fun () -> + Db.exec old_build () >>= fun () -> + Db.exec insert_from_new_build () >>= fun () -> + Db.exec drop_build () >>= fun () -> + Db.exec rename_build () >>= fun () -> + Db.exec idx_build_job_start () >>= fun () -> + Db.exec remove_nologin_user () >>= fun () -> + Db.exec (Grej.set_version old_version) () + + diff --git a/db/builder_db.ml b/db/builder_db.ml index bdefe38..6538c59 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -4,7 +4,7 @@ open Rep let application_id = 1234839235l (* Please update this when making changes! *) -let current_version = 6L +let current_version = 7L type id = Rep.id @@ -212,12 +212,13 @@ module Build = struct console : (int * string) list; script : string; main_binary : id option; + user_id : id; job_id : id; } let t = let rep = - Caqti_type.(tup2 + Caqti_type.(tup3 (tup4 uuid (tup2 @@ -229,13 +230,14 @@ module Build = struct (tup2 string (option Rep.id))) + id id) in - let encode { uuid; start; finish; result; console; script; main_binary; job_id } = - Ok ((uuid, (start, finish), (result, console), (script, main_binary)), job_id) + let encode { uuid; start; finish; result; console; script; main_binary; user_id; job_id } = + Ok ((uuid, (start, finish), (result, console), (script, main_binary)), user_id, job_id) in - let decode ((uuid, (start, finish), (result, console), (script, main_binary)), job_id) = - Ok { uuid; start; finish; result; console; script; main_binary; job_id } + let decode ((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 } in Caqti_type.custom ~encode ~decode rep @@ -246,12 +248,13 @@ module Build = struct finish : Ptime.t; result : Builder.execution_result; main_binary : id option; + user_id : id; job_id : id; } let t = let rep = - Caqti_type.(tup2 + Caqti_type.(tup3 (tup4 uuid (tup2 @@ -259,13 +262,14 @@ module Build = struct Rep.ptime) execution_result (option Rep.id)) + id id) in - let encode { uuid; start; finish; result; main_binary; job_id } = - Ok ((uuid, (start, finish), result, main_binary), job_id) + let encode { uuid; start; finish; result; main_binary; user_id; job_id } = + Ok ((uuid, (start, finish), result, main_binary), user_id, job_id) in - let decode ((uuid, (start, finish), result, main_binary), job_id) = - Ok { uuid; start; finish; result; main_binary; job_id } + let decode ((uuid, (start, finish), result, main_binary), user_id, job_id) = + Ok { uuid; start; finish; result; main_binary; user_id; job_id } in Caqti_type.custom ~encode ~decode rep end @@ -286,9 +290,11 @@ module Build = struct console BLOB NOT NULL, script TEXT NOT NULL, main_binary INTEGER, + user INTEGER NOT NULL, job INTEGER NOT NULL, FOREIGN KEY(main_binary) REFERENCES build_artifact(id), + FOREIGN KEY(user) REFERENCES user(id), FOREIGN KEY(job) REFERENCES job(id) ) |} @@ -304,7 +310,7 @@ module Build = struct t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, - console, script, main_binary, job + console, script, main_binary, user, job FROM build WHERE id = ? |} @@ -315,7 +321,7 @@ module Build = struct (Caqti_type.tup2 id t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, - console, script, main_binary, job + console, script, main_binary, user, job FROM build WHERE uuid = ? |} @@ -326,7 +332,7 @@ module Build = struct (Caqti_type.tup2 id t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, - script, main_binary, job + script, main_binary, user, job FROM build WHERE job = ? ORDER BY start_d DESC, start_ps DESC @@ -340,7 +346,7 @@ module Build = struct {| 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, - build.main_binary, build.job, + build.main_binary, build.user, build.job, build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size FROM build, job LEFT JOIN build_artifact ON @@ -359,7 +365,7 @@ module Build = struct {| 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, - b.main_binary, b.job, + b.main_binary, b.user, b.job, a.filepath, a.localpath, a.sha256, a.size FROM build b LEFT JOIN build_artifact a ON @@ -398,7 +404,7 @@ module Build = struct {| 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, - b.main_binary, b.job + b.main_binary, b.user, b.job FROM build b, build b0 WHERE b0.id = ? AND b0.job = b.job AND b.result_kind = 0 AND b.result_code = 0 AND @@ -412,9 +418,9 @@ module Build = struct t {| INSERT INTO build (uuid, start_d, start_ps, finish_d, finish_ps, - result_kind, result_code, result_msg, console, script, main_binary, job) + result_kind, result_code, result_msg, console, script, main_binary, user, job) VALUES - (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) + (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |} let get_by_hash = @@ -426,7 +432,7 @@ module Build = struct {| SELECT job.name, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_kind, b.result_code, b.result_msg, - b.console, b.script, b.main_binary, b.job + b.console, b.script, b.main_binary, b.user, b.job FROM build_artifact a INNER JOIN build b ON b.id = a.build INNER JOIN job ON job.id = b.job diff --git a/db/builder_db.mli b/db/builder_db.mli index f14406b..c8bbdd2 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -113,6 +113,7 @@ sig console : (int * string) list; script : string; main_binary : id option; + user_id : id; job_id : id; } module Meta : @@ -123,6 +124,7 @@ sig finish : Ptime.t; result : Builder.execution_result; main_binary : id option; + user_id : id; job_id : id; } end diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 8468a23..06be8b8 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -196,7 +196,9 @@ let add_routes datadir = |> Lwt_result.ok | false -> let datadir = Dream.global datadir_global req in - Dream.sql req (Model.add_build datadir exec) + (Lwt.return (Dream.local Authorization.user_info_local req |> + Option.to_result ~none:(`Msg "no authenticated user")) >>= fun (user_id, _) -> + Dream.sql req (Model.add_build datadir user_id exec)) |> if_error "Internal server error" ~log:(fun e -> Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e)) >>= fun () -> Dream.respond "" |> Lwt_result.ok diff --git a/lib/model.ml b/lib/model.ml index 66650ae..ddc538b 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -191,6 +191,7 @@ let commit_files datadir staging_dir job_name uuid = let add_build datadir + user_id ((job, uuid, console, start, finish, result, _) as exec) (module Db : CONN) = let open Builder_db in @@ -214,7 +215,7 @@ let add_build Lwt.return (Option.to_result ~none:(`Msg "No such job id") job_id) >>= fun job_id -> Db.exec Build.add { Build.uuid; start; finish; result; console; script = job.Builder.script; - main_binary = None; job_id } >>= fun () -> + main_binary = None; user_id; job_id } >>= fun () -> Db.find last_insert_rowid () >>= fun id -> List.fold_left (fun r file -> diff --git a/lib/model.mli b/lib/model.mli index 5a2e12f..1a08160 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -61,6 +61,7 @@ val authorized : Builder_db.id -> string -> Caqti_lwt.connection -> (unit, [> Ca val add_build : Fpath.t -> + Builder_db.id -> (Builder.job * Uuidm.t * (int * string) list * Ptime.t * Ptime.t * Builder.execution_result * (Fpath.t * string) list) -> Caqti_lwt.connection -> diff --git a/lib/views.ml b/lib/views.ml index 7fa8e73..d2faa8b 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -168,7 +168,7 @@ let job name builds = let job_build name - { Builder_db.Build.uuid; start; finish; result; console; script; main_binary = _; job_id = _ } + { Builder_db.Build.uuid; start; finish; result; console; script; _ } artifacts latest_uuid previous_build diff --git a/test/builder_db.ml b/test/builder_db.ml index 07802c0..145e487 100644 --- a/test/builder_db.ml +++ b/test/builder_db.ml @@ -75,12 +75,13 @@ let restricted = false let auth = Builder_web_auth.hash ~scrypt_params ~username ~password ~restricted () let add_test_user (module Db : CONN) = - Db.exec Builder_db.User.add auth + Db.exec Builder_db.User.add auth >>= fun () -> + Db.find Builder_db.last_insert_rowid () let with_user_db f () = or_fail (setup_db () >>= fun conn -> - add_test_user conn >>= fun () -> + add_test_user conn >>= fun _id -> f conn) let test_user_get_all (module Db : CONN) = @@ -150,17 +151,17 @@ let main_binary = let size = String.length data in { Builder_db.Rep.filepath; localpath; sha256; size } -let fail_if_none = - Option.to_result ~none:(`Msg "Failed to retrieve job id") +let fail_if_none a = + Option.to_result ~none:(`Msg "Failed to retrieve") a -let add_test_build (module Db : CONN) = +let add_test_build user_id (module Db : CONN) = let r = let open Builder_db in Db.start () >>= fun () -> Db.exec Job.try_add job_name >>= fun () -> Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id -> Db.exec Build.add { Build.uuid; start; finish; result; console; script; - main_binary = None; + main_binary = None; user_id; job_id } >>= fun () -> Db.find last_insert_rowid () >>= fun id -> Db.exec Build_artifact.add (main_binary, id) >>= fun () -> @@ -175,7 +176,8 @@ let add_test_build (module Db : CONN) = let with_build_db f () = or_fail (setup_db () >>= fun conn -> - add_test_build conn >>= fun () -> + add_test_user conn >>= fun user_id -> + add_test_build user_id conn >>= fun () -> f conn) let test_job_get_all (module Db : CONN) = @@ -224,10 +226,11 @@ let finish' = Option.get (Ptime.of_float_s 3601.) let add_second_build (module Db : CONN) = let uuid = uuid' and start = start' and finish = finish' in let open Builder_db in + Db.find_opt User.get_user username >>= fail_if_none >>= fun (user_id, _) -> Db.start () >>= fun () -> Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id -> Db.exec Build.add { Build.uuid; start; finish; result; console; script; - main_binary = None; job_id; + main_binary = None; user_id; job_id; } >>= fun () -> Db.find last_insert_rowid () >>= fun id -> Db.exec Build_artifact.add (main_binary, id) >>= fun () ->