[NM-8] Add new endpoint for returning the path to download result

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: hintr
 Title: R API for calling naomi district level HIV model
-Version: 1.2.0
+Version: 1.2.1
 Authors@R: 
     person(given = "Robert",
            family = "Ashton",

NEWS.md

@@ -1,3 +1,8 @@
+# hintr 1.2.1
+
+* Add new endpoint `/download/result/path/<id>` to return path to the download file on disk
+
+
 # hintr 1.2.0
 
 * Update plot metadata format to make it more generic and generally usable

R/api.R

@@ -24,6 +24,7 @@ api_build <- function(queue, validate = FALSE, logger = NULL) {
   api$handle(endpoint_download_submit(queue))
   api$handle(endpoint_download_status(queue))
   api$handle(endpoint_download_result(queue))
+  api$handle(endpoint_download_result_path(queue))
   api$handle(endpoint_download_result_head(queue))
   api$handle(endpoint_adr_metadata(queue))
   api$handle(endpoint_rehydrate_submit(queue))
@@ -413,6 +414,15 @@ endpoint_download_result_head <- function(queue) {
                                     validate = FALSE)
 }
 
+endpoint_download_result_path <- function(queue) {
+  response <- porcelain::porcelain_returning_json(
+    "DownloadResultResponse.schema", schema_root())
+  porcelain::porcelain_endpoint$new("GET",
+                                    "/download/result/path/<id>",
+                                    download_result_path(queue),
+                                    returning = response)
+}
+
 endpoint_adr_metadata <- function(queue) {
   response <- porcelain::porcelain_returning_json(
     "AdrMetadataResponse.schema", schema_root())

R/endpoints.R

@@ -664,7 +664,8 @@ calibrate_result_path <- function(queue) {
   function(id) {
     verify_result_available(queue, id)
     result <- queue$result(id)
-    relative_path <- fs::path_rel(result$plot_data_path, start = queue$results_dir)
+    relative_path <- fs::path_rel(result$plot_data_path,
+                                  start = queue$results_dir)
     list(
       path = scalar(relative_path)
     )
@@ -800,26 +801,34 @@ get_download_result <- function(queue, id, error_message) {
   res
 }
 
+download_file_label <- function(type) {
+  switch(type,
+         spectrum = "naomi-output",
+         coarse_output = "coarse-output",
+         summary = "summary-report",
+         comparison = "comparison-report",
+         agyw = "AGYW")
+}
+
+download_file_extension <- function(type) {
+  switch(type,
+         spectrum = ".zip",
+         coarse_output = ".zip",
+         summary = ".html",
+         comparison = ".html",
+         agyw = ".xlsx")
+}
+
 download_result <- function(queue) {
   function(id) {
     tryCatch({
       res <- get_download_result(queue, id, "FAILED_DOWNLOAD")
-      filename <- switch(res$metadata$type,
-                         spectrum = "naomi-output",
-                         coarse_output = "coarse-output",
-                         summary = "summary-report",
-                         comparison = "comparison-report",
-                         agyw = "AGYW")
-      ext <- switch(res$metadata$type,
-                    spectrum = ".zip",
-                    coarse_output = ".zip",
-                    summary = ".html",
-                    comparison = ".html",
-                    agyw = ".xlsx")
+      file_label <- download_file_label(res$metadata$type)
+      ext <- download_file_extension(res$metadata$type)
       bytes <- readBin(res$path, "raw", n = file.size(res$path))
       bytes <- porcelain::porcelain_add_headers(bytes, list(
         "Content-Disposition" = build_content_disp_header(res$metadata$areas,
-                                                          filename, ext),
+                                                          file_label, ext),
         "Content-Length" = length(bytes)))
       bytes
     },
@@ -833,6 +842,27 @@ download_result <- function(queue) {
   }
 }
 
+download_result_path <- function(queue) {
+  function(id) {
+    tryCatch({
+      res <- get_download_result(queue, id, "FAILED_DOWNLOAD")
+      relative_path <- fs::path_rel(res$path, start = queue$results_dir)
+      res$path <- relative_path
+      res$metadata$id <- id
+      res$metadata$file_label <- download_file_label(res$metadata$type)
+      res$metadata$file_extension <- download_file_extension(res$metadata$type)
+      recursive_scalar(res)
+    },
+    error = function(e) {
+      if (is_porcelain_error(e)) {
+        stop(e)
+      } else {
+        hintr_error(api_error_msg(e), "FAILED_TO_RETRIEVE_RESULT")
+      }
+    })
+  }
+}
+
 build_content_disp_header <- function(areas, filename, ext) {
   sprintf('attachment; filename="%s"',
           paste0(paste(c(areas, filename, iso_time_str()), collapse = "_"),

inst/schema/DownloadResultResponse.schema.json

@@ -0,0 +1,20 @@
+{
+  "$schema": "http://json-schema.org/draft-04/schema#",
+  "type": "object",
+  "properties": {
+    "path": { "type": "string" },
+    "metadata": {
+      "type": "object",
+      "properties": {
+        "id": { "type": "string" },
+        "description": { "type": "string" },
+        "areas": { "type": "string" },
+        "type": { "type": "string" },
+        "file_extension": { "type": "string" },
+        "file_label": { "type": "string" }
+      },
+      "required": [ "id", "description", "areas", "type", "file_extension", "file_label" ]
+    }
+  },
+  "required": [ "path", "metadata" ]
+}

tests/testthat/integration-server.R

@@ -1,6 +1,10 @@
+results_dir <- tempfile("results")
+dir.create(results_dir)
+
 withr::with_dir(testthat::test_path(), {
   server <- porcelain::porcelain_background$new(
-    api, args = list(queue_id = paste0("hintr:", ids::random_id())))
+    api, args = list(queue_id = paste0("hintr:", ids::random_id()),
+                     results_dir = results_dir))
   server$start()
 })
 
@@ -608,11 +612,20 @@ test_that("download streams bytes", {
 
   ## Can get ADR metadata
   adr_res <- server$request("GET", paste0("/meta/adr/", response$data$id))
-  expect_equal(httr::status_code(r), 200)
+  expect_equal(httr::status_code(adr_res), 200)
   adr_r <- response_from_json(adr_res)
   expect_equal(names(adr_r$data), c("type", "description"))
   expect_equal(adr_r$data$type, "spectrum")
   expect_type(adr_r$data$description, "character")
+
+  ## Can get path to output file
+  path_res <- server$request("GET",
+                             paste0("/download/result/path/", response$data$id))
+  expect_equal(httr::status_code(path_res), 200)
+  path_r <- response_from_json(path_res)
+  expect_true(file.exists(file.path(results_dir, path_r$data$path)))
+  expect_equal(path_r$data$metadata$file_label, "naomi-output")
+  expect_equal(path_r$data$metadata$file_extension, ".zip")
 })
 
 test_that("can quit", {

tests/testthat/test-01-endpoints-download.R

@@ -40,6 +40,20 @@ test_that("spectrum download returns bytes", {
                'attachment; filename="MWI_naomi-output_\\d+-\\d+.zip"')
   expect_equal(head_response$headers$`Content-Length`, size)
   expect_null(head_response$body, NULL)
+
+  ## Get download result path
+  path_data <- endpoint_download_result_path(q$queue)
+  path_response <- path_data$run(status_response$data$id)
+  expect_equal(path_response$status_code, 200)
+  path <- path_response$data
+  expect_true(file.exists(file.path(q$queue$results_dir, path$path)))
+  expect_equal(path$metadata$type, scalar("spectrum"))
+  expect_equal(path$metadata$areas, scalar("MWI"))
+  expect_match(path$metadata$description,
+               "Naomi output uploaded from Naomi web app")
+  expect_equal(path$metadata$id, scalar(status_response$data$id))
+  expect_equal(path$metadata$file_label, scalar("naomi-output"))
+  expect_equal(path$metadata$file_extension, scalar(".zip"))
 })
 
 test_that("api can call spectrum download", {
@@ -327,6 +341,14 @@ test_that("trying to download result for errored model run returns error", {
   expect_equal(names(error$data[[1]]), c("error", "detail", "key"))
   expect_equal(error$data[[1]]$error, scalar("OUTPUT_GENERATION_FAILED"))
   expect_equal(error$data[[1]]$detail, scalar("test error"))
+
+  ## Getting path to output file returns error
+  result_path <- download_result_path(queue)
+  path_error <- expect_error(result_path(response$id))
+  expect_equal(path_error$status_code, 400)
+  expect_equal(names(path_error$data[[1]]), c("error", "detail", "key"))
+  expect_equal(path_error$data[[1]]$error, scalar("OUTPUT_GENERATION_FAILED"))
+  expect_equal(path_error$data[[1]]$detail, scalar("test error"))
 })
 
 test_that("download result returns formatted error if unexpected issue", {
@@ -340,6 +362,17 @@ test_that("download result returns formatted error if unexpected issue", {
   expect_equal(error$data[[1]]$detail, scalar("Missing result for task: '1'"))
 })
 
+test_that("download result path returns formatted error if unexpected issue", {
+  queue <- MockQueue$new(workers = 0)
+  download <- download_result_path(queue)
+  error <- expect_error(download("1"))
+
+  expect_equal(error$status_code, 400)
+  expect_equal(names(error$data[[1]]), c("error", "detail", "key"))
+  expect_equal(error$data[[1]]$error, scalar("FAILED_TO_RETRIEVE_RESULT"))
+  expect_equal(error$data[[1]]$detail, scalar("Missing result for task: '1'"))
+})
+
 test_that("download submit returns error if queueing fails", {
   test_redis_available()
   ## Create mocks