Generate opam compare links only for successful builds

db/builder_db.ml

@@ -395,7 +395,7 @@ module Build = struct
       |}
 
   let get_latest_successful_uuid =
-    Caqti_request.find
+    Caqti_request.find_opt
       id
       Rep.uuid
       {| SELECT b.uuid
@@ -405,7 +405,7 @@ module Build = struct
          LIMIT 1
       |}
 
-  let get_previous =
+  let get_previous_successful =
     Caqti_request.find_opt
       id
       Caqti_type.(tup2 id Meta.t)
@@ -415,6 +415,7 @@ module Build = struct
            b.main_binary, b.job
          FROM build b, build b0
          WHERE b0.id = ? AND b0.job = b.job AND
+           b.result_kind = 0 AND b.result_code = 0 AND
            (b0.start_d > b.start_d OR b0.start_d = b.start_d AND b0.start_ps > b.start_ps)
          ORDER BY b.start_d DESC, b.start_ps DESC
          LIMIT 1

db/builder_db.mli

@@ -150,9 +150,9 @@ sig
     (id, id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
   val get_latest_successful_uuid :
-    (id, Uuidm.t, [< `Many | `One | `Zero > `One ])
+    (id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
-  val get_previous :
+  val get_previous_successful :
     (id, id * Meta.t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
   val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t

lib/builder_web.ml

@@ -142,7 +142,11 @@ let add_routes datadir =
   let redirect_latest req =
     let job_name = Dream.param "job" req in
     let path = Dream.path req |> String.concat "/" in
-    let* build = Dream.sql req (Model.latest_successful_build_uuid job_name) in
+    let* build =
+      Dream.sql req (Model.job_id job_name) >>= fun job_id ->
+      Dream.sql req (Model.latest_successful_build_uuid job_id)
+      >>= Model.not_found
+    in
     match build with
     | Error e ->
       Log.warn (fun m -> m "Error getting job: %a" pp_error e);
@@ -162,8 +166,8 @@ let add_routes datadir =
       let* data =
         Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
         Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts ->
-        Dream.sql req (Model.latest_build_uuid build.job_id) >>= fun latest_uuid ->
-        Dream.sql req (Model.build_previous build_id) >|= fun previous_build ->
+        Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid ->
+        Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build ->
         (build, artifacts, latest_uuid, previous_build)
       in
       match data with

lib/model.ml

@@ -64,12 +64,11 @@ let latest_build_uuid job_id (module Db : CONN) =
   (* We know there's at least one job when this is called, probably. *)
   not_found >|= snd
 
-let latest_successful_build_uuid job_name (module Db : CONN) =
-  Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
-  Db.find Builder_db.Build.get_latest_successful_uuid job_id
+let latest_successful_build_uuid job_id (module Db : CONN) =
+  Db.find_opt Builder_db.Build.get_latest_successful_uuid job_id
 
-let build_previous id (module Db : CONN) =
-  Db.find_opt Builder_db.Build.get_previous id >|=
+let previous_successful_build id (module Db : CONN) =
+  Db.find_opt Builder_db.Build.get_previous_successful id >|=
   Option.map (fun (_id, meta) -> meta)
 
 let main_binary id main_binary (module Db : CONN) =
@@ -83,6 +82,9 @@ let job job (module Db : CONN) =
   Db.collect_list Builder_db.Build.get_all_meta_by_name job >|=
   List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
 
+let job_id job_name (module Db : CONN) =
+  Db.find Builder_db.Job.get_id_by_name job_name
+
 let jobs (module Db : CONN) =
   Db.collect_list Builder_db.Job.get_all ()
 

lib/model.mli

@@ -2,6 +2,8 @@ type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath.
 
 val pp_error : Format.formatter -> error -> unit
 
+val not_found : 'a option -> ('a, [> error ]) result Lwt.t
+
 val staging : Fpath.t -> Fpath.t
 
 val cleanup_staging : Fpath.t -> Caqti_lwt.connection ->
@@ -28,10 +30,10 @@ val build_exists : Uuidm.t -> Caqti_lwt.connection ->
 val latest_build_uuid : Builder_db.id -> Caqti_lwt.connection ->
   (Uuidm.t, [> error ]) result Lwt.t
 
-val latest_successful_build_uuid : string -> Caqti_lwt.connection ->
-  (Uuidm.t, [> Caqti_error.call_or_retrieve ]) result Lwt.t
+val latest_successful_build_uuid : Builder_db.id -> Caqti_lwt.connection ->
+  (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
-val build_previous : Builder_db.id -> Caqti_lwt.connection ->
+val previous_successful_build : Builder_db.id -> Caqti_lwt.connection ->
   (Builder_db.Build.Meta.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
 val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
@@ -40,6 +42,9 @@ val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
 val job : string -> Caqti_lwt.connection ->
   ((Builder_db.Build.Meta.t * Builder_db.file option) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
+val job_id : string -> Caqti_lwt.connection ->
+  (Builder_db.id, [> Caqti_error.call_or_retrieve ]) result Lwt.t
+
 val jobs : Caqti_lwt.connection ->
   ((Builder_db.id * string) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 

lib/views.ml

@@ -174,24 +174,27 @@ let job_build
   previous_build
   =
   let delta = Ptime.diff finish start in
+  let successful_build = match result with Builder.Exited 0 -> true | _ -> false in
   layout ~title:(Fmt.strf "Job build %s %a" name pp_ptime start)
     [ h1 [txtf "Job build %s %a" name pp_ptime start];
       p [txtf "Build took %a." Ptime.Span.pp delta ];
       p [txtf "Execution result: %a." Builder.pp_execution_result result];
+      (match latest_uuid with
+       | Some latest_uuid when successful_build && not (Uuidm.equal latest_uuid uuid) ->
          p [
            a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
                    Uuidm.pp uuid Uuidm.pp latest_uuid]
              [txt "Compare opam-switch with latest build"];
-      ];
+         ]
+       | _ -> txt "");
       (match previous_build with
-       | Some previous_build ->
+       | Some previous_build when successful_build ->
          p [
            a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
                    Uuidm.pp uuid Uuidm.pp previous_build.Builder_db.Build.Meta.uuid]
              [txt "Compare opam-switch with previous build"];
          ]
-       | None ->
-         txt "");
+       | _ -> txt "");
       h3 [txt "Digests of build artifacts"];
       dl (List.concat_map
             (fun { Builder_db.filepath; localpath=_; sha256; size } ->

test/builder_db.ml

@@ -249,14 +249,14 @@ let test_build_get_previous (module Db : CONN) =
   add_second_build (module Db) >>= fun () ->
   Db.find_opt Builder_db.Build.get_by_uuid uuid'
   >>| get_opt "no build" >>= fun (id, _build) ->
-  Db.find_opt Builder_db.Build.get_previous id
+  Db.find_opt Builder_db.Build.get_previous_successful id
   >>| get_opt "no previous build" >>| fun (_id, meta) ->
   Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid
 
 let test_build_get_previous_none (module Db : CONN) =
   Db.find_opt Builder_db.Build.get_by_uuid uuid
   >>| get_opt "no build" >>= fun (id, _build) ->
-  Db.find_opt Builder_db.Build.get_previous id >>| function
+  Db.find_opt Builder_db.Build.get_previous_successful id >>| function
   | None -> ()
   | Some (_id, meta) ->
     Alcotest.failf "Got unexpected result %a" Uuidm.pp meta.uuid