diff --git a/db/builder_db.ml b/db/builder_db.ml index ddba0c3..6beba35 100644 --- a/db/builder_db.ml +++ b/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 - {| SELECT b.uuid + 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.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 - {| SELECT b.uuid + 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.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 - {| SELECT b.uuid - FROM build b, build b0 + 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.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 - {| SELECT b.uuid - FROM build b, build b0 + 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.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 diff --git a/db/builder_db.mli b/db/builder_db.mli index b558203..d92fc47 100644 --- a/db/builder_db.mli +++ b/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 : - ([`job] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) + val get_latest_successful : + ([`job] id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t - val get_latest_successful_uuid_by_platform : - ([`job] id * string, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) + val get_latest_successful_by_platform : + ([`job] id * string, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t - val get_previous_successful_uuid : - ([`build] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) + val get_previous_successful_different_output : + ([`build] id, t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t - val get_next_successful_uuid : - ([`build] id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) + val get_next_successful_different_output : + ([`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 diff --git a/lib/builder_web.ml b/lib/builder_web.ml index ee2a467..74f7a1a 100644 --- a/lib/builder_web.ml +++ b/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.next_successful_build_uuid build_id) >>= fun next_uuid -> - Dream.sql req (Model.previous_successful_build_uuid build_id) >|= fun previous_uuid -> - (readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid, next_uuid, previous_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_different_output build_id) >>= fun next -> + 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, 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) -> - 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 + >>= 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 next previous |> string_of_html |> Dream.html |> Lwt_result.ok in diff --git a/lib/model.ml b/lib/model.ml index e0076ec..5af4aa7 100644 --- a/lib/model.ml +++ b/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) = - Db.find_opt Builder_db.Build.get_previous_successful_uuid id +let latest_successful_build_uuid job_id platform db = + 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) = - Db.find_opt Builder_db.Build.get_next_successful_uuid id +let previous_successful_build_different_output id (module Db : CONN) = + 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 diff --git a/lib/model.mli b/lib/model.mli index f4c348f..2ca5156 100644 --- a/lib/model.mli +++ b/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 -> - (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t +val latest_successful_build : [`job] Builder_db.id -> string option -> Caqti_lwt.connection -> + (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 -> - (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t +val previous_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 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 diff --git a/lib/views.ml b/lib/views.ml index efd8b3f..f5896df 100644 --- a/lib/views.ml +++ b/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) = - match uu with - | Some uu when not (Uuidm.equal uuid uu) -> - [ li [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/" - Uuidm.pp uu Uuidm.pp uuid] - [txtf "With %s build" ctx]] + let opt_build (ctx, build) = + match build with + | Some b when not (Uuidm.equal uuid b.Builder_db.Build.uuid) -> + [ li [ txt ctx; + a ~a:[Fmt.kstr a_href "/compare/%a/%a/" + 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 = diff --git a/test/test_builder_db.ml b/test/test_builder_db.ml index 64bb168..5d13f8c 100644 --- a/test/test_builder_db.ml +++ b/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 - >>| get_opt "no previous build" >>| fun uuid' -> - Alcotest.(check Testable.uuid) "same uuid" uuid' uuid + Db.find_opt Builder_db.Build.get_previous_successful_different_output id + >>| get_opt "no previous build" >>| fun build -> + 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 -> - Alcotest.failf "Got unexpected result %a" Uuidm.pp uuid + | Some build -> + 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'