Add platform to build table

bin/migrations/builder_migrations.ml

@@ -162,5 +162,6 @@ let () =
         [ f20210712b ];
         actions (module M20210712c);
         [ f20210910 ];
+        actions (module M20211105);
       ])
   |> Cmdliner.Term.exit

bin/migrations/m20211105.ml

@@ -0,0 +1,179 @@
+let new_version = 15L and old_version = 14L
+and identifier = "2021-11-05"
+and migrate_doc = "add platform to build"
+and rollback_doc = "remove platform from build"
+
+open Grej.Syntax
+
+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_code INTEGER NOT NULL,
+         result_msg TEXT,
+         console TEXT NOT NULL,
+         script TEXT NOT NULL,
+         platform TEXT NOT NULL,
+         main_binary INTEGER,
+         user INTEGER NOT NULL,
+         job INTEGER NOT NULL,
+         input_id BLOB, -- sha256 (sha256<opam-switch> || sha256<build-environment> || sha256<system-packages>)
+
+         FOREIGN KEY(main_binary) REFERENCES build_artifact(id) DEFERRABLE INITIALLY DEFERRED,
+         FOREIGN KEY(user) REFERENCES user(id),
+         FOREIGN KEY(job) REFERENCES job(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_code INTEGER NOT NULL,
+         result_msg TEXT,
+         console TEXT NOT NULL,
+         script TEXT NOT NULL,
+         main_binary INTEGER,
+         user INTEGER NOT NULL,
+         job INTEGER NOT NULL,
+         input_id BLOB, -- sha256 (sha256<opam-switch> || sha256<build-environment> || sha256<system-packages>)
+
+         FOREIGN KEY(main_binary) REFERENCES build_artifact(id) DEFERRABLE INITIALLY DEFERRED,
+         FOREIGN KEY(user) REFERENCES user(id),
+         FOREIGN KEY(job) REFERENCES job(id)
+       )
+    |}
+
+let copy_from_old_build =
+  Caqti_request.exec
+    Caqti_type.unit
+    {| INSERT INTO new_build(id, uuid, start_d, start_ps, finish_d, finish_ps,
+         result_code, result_msg, console, script, platform, main_binary, user, job, input_id)
+       SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_code, result_msg,
+         console, script, 'PLACEHOLDER-PLATFORM', main_binary, user, job, input_id
+       FROM build
+    |}
+
+let copy_from_new_build =
+  Caqti_request.exec
+    Caqti_type.unit
+    {| INSERT INTO new_build(id, uuid, start_d, start_ps, finish_d, finish_ps,
+         result_code, result_msg, console, script, main_binary, user, job, input_id)
+       SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_code, result_msg,
+         console, script, main_binary, user, job, input_id
+       FROM build
+    |}
+
+let build_id_and_user =
+  Caqti_request.collect
+    Caqti_type.unit
+    Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) int64)
+    "SELECT id, user FROM build"
+
+let update_new_build_platform =
+  Caqti_request.exec
+    Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) string)
+    "UPDATE new_build SET platform = ?2 WHERE id = ?1"
+
+let drop_build =
+  Caqti_request.exec
+    Caqti_type.unit
+    "DROP TABLE build"
+
+let rename_build =
+  Caqti_request.exec
+    Caqti_type.unit
+    "ALTER TABLE new_build RENAME TO build"
+
+(*
+1|reynir
+2|freebsd-builder
+3|ubuntu-builder
+5|nologin
+6|reynir-solsort
+7|reynir-spurv
+*)
+let platform_of_user_id = function
+  | 1L -> assert false
+  | 2L -> "freebsd-12"
+  | 3L -> "ubuntu-20.04"
+  | 5L -> assert false
+  | 6L -> "debian-10"
+  | 7L -> "debian-11"
+  | _ -> assert false
+
+let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
+  let* () = Grej.check_version ~user_version:old_version (module Db) in
+  let* () = Db.exec new_build () in
+  let* () = Db.exec copy_from_old_build () in
+  let* builds = Db.collect_list build_id_and_user () in
+  let* () =
+    Grej.list_iter_result (fun (id, user) ->
+        let platform = platform_of_user_id user in
+        Db.exec update_new_build_platform (id, platform))
+      builds
+  in
+  let* () = Db.exec drop_build () in
+  let* () = Db.exec rename_build () in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)")
+      ()
+  in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_failed ON build(job, start_d DESC, start_ps DESC) WHERE result_code <> 0")
+      ()
+  in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_input_id ON build(input_id)")
+      ()
+  in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_main_binary ON build(main_binary)")
+      ()
+  in
+  Db.exec (Grej.set_version new_version) ()
+
+let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
+  let* () = Grej.check_version ~user_version:new_version (module Db) in
+  let* () = Db.exec old_build () in
+  let* () = Db.exec copy_from_new_build () in
+  let* () = Db.exec drop_build () in
+  let* () = Db.exec rename_build () in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)")
+      ()
+  in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_failed ON build(job, start_d DESC, start_ps DESC) WHERE result_code <> 0")
+      ()
+  in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_input_id ON build(input_id)")
+      ()
+  in
+  let* () =
+    Db.exec (Caqti_request.exec Caqti_type.unit
+        "CREATE INDEX idx_build_main_binary ON build(main_binary)")
+      ()
+  in
+  Db.exec (Grej.set_version old_version) ()
+

