Establish and apply formal principles (#28)

.Rbuildignore

@@ -8,3 +8,4 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^principles\.md$

NAMESPACE

@@ -7,13 +7,13 @@ S3method(resp_parse,httr2_response)
 S3method(resp_parse,list)
 export(call_api)
 export(compact_nested_list)
-export(do_if_defined)
+export(do_if_fn_defined)
+export(req_auth_api_key)
 export(req_modify)
 export(req_perform_opinionated)
 export(req_prepare)
 export(req_setup)
 export(resp_parse)
-export(security_api_key)
 export(stabilize_string)
 export(url_normalize)
 export(url_path_append)

R/security_api_key.R → R/auth.R

@@ -15,13 +15,13 @@
 #'
 #' @inherit .shared-request return
 #' @export
-security_api_key <- function(req,
+req_auth_api_key <- function(req,
                              ...,
                              location = "header") {
   switch(location,
-    header = .security_api_key_header(req, ...),
-    query = .security_api_key_query(req, ...),
-    cookie = .security_api_key_cookie(req, ...) # nocov
+    header = .req_auth_api_key_header(req, ...),
+    query = .req_auth_api_key_query(req, ...),
+    cookie = .req_auth_api_key_cookie(req, ...) # nocov
   )
 }
 
@@ -33,7 +33,7 @@ security_api_key <- function(req,
 #'
 #' @inherit .shared-request return
 #' @keywords internal
-.security_api_key_header <- function(req, ..., parameter_name, api_key) {
+.req_auth_api_key_header <- function(req, ..., parameter_name, api_key = NULL) {
   rlang::check_dots_empty()
   if (length(api_key) && nchar(api_key)) {
     req <- httr2::req_headers(
@@ -45,7 +45,15 @@ security_api_key <- function(req,
   return(req)
 }
 
-.security_api_key_query <- function(req, ..., parameter_name, api_key) {
+#' Authenticate with an API key in the query of the request
+#'
+#' @inheritParams .shared-parameters
+#' @param parameter_name The name to use for the API key.
+#' @param api_key The API key to use.
+#'
+#' @inherit .shared-request return
+#' @keywords internal
+.req_auth_api_key_query <- function(req, ..., parameter_name, api_key) {
   rlang::check_dots_empty()
   if (length(api_key) && nchar(api_key)) {
     req <- httr2::req_url_query(req, !!parameter_name := api_key)
@@ -56,13 +64,14 @@ security_api_key <- function(req,
 #' Authenticate with an API key in a cookie
 #'
 #' @inheritParams .shared-parameters
-#' @param path The path to the cookie.
+#' @param file_path The path to the cookie.
 #'
 #' @inherit .shared-request return
 #' @keywords internal
-.security_api_key_cookie <- function(req, ..., path) { # nocov start
-  if (length(path) && nchar(path)) {
-    req <- httr2::req_cookie_preserve(req, path)
+.req_auth_api_key_cookie <- function(req, ..., file_path) { # nocov start
+  rlang::check_dots_empty()
+  if (length(file_path) && nchar(file_path)) {
+    req <- httr2::req_cookie_preserve(req, file_path)
   }
   return(req)
 } # nocov end

R/call.R

@@ -7,7 +7,7 @@
 #' [httr2::resp_body_json()].
 #'
 #' @seealso [req_setup()], [req_modify()], [req_perform_opinionated()],
-#'   [resp_parse()], and [do_if_defined()] for finer control of the process.
+#'   [resp_parse()], and [do_if_fn_defined()] for finer control of the process.
 #'
 #' @inheritParams rlang::args_dots_empty
 #' @inheritParams req_setup
@@ -48,7 +48,7 @@ call_api <- function(base_url,
     mime_type = mime_type,
     method = method
   )
-  req <- do_if_defined(req, security_fn, !!!security_args)
+  req <- do_if_fn_defined(req, security_fn, !!!security_args)
   resp <- req_perform_opinionated(
     req,
     next_req = next_req,

R/req.R

@@ -35,14 +35,10 @@ req_setup <- function(base_url,
 #' path-specific properties.
 #'
 #' @inheritParams rlang::args_dots_empty
+#' @inheritParams .req_path_append
 #' @inheritParams .req_body_auto
-#' @inheritParams .shared-parameters
-#' @param method If the method is something other than GET or POST, supply it.
-#'   Case is ignored.
-#' @param path The route to an API endpoint. Optionally, a list with the path
-#'   plus variables to [glue::glue()] into the path.
-#' @param query An optional list of parameters to pass in the query portion of
-#'   the request.
+#' @inheritParams .req_method_apply
+#' @inheritParams .req_query_flatten
 #'
 #' @inherit .shared-request return
 #' @export
@@ -103,18 +99,3 @@ req_prepare <- function(base_url,
   )
   return(req)
 }
-
-.req_path_append <- function(req, path) {
-  if (length(path)) {
-    path <- rlang::inject(glue::glue(!!!path))
-    req <- httr2::req_url_path_append(req, path)
-  }
-  return(req)
-}
-
-.req_method_apply <- function(req, method) {
-  if (length(method)) {
-    return(httr2::req_method(req, method))
-  }
-  return(req)
-}

R/req_body.R

@@ -47,10 +47,7 @@
                            body,
                            mime_type = NULL) {
   body <- .prepare_body(body, mime_type)
-  if (length(body)) {
-    req <- .add_body(req, body)
-  }
-  return(req)
+  .do_if_args_defined(req, .add_body, body = body)
 }
 
 .add_body <- function(req, body) {

R/req_method.R

@@ -0,0 +1,14 @@
+#' Add a method if it is supplied
+#'
+#' [httr2::req_method()] errors if `method` is `NULL`, rather than using the
+#' default rules. This function deals with that.
+#'
+#' @inheritParams .shared-parameters
+#' @param method If the method is something other than GET or POST, supply it.
+#'   Case is ignored.
+#'
+#' @inherit .shared-request return
+#' @keywords internal
+.req_method_apply <- function(req, method) {
+  .do_if_args_defined(req, httr2::req_method, method = method)
+}

R/req_path.R

@@ -0,0 +1,19 @@
+#' Process a path with glue syntax and append it
+#'
+#' @inheritParams .shared-parameters
+#' @param path The route to an API endpoint. Optionally, a list or character
+#'   vector with the path as one or more unnamed arguments (which will be
+#'   concatenated with "/") plus named arguments to [glue::glue()] into the
+#'   path.
+#'
+#' @inherit .shared-request return
+#' @keywords internal
+.req_path_append <- function(req, path) {
+  .do_if_args_defined(req, .req_path_append_impl, path = path)
+}
+
+.req_path_append_impl <- function(req, path) {
+  path <- rlang::inject(glue::glue(!!!path, .sep = "/"))
+  path <- url_normalize(path)
+  req <- httr2::req_url_path_append(req, path)
+}

R/req_query.R

@@ -1,9 +1,15 @@
-.req_query_flatten <- function(req, query) {
+#' Add non-empty query elements to a request
+#'
+#' @inheritParams .shared-parameters
+#' @param query An optional list or character vector of parameters to pass in
+#'   the query portion of the request. Can also include a `.multi` argument to
+#'   pass to [httr2::req_url_query()] to control how elements containing
+#'   multiple values are handled.
+#'
+#' @inherit .shared-request return
+#' @keywords internal
+.req_query_flatten <- function(req,
+                               query) {
   query <- purrr::discard(query, is.null)
-  query <- purrr::map_chr(query, .prepare_query_element)
-  return(httr2::req_url_query(req, !!!query))
-}
-
-.prepare_query_element <- function(query_element) {
-  return(paste(unlist(query_element), collapse = ","))
+  rlang::inject(httr2::req_url_query(req, !!!query))
 }

R/resp.R

@@ -51,7 +51,7 @@ resp_parse.default <- function(resp,
 resp_parse.httr2_response <- function(resp,
                                       ...,
                                       response_parser = httr2::resp_body_json) {
-  do_if_defined(resp, response_parser, ...)
+  do_if_fn_defined(resp, response_parser, ...)
 }
 
 #' @export

R/utils.R

@@ -1,3 +1,5 @@
+# compact_nested_list ----------------------------------------------------------
+
 #' Discard empty elements
 #'
 #' Discard empty elements in nested lists.
@@ -35,6 +37,8 @@ compact_nested_list <- function(lst) {
   return(purrr::compact(lst))
 }
 
+# urls -------------------------------------------------------------------------
+
 #' Add path elements to a URL
 #'
 #' Append zero or more path elements to a URL without duplicating "/"
@@ -86,6 +90,8 @@ url_normalize <- function(url) {
   return(sub("/$", "", path))
 }
 
+# Do if ------------------------------------------------------------------------
+
 #' Use a provided function
 #'
 #' When constructing API calls programmatically, you may encounter situations
@@ -106,7 +112,7 @@ url_normalize <- function(url) {
 #' build_api_req <- function(endpoint, security_fn = NULL, ...) {
 #'   req <- httr2::request("https://example.com")
 #'   req <- httr2::req_url_path_append(req, endpoint)
-#'   do_if_defined(req, security_fn, ...)
+#'   do_if_fn_defined(req, security_fn, ...)
 #' }
 #'
 #' # Most endpoints of this API do not require authentication.
@@ -118,11 +124,32 @@ url_normalize <- function(url) {
 #'   "secure_endpoint", httr2::req_auth_bearer_token, "secret-token"
 #' )
 #' secure_req$headers$Authorization
-do_if_defined <- function(x, fn = NULL, ...) {
+do_if_fn_defined <- function(x, fn = NULL, ...) {
   if (is.function(fn)) {
     # Higher-level calls can include !!!'ed arguments.
     dots <- rlang::list2(...)
     x <- rlang::inject(fn(x, !!!dots))
   }
   return(x)
 }
+
+#' Use a function if args are provided
+#'
+#' @param x An object to potentially modify, such as a [httr2::request()]
+#'   object.
+#' @param fn A function to apply to `x`. If `fn` is `NULL`, `x` is returned
+#'   unchanged.
+#' @param ... Additional arguments to pass to `fn`.
+#'
+#' @return The object, potentially modified.
+#' @keywords internal
+.do_if_args_defined <- function(x, fn = NULL, ...) {
+  if (is.function(fn)) {
+    dots <- rlang::list2(...)
+    dots <- purrr::discard(dots, is.null)
+    if (length(dots)) {
+      x <- rlang::inject(fn(x, !!!dots))
+    }
+  }
+  return(x)
+}