Merge pull request #6 from mrc-ide/mrc-5585-submit-endpoint

Mrc 5585 submit endpoint

.gitattributes

@@ -0,0 +1 @@
+R/porcelain.R linguist-generated=true

R/api.R

@@ -11,14 +11,28 @@
 ##' @param log_level Logging level to use. Sensible options are "off",
 ##'   "info" and "all".
 ##'
+##' @param skip_queue_creation Skip queue creation, this is primarily
+##'   used for tests where we can't establish a Redis connection.
+##'
 ##' @return A [porcelain::porcelain] object. Notably this does *not*
 ##'   start the server
 ##'
 ##' @export
-api <- function(root, validate = NULL, log_level = "info") {
+api <- function(
+  root, validate = NULL, log_level = "info",
+  skip_queue_creation = FALSE
+) {
   logger <- porcelain::porcelain_logger(log_level)
+
+  # Set ORDERLY_RUNNER_QUEUE_ID to specify existing queue id
+  if (skip_queue_creation) {
+    queue <- NULL
+  } else {
+    queue <- Queue$new(root)
+  }
+
   api <- porcelain::porcelain$new(validate = validate, logger = logger)
-  api$include_package_endpoints(state = list(root = root))
+  api$include_package_endpoints(state = list(root = root, queue = queue))
   api
 }
 
@@ -70,3 +84,19 @@ report_parameters <- function(root, ref, name) {
     )
   })
 }
+
+##' @porcelain
+##'   POST /report/run => json(report_run_response)
+##'   state root :: root
+##'   state queue :: queue
+##'   body data :: json(report_run_request)
+submit_report_run <- function(root, queue, data) {
+  data <- jsonlite::parse_json(data)
+  task_id <- queue$submit(
+    data$name,
+    branch = data$branch,
+    ref = data$hash,
+    parameters = data$parameters
+  )
+  list(taskId = scalar(task_id))
+}

R/queue.R

@@ -34,6 +34,15 @@ Queue <- R6::R6Class("Queue", #nolint
                                    controller = self$controller)
     },
 
