Expose database repr, database fixup

Parts of the database representation are exposed.
A fixup command for builder-migrations is added to remove bad database
entries fixed in a57798f4c0. It is up to
the operator to remove the files and optionally re-upload the 'full'
files to builder-web.

bin/migrations/builder_migrations.ml

@@ -95,6 +95,12 @@ let r20210218 =
   Cmdliner.Term.(const do_database_action $ const M20210218.rollback $ setup_log $ dbpath),
   Cmdliner.Term.info ~doc "rollback-2021-02-18"
 
+let f20210308 =
+  let doc = "Remove broken builds as fixed in commit a57798f4c02eb4d528b90932ec26fb0b718f1a13. \
+    Note that the files on disk have to be removed manually." in
+  Cmdliner.Term.(const do_database_action $ const M20210308.fixup $ setup_log $ dbpath),
+  Cmdliner.Term.info ~doc "fixup-2021-03-08"
+
 let help_cmd =
   let topic =
     let doc = "Migration to get help on" in
@@ -117,5 +123,6 @@ let () =
       m20210202; r20210202;
       m20210216; r20210216;
       m20210218; r20210218;
+      f20210308;
     ]
   |> Cmdliner.Term.exit

bin/migrations/m20210308.ml

@@ -0,0 +1,23 @@
+module Rep = Builder_db.Rep
+
+let broken_builds =
+  Caqti_request.collect ~oneshot:true
+    Caqti_type.unit
+    (Caqti_type.tup3 Rep.id Rep.uuid Caqti_type.string)
+    {| SELECT b.id, b.uuid, job.name FROM build b, job
+       WHERE result_kind = 0 AND result_code = 0 AND main_binary IS NOT NULL AND job.id = b.job AND
+         (SELECT COUNT( * ) FROM build_artifact a
+          WHERE a.build = b.id and a.filepath = b.main_binary) = 0
+    |}
+
+let fixup (module Db : Caqti_blocking.CONNECTION) =
+  let open Rresult.R.Infix in
+  Db.rev_collect_list broken_builds () >>= fun broken_builds ->
+  List.fold_left
+    (fun r ((build, uuid, job_name) : Rep.id * Uuidm.t * string) ->
+       r >>= fun () ->
+       Format.printf "Removing job %a.\nPlease clean up data files in /var/db/builder-web/%s/%a\n"
+         Uuidm.pp uuid job_name Uuidm.pp uuid;
+       Db.exec Builder_db.Build.remove build)
+    (Ok ())
+    broken_builds

db/builder_db.ml

@@ -409,6 +409,11 @@ module Build = struct
          ORDER BY b.start_d DESC, b.start_ps DESC
          LIMIT 1
       |}
+
+  let remove =
+    Caqti_request.exec
+      id
+      "DELETE FROM build WHERE id = ?"
 end
 
 module User = struct

db/builder_db.mli

@@ -1,6 +1,24 @@
-type id
+module Rep : sig
+  type id
+  type file = {
+    filepath : Fpath.t;
+    localpath : Fpath.t;
+    sha256 : Cstruct.t;
+    size : int;
+  }
 
-type file = {
+  val id : id Caqti_type.t
+  val uuid : Uuidm.t Caqti_type.t
+  val ptime : Ptime.t Caqti_type.t
+  val fpath : Fpath.t Caqti_type.t
+  val cstruct : Cstruct.t Caqti_type.t
+  val file : file Caqti_type.t
+  val execution_result : Builder.execution_result Caqti_type.t
+  val console : (int * string) list Caqti_type.t
+end
+type id = Rep.id
+
+type file = Rep.file = {
   filepath : Fpath.t;
   localpath : Fpath.t;
   sha256 : Cstruct.t;
@@ -131,6 +149,7 @@ sig
   val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
   val get_by_hash :
     (Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t
+  val remove : (id, unit, [< `Many | `One | `Zero > `Zero]) Caqti_request.t
 end
 
 module User : sig