From 8dedc8b95bcb03322b4faa005a622cbdd9dc82ce Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Mon, 18 Sep 2023 11:07:50 +0200
Subject: [PATCH] only show active jobs, fixes #162

---
 lib/builder_web.ml | 19 ++++++++++++++++---
 lib/views.ml       |  6 +++++-
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/lib/builder_web.ml b/lib/builder_web.ml
index 54a3cf0..43f6a06 100644
--- a/lib/builder_web.ml
+++ b/lib/builder_web.ml
@@ -259,7 +259,7 @@ end
 
 
 let routes ~datadir ~cachedir ~configdir =
-  let builds req =
+  let builds ~filter_builds_later_than req =
     Dream.sql req Model.jobs_with_section_synopsis
     |> if_error "Error getting jobs"
       ~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 ->
            Dream.sql req (Model.build_with_main_binary job_id platform) >>= function
            | Some (build, artifact) ->
-             Lwt_result.return ((platform, build, artifact) :: acc)
+             if Ptime.is_later ~than:filter_builds_later_than build.finish then
+               Lwt_result.return ((platform, build, artifact) :: acc)
+             else
+               Lwt_result.return acc
            | None ->
              Log.warn (fun m -> m "Job without builds: %s" job_name);
              Lwt_result.return acc)
@@ -604,8 +607,17 @@ let routes ~datadir ~cachedir ~configdir =
 
   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/failed", (w job_with_failed);
     `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/all.tar.gz", (w job_build_targz);
     `Get, "/failed-builds", (w failed_builds);
+    `Get, "/all-builds", (w (builds ~filter_builds_later_than:Ptime.epoch));
     `Get, "/hash", (w hash);
     `Get, "/compare/:build_left/:build_right", (w compare_builds);
     `Post, "/upload", (Authorization.authenticate (w upload));
diff --git a/lib/views.ml b/lib/views.ml
index a800402..63e4b44 100644
--- a/lib/views.ml
+++ b/lib/views.ml
@@ -361,7 +361,11 @@ have questions or suggestions.
           H.txt "View the latest failed builds ";
           H.a ~a:H.[a_href "/failed-builds"]
             [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 =