From 4989fd6dab94951efbd23b7ac4fc913ed6985dd8 Mon Sep 17 00:00:00 2001 From: Adam Sadowski Date: Mon, 30 Oct 2023 17:50:32 -0400 Subject: [PATCH] WIP --- R/parse.R | 25 ++++++++++++++++--- R/perform.R | 12 ++++----- R/request.R | 49 ++++++++++++++++++++++++++++++------- man/mm_error_body.Rd | 10 +++++++- man/mm_get.Rd | 26 ++++++++++++++++++++ man/mm_req_perform.Rd | 4 +++ man/mm_request.Rd | 4 +-- tests/testthat/test-creds.R | 25 ++++++++++--------- tests/testthat/test-parse.R | 4 +-- 9 files changed, 124 insertions(+), 35 deletions(-) diff --git a/R/parse.R b/R/parse.R index 6950006..a0ed3e6 100644 --- a/R/parse.R +++ b/R/parse.R @@ -1,8 +1,7 @@ -#' Extract and parse body from Megamation API response +#' Extract data from Megamation API response #' -#' `mm_resp_parse()` extracts the raw bytes from an API response and parses -#' it, returning an R list object. After converting bytes to characters, encoding is done to resolve -#' a UTF-8 issue from Megamation's side. +#' `mm_resp_extract()` parses the raw bytes from an API response, +#' and extracts data from the parsed object. #' #' @param resp An API response. #' @description The body of the response contains raw bytes. @@ -10,6 +9,24 @@ #' a UTF-8 issue from Megamation's side. #' @returns A list. #' @export +mm_resp_extract <- function(resp) { + .from <- sub(".*/@", "", resp$url) |> tolower() + + resp |> + mm_resp_parse() |> + parsed_extract(.from) +} + +#' Parse body from Megamation API response +#' +#' `mm_resp_parse()` parses the raw bytes from an API response, +#' returning an R list object. After converting bytes to characters, +#' encoding is done to resolve +#' a UTF-8 issue from Megamation's side. +#' +#' @param resp An API response. +#' @returns A list. +#' @export mm_resp_parse <- function(resp) { resp |> httr2::resp_body_raw() |> diff --git a/R/perform.R b/R/perform.R index 8f0b2d5..1f4e36e 100644 --- a/R/perform.R +++ b/R/perform.R @@ -43,12 +43,15 @@ mm_get <- function(endpoint, ..., opts = req_opts()) { req <- mm_request(endpoint, ..., opts = opts) + req <- if (!opts$.paginate) { + req + } else mm_req_paginate(req) + resp <- mm_req_perform(req) - tbl_result <- if (!is_paginated(req)) { + tbl_result <- if (!opts$.paginate) { resp[[1]] |> - mm_resp_parse() |> - parsed_extract(.get) |> + mm_resp_extract() |> tibble::as_tibble() } else { resp |> @@ -61,11 +64,8 @@ mm_get <- function(endpoint, ..., opts = req_opts()) { } remove_api_urls(tbl_result) - } - - #' Perform a Megamation API request #' #' @description diff --git a/R/request.R b/R/request.R index c4bbef7..cad2afe 100644 --- a/R/request.R +++ b/R/request.R @@ -1,3 +1,40 @@ +#' Create a Megamation API request +#' +#' @description +#' `mm_req()` creates a request using [httr2::request()] and +#' does the following: +#' +#' * Inserts the base URL using the environment variable `MEGAMATION_URL` from +#' your `.Renviron`. Your key and base URL can be set using [mm_set_creds()]. +#' * Appends the URL with the endpoint defined by parameter `endpoint`. +#' * Sets the user-agent as the GitHub `megamation` package. +#' * Authenticates the request with HTTP basic authentication using +#' environment variables `MEGAMATION_KEY` and `MEGAMATION_URL` +#' from your `.Renviron`. +#' * Handles HTTP errors so useful information from the response is extracted +#' (e.g. "No response body"). +#' * Adds caching of responses if available. See [httr2::req_cache()]. +#' +#' @param endpoint The API endpoint. For example, +#' `"timecard"` for employee transactions, and `"workorder"` +#' for work orders. All endpoints are listed at +#' https://apidocs.megamation.com/. +#' @returns An object of class `httr2_request`. +#' @export +mm_req <- function(endpoint, opts = req_opts()) { + if (!inherits(opts, "megamation_req_opts")) { + cli::cli_abort("{.arg opts} must be created by {.fun req_opts}.") + } + + req <- req |> + httr2::req_user_agent( + "megamation (https://github.com/asadow/megamation)" + ) |> + httr2::req_auth_basic("APIDL", opts$.key) |> + httr2::req_error(body = mm_error_body) |> + httr2::req_cache(tempdir(), debug = TRUE) +} + #' Create a Megamation API request #' #' @description @@ -15,16 +52,16 @@ #' from your `.Renviron`. #' * Handles HTTP errors so useful information from the response is extracted #' (e.g. "No response body"). -#' * Automatic caching of responses. See [httr2::req_cache()]. +#' * Adds caching of responses if available. See [httr2::req_cache()]. #' -#' After creating a request with `mm_request()`, you can +#' If you create a GET request with `mm_request()`, you can then #' #' * Paginate the request using [mm_req_paginate()]. #' * Perform the request and fetch the response using [httr2::req_perform()] or #' [httr2::req_perform_iteratively()] if the request is paginated. #' #' Alternatively, -#' [mm_get()] can at once define, paginate, and perform a request. +#' [mm_get()] can at once define, paginate, and perform a GET request. #' #' @param endpoint The API endpoint. For example, #' `"timecard"` for employee transactions, and `"workorder"` @@ -71,12 +108,6 @@ mm_request <- function(endpoint, ..., allfields = TRUE, opts = req_opts()) { httr2::req_error(body = mm_error_body) |> httr2::req_cache(tempdir(), debug = TRUE) - cannot_be_paginated <- opts$.get != "data" - if (cannot_be_paginated || !opts$.paginate) { - return(req) - } - - mm_req_paginate(req) } diff --git a/man/mm_error_body.Rd b/man/mm_error_body.Rd index e9ae274..d21ef3f 100644 --- a/man/mm_error_body.Rd +++ b/man/mm_error_body.Rd @@ -13,5 +13,13 @@ mm_error_body(resp) A string from indexing the parsed response's \code{detail} list name. } \description{ -Extract error body from a Megamation API response +\code{mm_error_body()} simply plucks the \code{detail} list from the response body, +where Megamation's API includes informative error messages. +} +\examples{ +fake_mm_resp <- httr2::response_json( + body = list( + detail = "This is a fake detail/message from the API's response.") + ) +mm_error_body(resp) } diff --git a/man/mm_get.Rd b/man/mm_get.Rd index a2a9032..2f07c2f 100644 --- a/man/mm_get.Rd +++ b/man/mm_get.Rd @@ -32,3 +32,29 @@ containing the requested information. Where applicable, pagination is automatically applied to the request by \code{\link[=mm_req_paginate]{mm_req_paginate()}} and returned pages are automatically combined. } +\examples{ +\dontshow{if (httr2::secret_has_key("HTTR2_KEY")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + +# For status endpoint + +mm_get("status") +\dontshow{\}) # examplesIf} +\dontrun{ +# You can supply vectors to filtering variables +mm_get("workorder", wo_no = c("00001", "00002")) + +# You can supply API modifiers when filtering +mm_get("workorder", trade = "[]PCO") + +# You must supply date types to the date filter +jan_2023 <- seq.Date( + as.Date("2023-01-01"), + as.Date("2023-01-31"), + by = "day" + ) + +mm_get("employee", date = jan_2023) +} + + +} diff --git a/man/mm_req_perform.Rd b/man/mm_req_perform.Rd index 8e45e71..cfbb7d1 100644 --- a/man/mm_req_perform.Rd +++ b/man/mm_req_perform.Rd @@ -23,3 +23,7 @@ the results back to R. Where the request is paginated, pagination is automatically performed by \code{\link[httr2:req_perform_iteratively]{httr2::req_perform_iteratively()}}. } +\examples{ +\dontshow{if (httr2::secret_has_key("HTTR2_KEY")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{\}) # examplesIf} +} diff --git a/man/mm_request.Rd b/man/mm_request.Rd index 9219e24..1aa6a08 100644 --- a/man/mm_request.Rd +++ b/man/mm_request.Rd @@ -41,7 +41,7 @@ from your \code{.Renviron}. \item Automatic caching of responses. See \code{\link[httr2:req_cache]{httr2::req_cache()}}. } -After creating a request with \code{mm_request()}, you can +If you create a GET request with \code{mm_request()}, you can then \itemize{ \item Paginate the request using \code{\link[=mm_req_paginate]{mm_req_paginate()}}. \item Perform the request and fetch the response using \code{\link[httr2:req_perform]{httr2::req_perform()}} or @@ -49,5 +49,5 @@ After creating a request with \code{mm_request()}, you can } Alternatively, -\code{\link[=mm_get]{mm_get()}} can at once define, paginate, and perform a request. +\code{\link[=mm_get]{mm_get()}} can at once define, paginate, and perform a GET request. } diff --git a/tests/testthat/test-creds.R b/tests/testthat/test-creds.R index a8c5f70..32adb79 100644 --- a/tests/testthat/test-creds.R +++ b/tests/testthat/test-creds.R @@ -19,6 +19,7 @@ test_that("absence of API key or URL raises an error", { }) test_that("testing key", { + skip_on_cran() expect_equal( get_env_key(), testing_key() @@ -33,22 +34,11 @@ test_that("mm_set_creds() gives bad url error", { }) test_that("mm_set_creds() sets credentials", { - defer({ - mm_set_creds( - key = testing_key(), - url = 'https://api.megamation.com/uog/dl', - overwrite = TRUE - ) - }) mm_set_creds( key = "1", url = "https://api.megamation.com/uw/joe/", overwrite = TRUE ) - expect_equal( - get_env_key(), - "1" - ) expect_false( endsWith(Sys.getenv("MEGAMATION_URL"), "/") ) @@ -56,6 +46,19 @@ test_that("mm_set_creds() sets credentials", { get_env_url(), "https://api.megamation.com/uw/joe" ) + + skip_on_cran() + withr::defer({ + mm_set_creds( + key = testing_key(), + url = 'https://api.megamation.com/uog/dl', + overwrite = TRUE + ) + }) + expect_equal( + get_env_key(), + "1" + ) }) test_that("presence of bad creds raises an error", { diff --git a/tests/testthat/test-parse.R b/tests/testthat/test-parse.R index c96a7f6..ef3d576 100644 --- a/tests/testthat/test-parse.R +++ b/tests/testthat/test-parse.R @@ -22,7 +22,7 @@ with_mock_dir("status", { with_mock_dir("status_schema", { test_that("parse() gives list with embedded data", { - resp <- mm_request("status", opts = req_opts(.get = "criteria")) |> + resp <- mm_request("status", allfields = FALSE, opts = req_opts(.get = "schema")) |> httr2::req_perform() parsed <- resp |> mm_resp_parse() df <- extract_schema(parsed) @@ -37,7 +37,7 @@ with_mock_dir("status_schema", { with_mock_dir("status_criteria-or-labels", { test_that("extract_criteria() gives correct names", { - resp <- mm_request("status", opts = req_opts(.get = "criteria")) |> + resp <- mm_request("status", allfields = FALSE, opts = req_opts(.get = "criteria")) |> httr2::req_perform() parsed <- resp |> mm_resp_parse() df <- extract_criteria(parsed)