From 25a6fd07f7a6c110f50994440544c330778aaced Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Thu, 9 Jan 2025 17:21:21 +0000 Subject: [PATCH 1/3] Add an API to fetch repositories and list their branches. This API is a replacement for the one currently provided by outpack_server. A single instance of orderly.runner API is able to operate over an arbitrary number of Git repositories. The first time a URL is fetched, a `git clone` is performed. Subsequent fetches are incremental using `git fetch`. Repositories are each stored in their own directory, named using the hash of the URL. Using the hash makes it easy to support arbitrary upstreams, without having to worry about encoding the URL characters as file names. The existing endpoints still operate on the "root" repository, which is assumed to exist before the API is launched. Eventually all those APIs will be migrated to have a `url` argument. --- DESCRIPTION | 3 +- R/api.R | 45 ++++++++- R/git.R | 59 +++++++++++- R/main.R | 5 +- R/porcelain.R | 20 ++++ R/util.R | 9 ++ docker/test/run-test | 3 +- inst/schema/repository_branches.json | 39 ++++++++ inst/schema/repository_fetch_request.json | 8 ++ inst/schema/repository_fetch_response.json | 4 + man/api.Rd | 10 +- man/git_sync.Rd | 19 ++++ man/repository_path.Rd | 23 +++++ tests/testthat/helper-orderly-runner.R | 65 +++++-------- tests/testthat/test-api.R | 106 +++++++++++++++++++-- tests/testthat/test-git.R | 34 ++++++- tests/testthat/test-main.R | 29 +++--- tests/testthat/test-queue.R | 29 +++--- tests/testthat/test-reports.R | 5 +- tests/testthat/test-runner.R | 12 +-- tests/testthat/test-util.R | 6 ++ tests/testthat/test-zzz-e2e.R | 3 +- 22 files changed, 436 insertions(+), 100 deletions(-) create mode 100644 inst/schema/repository_branches.json create mode 100644 inst/schema/repository_fetch_request.json create mode 100644 inst/schema/repository_fetch_response.json create mode 100644 man/git_sync.Rd create mode 100644 man/repository_path.Rd diff --git a/DESCRIPTION b/DESCRIPTION index dabc519..1ece516 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,7 +8,7 @@ Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), Description: Small HTTP server for running orderly reports. License: MIT + file LICENSE Encoding: UTF-8 -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Roxygen: list(markdown = TRUE, roclets = c("rd", "namespace", "porcelain::porcelain_roclet")) URL: https://github.com/mrc-ide/orderly.runner BugReports: https://github.com/mrc-ide/orderly.runner/issues @@ -21,6 +21,7 @@ Imports: ids, jsonlite, orderly2 (>= 1.99.13), + openssl, porcelain, R6, redux, diff --git a/R/api.R b/R/api.R index 9082a81..914c141 100644 --- a/R/api.R +++ b/R/api.R @@ -4,6 +4,8 @@ ##' ##' @param root Orderly root ##' +##' @param repositories Path in which Git repositories are cloned +##' ##' @param validate Logical, indicating if validation should be done ##' on responses. This should be `FALSE` in production ##' environments. See [porcelain::porcelain] for details @@ -19,7 +21,8 @@ ##' ##' @export api <- function( - root, validate = NULL, log_level = "info", + root, repositories, + validate = NULL, log_level = "info", skip_queue_creation = FALSE) { logger <- porcelain::porcelain_logger(log_level) @@ -31,7 +34,10 @@ api <- function( } api <- porcelain::porcelain$new(validate = validate, logger = logger) - api$include_package_endpoints(state = list(root = root, queue = queue)) + api$include_package_endpoints(state = list( + root = root, + repositories = repositories, + queue = queue)) api } @@ -46,6 +52,41 @@ root <- function() { } +##' @porcelain POST /repository/fetch => json(repository_fetch_response) +##' state repositories :: repositories +##' body data :: json(repository_fetch_request) +repository_fetch <- function(repositories, data) { + data <- jsonlite::parse_json(data) + r <- git_sync(repositories, data$url) + + empty_object() +} + + +##' @porcelain GET /repository/branches => json(repository_branches) +##' state repositories :: repositories +##' query url :: string +repository_branches <- function(repositories, url) { + repo <- repository_path(repositories, url) + branches <- git_remote_list_branches(repo) + message <- vcapply(branches$commit, function(commit) { + gert::git_commit_info(repo = repo, ref = commit)$message + }) + + branches$message <- message + list( + default_branch = scalar(git_remote_default_branch_name(repo)), + branches = data.frame( + name = branches$name, + commit_hash = branches$commit, + time = as.numeric(branches$updated), + message = message, + row.names = NULL + ) + ) +} + + ##' @porcelain ##' GET /report/list => json(report_list) ##' query ref :: string diff --git a/R/git.R b/R/git.R index 41a2b8f..750e656 100644 --- a/R/git.R +++ b/R/git.R @@ -1,3 +1,48 @@ +#' Get the storage path for a repository. +#' +#' Repositories are all stored as subdirectories of a common base path, +#' using a hash of their URL as the directory name. +#' +#' @param base the base directory in which all repositories are stored. +#' @param url the URL of the remote repository. +#' @param check if TRUE and the repository does not exist locally yet, an error +#' is raised. +#' @return the path to the repository. +repository_path <- function(base, url, check = TRUE) { + hash <- openssl::sha1(url) + path <- file.path(base, hash) + if (check && !fs::dir_exists(path)) { + porcelain::porcelain_stop( + message = "Repository does not exist", + code = "NOT_FOUND", + status_code = 404) + } + path +} + + +#' Clone or fetch a remote repository. +#' +#' @param base the base directory in which all repositories are stored. +#' @param url the URL of the remote repository. +#' @return the path to the local clone of the repository. +git_sync <- function(base, url) { + repo <- repository_path(base, url, check = FALSE) + if (!fs::dir_exists(repo)) { + gert::git_clone(url = url, path = repo, bare = TRUE, verbose = FALSE) + } else { + gert::git_fetch(repo = repo, prune = TRUE, verbose = FALSE) + } + repo +} + +git_remote_list_branches <- function(repo) { + branches <- gert::git_branch_list(repo, local = FALSE) + branches$name <- gsub("^refs/remotes/origin/", "", branches$ref) + branches <- branches[branches$name != "HEAD", ] + branches +} + git_run <- function(args, repo = NULL, check = FALSE) { git <- sys_which("git") if (!is.null(repo)) { @@ -12,7 +57,7 @@ git_run <- function(args, repo = NULL, check = FALSE) { } -git_get_default_branch <- function(repo = NULL) { +git_remote_default_branch_ref <- function(repo) { # This is assuming remote origin exists. We'll get an error if it # doesn't. But this should be safe for us as we'll always have cloned # this from GitHub. @@ -21,10 +66,20 @@ git_get_default_branch <- function(repo = NULL) { } +git_remote_default_branch_name <- function(repo) { + ref <- git_remote_default_branch_ref(repo) + if (!is.null(ref)) { + gsub("^refs/remotes/origin/", "", ref) + } else { + NULL + } +} + + git_get_modified <- function(ref, base = NULL, relative_dir = NULL, repo = NULL) { if (is.null(base)) { - base <- git_get_default_branch(repo) + base <- git_remote_default_branch_ref(repo) } if (is.null(relative_dir)) { relative <- "" diff --git a/R/main.R b/R/main.R index 9701bde..f60cdfa 100644 --- a/R/main.R +++ b/R/main.R @@ -1,6 +1,6 @@ parse_main <- function(args = commandArgs(TRUE)) { usage <- "Usage: -orderly.runner.server [options] +orderly.runner.server [options] Options: --log-level=LEVEL Log-level (off, info, all) [default: info] @@ -12,12 +12,13 @@ Options: validate = dat$validate, port = as.integer(dat$port), path = dat$path, + repositories = dat$repositories, host = dat$host) } main <- function(args = commandArgs(TRUE)) { dat <- parse_main(args) - api_obj <- api(dat$path, dat$validate, dat$log_level) + api_obj <- api(dat$path, dat$repositories, dat$validate, dat$log_level) api_obj$run(host = dat$host, port = dat$port) } diff --git a/R/porcelain.R b/R/porcelain.R index c356a2e..d91503a 100644 --- a/R/porcelain.R +++ b/R/porcelain.R @@ -9,6 +9,26 @@ returning = porcelain::porcelain_returning_json("root"), validate = validate) }, + "POST /repository/fetch" = function(state, validate) { + porcelain::porcelain_endpoint$new( + "POST", + "/repository/fetch", + repository_fetch, + porcelain::porcelain_input_body_json("data", "repository_fetch_request"), + porcelain::porcelain_state(repositories = state$repositories), + returning = porcelain::porcelain_returning_json("repository_fetch_response"), + validate = validate) + }, + "GET /repository/branches" = function(state, validate) { + porcelain::porcelain_endpoint$new( + "GET", + "/repository/branches", + repository_branches, + porcelain::porcelain_input_query(url = "string"), + porcelain::porcelain_state(repositories = state$repositories), + returning = porcelain::porcelain_returning_json("repository_branches"), + validate = validate) + }, "GET /report/list" = function(state, validate) { porcelain::porcelain_endpoint$new( "GET", diff --git a/R/util.R b/R/util.R index a00eb9e..21168b3 100644 --- a/R/util.R +++ b/R/util.R @@ -7,6 +7,15 @@ scalar <- function(x) { jsonlite::unbox(x) } +empty_object <- function(x) { + # This is needed to get an empty JSON object. + # list() is `[]` and NULL may be `null` depending on the options passed to + # toJSON. + x <- list() + names(x) <- character(0) + x +} + package_version_string <- function(name) { as.character(utils::packageVersion(name)) diff --git a/docker/test/run-test b/docker/test/run-test index 1308a8b..eb7bd08 100755 --- a/docker/test/run-test +++ b/docker/test/run-test @@ -37,7 +37,8 @@ docker run --rm -d --pull=always \ -v $ORDERLY_VOLUME:$CONTAINER_ORDERLY_ROOT_PATH \ -v $ORDERLY_LOGS_VOLUME:$LOGS_DIR \ $ORDERLY_RUNNER_IMAGE \ - $CONTAINER_ORDERLY_ROOT_PATH + $CONTAINER_ORDERLY_ROOT_PATH \ + /repositories docker run --rm -d --pull=always \ --net=$NETWORK \ diff --git a/inst/schema/repository_branches.json b/inst/schema/repository_branches.json new file mode 100644 index 0000000..ceb700b --- /dev/null +++ b/inst/schema/repository_branches.json @@ -0,0 +1,39 @@ +{ + "$schema": "http://json-schema.org/draft-07/schema#", + "type": "object", + "properties": { + "branches": { + "type": "array", + "items": { + "type": "object", + "properties": { + "name": { + "type": "string" + }, + "commit_hash": { + "type": "string" + }, + "message": { + "type": "string" + }, + "time": { + "type": "number" + } + }, + "required": [ + "name", + "commit_hash", + "message", + "time" + ] + } + }, + "default_branch": { + "type": "string" + } + }, + "required": [ + "branches", + "default_branch" + ] +} diff --git a/inst/schema/repository_fetch_request.json b/inst/schema/repository_fetch_request.json new file mode 100644 index 0000000..4bec16c --- /dev/null +++ b/inst/schema/repository_fetch_request.json @@ -0,0 +1,8 @@ +{ + "$schema": "http://json-schema.org/draft-07/schema#", + "type": "object", + "properties": { + "url": { "type": "string" } + }, + "required": [ "url" ] +} diff --git a/inst/schema/repository_fetch_response.json b/inst/schema/repository_fetch_response.json new file mode 100644 index 0000000..a555810 --- /dev/null +++ b/inst/schema/repository_fetch_response.json @@ -0,0 +1,4 @@ +{ + "$schema": "http://json-schema.org/draft-07/schema#", + "type": "object" +} diff --git a/man/api.Rd b/man/api.Rd index 72aa89e..3c67504 100644 --- a/man/api.Rd +++ b/man/api.Rd @@ -4,11 +4,19 @@ \alias{api} \title{Create orderly runner} \usage{ -api(root, validate = NULL, log_level = "info", skip_queue_creation = FALSE) +api( + root, + repositories, + validate = NULL, + log_level = "info", + skip_queue_creation = FALSE +) } \arguments{ \item{root}{Orderly root} +\item{repositories}{Path in which Git repositories are cloned} + \item{validate}{Logical, indicating if validation should be done on responses. This should be \code{FALSE} in production environments. See \link[porcelain:porcelain]{porcelain::porcelain} for details} diff --git a/man/git_sync.Rd b/man/git_sync.Rd new file mode 100644 index 0000000..48b484b --- /dev/null +++ b/man/git_sync.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/git.R +\name{git_sync} +\alias{git_sync} +\title{Clone or fetch a remote repository.} +\usage{ +git_sync(base, url) +} +\arguments{ +\item{base}{the base directory in which all repositories are stored.} + +\item{url}{the URL of the remote repository.} +} +\value{ +the path to the local clone of the repository. +} +\description{ +Clone or fetch a remote repository. +} diff --git a/man/repository_path.Rd b/man/repository_path.Rd new file mode 100644 index 0000000..2735ed5 --- /dev/null +++ b/man/repository_path.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/git.R +\name{repository_path} +\alias{repository_path} +\title{Get the storage path for a repository.} +\usage{ +repository_path(base, url, check = TRUE) +} +\arguments{ +\item{base}{the base directory in which all repositories are stored.} + +\item{url}{the URL of the remote repository.} + +\item{check}{if TRUE and the repository does not exist locally yet, an error +is raised.} +} +\value{ +the path to the repository. +} +\description{ +Repositories are all stored as subdirectories of a common base path, +using a hash of their URL as the directory name. +} diff --git a/tests/testthat/helper-orderly-runner.R b/tests/testthat/helper-orderly-runner.R index 137429c..7eb9382 100644 --- a/tests/testthat/helper-orderly-runner.R +++ b/tests/testthat/helper-orderly-runner.R @@ -1,5 +1,7 @@ orderly_runner_endpoint <- function( - method, path, root, + method, path, + root = NULL, + repositories = NULL, validate = TRUE, skip_queue_creation = FALSE ) { @@ -10,7 +12,9 @@ orderly_runner_endpoint <- function( } porcelain::porcelain_package_endpoint( "orderly.runner", method, path, - state = list(root = root, queue = queue), + state = list(root = root, + repositories = repositories, + queue = queue), validate = validate ) } @@ -23,20 +27,6 @@ create_temporary_root <- function(...) { } -new_queue_quietly <- function(root, ...) { - suppressMessages(Queue$new(root, ...)) -} - - -start_queue_workers_quietly <- function(n_workers, - controller, env = parent.frame()) { - suppressMessages( - rrq::rrq_worker_spawn(n_workers, controller = controller) - ) - withr::defer(rrq::rrq_worker_stop(controller = controller), env = env) -} - - skip_if_no_redis <- function() { available <- redux::redis_available() if (!available) { @@ -46,20 +36,20 @@ skip_if_no_redis <- function() { } -test_prepare_orderly_example <- function(examples, ...) { - tmp <- tempfile() - withr::defer_parent(unlink(tmp, recursive = TRUE)) - suppressMessages(orderly2::orderly_init(tmp, ...)) - copy_examples(examples, tmp) - as.character(fs::path_norm(tmp)) +test_prepare_orderly_example <- function(examples, ..., env = parent.frame()) { + path <- withr::local_tempdir(.local_envir = env) + suppressMessages(orderly2::orderly_init(path, ...)) + copy_examples(examples, path) + + helper_add_git(path, orderly_gitignore = TRUE) + path } -test_prepare_orderly_remote_example <- function(examples, ...) { - path_remote <- test_prepare_orderly_example(examples, ...) - helper_add_git(path_remote, orderly_gitignore = TRUE) - path_local <- tempfile() - withr::defer_parent(unlink(path_local, recursive = TRUE)) +test_prepare_orderly_remote_example <- function(examples, ..., env = parent.frame()) { + path_remote <- test_prepare_orderly_example(examples, ..., env = env) + path_local <- withr::local_tempdir(.local_envir = env) + gert::git_clone(path_remote, path_local) orderly2::orderly_init(root = path_local, force = TRUE) list( @@ -168,32 +158,23 @@ initialise_git_repo <- function() { } -create_new_commit <- function(path, new_file = "new", message = "new message", - add = ".") { - writeLines("new file", file.path(path, new_file)) - gert::git_add(add, repo = path) - user <- "author " - gert::git_commit("new commit", author = user, committer = user, repo = path) -} - - -git_add_and_commit <- function(path, add = ".") { +git_add_and_commit <- function(path, add = ".", message = "new commit") { gert::git_add(add, repo = path) user <- "author " - gert::git_commit("new commit", author = user, committer = user, repo = path) + gert::git_commit(message, author = user, committer = user, repo = path) } -create_new_commit <- function(path, new_file = "new", add = ".") { +create_new_commit <- function(path, new_file = "new", add = ".", ...) { writeLines("new file", file.path(path, new_file)) - git_add_and_commit(path, add) + git_add_and_commit(path, add, ...) } -create_new_branch <- function(path, branch_name = "other") { +create_new_branch <- function(path, branch_name = "other", ...) { initial_branch <- gert::git_branch(repo = path) gert::git_branch_create(branch_name, repo = path) - commit_sha <- create_new_commit(path, branch_name) + commit_sha <- create_new_commit(path, branch_name, ...) gert::git_branch_checkout(initial_branch, repo = path) list(branch = branch_name, sha = commit_sha) } diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R index 221d075..f6b55c5 100644 --- a/tests/testthat/test-api.R +++ b/tests/testthat/test-api.R @@ -13,7 +13,9 @@ 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, skip_queue_creation = TRUE) + repositories <- withr::local_tempdir() + + obj <- api(root, repositories, 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,6 +24,101 @@ test_that("Can construct the api", { }) +test_that("can fetch repositories", { + upstream_a <- test_prepare_orderly_example("data") + upstream_b <- test_prepare_orderly_example("data") + + repositories <- withr::local_tempdir() + + endpoint <- orderly_runner_endpoint( + "POST", "/repository/fetch", + repositories = repositories, + skip_queue_creation = TRUE + ) + + res <- endpoint$run(jsonlite::toJSON(list(url = scalar(upstream_a)))) + expect_equal(res$status_code, 200) + expect_length(fs::dir_ls(repositories), 1) + + res <- endpoint$run(jsonlite::toJSON(list(url = scalar(upstream_b)))) + expect_equal(res$status_code, 200) + expect_length(fs::dir_ls(repositories), 2) +}) + + +test_that("can list branches in repository", { + upstream <- test_prepare_orderly_example("data") + + repositories <- withr::local_tempdir() + + fetch_endpoint <- orderly_runner_endpoint( + "POST", "/repository/fetch", + repositories = repositories, + skip_queue_creation = TRUE + ) + branches_endpoint <- orderly_runner_endpoint( + "GET", "/repository/branches", + repositories = repositories, + skip_queue_creation = TRUE + ) + + + # Start with just the initial master branch. Fetch the repo and list its + # branches: + res <- fetch_endpoint$run(jsonlite::toJSON(list(url = scalar(upstream)))) + expect_equal(res$status_code, 200) + + res <- branches_endpoint$run(upstream) + expect_equal(res$status_code, 200) + expect_equal(res$data$default_branch, scalar("master")) + expect_equal(nrow(res$data$branches), 1) + expect_equal(res$data$branches[1,]$name, "master") + expect_equal(res$data$branches[1,]$message, "new commit\n") + + + # Now create a "new-branch" branch and add a commit to it. Fetch the repo + # again and now the two branches should be listed: + info <- create_new_branch(upstream, "new-branch", message = "start new branch") + + res <- fetch_endpoint$run(jsonlite::toJSON(list(url = scalar(upstream)))) + expect_equal(res$status_code, 200) + + res <- branches_endpoint$run(upstream) + expect_equal(res$status_code, 200) + expect_setequal(res$data$branches$name, c("master", "new-branch")) + + b <- res$data$branches[res$data$branches$name == "new-branch",] + expect_equal(b$commit, info$sha) + expect_equal(b$message, "start new branch\n") + + # Finally delete the "new-branch". Fetch the repo and check that just the + # master branch remains in the list. + gert::git_branch_delete("new-branch", upstream) + + res <- fetch_endpoint$run(jsonlite::toJSON(list(url = scalar(upstream)))) + expect_equal(res$status_code, 200) + + res <- branches_endpoint$run(upstream) + expect_equal(nrow(res$data$branches), 1) + expect_equal(res$data$branches[1,]$name, "master") +}) + +test_that("listing branches fails if repository was not fetched", { + upstream <- test_prepare_orderly_example("data") + + repositories <- withr::local_tempdir() + + endpoint <- orderly_runner_endpoint( + "GET", "/repository/branches", + repositories = repositories, + skip_queue_creation = TRUE + ) + + res <- endpoint$run(upstream) + expect_equal(res$status_code, 404) +}) + + test_that("can list orderly reports", { repo <- test_prepare_orderly_remote_example(c("data", "parameters")) endpoint <- orderly_runner_endpoint( @@ -92,9 +189,7 @@ test_that("can run orderly reports", { queue_id <- orderly_queue_id() 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, logs_dir = tempfile()) worker_manager <- start_queue_workers_quietly( 1, queue$controller @@ -140,9 +235,6 @@ test_that("can get statuses of jobs", { skip_if_no_redis() queue_id <- orderly_queue_id() 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, logs_dir = tempfile()) worker_manager <- start_queue_workers_quietly( 1, queue$controller diff --git a/tests/testthat/test-git.R b/tests/testthat/test-git.R index 2d49688..b65bc2b 100644 --- a/tests/testthat/test-git.R +++ b/tests/testthat/test-git.R @@ -12,14 +12,21 @@ test_that("handle failure", { test_that("can get default branch when remote origin is set", { testthat::skip_on_cran() repo <- initialise_git_repo() - expect_null(git_get_default_branch(repo$path)) + + expect_null(git_remote_default_branch_ref(repo$path)) + expect_null(git_remote_default_branch_name(repo$path)) + git_run(c("symbolic-ref", "refs/remotes/origin/HEAD", "refs/remotes/origin/main"), repo = repo$path) - expect_equal(git_get_default_branch(repo$path), "refs/remotes/origin/main") -}) + expect_equal(git_remote_default_branch_ref(repo$path), + "refs/remotes/origin/main") + + expect_equal(git_remote_default_branch_name(repo$path), + "main") +}) test_that("can get files which have been modified", { testthat::skip_on_cran() @@ -45,3 +52,24 @@ test_that("can get files which have been modified", { repo = repo$local), character(0)) }) + + +test_that("repository path is unique", { + base <- withr::local_tempdir() + r1 <- repository_path(base, "https://github.com/mrc-ide/orderly", check = FALSE) + r2 <- repository_path(base, "https://github.com/mrc-ide/packit", check = FALSE) + expect_true(r1 != r2) +}) + + +test_that("repository_path checks if path exists", { + base <- withr::local_tempdir() + url <- "https://github.com/mrc-ide/orderly" + + expect_error(repository_path(base, url), "Repository does not exist") + + repo <- expect_no_error(repository_path(base, url, check = FALSE)) + fs::dir_create(repo) + + expect_no_error(repository_path(base, url)) +}) diff --git a/tests/testthat/test-main.R b/tests/testthat/test-main.R index 1560588..3fd66b2 100644 --- a/tests/testthat/test-main.R +++ b/tests/testthat/test-main.R @@ -1,35 +1,40 @@ test_that("Can parse arguments (server)", { - expect_mapequal(parse_main("path"), + expect_mapequal(parse_main(c("path", "repos")), list(log_level = "info", validate = FALSE, port = 8001, host = "0.0.0.0", - path = "path")) - expect_mapequal(parse_main(c("--port=8080", "path")), + path = "path", + repositories = "repos")) + expect_mapequal(parse_main(c("--port=8080", "path", "repos")), list(log_level = "info", validate = FALSE, port = 8080, host = "0.0.0.0", - path = "path")) - expect_mapequal(parse_main(c("--port=8080", "--validate", "path")), + path = "path", + repositories = "repos")) + expect_mapequal(parse_main(c("--port=8080", "--validate", "path", "repos")), list(log_level = "info", validate = TRUE, port = 8080, host = "0.0.0.0", - path = "path")) - expect_mapequal(parse_main(c("--log-level=debug", "--validate", "path")), + path = "path", + repositories = "repos")) + expect_mapequal(parse_main(c("--log-level=debug", "--validate", "path", "repos")), list(log_level = "debug", validate = TRUE, port = 8001, host = "0.0.0.0", - path = "path")) + path = "path", + repositories = "repos")) expect_mapequal( - parse_main(c("--host=host", "--log-level=debug", "--validate", "path")), + parse_main(c("--host=host", "--log-level=debug", "--validate", "path", "repos")), list(log_level = "debug", validate = TRUE, port = 8001, host = "host", - path = "path") + path = "path", + repositories = "repos") ) }) @@ -39,11 +44,11 @@ test_that("Can construct api", { mock_run <- mockery::mock() mock_api <- mockery::mock(list(run = mock_run)) mockery::stub(main, "api", mock_api) - main(c("--host=my-host", "--log-level=debug", "path")) + main(c("--host=my-host", "--log-level=debug", "path", "repositories")) mockery::expect_called(mock_api, 1) expect_equal(mockery::mock_args(mock_api)[[1]], - list("path", FALSE, "debug")) + list("path", "repositories", FALSE, "debug")) mockery::expect_called(mock_run, 1) expect_equal(mockery::mock_args(mock_run)[[1]], diff --git a/tests/testthat/test-queue.R b/tests/testthat/test-queue.R index d25e919..c648c47 100644 --- a/tests/testthat/test-queue.R +++ b/tests/testthat/test-queue.R @@ -78,11 +78,10 @@ test_that("Can submit task", { skip_if_no_redis() root <- test_prepare_orderly_example("data") - git_info <- helper_add_git(root, c("src", "orderly_config.yml")) q <- start_queue_with_workers(root, 1) - task_id <- q$submit("data", branch = git_info$branch) + task_id <- q$submit("data", branch = gert::git_branch(root)) expect_worker_task_complete(task_id, q$controller, 10) }) @@ -91,7 +90,6 @@ test_that("Can submit 2 tasks on different branches", { skip_if_no_redis() root <- test_prepare_orderly_example("data") - git_info <- helper_add_git(root, c("src", "orderly_config.yml")) gert::git_branch_create("branch", repo = root) gert::git_branch_checkout("branch", repo = root) @@ -99,7 +97,7 @@ test_that("Can submit 2 tasks on different branches", { q <- start_queue_with_workers(root, 2) - task_id1 <- q$submit("data", branch = git_info$branch) + task_id1 <- q$submit("data", branch = "master") task_id2 <- q$submit("data", branch = "branch") expect_worker_task_complete(task_id1, q$controller, 10) expect_worker_task_complete(task_id2, q$controller, 10) @@ -114,13 +112,13 @@ test_that("Can submit 2 tasks on different commit hashes", { skip_if_no_redis() root <- test_prepare_orderly_example("data") - git_info <- helper_add_git(root, c("src", "orderly_config.yml")) - sha2 <- create_new_commit(root, new_file = "test.txt", add = "test.txt") + commit1 <- gert::git_commit_id(repo = root) + commit2 <- create_new_commit(root, new_file = "test.txt", add = "test.txt") q <- start_queue_with_workers(root, 2) - task_id1 <- q$submit("data", ref = git_info$sha, branch = git_info$branch) - task_id2 <- q$submit("data", ref = sha2, branch = git_info$branch) + task_id1 <- q$submit("data", ref = commit1, branch = gert::git_branch(root)) + task_id2 <- q$submit("data", ref = commit2, branch = gert::git_branch(root)) expect_worker_task_complete(task_id1, q$controller, 10) expect_worker_task_complete(task_id2, q$controller, 10) @@ -133,10 +131,9 @@ test_that("Can submit 2 tasks on different commit hashes", { test_that("can get statuses on complete report runs with logs", { skip_if_no_redis() root <- test_prepare_orderly_example("data") - git_info <- helper_add_git(root, c("src", "orderly_config.yml")) q <- start_queue_with_workers(root, 1) - task_id1 <- q$submit("data", branch = git_info$branch) - task_id2 <- q$submit("data", branch = git_info$branch) + task_id1 <- q$submit("data", branch = gert::git_branch(root)) + task_id2 <- q$submit("data", branch = gert::git_branch(root)) task_ids <- c(task_id1, task_id2) wait_for_task_complete(task_ids, q$controller, 5) @@ -156,10 +153,9 @@ test_that("can get statuses wihtout logs if include_logs = false", { # run 2 reports skip_if_no_redis() root <- test_prepare_orderly_example("data") - git_info <- helper_add_git(root, c("src", "orderly_config.yml")) q <- start_queue_with_workers(root, 1) - task_id1 <- q$submit("data", branch = git_info$branch) - task_id2 <- q$submit("data", branch = git_info$branch) + task_id1 <- q$submit("data", branch = gert::git_branch(root)) + task_id2 <- q$submit("data", branch = gert::git_branch(root)) task_ids <- c(task_id1, task_id2) wait_for_task_complete(task_ids, q$controller, 5) @@ -179,10 +175,9 @@ test_that("can get status on pending report run", { # run 2 reports skip_if_no_redis() root <- test_prepare_orderly_example("data") - git_info <- helper_add_git(root, c("src", "orderly_config.yml")) q <- new_queue_quietly(root) - task_id1 <- q$submit("data", branch = git_info$branch) - task_id2 <- q$submit("data", branch = git_info$branch) + task_id1 <- q$submit("data", branch = gert::git_branch(root)) + task_id2 <- q$submit("data", branch = gert::git_branch(root)) task_ids <- c(task_id1, task_id2) statuses <- q$get_status(task_ids) diff --git a/tests/testthat/test-reports.R b/tests/testthat/test-reports.R index acba6df..afe6486 100644 --- a/tests/testthat/test-reports.R +++ b/tests/testthat/test-reports.R @@ -1,6 +1,5 @@ test_that("can get orderly script name", { root <- test_prepare_orderly_example(c("data", "parameters")) - git_info <- helper_add_git(root) expect_equal(get_orderly_script_path("data", "HEAD", root), "src/data/data.R") expect_equal(get_orderly_script_path("parameters", "HEAD", root), "src/parameters/parameters.R") @@ -17,7 +16,7 @@ test_that("can get orderly script name", { test_that("can get report parameters", { root <- test_prepare_orderly_example(c("data", "parameters")) - git_info <- helper_add_git(root) + old_sha <- gert::git_commit_id(repo = root) params <- get_report_parameters("data", "HEAD", root) expect_null(params) @@ -40,6 +39,6 @@ test_that("can get report parameters", { b = 2, c = NULL)) - params_old <- get_report_parameters("parameters", git_info$sha, root) + params_old <- get_report_parameters("parameters", old_sha, root) expect_equal(params, params_old) }) diff --git a/tests/testthat/test-runner.R b/tests/testthat/test-runner.R index 0de32bf..5b30c52 100644 --- a/tests/testthat/test-runner.R +++ b/tests/testthat/test-runner.R @@ -1,6 +1,5 @@ test_that("runner runs as expected", { orderly_root <- test_prepare_orderly_example("data") - git_info <- helper_add_git(orderly_root, c("src", "orderly_config.yml")) worker_id <- ids::adjective_animal() make_worker_dirs(orderly_root, worker_id) @@ -8,7 +7,8 @@ test_that("runner runs as expected", { suppressMessages(withr::with_envvar( c(RRQ_WORKER_ID = worker_id), - runner_run(orderly_root, "data", NULL, git_info$branch, + runner_run(orderly_root, "data", NULL, + gert::git_branch(orderly_root), "HEAD", echo = FALSE) )) @@ -20,7 +20,6 @@ test_that("runner runs as expected", { test_that("runner runs as expected with parameters", { orderly_root <- test_prepare_orderly_example("parameters") - git_info <- helper_add_git(orderly_root, c("src", "orderly_config.yml")) worker_id <- ids::adjective_animal() make_worker_dirs(orderly_root, worker_id) @@ -30,7 +29,8 @@ test_that("runner runs as expected with parameters", { suppressMessages(withr::with_envvar( c(RRQ_WORKER_ID = worker_id), runner_run(orderly_root, "parameters", parameters, - git_info$branch, "HEAD", echo = FALSE) + gert::git_branch(orderly_root), + "HEAD", echo = FALSE) )) report_archive <- file.path(orderly_root, "archive", "parameters") @@ -46,7 +46,6 @@ test_that("git clean clears unnecessary files", { # and there will also be an empty folder draft/git-clean so we test # all components of git_clean orderly_root <- test_prepare_orderly_example("git-clean") - git_info <- helper_add_git(orderly_root, c("src", "orderly_config.yml")) worker_id <- ids::adjective_animal() make_worker_dirs(orderly_root, worker_id) @@ -54,7 +53,8 @@ test_that("git clean clears unnecessary files", { suppressMessages(withr::with_envvar( c(RRQ_WORKER_ID = worker_id), - runner_run(orderly_root, "git-clean", NULL, git_info$branch, + runner_run(orderly_root, "git-clean", NULL, + gert::git_branch(orderly_root), "HEAD", echo = FALSE) )) diff --git a/tests/testthat/test-util.R b/tests/testthat/test-util.R index b01211b..390e1d8 100644 --- a/tests/testthat/test-util.R +++ b/tests/testthat/test-util.R @@ -18,3 +18,9 @@ test_that("sys_which", { expect_error(sys_which(prog), "Did not find 'a-path-that-does-not-exist'") }) + + +test_that("empty_object serializes correctly", { + expect_equal(unclass(jsonlite::toJSON(empty_object())), "{}") + expect_equal(unclass(jsonlite::toJSON(empty_object(), null = "null")), "{}") +}) diff --git a/tests/testthat/test-zzz-e2e.R b/tests/testthat/test-zzz-e2e.R index 6dd14d7..74be90e 100644 --- a/tests/testthat/test-zzz-e2e.R +++ b/tests/testthat/test-zzz-e2e.R @@ -5,10 +5,11 @@ queue_id <- "orderly.runner:cuteasdanimal" root <- test_prepare_orderly_remote_example( c("data", "parameters") ) +repositories <- withr::local_tempdir() queue <- start_queue_with_workers(root$local, 1, queue_id = queue_id) bg <- porcelain::porcelain_background$new( api, - args = list(root$local), + args = list(root$local, repositories), env = c(ORDERLY_RUNNER_QUEUE_ID = queue_id) ) bg$start() From 9353f30baee197f1f1f5bea04c4a7fdfbc755cee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Mon, 13 Jan 2025 14:25:14 +0000 Subject: [PATCH 2/3] Code review --- R/api.R | 19 ++++++++++--------- R/porcelain.R | 4 ++-- man/api.Rd | 5 +++-- tests/testthat/helper-orderly-runner.R | 2 +- 4 files changed, 16 insertions(+), 14 deletions(-) diff --git a/R/api.R b/R/api.R index 914c141..4b89b24 100644 --- a/R/api.R +++ b/R/api.R @@ -4,7 +4,8 @@ ##' ##' @param root Orderly root ##' -##' @param repositories Path in which Git repositories are cloned +##' @param repositories_base_path Path in which Git repositories are +##' cloned. ##' ##' @param validate Logical, indicating if validation should be done ##' on responses. This should be `FALSE` in production @@ -21,7 +22,7 @@ ##' ##' @export api <- function( - root, repositories, + root, repositories_base_path, validate = NULL, log_level = "info", skip_queue_creation = FALSE) { logger <- porcelain::porcelain_logger(log_level) @@ -36,7 +37,7 @@ api <- function( api <- porcelain::porcelain$new(validate = validate, logger = logger) api$include_package_endpoints(state = list( root = root, - repositories = repositories, + repositories_base_path = repositories_base_path, queue = queue)) api } @@ -53,21 +54,21 @@ root <- function() { ##' @porcelain POST /repository/fetch => json(repository_fetch_response) -##' state repositories :: repositories +##' state repositories_base_path :: repositories_base_path ##' body data :: json(repository_fetch_request) -repository_fetch <- function(repositories, data) { +repository_fetch <- function(repositories_base_path, data) { data <- jsonlite::parse_json(data) - r <- git_sync(repositories, data$url) + r <- git_sync(repositories_base_path, data$url) empty_object() } ##' @porcelain GET /repository/branches => json(repository_branches) -##' state repositories :: repositories +##' state repositories_base_path :: repositories_base_path ##' query url :: string -repository_branches <- function(repositories, url) { - repo <- repository_path(repositories, url) +repository_branches <- function(repositories_base_path, url) { + repo <- repository_path(repositories_base_path, url) branches <- git_remote_list_branches(repo) message <- vcapply(branches$commit, function(commit) { gert::git_commit_info(repo = repo, ref = commit)$message diff --git a/R/porcelain.R b/R/porcelain.R index d91503a..cbf63ae 100644 --- a/R/porcelain.R +++ b/R/porcelain.R @@ -15,7 +15,7 @@ "/repository/fetch", repository_fetch, porcelain::porcelain_input_body_json("data", "repository_fetch_request"), - porcelain::porcelain_state(repositories = state$repositories), + porcelain::porcelain_state(repositories_base_path = state$repositories_base_path), returning = porcelain::porcelain_returning_json("repository_fetch_response"), validate = validate) }, @@ -25,7 +25,7 @@ "/repository/branches", repository_branches, porcelain::porcelain_input_query(url = "string"), - porcelain::porcelain_state(repositories = state$repositories), + porcelain::porcelain_state(repositories_base_path = state$repositories_base_path), returning = porcelain::porcelain_returning_json("repository_branches"), validate = validate) }, diff --git a/man/api.Rd b/man/api.Rd index 3c67504..518c80b 100644 --- a/man/api.Rd +++ b/man/api.Rd @@ -6,7 +6,7 @@ \usage{ api( root, - repositories, + repositories_base_path, validate = NULL, log_level = "info", skip_queue_creation = FALSE @@ -15,7 +15,8 @@ api( \arguments{ \item{root}{Orderly root} -\item{repositories}{Path in which Git repositories are cloned} +\item{repositories_base_path}{Path in which Git repositories are +cloned.} \item{validate}{Logical, indicating if validation should be done on responses. This should be \code{FALSE} in production diff --git a/tests/testthat/helper-orderly-runner.R b/tests/testthat/helper-orderly-runner.R index 7eb9382..c42ece6 100644 --- a/tests/testthat/helper-orderly-runner.R +++ b/tests/testthat/helper-orderly-runner.R @@ -13,7 +13,7 @@ orderly_runner_endpoint <- function( porcelain::porcelain_package_endpoint( "orderly.runner", method, path, state = list(root = root, - repositories = repositories, + repositories_base_path = repositories, queue = queue), validate = validate ) From dfcdb1364f6cb1d265e8e37b7289ac8f7578b246 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Mon, 13 Jan 2025 15:49:48 +0000 Subject: [PATCH 3/3] Use random queue ID --- tests/testthat/test-zzz-e2e.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-zzz-e2e.R b/tests/testthat/test-zzz-e2e.R index 74be90e..6c899f8 100644 --- a/tests/testthat/test-zzz-e2e.R +++ b/tests/testthat/test-zzz-e2e.R @@ -1,7 +1,7 @@ skip_if_not_installed("httr") skip_if_no_redis() -queue_id <- "orderly.runner:cuteasdanimal" +queue_id <- orderly_queue_id() root <- test_prepare_orderly_remote_example( c("data", "parameters") )