fix #8 set timeout of 5 sec for all http requests

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: proofr
 Title: Client for the PROOF API
-Version: 0.0.0.91
+Version: 0.0.1.91
 Authors@R: 
     person("Scott", "Chamberlain", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-1444-9135"))

NAMESPACE

@@ -5,9 +5,11 @@ export(proof_cancel)
 export(proof_header)
 export(proof_start)
 export(proof_status)
+export(proof_timeout)
 importFrom(httr,DELETE)
 importFrom(httr,GET)
 importFrom(httr,POST)
 importFrom(httr,add_headers)
 importFrom(httr,content)
 importFrom(httr,stop_for_status)
+importFrom(httr,timeout)

R/auth.R

@@ -24,17 +24,22 @@ proof_header <- function(token = NULL) {
 #' @export
 #' @param username (character) HutchNet username
 #' @param password (character) HutchNet password
+#' @inheritSection proof_status Timeout
 #' @return A single token (character) for bearer authentication with
 #' the PROOF API
 #' @examples
 #' # Sys.getenv("PROOF_TOKEN")
 #' # x <- proof_authenticate("username", "password")
 #' # Sys.getenv("PROOF_TOKEN")
 proof_authenticate <- function(username, password) {
-  response <- POST(make_url("authenticate"), body = list(
-    username = username,
-    password = password
-  ), encode = "json")
+  response <- POST(make_url("authenticate"),
+    body = list(
+      username = username,
+      password = password
+    ),
+    encode = "json",
+    timeout(proofr_env$timeout_sec)
+  )
   stop_for_status(response)
   parsed <- content(response, as = "parsed")
   token <- parsed$token

R/cancel.R

@@ -2,10 +2,15 @@
 #'
 #' @export
 #' @references <https://github.com/FredHutch/proof-api#delete-cromwell-server>
+#' @inheritSection proof_status Timeout
 #' @return A list with a single field:
 #' - `message` (character)
 proof_cancel <- function() {
-  response <- DELETE(make_url("cromwell-server"), proof_header())
+  response <- DELETE(
+    make_url("cromwell-server"),
+    proof_header(),
+    timeout(proofr_env$timeout_sec)
+  )
   # FIXME: better error handling - surface error messages
   stop_for_status(response)
   content(response, as = "parsed")

R/onLoad.R

@@ -0,0 +1,6 @@
+proofr_env <- new.env() # nocov start
+
+.onLoad <- function(libname, pkgname) {
+  # use the same timezone throughout the package
+  proofr_env$timeout_sec <<- 5
+} # nocov end

R/proofr-package.R

@@ -2,6 +2,7 @@
 "_PACKAGE"
 
 ## usethis namespace: start
-#' @importFrom httr GET POST DELETE add_headers content stop_for_status
+#' @importFrom httr GET POST DELETE add_headers content
+#' stop_for_status timeout
 ## usethis namespace: end
 NULL

R/start.R

@@ -7,6 +7,7 @@
 #' @details Does not return PROOF/Cromwell server URL, for that you have to
 #' periodically call [proof_status()], or wait for the email from the
 #' PROOF API
+#' @inheritSection proof_status Timeout
 #' @return A list with fields:
 #' - `job_id` (character)
 #' - `info` (character)
@@ -15,7 +16,8 @@ proof_start <- function(pi_name = NULL) {
     make_url("cromwell-server"),
     proof_header(),
     body = list(pi_name = pi_name),
-    encode = "json"
+    encode = "json",
+    timeout(proofr_env$timeout_sec)
   )
   # FIXME: better error handling - surface error messages
   stop_for_status(response)

R/status.R

@@ -2,6 +2,10 @@
 #'
 #' @export
 #' @references <https://github.com/FredHutch/proof-api#get-cromwell-server>
+#' @section Timeout:
+#' If the PROOF API is unavailable, this function will timeout after
+#' 5 seconds. Contact the package maintainer if you get a timeout error.
+#' See [proof_timeout()].
 #' @return A list with fields:
 #' - `canJobStart` (logical): can a job to make a Cromwell server be started?
 #' `FALSE` if server already running; `TRUE` if server not running
@@ -12,7 +16,11 @@
 #' - `jobInfo` (list): metadata on the Cromwell server. All slots `NULL`
 #' if server not running
 proof_status <- function() {
-  response <- GET(make_url("cromwell-server"), proof_header())
+  response <- GET(
+    make_url("cromwell-server"),
+    proof_header(),
+    timeout(proofr_env$timeout_sec)
+  )
   stop_for_status(response)
   content(response, as = "parsed")
 }

R/timeout.R

@@ -0,0 +1,11 @@
+#' Set the timeout for all requests to the PROOF API
+#'
+#' @export
+#' @param sec (integer/numeric) number of seconds after which
+#' requests will timeout. default: 5 sec (5000 ms)
+#' @references <https://httr.r-lib.org/reference/timeout.html>
+#' @return nothing, side effect of setting the timeout for requests
+proof_timeout <- function(sec = 5) {
+  assert(sec, c("integer", "numeric"))
+  proofr_env$timeout_sec <- sec
+}

R/utils.R

@@ -3,3 +3,12 @@ proof_base <- "https://proof-api.fredhutch.org"
 make_url <- function(...) {
   file.path(proof_base, ...)
 }
+
+assert <- function(x, y) {
+  if (!is.null(x)) {
+    if (!inherits(x, y)) {
+      stop(deparse(substitute(x)), " must be of class ",
+           paste0(y, collapse = ", "), call. = FALSE)
+    }
+  }
+}