builder-web/bin/migrations/m20210629.ml

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 VARCHAR(255) 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.id
    "SELECT id FROM job"

let latest_successful_build =
  Caqti_request.find
    Builder_db.Rep.id
    Builder_db.Rep.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.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 switch =
    let root = switch.OpamFile.SwitchExport.selections.OpamTypes.sel_roots in
    if OpamPackage.Set.cardinal root <> 1 then
      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
      | Some opam -> OpamFile.OPAM.synopsis 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 (monitoring)"
    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
  | 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 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.id string Builder_db.Rep.id)
     "INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"

let find_tag =
   Caqti_request.find
     Caqti_type.string
     Builder_db.Rep.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.find find_tag "section" >>= fun section_id ->
  Db.find find_tag "synopsis" >>= fun synopsis_id ->
  Db.collect_list jobs () >>= fun jobs ->
  Grej.list_iter_result (fun job ->
    Db.find latest_successful_build job >>= fun 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)))
    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) ()