From edcbf73386d4ca1f8ae9db826912dd58db8f051c Mon Sep 17 00:00:00 2001
From: Robur <team@robur.coop>
Date: Wed, 8 Sep 2021 09:10:30 +0000
Subject: [PATCH] Add /job/<job>/build/<build>/main-binary redirect endpoint

Fixes #52
---
 db/builder_db.ml   |  7 +++++++
 db/builder_db.mli  |  1 +
 lib/builder_web.ml | 20 ++++++++++++++++++++
 lib/model.ml       |  3 +++
 lib/model.mli      |  3 +++
 5 files changed, 34 insertions(+)

diff --git a/db/builder_db.ml b/db/builder_db.ml
index 2a1af9c..fd66e83 100644
--- a/db/builder_db.ml
+++ b/db/builder_db.ml
@@ -188,6 +188,13 @@ module Build_artifact = struct
       Caqti_type.unit
       "DROP TABLE IF EXISTS build_artifact"
 
+  let get =
+    Caqti_request.find
+      (id `build_artifact)
+      file
+      {| SELECT filepath, localpath, sha256, size
+         FROM build_artifact WHERE id = ? |}
+
   let get_by_build =
     Caqti_request.find
       (Caqti_type.tup2 (id `build) fpath)
diff --git a/db/builder_db.mli b/db/builder_db.mli
index 11d23eb..bb24f94 100644
--- a/db/builder_db.mli
+++ b/db/builder_db.mli
@@ -99,6 +99,7 @@ module Build_artifact : sig
   val rollback :
     (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
 
+  val get : ([`build_artifact] id, file, [< `Many | `One | `Zero > `One]) Caqti_request.t
   val get_by_build :
     ([`build] id * Fpath.t, [`build_artifact] id * file,
      [< `Many | `One | `Zero > `One ]) Caqti_request.t
diff --git a/lib/builder_web.ml b/lib/builder_web.ml
index d468ef9..a9d9b9a 100644
--- a/lib/builder_web.ml
+++ b/lib/builder_web.ml
@@ -130,6 +130,25 @@ let add_routes datadir =
     |> Lwt_result.ok
   in
 
+  let redirect_main_binary req =
+    let job_name = Dream.param "job" req
+    and build = Dream.param "build" req in
+    get_uuid build >>= fun uuid ->
+    Dream.sql req (Model.build uuid)
+    |> if_error "Error getting job build"
+     ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
+    >>= fun (_id, build) ->
+    match build.Builder_db.Build.main_binary with
+    | None -> Lwt_result.fail ("Resource not found", `Not_Found)
+    | Some main_binary ->
+      Dream.sql req (Model.build_artifact_by_id main_binary)
+      |> if_error "Error getting main binary" >>= fun main_binary ->
+      Dream.redirect req
+        (Fmt.strf "/job/%s/build/%a/f/%a" job_name Uuidm.pp uuid
+          Fpath.pp main_binary.Builder_db.filepath)
+      |> Lwt_result.ok
+  in
+
   let job_build req =
     let job_name = Dream.param "job" req
     and build = Dream.param "build" req in
@@ -302,6 +321,7 @@ let add_routes datadir =
     Dream.get "/job/:job/build/latest/**" (w redirect_latest);
     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 "/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 7a11ede..e6f8f6d 100644
--- a/lib/model.ml
+++ b/lib/model.ml
@@ -36,6 +36,9 @@ let build_artifact build filepath (module Db : CONN) =
   Db.find_opt Builder_db.Build_artifact.get_by_build_uuid (build, filepath)
   >>= not_found >|= snd
 
+let build_artifact_by_id id (module Db : CONN) =
+  Db.find Builder_db.Build_artifact.get id
+
 let build_artifact_data datadir file =
   read_file datadir file.Builder_db.localpath
 
diff --git a/lib/model.mli b/lib/model.mli
index 5c7dad7..c5d3f77 100644
--- a/lib/model.mli
+++ b/lib/model.mli
@@ -12,6 +12,9 @@ val cleanup_staging : Fpath.t -> Caqti_lwt.connection ->
 val build_artifact : Uuidm.t -> Fpath.t -> Caqti_lwt.connection ->
   (Builder_db.file, [> error ]) result Lwt.t
 
+val build_artifact_by_id : [`build_artifact] Builder_db.id -> Caqti_lwt.connection ->
+  (Builder_db.file, [> Caqti_error.call_or_retrieve ]) result Lwt.t
+
 val build_artifact_data : Fpath.t -> Builder_db.file ->
   (string, [> error ]) result Lwt.t