Generate opam compare links only for successful builds

This commit is contained in:
Robur 2021-06-02 13:05:10 +00:00
parent fb2515e713
commit a45a584831
7 changed files with 40 additions and 25 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 ()

View file

@ -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

View file

@ -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];
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"];
];
(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 } ->

View file

@ -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