builds: improve comparisons (text and query) to earlier and later builds

only take into consideration the builds that have a different output

db/builder_db.ml

@@ -407,22 +407,28 @@ module Build = struct
          LIMIT 1
       |}
 
-  let get_latest_successful_uuid =
+  let get_latest_successful =
     Caqti_request.find_opt
       (id `job)
-      Rep.uuid
+      t
-      {| SELECT b.uuid
+      {| 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.platform, b.main_binary, b.input_id, b.user, b.job
          FROM build b
          WHERE b.job = ? AND b.result_code = 0
          ORDER BY b.start_d DESC, b.start_ps DESC
          LIMIT 1
       |}
 
-  let get_latest_successful_uuid_by_platform =
+  let get_latest_successful_by_platform =
     Caqti_request.find_opt
       Caqti_type.(tup2 (id `job) string)
-      Rep.uuid
+      t
-      {| SELECT b.uuid
+      {| 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.platform, b.main_binary, b.input_id, b.user, b.job
          FROM build b
          WHERE b.job = ?1 AND b.result_code = 0 AND b.platform = ?2
          ORDER BY b.start_d DESC, b.start_ps DESC
@@ -430,29 +436,39 @@ module Build = struct
       |}
 
 
-  let get_previous_successful_uuid =
+  let get_previous_successful_different_output =
     Caqti_request.find_opt
       (id `build)
-      Rep.uuid
+      t
-      {| SELECT b.uuid
+      {| SELECT
-         FROM build b, build b0
+           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.platform, b.main_binary, b.input_id, b.user, b.job
+         FROM build b, build b0, build_artifact a, build_artifact a0
          WHERE b0.id = ? AND b0.job = b.job AND
            b.platform = b0.platform AND
            b.result_code = 0 AND
+           a.id = b.main_binary AND a0.id = b0.main_binary AND
+           a.sha256 <> a0.sha256 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
       |}
 
-  let get_next_successful_uuid =
+  let get_next_successful_different_output =
     Caqti_request.find_opt
       (id `build)
-      Rep.uuid
+      t
-      {| SELECT b.uuid
+      {| SELECT
-         FROM build b, build b0
+           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.platform, b.main_binary, b.input_id, b.user, b.job
+         FROM build b, build b0, build_artifact a, build_artifact a0
          WHERE b0.id = ? AND b0.job = b.job AND
            b.platform = b0.platform AND
            b.result_code = 0 AND
+           a.id = b.main_binary AND a0.id = b0.main_binary AND
+           a.sha256 <> a0.sha256 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 ASC, b.start_ps ASC
          LIMIT 1

db/builder_db.mli

@@ -128,17 +128,17 @@ sig
     ([`job] id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t
   val get_latest_failed_by_platform :
     ([`job] id * string, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t
-  val get_latest_successful_uuid :
+  val get_latest_successful :
-    ([`job] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
+    ([`job] id, t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
-  val get_latest_successful_uuid_by_platform :
+  val get_latest_successful_by_platform :
-    ([`job] id * string, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
+    ([`job] id * string, t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
-  val get_previous_successful_uuid :
+  val get_previous_successful_different_output :
-    ([`build] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
+    ([`build] id, t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
-  val get_next_successful_uuid :
+  val get_next_successful_different_output :
-    ([`build] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
+    ([`build] id, t, [< `Many | `One | `Zero > `One `Zero ])
       Caqti_request.t
   val get_same_input_same_output_builds :
     ([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t

lib/builder_web.ml

@@ -171,14 +171,14 @@ let add_routes datadir =
      Dream.sql req (Model.builds_with_same_input_and_same_main_binary build_id) >>= fun same_input_same_output ->
      Dream.sql req (Model.builds_with_different_input_and_same_main_binary build_id) >>= fun different_input_same_output ->
      Dream.sql req (Model.builds_with_same_input_and_different_main_binary build_id) >>= fun same_input_different_output ->
-     Dream.sql req (Model.latest_successful_build_uuid build.job_id (Some build.Builder_db.Build.platform)) >>= fun latest_uuid ->
+     Dream.sql req (Model.latest_successful_build build.job_id (Some build.Builder_db.Build.platform)) >>= fun latest ->
-     Dream.sql req (Model.next_successful_build_uuid build_id) >>= fun next_uuid ->
+     Dream.sql req (Model.next_successful_build_different_output build_id) >>= fun next ->
-     Dream.sql req (Model.previous_successful_build_uuid build_id) >|= fun previous_uuid ->
+     Dream.sql req (Model.previous_successful_build_different_output build_id) >|= fun previous ->
-         (readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid, next_uuid, previous_uuid))
+         (readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous))
     |> if_error "Error getting job build"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
-    >>= fun (readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid, next_uuid, previous_uuid) ->
+    >>= fun (readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) ->
-    Views.job_build job_name readme build artifacts same_input_same_output different_input_same_output same_input_different_output latest_uuid next_uuid previous_uuid
+    Views.job_build job_name readme build artifacts same_input_same_output different_input_same_output same_input_different_output latest next previous
     |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 

lib/model.ml

@@ -68,18 +68,22 @@ let build_exists uuid (module Db : CONN) =
   Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
   Option.is_some
 
-let latest_successful_build_uuid job_id platform (module Db : CONN) =
+let latest_successful_build job_id platform (module Db : CONN) =
   match platform with
   | None ->
-    Db.find_opt Builder_db.Build.get_latest_successful_uuid job_id
+    Db.find_opt Builder_db.Build.get_latest_successful job_id
   | Some platform ->
-    Db.find_opt Builder_db.Build.get_latest_successful_uuid_by_platform (job_id, platform)
+    Db.find_opt Builder_db.Build.get_latest_successful_by_platform (job_id, platform)
 
-let previous_successful_build_uuid id (module Db : CONN) =
+let latest_successful_build_uuid job_id platform db =
-  Db.find_opt Builder_db.Build.get_previous_successful_uuid id
+  latest_successful_build job_id platform db >|= fun build ->
+  Option.map (fun build -> build.Builder_db.Build.uuid) build
 
-let next_successful_build_uuid id (module Db : CONN) =
+let previous_successful_build_different_output id (module Db : CONN) =
-  Db.find_opt Builder_db.Build.get_next_successful_uuid id
+  Db.find_opt Builder_db.Build.get_previous_successful_different_output id
+
+let next_successful_build_different_output id (module Db : CONN) =
+  Db.find_opt Builder_db.Build.get_next_successful_different_output id
 
 let failed_builds platform (module Db : CONN) =
   match platform with

lib/model.mli

@@ -39,11 +39,14 @@ val build_exists : Uuidm.t -> Caqti_lwt.connection ->
 val latest_successful_build_uuid : [`job] Builder_db.id -> string option -> Caqti_lwt.connection ->
   (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
-val previous_successful_build_uuid : [`build] Builder_db.id -> Caqti_lwt.connection ->
+val latest_successful_build : [`job] Builder_db.id -> string option -> Caqti_lwt.connection ->
-  (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
+  (Builder_db.Build.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
-val next_successful_build_uuid : [`build] Builder_db.id -> Caqti_lwt.connection ->
+val previous_successful_build_different_output : [`build] Builder_db.id -> Caqti_lwt.connection ->
-  (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
+  (Builder_db.Build.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
+
+val next_successful_build_different_output : [`build] Builder_db.id -> Caqti_lwt.connection ->
+  (Builder_db.Build.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
 val failed_builds : string option -> Caqti_lwt.connection ->
   ((string * Builder_db.Build.t) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t

lib/views.ml

@@ -257,7 +257,7 @@ let job_build
   ({ Builder_db.Build.uuid; start; finish; result; platform; _ } as build)
   artifacts
   same_input_same_output different_input_same_output same_input_different_output
-  latest_uuid next_uuid previous_uuid
+  latest next previous
   =
   let delta = Ptime.diff finish start in
   layout ~nav:(`Build (name, build)) ~title:(Fmt.str "Job %s %a" name pp_ptime start)
@@ -331,17 +331,21 @@ let job_build
               same_input_different_output)
           ]) @
        [ h3 [txt "Comparisons with other builds on the same platform"];
-       let opt_build (ctx, uu) =
+       let opt_build (ctx, build) =
-         match uu with
+         match build with
-         | Some uu when not (Uuidm.equal uuid uu) ->
+         | Some b when not (Uuidm.equal uuid b.Builder_db.Build.uuid) ->
-            [ li [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/"
+             [ li [ txt ctx;
-                      Uuidm.pp uu Uuidm.pp uuid]
+                    a ~a:[Fmt.kstr a_href "/compare/%a/%a/"
-                   [txtf "With %s build" ctx]]
+                        Uuidm.pp b.uuid Uuidm.pp uuid]
+                   [txtf "%a" pp_ptime b.start]]
             ]
           | _ -> []
         in
         ul
-          (List.concat_map opt_build [ ("latest", latest_uuid) ; ("next", next_uuid) ; ("previous", previous_uuid) ])
+          (List.concat_map opt_build
+            [ ("Latest build ", latest) ;
+              ("Later build with different output ", next) ;
+              ("Earlier build with different output ", previous) ])
     ])
 
 let key_values xs =

test/test_builder_db.ml

@@ -138,6 +138,11 @@ 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 main_binary2 =
+  let data = "#!/bin/sh\necho Hello, World 2\n" in
+  let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
+  let size = String.length data in
+  { main_binary with sha256 ; size }
 let platform = "exotic-os"
 
 let fail_if_none a =
@@ -211,7 +216,7 @@ let add_second_build (module Db : CONN) =
   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 () ->
+  Db.exec Build_artifact.add (main_binary2, id) >>= fun () ->
   Db.find last_insert_rowid () >>= fun main_binary_id ->
   Db.exec Build.set_main_binary (id, main_binary_id) >>= fun () ->
   Db.commit ()
@@ -222,28 +227,32 @@ let test_build_get_latest (module Db : CONN) =
   Db.find_opt Builder_db.Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
   Db.find_opt Builder_db.Build.get_latest (job_id, platform)
   >>| get_opt "no latest build" >>| fun (_id, meta, main_binary') ->
-  Alcotest.(check (option Testable.file)) "same main binary" main_binary' (Some main_binary);
+  Alcotest.(check (option Testable.file)) "same main binary" main_binary' (Some main_binary2);
   Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid'
 
 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_successful_uuid id
+  Db.find_opt Builder_db.Build.get_previous_successful_different_output id
-  >>| get_opt "no previous build" >>| fun uuid' ->
+  >>| get_opt "no previous build" >>| fun build ->
-  Alcotest.(check Testable.uuid) "same uuid" uuid' uuid
+  Alcotest.(check Testable.uuid) "same uuid" build.Builder_db.Build.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_successful_uuid id >>| function
+  Db.find_opt Builder_db.Build.get_previous_successful_different_output id >>| function
   | None -> ()
-  | Some uuid ->
+  | Some build ->
-    Alcotest.failf "Got unexpected result %a" Uuidm.pp uuid
+    Alcotest.failf "Got unexpected result %a" Uuidm.pp build.Builder_db.Build.uuid
 
 let test_build_get_with_jobname_by_hash (module Db : CONN) =
   add_second_build (module Db) >>= fun () ->
   Db.find_opt Builder_db.Build.get_with_jobname_by_hash main_binary.sha256
+  >>| get_opt "no build" >>= fun (job_name', build) ->
+  Alcotest.(check string) "same job" job_name' job_name;
+  Alcotest.(check Testable.uuid) "same uuid" build.uuid uuid;
+  Db.find_opt Builder_db.Build.get_with_jobname_by_hash main_binary2.sha256
   >>| get_opt "no build" >>| fun (job_name', build) ->
   Alcotest.(check string) "same job" job_name' job_name;
   Alcotest.(check Testable.uuid) "same uuid" build.uuid uuid'