Allow non-master branches

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly.server
 Title: Serve Orderly
-Version: 0.3.25
+Version: 0.3.26
 Description: Run orderly reports as a server.
 License: MIT + file LICENSE
 Author: Rich FitzJohn
@@ -13,7 +13,7 @@ Imports:
     ids,
     jsonlite,
     lgr,
-    orderly (>= 1.4.4),
+    orderly (>= 1.4.9),
     porcelain (>= 0.1.8),
     processx,
     redux,
@@ -22,15 +22,15 @@ Imports:
     yaml
 Suggests:
     callr,
-    gert,
+    gert (>= 1.6.0),
     httr,
     jsonvalidate (>= 1.2.2),
     mockery,
     RSQLite,
     testthat,
     withr,
     zip
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0
 Encoding: UTF-8
 Remotes:
     reside-ic/porcelain,

Makefile

@@ -1,4 +1,4 @@
-RSCRIPT = Rscript --no-init-file
+RSCRIPT = Rscript
 
 test:
 	VAULT_BIN_PATH=${PWD}/.vault VAULTR_TEST_SERVER_PORT=18200 ${RSCRIPT} -e 'library(methods); devtools::test()'

R/api.R

@@ -1,28 +1,31 @@
-build_api <- function(runner, path, backup_period = NULL,
+build_api <- function(runner, backup_period = NULL,
                       rate_limit = 2 * 60,
                       logger = NULL) {
   force(runner)
+  path <- runner$root
   api <- porcelain::porcelain$new(logger = logger)
   api$handle(endpoint_root())
-  api$handle(endpoint_git_status(path))
-  api$handle(endpoint_git_fetch(path))
-  api$handle(endpoint_git_pull(path))
-  api$handle(endpoint_git_branches(path))
-  api$handle(endpoint_git_commits(path))
-  api$handle(endpoint_available_reports(path))
-  api$handle(endpoint_report_parameters(path))
+  api$handle(endpoint_git_status(runner))
+  api$handle(endpoint_git_fetch(runner))
+  api$handle(endpoint_git_pull(runner))
+  api$handle(endpoint_git_branches(runner))
+  api$handle(endpoint_git_commits(runner))
+  api$handle(endpoint_available_reports(runner))
+  api$handle(endpoint_report_parameters(runner))
   api$handle(endpoint_bundle_pack(path))
   api$handle(endpoint_bundle_import(path))
-  api$handle(endpoint_report_info(path))
+  api$handle(endpoint_report_info(runner))
   api$handle(endpoint_run(runner))
   api$handle(endpoint_status(runner))
   api$handle(endpoint_queue_status(runner))
   api$handle(endpoint_kill(runner))
-  api$handle(endpoint_dependencies(path))
+  api$handle(endpoint_dependencies(runner))
   api$handle(endpoint_run_metadata(runner))
   api$handle(endpoint_workflow_summary(runner))
   api$handle(endpoint_workflow_run(runner))
   api$handle(endpoint_workflow_status(runner))
+  ## NOTE: these all use path not runner; there's no good reason for
+  ## this.
   api$handle(endpoint_report_versions(path))
   api$handle(endpoint_report_version_artefact_hashes(path))
   api$handle(endpoint_report_versions_custom_fields(path))
@@ -54,7 +57,8 @@ endpoint_root <- function() {
     returning = returning_json("Root.schema"))
 }
 
-target_git_status <- function(path) {
+target_git_status <- function(runner) {
+  path <- runner$root
   ret <- list(
     branch = scalar(git_branch_name(path)),
     hash = scalar(git_ref_to_sha("HEAD", path))
@@ -65,85 +69,92 @@ target_git_status <- function(path) {
   ret
 }
 
-endpoint_git_status <- function(path) {
+endpoint_git_status <- function(runner) {
   endpoint_git_status <- porcelain::porcelain_endpoint$new(
     "GET", "/v1/reports/git/status/", target_git_status,
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("GitStatus.schema"))
 }
 
-target_git_fetch <- function(path) {
+target_git_fetch <- function(runner) {
+  path <- runner$root
   res <- git_fetch(path)
   if (length(res$output) > 0L) {
     orderly::orderly_log("fetch", res$output)
   }
   res$output
 }
 
-endpoint_git_fetch <- function(path) {
+endpoint_git_fetch <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "POST", "/v1/reports/git/fetch/", target_git_fetch,
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("GitFetch.schema"))
 }
 
-target_git_pull <- function(path) {
-  res <- git_pull(path)
+target_git_pull <- function(runner) {
+  res <- git_pull(runner$root)
   if (length(res$output) > 0L) {
     orderly::orderly_log("pull", res$output)
   }
   res$output
 }
 
-endpoint_git_pull <- function(path) {
+endpoint_git_pull <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "POST", "/v1/reports/git/pull/", target_git_pull,
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("GitPull.schema"))
 }
 
-target_git_branches <- function(path) {
-  git_branches_no_merged(path, include_master = TRUE)
+target_git_branches <- function(runner) {
+  path <- runner$root
+  default_branch <- runner$default_branch
+  git_branches_no_merged(path, include_default = TRUE,
+                         default_branch = default_branch)
 }
 
-endpoint_git_branches <- function(path) {
+endpoint_git_branches <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "GET", "/git/branches", target_git_branches,
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("GitBranches.schema"))
 }
 
-target_git_commits <- function(path, branch) {
-  git_commits(branch, path)
+target_git_commits <- function(runner, branch) {
+  git_commits(branch, runner$root, runner$default_branch)
 }
 
-endpoint_git_commits <- function(path) {
+endpoint_git_commits <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "GET", "/git/commits", target_git_commits,
     porcelain::porcelain_input_query(branch = "string"),
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("GitCommits.schema"))
 }
 
-target_available_reports <- function(path, branch = NULL, commit = NULL,
+target_available_reports <- function(runner, branch = NULL, commit = NULL,
                                      show_all = FALSE) {
-  get_reports(branch, commit, show_all, path)
+  get_reports(branch, commit, show_all, runner$default_branch, runner$root)
 }
 
-endpoint_available_reports <- function(path) {
+endpoint_available_reports <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "GET", "/reports/source", target_available_reports,
     porcelain::porcelain_input_query(branch = "string"),
     porcelain::porcelain_input_query(commit = "string"),
     porcelain::porcelain_input_query(show_all = "logical"),
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("AvailableReports.schema")
   )
 }
 
-target_report_parameters <- function(path, report_id, commit = NULL) {
+target_report_parameters <- function(runner, report_id, commit = NULL) {
+  path <- runner$root
+  default_branch <- runner$default_branch
   tryCatch(
-    parameters <- get_report_parameters(report_id, commit, path),
+    parameters <- get_report_parameters(report_id, commit, path,
+                                        default_branch),
     error = function(e) {
       porcelain::porcelain_stop(e$message, "FAILED_RETRIEVE_PARAMS")
     }
@@ -166,11 +177,11 @@ target_report_parameters <- function(path, report_id, commit = NULL) {
   })
 }
 
-endpoint_report_parameters <- function(path) {
+endpoint_report_parameters <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "GET", "/reports/<report_id>/parameters", target_report_parameters,
     porcelain::porcelain_input_query(commit = "string"),
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("ReportParameters.schema")
   )
 }
@@ -218,21 +229,21 @@ endpoint_bundle_import <- function(path, data) {
     returning = returning_json("BundleImport.schema"))
 }
 
-target_report_info <- function(path, id, name) {
-  info <- orderly::orderly_info(id, name, root = path)
+target_report_info <- function(runner, id, name) {
+  info <- orderly::orderly_info(id, name, root = runner$root)
   info <- recursive_scalar(info)
   ## Rename parameters to params for consistency with rest of API
   info <- append(info, list(params = info$parameters))
   info$parameters <- NULL
   info
 }
 
-endpoint_report_info <- function(path) {
+endpoint_report_info <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "GET", "/v1/reports/info", target_report_info,
     porcelain::porcelain_input_query(id = "string"),
     porcelain::porcelain_input_query(name = "string"),
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("ReportInfo.schema")
   )
 }
@@ -312,14 +323,14 @@ endpoint_kill <- function(runner) {
     returning = returning_json("Kill.schema"))
 }
 
-target_dependencies <- function(path, name,
+target_dependencies <- function(runner, name,
                                 id = "latest",
                                 direction = "downstream",
                                 propagate = TRUE,
                                 max_depth = 100,
                                 show_all = FALSE,
                                 use = "archive") {
-  get_dependencies(path = path,
+  get_dependencies(path = runner$root,
                    name = name,
                    id = id,
                    direction = direction,
@@ -329,7 +340,7 @@ target_dependencies <- function(path, name,
                    use = use)
 }
 
-endpoint_dependencies <- function(path) {
+endpoint_dependencies <- function(runner) {
   porcelain::porcelain_endpoint$new(
     "GET", "/v1/reports/<name>/dependencies/", target_dependencies,
     porcelain::porcelain_input_query(id = "string",
@@ -338,7 +349,7 @@ endpoint_dependencies <- function(path) {
                                max_depth = "integer",
                                show_all = "logical",
                                use = "string"),
-    porcelain::porcelain_state(path = path),
+    porcelain::porcelain_state(runner = runner),
     returning = returning_json("Dependencies.schema"))
 }
 
@@ -364,7 +375,7 @@ target_run_metadata <- function(runner) {
     instances_supported <- any(lengths(instances) > 0)
   }
 
-  git_supported <- !isTRUE(server_options$master_only)
+  git_supported <- !isTRUE(server_options$default_branch_only)
 
   list(
     name = scalar(runner$config$server_options()$name),

R/git.R

@@ -92,17 +92,19 @@ git_pull <- function(root = NULL) {
   git_run("pull", root = root, check = TRUE)
 }
 
-git_branches_no_merged <- function(root = NULL, include_master = FALSE) {
+git_branches_no_merged <- function(root = NULL, include_default = FALSE,
+                                   default_branch = "master") {
   branches <- git_run(c("for-each-ref", "refs/remotes/origin",
                         "--sort=-committerdate",
                         "--format='%(refname:lstrip=3),%(committerdate:unix)'",
-                        "--no-merged=origin/master"),
+                        sprintf("--no-merged=origin/%s", default_branch)),
                       root = root, check = TRUE)$output
-  if (isTRUE(include_master)) {
-    master <- git_run(c("for-each-ref", "refs/remotes/origin/master",
+  if (isTRUE(include_default)) {
+    default <- git_run(c("for-each-ref",
+                         sprintf("refs/remotes/origin/%s", default_branch),
                         "--format='%(refname:lstrip=3),%(committerdate:unix)'"),
                       root = root, check = TRUE)$output
-    branches <- c(master, branches)
+    branches <- c(default, branches)
   }
   branches <- utils::read.table(text = branches, stringsAsFactors = FALSE,
                                 sep = ",", col.names = c("name", "last_commit"))
@@ -112,10 +114,10 @@ git_branches_no_merged <- function(root = NULL, include_master = FALSE) {
   branches
 }
 
-## This gets last 25 commits from master
-## if not master then gets the unmerged commits (limit 25)
-git_commits <- function(branch, root = NULL) {
-  if (branch == "master") {
+## This gets last 25 commits from default branch
+## if not the default branch then gets the unmerged commits (limit 25)
+git_commits <- function(branch, root = NULL, default_branch = "master") {
+  if (branch == default_branch) {
     args <- c("log", "--pretty='%h,%cd'", "--date=unix", "--max-count=25",
               sprintf("refs/remotes/origin/%s", branch))
   } else {
@@ -127,7 +129,8 @@ git_commits <- function(branch, root = NULL) {
     remote_branch <- sprintf("refs/remotes/origin/%s", branch)
     args <- c("log", "--pretty='%h,%cd'", "--date=unix", "--max-count=25",
               "--right-only", "--cherry-pick",
-              paste0("refs/remotes/origin/master...", remote_branch),
+              sprintf("refs/remotes/origin/%s...%s",
+                      default_branch, remote_branch),
               remote_branch)
   }
   commits <- git_run(args, root = root, check = TRUE)$output
@@ -148,8 +151,8 @@ git_latest_commit <- function(branch = "master", root = NULL) {
   git_run(args, root = root, check = TRUE)$output
 }
 
-get_reports <- function(branch, commit, show_all, root) {
-  list_all <- show_all || identical(branch, "master") || is.null(branch)
+get_reports <- function(branch, commit, show_all, default_branch, root) {
+  list_all <- show_all || identical(branch, default_branch) || is.null(branch)
   if (list_all) {
     if (is.null(commit)) {
       commit <- git_latest_commit(branch, root = root)
@@ -164,7 +167,7 @@ get_reports <- function(branch, commit, show_all, root) {
     ## the porcelain version
     reports <- git_run(
       c("diff", "--name-only", "--relative=src/",
-      paste0("refs/remotes/origin/master...", commit),
+      sprintf("refs/remotes/origin/%s...%s", default_branch, commit),
       "-- src/"),
       root = root, check = TRUE)$output
     ## We only want to return the reports which have changes i.e. the dirname
@@ -174,11 +177,11 @@ get_reports <- function(branch, commit, show_all, root) {
   reports
 }
 
-get_report_parameters <- function(report, commit, root) {
+get_report_parameters <- function(report, commit, root, branch = "master") {
   tryCatch({
-    ## Default to latest commit from master if missing
+    ## Default to latest commit from 'branch' if missing
     if (is.null(commit)) {
-      commit <- git_latest_commit(root = root)
+      commit <- git_latest_commit(branch, root = root)
     }
     yml <- git_run(
       c("show", paste0(commit, file.path(":src", report, "orderly.yml"))),

R/main.R

@@ -10,8 +10,8 @@ main_args <- function(args) {
 Options:
   --port=PORT                    Port to run on [default: 8321]
   --host=HOST                    IP address owned by this server [default: 0.0.0.0]
-  --no-ref                       Prevent git reference switching
   --go-signal=PATH               Relative path for go signal
+  --identity=NAME                Identity to use
   --queue-id=ID                  rrq ID
   --workers=WORKERS              Number of workers to spawn [default: 0]
   --backup-period=BACKUP_PERIOD  How frequently should backup be run, 0 or negative for no backup [default: 600]
@@ -26,7 +26,7 @@ Options:
   list(path = res[["path"]],
        port = as.integer(res[["port"]]),
        host = res[["host"]],
-       allow_ref = !res[["no_ref"]],
+       identity = res[["identity"]],
        go_signal = res[["go_signal"]],
        queue_id = res[["queue_id"]],
        workers = as.integer(res[["workers"]]),