Merge pull request #8 from ScotGovAnalysis/tidy-up

Rename some functions and rejig R/

NAMESPACE

@@ -6,10 +6,10 @@ export(create_folder)
 export(download_file)
 export(my_user_id)
 export(my_workspaces)
-export(new_document)
-export(new_document_version)
+export(new_version)
 export(objectiveR)
 export(objectiveR_auth)
 export(participant_bypass_2fa)
 export(participants)
+export(upload_file)
 export(workspace_assets)

R/download_file.R → R/download.R

@@ -1,4 +1,4 @@
-#' Download file
+#' Download a file
 #'
 #' @param document_uuid UUID of existing document
 #' @param folder Folder to save downloaded file to

R/objectiveR.R

@@ -95,6 +95,94 @@ objectiveR <- function(endpoint,
 }
 
 
+#' Authenticate HTTP request
+#'
+#' @description This sets the authorisation header of an HTTP request. If a
+#' token variable exists in global environment, this is used, otherwise,
+#' the user is prompted to enter an authenticating username and password.
+#'
+#' @param req An [httr2 request](https://httr2.r-lib.org/reference/request.html)
+#'
+#' @return A modified [httr2 request](https://httr2.r-lib.org/reference/request.html)
+#'
+#' @examples
+#' \dontrun{
+#' httr2::request("http://example.com") |>
+#'   objectiveR_auth()
+#' }
+#'
+#' token <- "test"
+#' httr2::request("http://example.com") |> objectiveR_auth()
+#'
+#' @export
+
+objectiveR_auth <- function(req) {
+
+  # Check request is correct type
+  if(!inherits(req, "httr2_request")) {
+    cli::cli_abort(c(
+      "x" = "{.var req} must be an HTTP2 request object"
+    ))
+  }
+
+  if(exists("token", where = parent.frame())) {
+
+    httr2::req_headers(
+      req,
+      Authorization = get("token", pos = parent.frame())
+    )
+
+  } else {
+
+    httr2::req_auth_basic(
+      req,
+      input_value("usr"),
+      input_value("pwd")
+    )
+
+  }
+
+}
+
+
+#' Store session token from API response
+#'
+#' @param response An httr2 response object; must contain an 'Authorization'
+#' header.
+#' @param store_env The environment to bind the token to.
+#'
+#' @return Returns the token invisibly. This function is primarily used
+#' for its side effect - an environment variable is created called "token".
+#'
+#' @noRd
+
+store_token <- function(response, store_env = globalenv()) {
+
+  # Check response is in expected format
+  if(!inherits(response, "httr2_response")) {
+    cli::cli_abort(c(
+      "x" = "{.var response} must be an HTTP response object"
+    ))
+  }
+
+  # Check Authorization header exists
+  if(!httr2::resp_header_exists(response, "Authorization")) {
+    cli::cli_abort(c(
+      "x" = "{.var response} must have Authorization header"
+    ))
+  }
+
+  token <- httr2::resp_header(response, "Authorization")
+
+  if(!exists("token", where = store_env)) {
+    rlang::env_poke(env = store_env, nm = "token", value = token)
+  }
+
+  return(invisible(token))
+
+}
+
+
 #' Translate error code into helpful message
 #'
 #' @param response An httr2 [httr2::response()][response]

R/upload_file.R → R/upload.R

@@ -1,4 +1,4 @@
-#' Create a new document
+#' Upload a file to create a new document
 #'
 #' @param file File path of document to upload
 #' @param name Name to give document. If this isn't provided, the name of the
@@ -12,12 +12,12 @@
 #'
 #' @export
 
-new_document <- function(file,
-                         workspace_uuid,
-                         name = NULL,
-                         description = NULL,
-                         parent_uuid = NULL,
-                         use_proxy = FALSE) {
+upload_file <- function(file,
+                        workspace_uuid,
+                        name = NULL,
+                        description = NULL,
+                        parent_uuid = NULL,
+                        use_proxy = FALSE) {
 
   # If name not provided, use file name
   name <- if(is.null(name)) {
@@ -49,17 +49,17 @@ new_document <- function(file,
 }
 
 
-#' Create a new document version
+#' Upload a file to create a new document version
 #'
 #' @param file File path of document to upload
 #' @param document_uuid UUID of existing document
 #' @inheritParams objectiveR
 #'
 #' @export
 
-new_document_version <- function(file,
-                                 document_uuid,
-                                 use_proxy = FALSE) {
+new_version <- function(file,
+                        document_uuid,
+                        use_proxy = FALSE) {
 
   response <- objectiveR(
     endpoint = "documents",
@@ -82,4 +82,3 @@ new_document_version <- function(file,
   invisible(response)
 
 }
-

R/utils.R

@@ -119,3 +119,28 @@ form_data_null <- function(value) {
   }
 
 }
+
+
+#' Generate random UUID
+#'
+#' @param seed Integer to set seed for random sampling. Default value is NULL.
+#'
+#' @return A single character value in the format of eight blocks of four
+#' letters/integers separated by dashes.
+#'
+#' @noRd
+
+random_uuid <- function(seed = NULL) {
+
+  options <- c(letters, 0:9)
+
+  # There should be equal probability of a letter or integer being sampled
+  prob_weights <- c(rep(1/26, 26), rep(1/10, 10))
+
+  set.seed(seed)
+
+  replicate(8, paste0(sample(options, 4, replace = TRUE, prob = prob_weights),
+                      collapse = "")) |>
+    paste0(collapse = "-")
+
+}

_pkgdown.yml

@@ -62,9 +62,9 @@ reference:
   - workspace_assets
   - asset_info
   - create_folder
-  - new_document
-  - new_document_version
   - download_file
+  - upload_file
+  - new_version
 
 - title: API authentication
   contents: