From f9f8b01ad6a25c11eab8b0bdfb45d808cb2ac50a Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Tue, 12 Mar 2024 11:55:00 -0500 Subject: [PATCH] Export the sub-functions. (#18) Closes #10. --- DESCRIPTION | 2 +- NAMESPACE | 3 ++ R/aaa_shared.R | 8 ++- R/call.R | 72 ++++--------------------- R/req.R | 55 +++++++++++++++++++ man/call_api.Rd | 3 +- man/dot-shared-parameters.Rd | 12 +++-- man/reexports.Rd | 16 ++++++ man/req_prepare.Rd | 53 +++++++++++++++++++ tests/testthat/_snaps/req_body.md | 5 +- tests/testthat/test-call.R | 87 ++++--------------------------- tests/testthat/test-req.R | 64 +++++++++++++++++++++++ tests/testthat/test-req_body.R | 18 ++----- tests/testthat/test-req_query.R | 20 ++----- 14 files changed, 239 insertions(+), 179 deletions(-) create mode 100644 R/req.R create mode 100644 man/reexports.Rd create mode 100644 man/req_prepare.Rd create mode 100644 tests/testthat/test-req.R diff --git a/DESCRIPTION b/DESCRIPTION index 3a320e6..7e6358a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,4 +28,4 @@ Remotes: Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/NAMESPACE b/NAMESPACE index cffc4e0..912ec19 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,7 +4,10 @@ S3method(.add_body,json) S3method(.add_body,multipart) export(call_api) export(compact_nested_list) +export(req_perform) +export(req_prepare) export(security_api_key) export(stabilize_string) importFrom(fs,path) +importFrom(httr2,req_perform) importFrom(rlang,":=") diff --git a/R/aaa_shared.R b/R/aaa_shared.R index 2ae9537..a811724 100644 --- a/R/aaa_shared.R +++ b/R/aaa_shared.R @@ -11,16 +11,20 @@ #' @param case The case standard to apply. The possible values are #' self-descriptive. Defaults to "snake_case". #' @param depth The current recursion depth. -#' @param path The route to an API endpoint. Optionally, a list with the path -#' plus variables to [glue::glue()] into the path. #' @param method If the method is something other than GET or POST, supply it. #' Case is ignored. #' @param mime_type A character scalar indicating the mime type of any files #' present in the body. Some APIs allow you to leave this as NULL for them to #' guess. +#' @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. #' @param req An [httr2::request()] object. +#' @param security_fn A function to use to authenticate the request. By default +#' (`NULL`), no authentication is performed. +#' @param security_args An optional list of arguments to the `security_fn` +#' function. #' @param user_agent A string to identify where this request is coming from. #' It's polite to set the user agent to identify your package, such as #' "MyPackage (https://mypackage.com)". diff --git a/R/call.R b/R/call.R index 082c11f..c06c607 100644 --- a/R/call.R +++ b/R/call.R @@ -2,13 +2,10 @@ #' #' This function implements an opinionated framework for making API calls. It is #' intended to be used inside an API client package. It serves as a wrapper -#' around the `req_` family of functions, such as [httr2::request()]. +#' around the `req_` family of functions, such as [httr2::request()], as well as +#' [httr2::req_perform()] and, by default, [httr2::resp_body_json()]. #' #' @inheritParams .shared-parameters -#' @param security_fn A function to use to authenticate the request. By default -#' (`NULL`), no authentication is performed. -#' @param security_args An optional list of arguments to the `security_fn` -#' function. #' @param response_parser A function to use to parse the server response. #' Defaults to [httr2::resp_body_json()], since JSON responses are common. Set #' this to `NULL` to return the raw response from [httr2::req_perform()]. @@ -28,72 +25,21 @@ call_api <- function(base_url, response_parser = httr2::resp_body_json, response_parser_args = list(), user_agent = "nectar (https://nectar.api2r.org)") { - req <- .req_prep( + req <- req_prepare( base_url = base_url, path = path, query = query, body = body, - method = method, mime_type = mime_type, - user_agent = user_agent, - security_fn = security_fn, - security_args = security_args + method = method, + user_agent = user_agent ) - resp <- .resp_get(req) + req <- .req_security_apply(req, security_fn, security_args) + resp <- req_perform(req) resp <- .resp_parse(resp, response_parser, response_parser_args) return(resp) } -.resp_get <- function(req) { - return(httr2::req_perform(req)) # nocov -} - -.req_prep <- function(base_url, - path, - query, - body, - method, - mime_type, - user_agent, - security_fn, - security_args) { - req <- httr2::request(base_url) - req <- .req_path_append(req, path) - req <- .req_query_flatten(req, query) - req <- .req_body_auto(req, body, mime_type) - req <- .req_method_apply(req, method) - req <- .req_user_agent_apply(req, user_agent) - req <- .req_security_apply(req, security_fn, security_args) - return(req) -} - -.req_path_append <- function(req, path) { - if (length(path)) { - path <- rlang::inject(glue::glue(!!!path)) - } - return(httr2::req_url_path_append(req, path)) -} - -.req_method_apply <- function(req, method) { - if (!length(method)) { - # I'm pretty sure this is a current httr2 or httptest2 bug. NULL methods - # fail during testing. - if (length(req$body)) { - method <- "POST" - } else { - method <- "GET" - } - } - return(httr2::req_method(req, method)) -} - -.req_user_agent_apply <- function(req, user_agent) { - if (length(user_agent)) { - req <- httr2::req_user_agent(req, user_agent) - } - return(req) -} - .req_security_apply <- function(req, security_fn, security_args) { if (length(security_fn)) { req <- rlang::inject( @@ -103,6 +49,10 @@ call_api <- function(base_url, return(req) } +#' @export +#' @importFrom httr2 req_perform +httr2::req_perform + .resp_parse <- function(resp, response_parser, response_parser_args) { if (length(response_parser)) { resp <- .resp_parse_apply( diff --git a/R/req.R b/R/req.R new file mode 100644 index 0000000..dc08f2c --- /dev/null +++ b/R/req.R @@ -0,0 +1,55 @@ +#' Prepare a request for an API +#' +#' This function implements an opinionated framework for preparing an API +#' request. It is intended to be used inside an API client package. It serves as +#' a wrapper around the `req_` family of functions, such as [httr2::request()]. +#' +#' @inheritParams .shared-parameters +#' @inheritParams rlang::args_dots_empty +#' +#' @return A [httr2::request()] object. +#' @export +req_prepare <- function(base_url, + ..., + path = NULL, + query = NULL, + body = NULL, + mime_type = NULL, + method = NULL, + user_agent = "nectar (https://nectar.api2r.org)") { + rlang::check_dots_empty() + req <- httr2::request(base_url) + req <- .req_path_append(req, path) + req <- .req_query_flatten(req, query) + req <- .req_body_auto(req, body, mime_type) + req <- .req_method_apply(req, method) + req <- .req_user_agent_apply(req, user_agent) + return(req) +} + +.req_path_append <- function(req, path) { + if (length(path)) { + path <- rlang::inject(glue::glue(!!!path)) + } + return(httr2::req_url_path_append(req, path)) +} + +.req_method_apply <- function(req, method) { + if (!length(method)) { + # I'm pretty sure this is a current httr2 or httptest2 bug. NULL methods + # fail during testing. + if (length(req$body)) { + method <- "POST" + } else { + method <- "GET" + } + } + return(httr2::req_method(req, method)) +} + +.req_user_agent_apply <- function(req, user_agent) { + if (length(user_agent)) { + req <- httr2::req_user_agent(req, user_agent) + } + return(req) +} diff --git a/man/call_api.Rd b/man/call_api.Rd index db6c677..d75bb68 100644 --- a/man/call_api.Rd +++ b/man/call_api.Rd @@ -63,5 +63,6 @@ The response from the API, parsed by the \code{response_parser}. \description{ This function implements an opinionated framework for making API calls. It is intended to be used inside an API client package. It serves as a wrapper -around the \code{req_} family of functions, such as \code{\link[httr2:request]{httr2::request()}}. +around the \code{req_} family of functions, such as \code{\link[httr2:request]{httr2::request()}}, as well as +\code{\link[httr2:req_perform]{httr2::req_perform()}} and, by default, \code{\link[httr2:resp_body_raw]{httr2::resp_body_json()}}. } diff --git a/man/dot-shared-parameters.Rd b/man/dot-shared-parameters.Rd index de63ffc..a4faaaf 100644 --- a/man/dot-shared-parameters.Rd +++ b/man/dot-shared-parameters.Rd @@ -17,9 +17,6 @@ self-descriptive. Defaults to "snake_case".} \item{depth}{The current recursion depth.} -\item{path}{The route to an API endpoint. Optionally, a list with the path -plus variables to \code{\link[glue:glue]{glue::glue()}} into the path.} - \item{method}{If the method is something other than GET or POST, supply it. Case is ignored.} @@ -27,11 +24,20 @@ Case is ignored.} present in the body. Some APIs allow you to leave this as NULL for them to guess.} +\item{path}{The route to an API endpoint. Optionally, a list with the path +plus variables to \code{\link[glue:glue]{glue::glue()}} into the path.} + \item{query}{An optional list of parameters to pass in the query portion of the request.} \item{req}{An \code{\link[httr2:request]{httr2::request()}} object.} +\item{security_fn}{A function to use to authenticate the request. By default +(\code{NULL}), no authentication is performed.} + +\item{security_args}{An optional list of arguments to the \code{security_fn} +function.} + \item{user_agent}{A string to identify where this request is coming from. It's polite to set the user agent to identify your package, such as "MyPackage (https://mypackage.com)".} diff --git a/man/reexports.Rd b/man/reexports.Rd new file mode 100644 index 0000000..993948a --- /dev/null +++ b/man/reexports.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/call.R +\docType{import} +\name{reexports} +\alias{reexports} +\alias{req_perform} +\title{Objects exported from other packages} +\keyword{internal} +\description{ +These objects are imported from other packages. Follow the links +below to see their documentation. + +\describe{ + \item{httr2}{\code{\link[httr2]{req_perform}}} +}} + diff --git a/man/req_prepare.Rd b/man/req_prepare.Rd new file mode 100644 index 0000000..6c2358c --- /dev/null +++ b/man/req_prepare.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/req.R +\name{req_prepare} +\alias{req_prepare} +\title{Prepare a request for an API} +\usage{ +req_prepare( + base_url, + ..., + path = NULL, + query = NULL, + body = NULL, + mime_type = NULL, + method = NULL, + user_agent = "nectar (https://nectar.api2r.org)" +) +} +\arguments{ +\item{base_url}{The part of the url that is shared by all calls to the API. +In some cases there may be a family of base URLs, from which you will need +to choose one.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{path}{The route to an API endpoint. Optionally, a list with the path +plus variables to \code{\link[glue:glue]{glue::glue()}} into the path.} + +\item{query}{An optional list of parameters to pass in the query portion of +the request.} + +\item{body}{An object to use as the body of the request. If any component of +the body is a path, pass it through \code{\link[fs:path]{fs::path()}} or otherwise give it the +class "fs_path" to indicate that it is a path.} + +\item{mime_type}{A character scalar indicating the mime type of any files +present in the body. Some APIs allow you to leave this as NULL for them to +guess.} + +\item{method}{If the method is something other than GET or POST, supply it. +Case is ignored.} + +\item{user_agent}{A string to identify where this request is coming from. +It's polite to set the user agent to identify your package, such as +"MyPackage (https://mypackage.com)".} +} +\value{ +A \code{\link[httr2:request]{httr2::request()}} object. +} +\description{ +This function implements an opinionated framework for preparing an API +request. It is intended to be used inside an API client package. It serves as +a wrapper around the \code{req_} family of functions, such as \code{\link[httr2:request]{httr2::request()}}. +} diff --git a/tests/testthat/_snaps/req_body.md b/tests/testthat/_snaps/req_body.md index 5d56b28..eac192b 100644 --- a/tests/testthat/_snaps/req_body.md +++ b/tests/testthat/_snaps/req_body.md @@ -1,9 +1,8 @@ # bodies with paths are handled properly Code - test_result <- call_api(base_url = "https://example.com", body = list(foo = "bar", - baz = fs::path(test_path("img-test.png"))), response_parser = NULL, - user_agent = NULL) + test_result <- req_prepare(base_url = "https://example.com", body = list(foo = "bar", + baz = fs::path(test_path("img-test.png"))), user_agent = NULL) test_result$body Output $data diff --git a/tests/testthat/test-call.R b/tests/testthat/test-call.R index e76ab7c..1b1a021 100644 --- a/tests/testthat/test-call.R +++ b/tests/testthat/test-call.R @@ -1,6 +1,6 @@ test_that("call_api() calls an API", { local_mocked_bindings( - .resp_get = function(req) { + req_perform = function(req) { structure(req, class = c("performed", class(req))) } ) @@ -17,41 +17,30 @@ test_that("call_api() calls an API", { ) }) -test_that("call_api() deals with paths.", { +test_that("call_api() applies security", { local_mocked_bindings( - .resp_get = function(req) { + req_perform = function(req) { structure(req, class = c("performed", class(req))) } ) test_result <- call_api( base_url = "https://example.com", - path = "foo/bar", - response_parser = NULL, - user_agent = NULL - ) - expect_identical( - test_result$url, - "https://example.com/foo/bar" - ) - - test_result <- call_api( - base_url = "https://example.com", - path = list( - "foo/{bar}", - bar = "baz" + user_agent = NULL, + security_fn = httr2::req_url_query, + security_args = list( + security = "set" ), - response_parser = NULL, - user_agent = NULL + response_parser = NULL ) expect_identical( test_result$url, - "https://example.com/foo/baz" + "https://example.com/?security=set" ) }) test_that("call_api() uses response_parser", { local_mocked_bindings( - .resp_get = function(req) { + req_perform = function(req) { structure(req, class = c("performed", class(req))) }, .resp_parse_apply = function(resp, response_parser, response_parser_args) { @@ -76,59 +65,3 @@ test_that("call_api() uses response_parser", { test_result }) }) - -test_that("call_api() applies methods", { - local_mocked_bindings( - .resp_get = function(req) { - structure(req, class = c("performed", class(req))) - } - ) - test_result <- call_api( - base_url = "https://example.com", - method = "PATCH", - response_parser = NULL, - user_agent = NULL - ) - expect_identical( - test_result$method, - "PATCH" - ) -}) - -test_that("call_api() applies user_agent", { - local_mocked_bindings( - .resp_get = function(req) { - structure(req, class = c("performed", class(req))) - } - ) - test_result <- call_api( - base_url = "https://example.com", - response_parser = NULL, - user_agent = "foo" - ) - expect_identical( - test_result$options$useragent, - "foo" - ) -}) - -test_that("call_api() applies security", { - local_mocked_bindings( - .resp_get = function(req) { - structure(req, class = c("performed", class(req))) - } - ) - test_result <- call_api( - base_url = "https://example.com", - response_parser = NULL, - user_agent = NULL, - security_fn = httr2::req_url_query, - security_args = list( - security = "set" - ) - ) - expect_identical( - test_result$url, - "https://example.com/?security=set" - ) -}) diff --git a/tests/testthat/test-req.R b/tests/testthat/test-req.R new file mode 100644 index 0000000..5019dff --- /dev/null +++ b/tests/testthat/test-req.R @@ -0,0 +1,64 @@ +test_that("req_prepare() deals with paths.", { + test_result <- req_prepare( + base_url = "https://example.com", + path = "foo/bar", + user_agent = NULL + ) + expect_identical( + test_result$url, + "https://example.com/foo/bar" + ) + + test_result <- req_prepare( + base_url = "https://example.com", + path = list( + "foo/{bar}", + bar = "baz" + ), + user_agent = NULL + ) + expect_identical( + test_result$url, + "https://example.com/foo/baz" + ) +}) + +test_that("req_prepare() applies methods", { + test_result <- req_prepare( + base_url = "https://example.com", + method = "PATCH", + user_agent = NULL + ) + expect_identical( + test_result$method, + "PATCH" + ) + test_result <- req_prepare( + base_url = "https://example.com", + user_agent = NULL + ) + expect_identical( + test_result$method, + "GET" + ) + test_result <- req_prepare( + base_url = "https://example.com", + body = list(a = 1), + user_agent = NULL + ) + expect_identical( + test_result$method, + "POST" + ) +}) + +test_that("req_prepare() applies user_agent", { + test_result <- req_prepare( + base_url = "https://example.com", + user_agent = "foo" + ) + expect_identical( + test_result$options$useragent, + "foo" + ) +}) diff --git a/tests/testthat/test-req_body.R b/tests/testthat/test-req_body.R index 9af3a8b..8fafacd 100644 --- a/tests/testthat/test-req_body.R +++ b/tests/testthat/test-req_body.R @@ -1,16 +1,10 @@ -test_that("call_api() uses body parameters", { - local_mocked_bindings( - .resp_get = function(req) { - structure(req, class = c("performed", class(req))) - } - ) - test_result <- call_api( +test_that("req_prepare() uses body parameters", { + test_result <- req_prepare( base_url = "https://example.com", body = list( foo = "bar", baz = "qux" ), - response_parser = NULL, user_agent = NULL ) expect_identical( @@ -20,19 +14,13 @@ test_that("call_api() uses body parameters", { }) test_that("bodies with paths are handled properly", { - local_mocked_bindings( - .resp_get = function(req) { - structure(req, class = c("performed", class(req))) - } - ) expect_snapshot({ - test_result <- call_api( + test_result <- req_prepare( base_url = "https://example.com", body = list( foo = "bar", baz = fs::path(test_path("img-test.png")) ), - response_parser = NULL, user_agent = NULL ) test_result$body diff --git a/tests/testthat/test-req_query.R b/tests/testthat/test-req_query.R index ccac83a..69d8caa 100644 --- a/tests/testthat/test-req_query.R +++ b/tests/testthat/test-req_query.R @@ -1,16 +1,10 @@ -test_that("call_api() uses query parameters", { - local_mocked_bindings( - .resp_get = function(req) { - structure(req, class = c("performed", class(req))) - } - ) - test_result <- call_api( +test_that("req_prepare() uses query parameters", { + test_result <- req_prepare( base_url = "https://example.com", query = list( foo = "bar", baz = "qux" ), - response_parser = NULL, user_agent = NULL ) expect_identical( @@ -19,19 +13,13 @@ test_that("call_api() uses query parameters", { ) }) -test_that("call_api() smushes and concatenates multi-value query parameters", { - local_mocked_bindings( - .resp_get = function(req) { - structure(req, class = c("performed", class(req))) - } - ) - test_result <- call_api( +test_that("req_prepare() smushes and concatenates multi-value query parameters", { + test_result <- req_prepare( base_url = "https://example.com", query = list( foo = "bar", baz = c("qux", "quux") ), - response_parser = NULL, user_agent = NULL ) expect_identical(