R/submit.R

In labbcb/CromwellClient: R package for consuming Cromwell API

#' Submit a workflow for execution
#'
#' Submits a workflow to Cromwell Server.
#'
#' @param x Cromwell API endpoint.
#' @param workflow The workflow source file to submit for execution.
#' @param inputs JSON or YAML file containing the inputs as an object.
#' @param options JSON file containing configuration options for the execution
#' of this workflow.
#' @param labels JSON file containing a set of collection of key/value pairs for
#' labels to apply to this workflow.
#' @param version Cromwell API Version.
#'
#' @return WorkflowIdAndStatus object containing status and id.
#'
#' @examples
#' \dontrun{
#' host <- "http://localhost:8000"
#' workflow <- system.file("extdata/workflow.wdl", package = "CromwellClient")
#' inputs <- system.file("extdata/inputs.json", package = "CromwellClient")
#' submit(host, workflow, inputs)
#' }
#'
#' @export
submit <- function(x, workflow, inputs, options = NULL, labels = NULL, version = "v1")
{
	url <- file.path(x, "api/workflows", version)


	body <- list(
		workflowSource = httr::upload_file(path = get_file(workflow),
			type = "text/plain"),
		workflowInputs = httr::upload_file(path = get_file(inputs))
	)

	if (!is.null(options)) {
		body$workflowOptions <- httr::upload_file(get_file(options),
			type = "application/json")
	}

	if (!is.null(labels)) {
		body$labels <- httr::upload_file(get_file(labels),
			type = "application/json")
	}

	response <- httr::POST(url = url, body = body, cromwellAgent())

	if (httr::http_error(response)) {
		stop(paste0("Cromwell API request failed: ",
			httr::status_code(response)), call. = FALSE)
	}

	if (httr::http_type(response) != "application/json") {
		stop("API did not return json", call. = FALSE)
	}

	content <- jsonlite::fromJSON(httr::content(response, "text"))

	structure(
		list(
			id = content$id,
			status = content$status,
			host = x,
			version = version
		),
		class = "WorkflowIdAndStatus"
	)
}

get_file <- function(file)
{
	if (file.exists(file)) {
		file
	} else {
		temp <- tempfile()
		download.file(file, temp)
		temp
	}
}