Work towards failed-builds page

This commit is contained in:
Robur 2021-11-17 14:02:04 +00:00
parent 675b57a579
commit c566cd0215
6 changed files with 41 additions and 0 deletions

View file

@ -315,6 +315,19 @@ module Build = struct
ORDER BY start_d DESC, start_ps DESC
|}
(* XXX: caqti doesn't like this *)
let get_all_failed =
Caqti_request.collect
Caqti_type.(option string)
(Caqti_type.tup2 (id `build) t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script, platform,
main_binary, input_id, user, job
FROM build
WHERE ?1 IS NULL OR ?1 = build.platform
ORDER BY start_d DESC, start_ps DESC
|}
let get_all_artifact_sha =
Caqti_request.collect
(id `job)

View file

@ -113,6 +113,8 @@ sig
Caqti_request.t
val get_all :
([`job] id, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_failed :
(string option, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_artifact_sha :
([`job] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_artifact_sha_by_platform :

View file

@ -230,6 +230,15 @@ let add_routes datadir =
Dream.respond ~headers data |> Lwt_result.ok
in
let failed_builds req =
let platform = Dream.query "platform" req in
Dream.sql req (Model.failed_builds platform)
|> if_error "Error getting data"
~log:(fun e -> Log.warn (fun m -> m "Error getting failed builds: %a"
pp_error e)) >>= fun builds ->
Views.failed_builds builds |> string_of_html |> Dream.html |> Lwt_result.ok
in
let upload req =
let* body = Dream.body req in
Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return
@ -369,6 +378,7 @@ let add_routes datadir =
Dream.get "/job/:job/build/:build/main-binary" (w redirect_main_binary);
Dream.get "/job/:job/build/:build/script" (w (job_build_static_file `Script));
Dream.get "/job/:job/build/:build/console" (w (job_build_static_file `Console));
Dream.get "/failed-builds/" (w failed_builds);
Dream.get "/hash" (w hash);
Dream.get "/compare/:build_left/:build_right/" (w compare_builds);
Dream.post "/upload" (Authorization.authenticate (w upload));

View file

@ -81,6 +81,9 @@ let previous_successful_build_uuid id (module Db : CONN) =
let next_successful_build_uuid id (module Db : CONN) =
Db.find_opt Builder_db.Build.get_next_successful_uuid id
let failed_builds platform (module Db : CONN) =
Db.collect_list Builder_db.Build.get_all_failed platform >|= List.map snd
let builds_with_different_input_and_same_main_binary id (module Db : CONN) =
Db.collect_list Builder_db.Build.get_different_input_same_output_input_ids id >>= fun ids ->
Lwt_list.fold_left_s (fun acc input_id ->

View file

@ -45,6 +45,9 @@ val previous_successful_build_uuid : [`build] Builder_db.id -> Caqti_lwt.connect
val next_successful_build_uuid : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val failed_builds : string option -> Caqti_lwt.connection ->
(Builder_db.Build.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val builds_with_different_input_and_same_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t

View file

@ -493,3 +493,13 @@ let compare_builds job_left job_right
h3 ~a:[a_id "pkgs-changed"] [txt "System packages changed"];
code (key_value_changes changed_pkgs);
])
let failed_builds builds =
let build build =
let _ = build in
li [txt "build info here"]
in
layout ~title:"Failed builds"
([ h1 [txt "Failed builds"];
ul (List.map build builds) ])