Opencpu client dev

DESCRIPTION

@@ -25,6 +25,7 @@ Imports:
     DBI,
     dplyr,
     glue,
+    httr,
     jsonlite,
     lubridate,
     methods,

NAMESPACE

@@ -17,6 +17,7 @@ export(get_tags)
 export(list_acoustic_project_codes)
 export(list_acoustic_tag_ids)
 export(list_animal_ids)
+export(list_animal_ids_api)
 export(list_animal_project_codes)
 export(list_cpod_project_codes)
 export(list_deployment_ids)

R/list_animal_ids_api.R

@@ -0,0 +1,27 @@
+#' List all available animal ids
+#'
+#' @param credentials Login credentials to the ETN database, as created by
+#'   `get_credentials()`
+#'
+#' @return A vector of all unique `id_pk` present in `common.animal_release`.
+#'
+#' @export
+list_animal_ids_api <- function(credentials = get_credentials()) {
+  api_domain <- "https://opencpu.lifewatch.be"
+  function_path <- "library/etn/R/list_animal_ids"
+
+  # POST the function request to the api_domain, request json as direct return
+  response <-
+    httr::POST(stringr::str_glue(api_domain, function_path, "json", .sep = "/"),
+      body = list(
+        con = credentials
+      )
+    )
+  # If request was not succesful, generate a warning
+  httr::warn_for_status(response, "submit request to API server")
+
+  # Parse server response JSON to a vector
+  response %>%
+    httr::content(as = "text", encoding = "UTF-8") %>%
+    jsonlite::fromJSON(simplifyVector = TRUE)
+}

R/utils.R

@@ -86,3 +86,83 @@ check_date_time <- function(date_time, date_name = "start_date") {
   )
   as.character(parsed)
 }
+
+#' Get the credentials from environment variables, or set them manually
+#'
+#' By default, it's not necessary to set any values in this function as it's
+#' used in the background by other functions. However, if you wish to provide
+#' your username and password on a per function basis, this function allows you
+#' to do so.
+#'
+#' @param username ETN Data username, by default read from the environment, but
+#'   you can set it manually too.
+#' @param password ETN Data password, by default read from the environment, but
+#'   you can set it manually too.
+#'
+#' @return A string as it is ingested by other functions that need
+#'   authentication
+#' @family helper functions
+#' @noRd
+
+get_credentials <-
+  function(username = Sys.getenv("userid"),
+           password = Sys.getenv("pwd")) {
+    stringr::str_glue('list(username = "{username}", password = "{password}")')
+  }
+
+#' Extract the OCPU temp key from a response object
+#'
+#' When posting a request to the opencpu api service without the json flag, a
+#' response object is returned containing all the generated objects, with a
+#' unique temp key in the path. To retrieve these objects in a subsequent GET
+#' request, it is convenient to retrieve this temp key from the original
+#' response object
+#'
+#' @param response The response resulting from a POST request to a opencpu api
+#'   service
+#'
+#' @return the OCPU temp key to be used as part of a GET request to an opencpu
+#'   api service
+#' @family helper functions
+#' @noRd
+extract_temp_key <- function(response) {
+  response %>%
+    httr::content(as = "text") %>%
+    stringr::str_extract("(?<=tmp\\/).{15}(?=\\/)")
+}
+
+#' Retrieve the result of a function called to the opencpu api
+#'
+#' Loading the evaluated object into the current environment, to be used
+#' internally in functions calling the opencpu api service to convert a response
+#' object included in the response from a post request, to the corresponding
+#' objects resulting from the original call.
+#'
+#' @param temp_key the temp key returned from the POST request to the API
+#'
+#' @return the uncompressed object resulting form a GET request to the API
+#' @family helper functions
+#' @noRd
+#' @examples
+#' \dontrun{
+#' etn:::extract_temp_key(response) %>% get_val()
+#' }
+#'
+#' # using the opencpu test instance
+#' api_url <- "https://cloud.opencpu.org/ocpu/library/stats/R/rnorm"
+#' httr::POST(api_url, body = list(n = 10, mean = 5)) %>%
+#'   extract_temp_key() %>%
+#'   get_val(api_domain = "https://cloud.opencpu.org/ocpu")
+get_val <- function(temp_key, api_domain = "https://opencpu.lifewatch.be") {
+  httr::GET(
+    stringr::str_glue(
+      "{api_domain}",
+      "tmp/{temp_key}/R/.val/rds",
+      .sep = "/"
+    )
+  ) %>%
+    httr::content(as = "raw") %>%
+    rawConnection() %>%
+    gzcon() %>%
+    readRDS()
+}

tests/testthat/test-list_animal_ids_api.R

@@ -0,0 +1,17 @@
+test_that("list_animal_ids_api() returns unique list of values", {
+  result <- list_animal_ids_api()
+
+  # tests based on test-list_animal_project_codes.R
+  expect_is(result, "integer")
+  expect_false(any(duplicated(result)))
+  expect_true(all(!is.na(result)))
+})
+
+test_that("list_animal_ids_api() returns at least 5 known values", {
+  result <- list_animal_ids_api()
+
+  # a set of 5 known id_pk present in common.animal_release
+  known_ids <- c("56314", "8504", "7601", "4293", "58407")
+
+  testthat::expect_true(all(known_ids %in% result))
+})