first draft of the package

Author: sckott

.Rbuildignore

@@ -0,0 +1,7 @@
+^LICENSE\.md$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^README\.Rmd$
+^\.github$
+^Makefile$

.gitignore

@@ -0,0 +1 @@
+docs

DESCRIPTION

@@ -0,0 +1,17 @@
+Package: proofr
+Title: Client for the PROOF API
+Version: 0.0.0.91
+Authors@R: 
+    person("Scott", "Chamberlain", , "[email protected]", role = c("aut", "cre"),
+           comment = c(ORCID = "0000-0003-1444-9135"))
+Description: Client for the PROOF API.
+License: MIT + file LICENSE
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3
+Imports:
+    httr
+Suggests: 
+    testthat (>= 3.0.0),
+    withr
+Config/testthat/edition: 3

Makefile

@@ -0,0 +1,42 @@
+PACKAGE := $(shell grep '^Package:' DESCRIPTION | sed -E 's/^Package:[[:space:]]+//')
+RSCRIPT = Rscript --no-init-file
+FILE_TARGET := "R/${FILE}.R"
+
+install: doc build
+	R CMD INSTALL . && rm *.tar.gz
+
+build:
+	R CMD build .
+
+doc:
+	${RSCRIPT} -e "devtools::document()"
+
+eg:
+	${RSCRIPT} -e "devtools::run_examples(run_dontrun = TRUE)"
+
+check: build
+	_R_CHECK_CRAN_INCOMING_=FALSE R CMD CHECK --as-cran --no-manual `ls -1tr ${PACKAGE}*gz | tail -n1`
+	@rm -f `ls -1tr ${PACKAGE}*gz | tail -n1`
+	@rm -rf ${PACKAGE}.Rcheck
+
+vign_getting_started:
+	cd vignettes;\
+	${RSCRIPT} -e "Sys.setenv(NOT_CRAN='true'); knitr::knit('${PACKAGE}.Rmd.og', output = '${PACKAGE}.Rmd')";\
+	cd ..
+
+test:
+	${RSCRIPT} -e "devtools::test()"
+
+readme:
+	${RSCRIPT} -e "knitr::knit('README.Rmd')"
+
+lint_package:
+	${RSCRIPT} -e "lintr::lint_package()"
+
+# use: `make style_file FILE=stuff.R`
+# ("R/" is prepended); accepts 1 file only
+style_file:
+	${RSCRIPT} -e 'styler::style_file(${FILE_TARGET})'
+
+style_package:
+	${RSCRIPT} -e "styler::style_pkg()"

NAMESPACE

@@ -0,0 +1,12 @@
+# Generated by roxygen2: do not edit by hand
+
+export(proof_authenticate)
+export(proof_job_cancel)
+export(proof_job_start)
+export(proof_job_status)
+importFrom(httr,DELETE)
+importFrom(httr,GET)
+importFrom(httr,POST)
+importFrom(httr,add_headers)
+importFrom(httr,content)
+importFrom(httr,stop_for_status)

R/auth.R

@@ -0,0 +1,47 @@
+find_token <- function(token = NULL) {
+  if (!is.null(token)) {
+    return(token)
+  }
+  token <- Sys.getenv("PROOF_TOKEN")
+  if (identical(token, "")) {
+    stop("token not found - see ?proof_authenticate")
+  }
+  token
+}
+
+#' Get header for PROOF API calls
+#'
+#' Utility method to get header for PROOF API calls
+#'
+#' @keywords internal
+#' @param token PROOF API token
+#' @return A `request` S3 class with the HTTP header that can be passed
+#' to `httr::GET()`, `httr::POST()`, etc.
+proof_header <- function(token = NULL) {
+  add_headers(Authorization = paste0("Bearer ", find_token(token)))
+}
+
+#' Authenticate with PROOF API
+#'
+#' Authenticates with HutchNet credentials, returns PROOF API token
+#'
+#' @export
+#' @param username (character) HutchNet username
+#' @param password (character) HutchNet password
+#' @return A single token (character) for bearer authentication with
+#' the PROOF API
+#' @examples
+#' # Sys.getenv("PROOF_TOKEN")
+#' # x <- proof_authenticate()
+#' # Sys.getenv("PROOF_TOKEN")
+proof_authenticate <- function(username, password) {
+  response <- POST(make_url("authenticate"), body = list(
+    username = username,
+    password = password
+  ), encode = "json")
+  stop_for_status(response)
+  parsed <- content(response, as = "parsed")
+  token <- parsed$token
+  Sys.setenv(PROOF_TOKEN = token)
+  token
+}

R/cancel.R

@@ -0,0 +1,14 @@
+#' Delete PROOF Cromwell server
+#'
+#' @export
+#' @references <https://github.com/FredHutch/proof-api#delete-cromwell-server>
+#' @details Does not return PROOF/Cromwell server URL, for that you have to
+#' periodically call [proof_job_status()], or wait for the email from the
+#' PROOF API
+#' @return A list with fields `job_id` and `info`
+proof_job_cancel <- function() {
+  response <- DELETE(make_url("cromwell-server"), proof_header())
+  # FIXME: better error handling - surface error messages
+  stop_for_status(response)
+  content(response, as = "parsed")
+}

R/job_status.R

@@ -0,0 +1,13 @@
+#' Get PROOF API job status - is job running, what's its URL...
+#'
+#' @export
+#' @references <https://github.com/FredHutch/proof-api#get-cromwell-server>
+#' @return A list with slots:
+#' - `canJobStart`
+#' - `jobStatus`
+#' - `cromwellUrl`
+proof_job_status <- function() {
+  response <- GET(make_url("cromwell-server"), proof_header())
+  stop_for_status(response)
+  content(response, as = "parsed")
+}

R/proofr-package.R

@@ -0,0 +1,7 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom httr GET POST DELETE add_headers content stop_for_status
+## usethis namespace: end
+NULL

R/start.R

@@ -0,0 +1,21 @@
+#' Start PROOF Cromwell server
+#'
+#' @export
+#' @param pi_name (character) PI name in the form last_f; only needed if user
+#' is in more than one SLURM account
+#' @references <https://github.com/FredHutch/proof-api#post-cromwell-server>
+#' @details Does not return PROOF/Cromwell server URL, for that you have to
+#' periodically call [proof_job_status()], or wait for the email from the
+#' PROOF API
+#' @return A list with fields `job_id` and `info`
+proof_job_start <- function(pi_name = NULL) {
+  response <- POST(
+    make_url("cromwell-server"),
+    proof_header(),
+    body = list(pi_name = pi_name),
+    encode = "json"
+  )
+  # FIXME: better error handling - surface error messages
+  stop_for_status(response)
+  content(response, as = "parsed")
+}