builder-web/bin/migrations/m20210630.ml

88 lines
2.8 KiB
OCaml
Raw Normal View History

let new_version = 10L and old_version = 9L
let identifier = "2021-06-30"
let migrate_doc = "add readme.md tag"
let rollback_doc = "remove readme.md tag"
2022-04-04 16:30:21 +00:00
open Grej.Infix
let jobs =
2022-04-04 16:30:21 +00:00
Caqti_type.unit ->* Builder_db.Rep.untyped_id @@
"SELECT id FROM job"
let latest_successful_build =
2022-04-04 16:30:21 +00:00
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
ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1
|}
let build_artifacts =
2022-04-04 16:30:21 +00:00
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
WHERE a.build = ?
|}
let insert_tag =
2022-04-04 16:30:21 +00:00
Caqti_type.string ->. Caqti_type.unit @@
"INSERT INTO tag (tag) VALUES (?)"
let insert_job_tag =
2022-04-04 16:30:21 +00:00
Caqti_type.(tup3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) ->.
Caqti_type.unit @@
"INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"
let find_tag =
2022-04-04 16:30:21 +00:00
Caqti_type.string ->! Builder_db.Rep.untyped_id @@
"SELECT id FROM tag where tag = ?"
let remove_job_tag =
2022-04-04 16:30:21 +00:00
Builder_db.Rep.untyped_id ->. Caqti_type.unit @@
"DELETE FROM job_tag where tag = ?"
let remove_tag =
2022-04-04 16:30:21 +00:00
Builder_db.Rep.untyped_id ->. Caqti_type.unit @@
"DELETE FROM tag where id = ?"
let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec insert_tag "readme.md" >>= fun () ->
Db.find find_tag "readme.md" >>= fun readme_id ->
Db.collect_list jobs () >>= fun jobs ->
Grej.list_iter_result (fun job ->
Db.find_opt latest_successful_build job >>= function
| None -> Ok ()
| Some build ->
Db.collect_list build_artifacts build >>= fun artifacts ->
List.fold_left (fun acc (fpath, lpath) ->
acc >>= fun acc ->
Bos.OS.File.read Fpath.(append datadir lpath) >>= fun data ->
Ok ((fpath, data) :: acc))
(Ok [])
artifacts >>= fun files ->
let readme =
List.find_opt (fun (p, _) -> Fpath.(equal (v "README.md") p)) files
in
let readme_anywhere =
List.find_opt (fun (p, _) -> String.equal "README.md" (Fpath.basename p)) files
in
(match readme, readme_anywhere with
| None, None -> Ok ()
| Some (_, data), _ | None, Some (_, data) ->
Db.exec insert_job_tag (readme_id, data, job)))
jobs >>= 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.find find_tag "readme.md" >>= fun readme_id ->
Db.exec remove_job_tag readme_id >>= fun () ->
Db.exec remove_tag readme_id >>= fun () ->
Db.exec (Grej.set_version old_version) ()