+    #' @description
+    #' Submit a job the Redis queue for runner to run.
+    #'
+    #' @param reportname Name of orderly report.
+    #' @param parameters Parameters to run the report with (default NULL)
+    #' @param branch Name of git branch to checkout the repository
+    #'   (default master)
+    #' @param ref Git commit-ish value (e.g HEAD or commit hash or branch name).
+    #'   We reset hard to this ref and run the report. (default HEAD)
     submit = function(reportname, parameters = NULL,
                       branch = "master", ref = "HEAD") {
       run_args <- list(

inst/schema/report_run_request.json

@@ -0,0 +1,29 @@
+{
+    "$schema": "http://json-schema.org/draft-07/schema#",
+    "type": "object",
+    "properties": {
+        "name": {
+            "type": "string"
+        },
+        "branch": {
+            "type": "string"
+        },
+        "hash": {
+            "type": "string"
+        },
+        "parameters": {
+            "oneOf": [
+                { "type": "null" },
+                {
+                    "type": "object",
+                    "properties": {},
+                    "additionalProperties": {
+                        "type": ["boolean", "integer", "number", "string"]
+                    }
+                }
+            ]
+        }
+    },
+    "required": ["name", "branch", "hash", "parameters"],
+    "additionalProperties": false
+}

inst/schema/report_run_response.json

@@ -0,0 +1,11 @@
+{
+    "$schema": "http://json-schema.org/draft-07/schema#",
+    "type": "object",
+    "properties": {
+        "taskId": {
+            "type": "string"
+        }
+    },
+    "required": ["taskId"],
+    "additionalProperties": false
+}

tests/testthat/examples/data/data.R

@@ -1,3 +1,3 @@
-orderly2::orderly_artefact("Some data", "data.rds")
+orderly2::orderly_artefact(description = "Some data", "data.rds")
 d <- data.frame(a = 1:10, x = runif(10), y = 1:10 + runif(10))
 saveRDS(d, "data.rds")

tests/testthat/examples/git-clean/git-clean.R

@@ -1,4 +1,4 @@
-orderly2::orderly_artefact("Some data", "data.rds")
+orderly2::orderly_artefact(description = "Some data", "data.rds")
 d <- data.frame(a = 1:10, x = runif(10), y = 1:10 + runif(10))
 write.table("test", file = file.path("..", "..", "inside_draft.txt"))
 write.table("test", file = file.path("..", "..", "..", "outside_draft.txt"))

tests/testthat/helper-orderly-runner.R

@@ -1,7 +1,18 @@
-orderly_runner_endpoint <- function(method, path, root, validate = TRUE) {
-  porcelain::porcelain_package_endpoint("orderly.runner", method, path,
-                                        state = list(root = root),
-                                        validate = validate)
+orderly_runner_endpoint <- function(
+  method, path, root,
+  validate = TRUE,
+  skip_queue_creation = FALSE
+) {
+  if (skip_queue_creation) {
+    queue <- NULL
+  } else {
+    queue <- Queue$new(root)
+  }
+  porcelain::porcelain_package_endpoint(
+    "orderly.runner", method, path,
+    state = list(root = root, queue = queue),
+    validate = validate
+  )
 }
 
 
@@ -46,10 +57,11 @@ test_prepare_orderly_example <- function(examples, ...) {
 
 test_prepare_orderly_remote_example <- function(examples, ...) {
   path_remote <- test_prepare_orderly_example(examples, ...)
-  helper_add_git(path_remote)
+  helper_add_git(path_remote, orderly_gitignore = TRUE)
   path_local <- tempfile()
   withr::defer_parent(unlink(path_local, recursive = TRUE))
   gert::git_clone(path_remote, path_local)
+  orderly2::orderly_init(root = path_local, force = TRUE)
   list(
     remote = path_remote,
     local = path_local
@@ -67,8 +79,11 @@ copy_examples <- function(examples, path_src) {
 }
 
 
-helper_add_git <- function(path, add = ".") {
+helper_add_git <- function(path, add = ".", orderly_gitignore = FALSE) {
   gert::git_init(path)
+  if (orderly_gitignore) {
+    orderly2::orderly_gitignore_update("(root)", root = path)
+  }
   sha <- git_add_and_commit(path, add)
   branch <- gert::git_branch(repo = path)
   url <- "https://example.com/git"
@@ -104,8 +119,10 @@ start_queue_workers_quietly <- function(n_workers,
   worker_manager
 }
 
-start_queue_with_workers <- function(root, n_workers, env = parent.frame()) {
-  q <- new_queue_quietly(root)
+start_queue_with_workers <- function(
+  root, n_workers, env = parent.frame(), queue_id = NULL
+) {
+  q <- new_queue_quietly(root, queue_id = queue_id)
   worker_manager <- start_queue_workers_quietly(n_workers, q$controller,
                                                 env = env)
   make_worker_dirs(root, worker_manager$id)

tests/testthat/test-api.R

@@ -1,6 +1,7 @@
 test_that("root data returns sensible, validated, data", {
   ## Just hello world for the package really
-  endpoint <- orderly_runner_endpoint("GET", "/", NULL)
+  endpoint <- orderly_runner_endpoint("GET", "/", NULL,
+                                      skip_queue_creation = TRUE)
   res <- endpoint$run()
   expect_true(res$validated)
   expect_true(all(c("orderly2", "orderly.runner") %in%
@@ -11,7 +12,7 @@ test_that("root data returns sensible, validated, data", {
 
 test_that("Can construct the api", {
   root <- create_temporary_root(use_file_store = TRUE)
-  obj <- api(root)
+  obj <- api(root, skip_queue_creation = TRUE)
   result <- evaluate_promise(value <- obj$request("GET", "/")$status)
   expect_equal(value, 200)
   logs <- lapply(strsplit(result$output, "\n")[[1]], jsonlite::parse_json)
@@ -22,7 +23,10 @@ test_that("Can construct the api", {
 
 test_that("can list orderly reports", {
   repo <- test_prepare_orderly_remote_example(c("data", "parameters"))
-  endpoint <- orderly_runner_endpoint("GET", "/report/list", repo$local)
+  endpoint <- orderly_runner_endpoint(
+    "GET", "/report/list",
+    repo$local, skip_queue_creation = TRUE
+  )
 
   res <- endpoint$run(gert::git_branch(repo$local))
   expect_equal(res$status_code, 200)
@@ -61,8 +65,10 @@ test_that("can list orderly reports", {
 
 test_that("can get parameters for a report", {
   repo <- test_prepare_orderly_remote_example(c("data", "parameters"))
-  endpoint <- orderly_runner_endpoint("GET", "/report/<name:string>/parameters", 
-                                      repo$local)
+  endpoint <- orderly_runner_endpoint(
+    "GET", "/report/<name:string>/parameters",
+    repo$local, skip_queue_creation = TRUE
+  )
 
   res <- endpoint$run("HEAD", "data")
   expect_equal(res$status_code, 200)
@@ -73,6 +79,54 @@ test_that("can get parameters for a report", {
   expect_equal(res$data, list(
     list(name = scalar("a"), value = NULL),
     list(name = scalar("b"), value = scalar("2")),
-    list(name = scalar("c"), value = NULL))
+    list(name = scalar("c"), value = NULL)
+  ))
+})
+
+test_that("can run orderly reports", {
+  skip_if_no_redis()
+
+  queue_id <- "orderly.runner:cute-animal"
+  repo <- test_prepare_orderly_example(c("data", "parameters"))
+  gert::git_init(repo)
+  orderly2::orderly_gitignore_update("(root)", root = repo)
+  git_add_and_commit(repo)
+  queue <- Queue$new(repo, queue_id = queue_id)
+  worker_manager <- start_queue_workers_quietly(
+    1, queue$controller
+  )
+  make_worker_dirs(repo, worker_manager$id)
+
+  endpoint <- withr::with_envvar(
+    c(ORDERLY_RUNNER_QUEUE_ID = queue_id),
+    orderly_runner_endpoint("POST", "/report/run", repo)
+  )
+
+  req <- list(
+    name = scalar("data"),
+    branch = scalar(gert::git_branch(repo = repo)),
+    hash = scalar(gert::git_commit_id(repo = repo)),
+    parameters = scalar(NULL)
+  )
+
+  res <- endpoint$run(jsonlite::toJSON(req))
+  rrq::rrq_task_wait(res$data$taskId, controller = queue$controller)
+  expect_equal(
+    rrq::rrq_task_status(res$data$taskId, controller = queue$controller),
+    "COMPLETE"
+  )
+
+  req <- list(
+    name = scalar("parameters"),
+    branch = scalar(gert::git_branch(repo = repo)),
+    hash = scalar(gert::git_commit_id(repo = repo)),
+    parameters = list(a = scalar(1), c = scalar(3))
+  )
+
+  res <- endpoint$run(jsonlite::toJSON(req))
+  rrq::rrq_task_wait(res$data$taskId, controller = queue$controller)
+  expect_equal(
+    rrq::rrq_task_status(res$data$taskId, controller = queue$controller),
+    "COMPLETE"
   )
 })