let new_version = 9L and old_version = 8L let identifier = "2021-06-29" let migrate_doc = "add tag and job_tag table" let rollback_doc = "remove tag and job tag table" let tag = Caqti_request.exec Caqti_type.unit {| CREATE TABLE tag ( id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, tag VARCHAR(255) NOT NULL UNIQUE ) |} let job_tag = Caqti_request.exec Caqti_type.unit {| CREATE TABLE job_tag ( id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, tag INTEGER NOT NULL, value TEXT NOT NULL, job INTEGER NOT NULL, FOREIGN KEY(job) REFERENCES job(id), FOREIGN KEY(tag) REFERENCES tag(id), UNIQUE(tag, job) ) |} let jobs = Caqti_request.collect Caqti_type.unit Builder_db.Rep.untyped_id "SELECT id FROM job" let latest_successful_build = Caqti_request.find_opt 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 = Caqti_request.collect 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 infer_section_and_synopsis artifacts = let opam_switch = match List.find_opt (fun (p, _) -> String.equal (Fpath.basename p) "opam-switch") artifacts with | None -> None | Some (_, data) -> Some (OpamFile.SwitchExport.read_from_string data) in let infer_synopsis_and_descr switch = let root = switch.OpamFile.SwitchExport.selections.OpamTypes.sel_roots in if OpamPackage.Set.cardinal root <> 1 then None, None else let root = OpamPackage.Set.choose root in match OpamPackage.Name.Map.find_opt root.OpamPackage.name switch.OpamFile.SwitchExport.overlays with | None -> None, None | Some opam -> OpamFile.OPAM.synopsis opam, OpamFile.OPAM.descr_body opam in let infer_section_from_packages switch = let influx = OpamPackage.Name.of_string "metrics-influx" in if OpamPackage.Set.exists (fun p -> OpamPackage.Name.equal p.OpamPackage.name influx) switch.OpamFile.SwitchExport.selections.OpamTypes.sel_installed then "Unikernel (with metrics reported to Influx)" else "Unikernel" in let infer_section_from_extension = match List.find_opt (fun (p, _) -> Fpath.(is_prefix (v "bin/") p)) artifacts with | None -> None | Some (p, _) -> match Fpath.get_ext p with | ".deb" -> Some "Debian Package" | ".txz" -> Some "FreeBSD Package" | _ -> None in match opam_switch with | None -> None, (None, None) | Some opam_switch -> let section = match infer_section_from_extension with | Some x -> x | None -> infer_section_from_packages opam_switch in Some section, infer_synopsis_and_descr opam_switch let remove_tag = Caqti_request.exec Caqti_type.unit "DROP TABLE tag" let remove_job_tag = Caqti_request.exec Caqti_type.unit "DROP TABLE job_tag" let insert_tag = Caqti_request.exec Caqti_type.string "INSERT INTO tag (tag) VALUES (?)" let insert_job_tag = Caqti_request.exec 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.untyped_id "SELECT id FROM tag where tag = ?" open Rresult.R.Infix let migrate datadir (module Db : Caqti_blocking.CONNECTION) = Grej.check_version ~user_version:old_version (module Db) >>= fun () -> Db.exec tag () >>= fun () -> Db.exec job_tag () >>= fun () -> Db.exec insert_tag "section" >>= fun () -> Db.exec insert_tag "synopsis" >>= fun () -> Db.exec insert_tag "description" >>= fun () -> Db.find find_tag "section" >>= fun section_id -> Db.find find_tag "synopsis" >>= fun synopsis_id -> Db.find find_tag "description" >>= fun descr_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 sec_syn = infer_section_and_synopsis files in (match fst sec_syn with None -> Ok () | Some s -> Db.exec insert_job_tag (section_id, s, job)) >>= fun () -> (match snd sec_syn with None, _ -> Ok () | Some s, _ -> Db.exec insert_job_tag (synopsis_id, s, job)) >>= fun () -> (match snd sec_syn with _, None -> Ok () | _, Some s -> Db.exec insert_job_tag (descr_id, s, 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.exec remove_tag () >>= fun () -> Db.exec remove_job_tag () >>= fun () -> Db.exec (Grej.set_version old_version) ()