robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

only show active jobs, fixes #162

Browse source
This commit is contained in:
Hannes Mehnert 2023-09-18 11:07:50 +02:00 committed by Reynir Björnsson
parent fde834ad02
commit 8dedc8b95b
2 changed files with 21 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lib/builder_web.ml
View file

@ -259,7 +259,7 @@ end
let routes ~datadir ~cachedir ~configdir = let routes ~datadir ~cachedir ~configdir =
let builds req = let builds ~filter_builds_later_than req =
Dream.sql req Model.jobs_with_section_synopsis Dream.sql req Model.jobs_with_section_synopsis
|> if_error "Error getting jobs" |> if_error "Error getting jobs"
~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e)) ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
@ -272,7 +272,10 @@ let routes ~datadir ~cachedir ~configdir =
r >>= fun acc -> r >>= fun acc ->
Dream.sql req (Model.build_with_main_binary job_id platform) >>= function Dream.sql req (Model.build_with_main_binary job_id platform) >>= function
| Some (build, artifact) -> | Some (build, artifact) ->
if Ptime.is_later ~than:filter_builds_later_than build.finish then
Lwt_result.return ((platform, build, artifact) :: acc) Lwt_result.return ((platform, build, artifact) :: acc)
else
Lwt_result.return acc
| None -> | None ->
Log.warn (fun m -> m "Job without builds: %s" job_name); Log.warn (fun m -> m "Job without builds: %s" job_name);
Lwt_result.return acc) Lwt_result.return acc)
@ -604,8 +607,17 @@ let routes ~datadir ~cachedir ~configdir =
let w f req = or_error_response (f req) in let w f req = or_error_response (f req) in
let thirty_days_ago =
let thirty = Ptime.Span.v (30, 0L) in
let now = Ptime_clock.now () in
Ptime.Span.sub (Ptime.to_span now) thirty |> Ptime.of_span |>
Option.fold
~none:Ptime.epoch
~some:Fun.id
in
[ [
`Get, "/", (w builds); `Get, "/", (w (builds ~filter_builds_later_than:thirty_days_ago));
`Get, "/job/:job", (w job); `Get, "/job/:job", (w job);
`Get, "/job/:job/failed", (w job_with_failed); `Get, "/job/:job/failed", (w job_with_failed);
`Get, "/job/:job/build/latest/**", (w redirect_latest); `Get, "/job/:job/build/latest/**", (w redirect_latest);
@ -619,6 +631,7 @@ let routes ~datadir ~cachedir ~configdir =
`Get, "/job/:job/build/:build/console", (w (job_build_static_file `Console)); `Get, "/job/:job/build/:build/console", (w (job_build_static_file `Console));
`Get, "/job/:job/build/:build/all.tar.gz", (w job_build_targz); `Get, "/job/:job/build/:build/all.tar.gz", (w job_build_targz);
`Get, "/failed-builds", (w failed_builds); `Get, "/failed-builds", (w failed_builds);
`Get, "/all-builds", (w (builds ~filter_builds_later_than:Ptime.epoch));
`Get, "/hash", (w hash); `Get, "/hash", (w hash);
`Get, "/compare/:build_left/:build_right", (w compare_builds); `Get, "/compare/:build_left/:build_right", (w compare_builds);
`Post, "/upload", (Authorization.authenticate (w upload)); `Post, "/upload", (Authorization.authenticate (w upload));

6
lib/views.ml
View file

@ -361,7 +361,11 @@ have questions or suggestions.
H.txt "View the latest failed builds "; H.txt "View the latest failed builds ";
H.a ~a:H.[a_href "/failed-builds"] H.a ~a:H.[a_href "/failed-builds"]
[H.txt "here"]; [H.txt "here"];
H.txt "." H.txt ".";
H.txt "View all jobs ";
H.a ~a:H.[a_href "/all-builds"]
[H.txt "here"];
H.txt ".";
]] ]]
let make section_job_map = let make section_job_map =