From 125b163b3104bf737ed480c47e01d242187cbd44 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= <reynir@reynir.dk>
Date: Thu, 16 Jan 2025 12:04:55 +0100
Subject: [PATCH] Add more json to endpoints, populate-local.sh

Some basic json is added to the endpoints that list jobs and builds.

With this a script populate-local.sh can be used to fetch a number of
builds from a remote instance and upload them to a local instance. This
is useful for populating an instance with real builds for testing
purposes.

Closes #11.
---
 lib/builder_web.ml | 23 ++++++++++++++++++-----
 lib/views.ml       | 40 +++++++++++++++++++++++++++++++++++++++-
 populate-local.sh  | 30 ++++++++++++++++++++++++++++++
 3 files changed, 87 insertions(+), 6 deletions(-)
 create mode 100755 populate-local.sh

diff --git a/lib/builder_web.ml b/lib/builder_web.ml
index 0a6ec41..c8460f1 100644
--- a/lib/builder_web.ml
+++ b/lib/builder_web.ml
@@ -307,7 +307,10 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
     |> if_error "Error getting jobs"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
     >>= fun jobs ->
-    Views.Builds.make ~all jobs |> string_of_html |> Dream.html |> Lwt_result.ok
+    if is_accept_json req then
+      Views.Builds.make_json ~all jobs |> Yojson.Basic.to_string |> Dream.json |> Lwt_result.ok
+    else
+      Views.Builds.make ~all jobs |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let job req =
@@ -319,8 +322,13 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
     |> if_error "Error getting job"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
     >>= fun (readme, builds) ->
-    Views.Job.make ~failed:false ~job_name ~platform ~readme builds
-    |> string_of_html |> Dream.html |> Lwt_result.ok
+    if is_accept_json req then
+      Views.Job.make_json ~failed:false ~job_name ~platform ~readme builds
+      |> Yojson.Basic.to_string
+      |> Dream.json |> Lwt_result.ok
+    else
+      Views.Job.make ~failed:false ~job_name ~platform ~readme builds
+      |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let job_with_failed req =
@@ -332,8 +340,13 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
     |> if_error "Error getting job"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
     >>= fun (readme, builds) ->
-    Views.Job.make ~failed:true ~job_name ~platform ~readme builds
-    |> string_of_html |> Dream.html |> Lwt_result.ok
+    if is_accept_json req then
+      Views.Job.make_json ~failed:true ~job_name ~platform ~readme builds
+      |> Yojson.Basic.to_string
+      |> Dream.json |> Lwt_result.ok
+    else
+      Views.Job.make ~failed:true ~job_name ~platform ~readme builds
+      |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let redirect_latest req ~job_name ~platform ~artifact =
diff --git a/lib/views.ml b/lib/views.ml
index f680024..35c144f 100644
--- a/lib/views.ml
+++ b/lib/views.ml
@@ -374,6 +374,23 @@ have questions or suggestions.
        @ make_failed_builds
        @ make_all_or_active all)
 
+  let make_json ~all:_ section_job_map =
+    let all_jobs =
+      Utils.String_map.fold
+        (fun _section jobs acc ->
+           List.map (fun (job_name, _, _) -> `String job_name) jobs @ acc)
+        section_job_map []
+    in
+    let by_section =
+      Utils.String_map.fold
+        (fun section jobs acc ->
+           (section, `List (List.map (fun (job_name, _, _) -> `String job_name) jobs)) :: acc)
+        section_job_map []
+    in
+    `Assoc [
+      "jobs", `List all_jobs;
+      "jobs_by_section", `Assoc by_section;
+    ]
 end
 
 module Job = struct
@@ -452,7 +469,28 @@ module Job = struct
     let title = Fmt.str "Job %s %a" job_name pp_platform platform in
     layout ~nav ~title @@ make_body ~failed ~job_name ~platform ~readme builds
 
-
+  let make_json ~failed ~job_name ~platform ~readme builds =
+    (* TODO? *)
+    ignore failed; ignore job_name; ignore platform; ignore readme;
+    let build (build, main_binary) =
+      let main_binary =
+        match main_binary with
+        | None -> `Null
+        | Some { Builder_db.filepath; sha256; size } ->
+          `Assoc [
+            "filename", `String (Fpath.basename filepath);
+            "sha256", `String (Ohex.encode sha256);
+            "size", `Int size;
+          ]
+      in
+      `Assoc [
+        "uuid", `String (Uuidm.to_string build.Builder_db.Build.uuid);
+        "main_binary", main_binary
+      ]
+    in
+    `Assoc [
+      "builds", `List (List.map build builds);
+    ]
 end
 
 module Job_build = struct
diff --git a/populate-local.sh b/populate-local.sh
new file mode 100755
index 0000000..851a305
--- /dev/null
+++ b/populate-local.sh
@@ -0,0 +1,30 @@
+#!/bin/sh
+
+# Edit these values to your needs:
+remote_instance=https://builds.robur.coop
+local_user_pass=test:test
+local_instance="http://${local_user_pass}@localhost:3000"
+limit=100
+
+curl_json () {
+	curl --silent --fail --location --header "Accept: application/json" "$@"
+}
+
+curl_json "${remote_instance}/" | jq -r .jobs[] | {
+	while read -r job_name; do
+		curl_json "${remote_instance}/job/${job_name}" | jq -r .builds[].uuid | {
+			while read -r build_uuid; do
+				if [ "$limit" -eq 0 ]; then
+					break 2;
+				fi
+				dest=$(mktemp "builder-${build_uuid}.XXXXXXXXXX")
+				curl --silent --fail "${remote_instance}/job/${job_name}/build/${build_uuid}/exec" > "$dest" && {
+					echo "Uploading $job_name build $build_uuid"
+                                        curl --data-binary "@${dest}" "${local_instance}/upload"
+				}
+				rm -f "$dest"
+				limit=$((limit - 1))
+			done
+		}
+	done
+}