From f24a9297d04f1ec562165a9ee05e681bf8e90c4a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= <reynir@reynir.dk>
Date: Thu, 9 Sep 2021 18:06:08 +0200
Subject: [PATCH] Re-add viewing build script and build console

Instead of displaying the script and console output in the build page
the build page links to new endpoints for viewing the script and the
console output.
---
 lib/builder_web.ml | 19 +++++++++++++++++++
 lib/model.ml       |  8 ++++++++
 lib/model.mli      |  6 ++++++
 lib/views.ml       |  9 +++++++++
 4 files changed, 42 insertions(+)

diff --git a/lib/builder_web.ml b/lib/builder_web.ml
index a9d9b9a..142917a 100644
--- a/lib/builder_web.ml
+++ b/lib/builder_web.ml
@@ -199,6 +199,23 @@ let add_routes datadir =
       Dream.respond ~headers data |> Lwt_result.ok
   in
 
+  let job_build_static_file (file : [< `Console | `Script ]) req =
+    let datadir = Dream.global datadir_global req in
+    let _job_name = Dream.param "job" req
+    and build = Dream.param "build" req in
+    get_uuid build >>= fun build ->
+    (match file with
+    | `Console ->
+      Dream.sql req (Model.build_console_by_uuid datadir build)
+    | `Script ->
+      Dream.sql req (Model.build_script_by_uuid datadir build))
+    |> if_error "Error getting data"
+      ~log:(fun e -> Log.warn (fun m -> m "Error getting script or console data for build %a: %a"
+                                  Uuidm.pp build pp_error e)) >>= fun data ->
+    let headers = [ "Content-Type", "text/plain" ] in
+    Dream.respond ~headers data |> Lwt_result.ok
+  in
+
   let upload req =
     let* body = Dream.body req in
     Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return
@@ -322,6 +339,8 @@ let add_routes datadir =
     Dream.get "/job/:job/build/:build/" (w job_build);
     Dream.get "/job/:job/build/:build/f/**" (w job_build_file);
     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 "/hash" (w hash);
     Dream.get "/compare/:build_left/:build_right/opam-switch" (w compare_opam);
     Dream.post "/upload" (Authorization.authenticate (w upload));
diff --git a/lib/model.ml b/lib/model.ml
index e6f8f6d..0adb421 100644
--- a/lib/model.ml
+++ b/lib/model.ml
@@ -96,6 +96,14 @@ let builds_with_same_input_and_different_main_binary id (module Db : CONN) =
        Lwt.return (Ok (build :: metas)))
    (Ok []) hashes
 
+let build_console_by_uuid datadir uuid (module Db : CONN) =
+  build uuid (module Db) >>= fun (_id, { Builder_db.Build.console; _ })->
+  read_file datadir console
+
+let build_script_by_uuid datadir uuid (module Db : CONN) =
+  build uuid (module Db) >>= fun (_id, { Builder_db.Build.script; _ })->
+  read_file datadir script
+
 let job_id job_name (module Db : CONN) =
   Db.find_opt Builder_db.Job.get_id_by_name job_name
 
diff --git a/lib/model.mli b/lib/model.mli
index c5d3f77..f3ccc83 100644
--- a/lib/model.mli
+++ b/lib/model.mli
@@ -51,6 +51,12 @@ val builds_with_same_input_and_same_main_binary : [`build] Builder_db.id -> Caqt
 val builds_with_same_input_and_different_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
   (Builder_db.Build.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
+val build_console_by_uuid : Fpath.t -> Uuidm.t -> Caqti_lwt.connection ->
+  (string, [> error ]) result Lwt.t
+
+val build_script_by_uuid : Fpath.t -> Uuidm.t -> Caqti_lwt.connection ->
+  (string, [> error ]) result Lwt.t
+
 val readme : string -> Caqti_lwt.connection ->
   (string option, [> error ]) result Lwt.t
 
diff --git a/lib/views.ml b/lib/views.ml
index e38a1d9..522d00c 100644
--- a/lib/views.ml
+++ b/lib/views.ml
@@ -221,6 +221,15 @@ let job_build
                 [txtf "%a" pp_ptime start] ;
                txt ", " ])
          xs) ] ) @ [
+      h3 [txt "Build info"];
+      ul [
+        li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp uuid]
+               [txt "Console output"];
+           ];
+        li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp uuid]
+               [txt "Build script"];
+           ]
+      ];
       h3 [txt "Comparisons with other builds"];
       p
         ((match latest_uuid with