db/builder_db.ml

@@ -4,7 +4,7 @@ open Rep
 let application_id = 1234839235l
 
 (* Please update this when making changes! *)
-let current_version = 14L
+let current_version = 15L
 
 type 'a id = 'a Rep.id
 
@@ -248,6 +248,7 @@ module Build = struct
     result : Builder.execution_result;
     console : Fpath.t;
     script : Fpath.t;
+    platform : string;
     main_binary : [`build_artifact] id option;
     input_id : Cstruct.t option;
     user_id : [`user] id;
@@ -265,18 +266,19 @@ module Build = struct
                        (tup2
                           execution_result
                           fpath)
-                       (tup3
+                       (tup4
                           fpath
+                          string
                           (option (Rep.id `build_artifact))
                           (option Rep.cstruct)))
                     (id `user)
                     (id `job))
     in
-    let encode { uuid; start; finish; result; console; script; main_binary; input_id; user_id; job_id } =
+    let encode { uuid; start; finish; result; console; script; platform; main_binary; input_id; user_id; job_id } =
-      Ok ((uuid, (start, finish), (result, console), (script, 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, 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; 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
 
@@ -294,6 +296,7 @@ module Build = struct
            result_msg TEXT,
            console TEXT NOT NULL,
            script TEXT NOT NULL,
+           platform TEXT NOT NULL,
            main_binary INTEGER,
            user INTEGER NOT NULL,
            job INTEGER NOT NULL,
@@ -316,7 +319,7 @@ module Build = struct
       t
       {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
                 result_code, result_msg,
-                console, script, main_binary, input_id, user, job
+                console, script, platform, main_binary, input_id, user, job
            FROM build
            WHERE id = ?
         |}
@@ -327,7 +330,7 @@ module Build = struct
       (Caqti_type.tup2 (id `build) t)
       {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
                   result_code, result_msg,
-                  console, script, main_binary, input_id, user, job
+                  console, script, platform, main_binary, input_id, user, job
            FROM build
            WHERE uuid = ?
         |}
@@ -338,7 +341,7 @@ module Build = struct
       (Caqti_type.tup2 (id `build) t)
       {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
                   result_code, result_msg, console,
-                  script, main_binary, input_id, user, job
+                  script, platform, main_binary, input_id, user, job
            FROM build
            WHERE job = ?
            ORDER BY start_d DESC, start_ps DESC
@@ -351,8 +354,8 @@ module Build = struct
          (id `build) t file_opt)
       {| SELECT build.id, build.uuid,
                 build.start_d, build.start_ps, build.finish_d, build.finish_ps,
-                build.result_code, build.result_msg, console, script,
+                build.result_code, build.result_msg, build.console, build.script,
-                build.main_binary, build.input_id, build.user, build.job,
+                build.platform, build.main_binary, build.input_id, build.user, build.job,
                 build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size
            FROM build, job
            LEFT JOIN build_artifact ON
@@ -377,7 +380,7 @@ module Build = struct
       t
       {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
                 result_code, result_msg, console, script,
-                main_binary, input_id, user, job
+                platform, main_binary, input_id, user, job
          FROM build
          WHERE job = ? AND result_code <> 0
          ORDER BY start_d DESC, start_ps DESC
@@ -394,7 +397,7 @@ module Build = struct
       {| 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,
-           b.main_binary, b.input_id, b.user, b.job,
+           b.platform, b.main_binary, b.input_id, b.user, b.job,
            a.filepath, a.localpath, a.sha256, a.size
          FROM build b
          LEFT JOIN build_artifact a ON
@@ -433,7 +436,7 @@ module Build = struct
       {| 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,
-           b.main_binary, b.input_id, b.user, b.job
+           b.platform, b.main_binary, b.input_id, b.user, b.job
          FROM build b, build b0
          WHERE b0.id = ? AND b0.job = b.job AND
            b.result_code = 0 AND
@@ -448,7 +451,7 @@ module Build = struct
       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,
-           b.main_binary, b.input_id, b.user, b.job
+           b.platform, b.main_binary, b.input_id, b.user, b.job
          FROM build b0, build_artifact a0, build b, build_artifact a
          WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256
            AND b.main_binary = a.id AND b.id <> b0.id AND b0.input_id = b.input_id
@@ -482,7 +485,7 @@ module Build = struct
       t
       {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
           result_code, result_msg, console, script,
-          main_binary, input_id, user, job
+          platform, main_binary, input_id, user, job
          FROM build
          WHERE input_id = ?
          ORDER BY start_d DESC, start_ps DESC
@@ -494,9 +497,9 @@ module Build = struct
       t
       {| INSERT INTO build
            (uuid, start_d, start_ps, finish_d, finish_ps,
-           result_code, result_msg, console, script, main_binary, input_id, user, job)
+           result_code, result_msg, console, script, platform, main_binary, input_id, user, job)
            VALUES
-           (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
+           (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
         |}
 
   let get_by_hash =
@@ -506,7 +509,7 @@ module Build = struct
       {| 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.main_binary, b.input_id, b.user, b.job
+           b.platform, b.main_binary, b.input_id, b.user, b.job
          FROM build_artifact a
          INNER JOIN build b ON b.id = a.build
          WHERE a.sha256 = ?
@@ -520,7 +523,7 @@ module Build = struct
       (Caqti_type.tup2 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.main_binary, b.input_id, b.user, b.job,
+                b.platform, b.main_binary, b.input_id, b.user, b.job,
                 a.filepath, a.localpath, a.sha256, a.size
            FROM build_artifact a
            INNER JOIN build b ON b.id = a.build
@@ -538,7 +541,7 @@ module Build = struct
       {| 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.main_binary, b.input_id, b.user, b.job
+           b.console, b.script, b.platform, b.main_binary, b.input_id, 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

db/builder_db.mli

@@ -127,6 +127,7 @@ sig
     result : Builder.execution_result;
     console : Fpath.t;
     script : Fpath.t;
+    platform : string;
     main_binary : [`build_artifact] id option;
     input_id : Cstruct.t option;
     user_id : [`user] id;

lib/model.ml

@@ -366,11 +366,12 @@ let add_build
     Db.exec Tag.try_add readme_tag >>= fun () ->
     Db.find Tag.get_id_by_name readme_tag >>= fun readme_id ->
     let input_id = compute_input_id artifacts in
+    let platform = job.Builder.platform in
     Db.exec Build.add { Build.uuid; start; finish; result;
-                        console; script;
+                        console; script; platform;
                         main_binary = None; input_id; user_id; job_id } >>= fun () ->
     Db.find last_insert_rowid () >>= fun id ->
-    let sec_syn = infer_section_and_synopsis job.Builder.platform job_name raw_artifacts in
+    let sec_syn = infer_section_and_synopsis platform job_name raw_artifacts in
     let add_or_update tag_id tag_value =
       Db.find_opt Job_tag.get_value (tag_id, job_id) >>= function
       | None -> Db.exec Job_tag.add (tag_id, tag_value, job_id)

test/builder_db.ml

@@ -148,6 +148,7 @@ let main_binary =
   let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
   let size = String.length data in
   { Builder_db.Rep.filepath; localpath; sha256; size }
+let platform = "exotic-os"
 
 let fail_if_none a =
   Option.to_result ~none:(`Msg "Failed to retrieve") a
@@ -158,7 +159,7 @@ let add_test_build user_id (module Db : CONN) =
     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;
+    Db.exec Build.add { Build.uuid; start; finish; result; console; script; platform;
                         main_binary = None; input_id = None; user_id; job_id } >>= fun () ->
     Db.find last_insert_rowid () >>= fun id ->
     Db.exec Build_artifact.add (main_binary, id) >>= fun () ->
@@ -225,7 +226,7 @@ let add_second_build (module Db : CONN) =
   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;
+  Db.exec Build.add { Build.uuid; start; finish; result; console; script; platform;
                      main_binary = None; input_id = None; user_id; job_id; } >>= fun () ->
   Db.find last_insert_rowid () >>= fun id ->
   Db.exec Build_artifact.add (main_binary, id) >>= fun () ->