Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 46 additions & 20 deletions R/response_process.R
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@
#' @param error_message Function that produces an informative error message from
#' the primary input, `resp`. It must return a character vector.
#' @param remember Whether to remember the most recently processed response.
#' @inheritParams rlang::abort
#'
#' @return The content of the request, as a list. An HTTP status code of 204 (No
#' content) is a special case returning `TRUE`.
Expand Down Expand Up @@ -72,7 +73,8 @@
#' }
response_process <- function(resp,
error_message = gargle_error_message,
remember = TRUE) {
remember = TRUE,
call = caller_env()) {
if (remember) {
gargle_env$last_response <- redact_response(resp)
}
Expand All @@ -83,17 +85,21 @@ response_process <- function(resp,
# HTTP status: No content
TRUE
} else {
response_as_json(resp)
response_as_json(resp, call = call)
}
} else {
gargle_abort_request_failed(error_message(resp), resp)
gargle_abort_request_failed(
error_message(resp, call = call),
resp,
call = call
)
}
}

#' @export
#' @rdname response_process
response_as_json <- function(resp) {
check_for_json(resp)
response_as_json <- function(resp, call = caller_env()) {
check_for_json(resp, call = call)

content <- httr::content(resp, type = "raw")
content <- rawToChar(content)
Expand All @@ -107,40 +113,38 @@ check_for_json <- function(resp, call = caller_env()) {
return(invisible(resp))
}

content <- httr::content(resp, as = "text")
gargle_abort_request_failed(
c(
gargle_map_cli(
type,
template = "Expected content type {.field application/json}, not \\
{.field <<x>>}."
),
"*" = obfuscate(content, first = 197, last = 0)
Copy link
Member Author

@jennybc jennybc May 16, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note: this is where the Could not parse cli {} expression: ... error was coming from (#254). When the content is html, it can contain curly braces (and, indeed, in this case, did), which then confuses cli when it processes the error message bullets.

There is a solution, which is to refer to the {-and-}-containing string from a template:

https://cli.r-lib.org/reference/inline-markup.html#escaping-and-

However, I decided not to do that, but instead to make it much easier to see the full html. Previously, my only direct experience of html errors was from the token info endpoints, which seemed rather obscure and the examples I knew about produced a relatively small amount of html, so it seemed sensible to show a part (and maybe all) of the html in the actual error message.

But the error seen in #254 is actually important for the user (429 too many requests, from googledrive) and involved considerably more html (so a wee little excerpt didn't reveal anything useful).

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

),
"Expected content type {.field application/json}, not {.field {type}}.",
call = call,
resp = resp
)
}

# personal policy: a wrapper around a wrapper around cli_abort() should not
# capture/pass an environment
# if you really want cli styling, you have to pre-interpolate
gargle_abort_request_failed <- function(message, resp, call = caller_env()) {
gargle_abort_request_failed <- function(message,
resp,
.envir = parent.frame(),
call = caller_env()) {
gargle_abort(
message,
class = c(
"gargle_error_request_failed",
glue("http_error_{httr::status_code(resp)}")
),
.envir = .envir,
call = call,
resp = redact_response(resp)
)
}

#' @export
#' @rdname response_process
gargle_error_message <- function(resp) {
content <- response_as_json(resp)
gargle_error_message <- function(resp, call = caller_env()) {
type <- httr::http_type(resp)
if (type == "text/html") {
return(gargle_html_error_message(resp))
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Instead of letting html trigger an error in check_for_json() inside response_as_json(), I handle that case explicitly here.

}

content <- response_as_json(resp, call = call)
error <- content[["error"]]

# Handle variety of error messages returned by different google APIs
Expand Down Expand Up @@ -308,3 +312,25 @@ reveal_detail <- function(x) {
)
)
}

gargle_html_error_message <- function(resp) {
stopifnot(httr::http_type(resp) == "text/html")

content <- httr::content(resp, as = "text")
tmp <- tempfile("gargle-unexpected-html-error-", fileext = ".html")
writeLines(content, tmp)
browse_hint <- glue('browseURL("{tmp}")')

# pre-interpolate, since `tmp` and `browse_hint` are only known here.
c(
httr::http_status(resp)$message,
"x" = "Expected content type {.field application/json}, not \\
{.field text/html}.",
"i" = gargle_map_cli(tmp, "See {.file <<x>>} for the html error content."),
"i" = gargle_map_cli(
browse_hint,
"Or execute {.code <<x>>} to view it in your browser."
)
)

}
25 changes: 22 additions & 3 deletions man/response_process.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

156 changes: 97 additions & 59 deletions tests/testthat/_snaps/response_process.md
Original file line number Diff line number Diff line change
@@ -1,86 +1,124 @@
# Resource exhausted (Sheets, ReadGroup)

Client error: (429) RESOURCE_EXHAUSTED
* Either out of resource quota or reaching rate limiting. The client should look for google.rpc.QuotaFailure error detail for more information.
* Quota exceeded for quota metric 'Read requests' and limit 'Read requests per minute per user' of service 'sheets.googleapis.com' for consumer 'project_number:603366585132'.

Error details:
* reason: RATE_LIMIT_EXCEEDED
* domain: googleapis.com
* metadata.quota_location: global
* metadata.quota_metric: sheets.googleapis.com/read_requests
* metadata.quota_limit: ReadRequestsPerMinutePerUser
* metadata.quota_limit_value: 60
* metadata.consumer: projects/603366585132
* metadata.service: sheets.googleapis.com
Links
* Description: Request a higher quota limit.
URL: https://cloud.google.com/docs/quota#requesting_higher_quota
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (429) RESOURCE_EXHAUSTED
* Either out of resource quota or reaching rate limiting. The client should look for google.rpc.QuotaFailure error detail for more information.
* Quota exceeded for quota metric 'Read requests' and limit 'Read requests per minute per user' of service 'sheets.googleapis.com' for consumer 'project_number:603366585132'.
Error details:
* reason: RATE_LIMIT_EXCEEDED
* domain: googleapis.com
* metadata.quota_location: global
* metadata.quota_metric: sheets.googleapis.com/read_requests
* metadata.quota_limit: ReadRequestsPerMinutePerUser
* metadata.quota_limit_value: 60
* metadata.consumer: projects/603366585132
* metadata.service: sheets.googleapis.com
Links
* Description: Request a higher quota limit.
URL: https://cloud.google.com/docs/quota#requesting_higher_quota

# Request for non-existent resource (Drive)

Client error: (404) Not Found
File not found: NOPE_NOT_A_GOOD_ID.
* domain: global
* reason: notFound
* message: File not found: NOPE_NOT_A_GOOD_ID.
* locationType: parameter
* location: fileId
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (404) Not Found
File not found: NOPE_NOT_A_GOOD_ID.
* domain: global
* reason: notFound
* message: File not found: NOPE_NOT_A_GOOD_ID.
* locationType: parameter
* location: fileId

# Request for which we don't have scope (Fitness)

Client error: (403) Forbidden
Request had insufficient authentication scopes.
PERMISSION_DENIED
* message: Insufficient Permission
* domain: global
* reason: insufficientPermissions
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (403) Forbidden
Request had insufficient authentication scopes.
PERMISSION_DENIED
* message: Insufficient Permission
* domain: global
* reason: insufficientPermissions

# Use key that's not enabled for the API (Sheets)

Client error: (403) PERMISSION_DENIED
* Client does not have sufficient permission. This can happen because the OAuth token does not have the right scopes, the client doesn't have permission, or the API has not been enabled for the client project.
* Google Sheets API has not been used in project 977449744253 before or it is disabled. Enable it by visiting https://console.developers.google.com/apis/api/sheets.googleapis.com/overview?project=977449744253 then retry. If you enabled this API recently, wait a few minutes for the action to propagate to our systems and retry.

Error details:
Links
* Description: Google developers console API activation
URL: https://console.developers.google.com/apis/api/sheets.googleapis.com/overview?project=977449744253
* reason: SERVICE_DISABLED
* domain: googleapis.com
* metadata.consumer: projects/977449744253
* metadata.service: sheets.googleapis.com
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (403) PERMISSION_DENIED
* Client does not have sufficient permission. This can happen because the OAuth token does not have the right scopes, the client doesn't have permission, or the API has not been enabled for the client project.
* Google Sheets API has not been used in project 977449744253 before or it is disabled. Enable it by visiting https://console.developers.google.com/apis/api/sheets.googleapis.com/overview?project=977449744253 then retry. If you enabled this API recently, wait a few minutes for the action to propagate to our systems and retry.
Error details:
Links
* Description: Google developers console API activation
URL: https://console.developers.google.com/apis/api/sheets.googleapis.com/overview?project=977449744253
* reason: SERVICE_DISABLED
* domain: googleapis.com
* metadata.consumer: projects/977449744253
* metadata.service: sheets.googleapis.com

# Request with invalid argument (Sheets, bad range)

Client error: (400) INVALID_ARGUMENT
* Client specified an invalid argument. Check error message and error details for more information.
* Unable to parse range: NOPE!A5:F15
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (400) INVALID_ARGUMENT
* Client specified an invalid argument. Check error message and error details for more information.
* Unable to parse range: NOPE!A5:F15

# Request with bad field mask (Sheets)

Client error: (400) INVALID_ARGUMENT
* Client specified an invalid argument. Check error message and error details for more information.
* Request contains an invalid argument.

Error details:
Field violations
* Field: sheets.sheetProperties
Description: Error expanding 'fields' parameter. Cannot find matching fields for path 'sheets.sheetProperties'.
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (400) INVALID_ARGUMENT
* Client specified an invalid argument. Check error message and error details for more information.
* Request contains an invalid argument.
Error details:
Field violations
* Field: sheets.sheetProperties
Description: Error expanding 'fields' parameter. Cannot find matching fields for path 'sheets.sheetProperties'.

# Request for nonexistent resource (Sheets)

Client error: (404) NOT_FOUND
* A specified resource is not found, or the request is rejected by undisclosed reasons, such as whitelisting.
* Requested entity was not found.
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (404) NOT_FOUND
* A specified resource is not found, or the request is rejected by undisclosed reasons, such as whitelisting.
* Requested entity was not found.

# Request with invalid value (tokeninfo, stale token)

Client error: (400) Bad Request
* Invalid Value
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (400) Bad Request
* Invalid Value

# Request to bad URL (tokeninfo, HTML content)

Expected content type 'application/json', not 'text/html'.
* Not Found
Code
response_process(resp)
Condition
Error in `expect_recorded_error()`:
! Client error: (404) Not Found
x Expected content type 'application/json', not 'text/html'.
i See 'VOLATILE_FILE_PATH' for the html error content.
i Or execute `browseURL("VOLATILE_FILE_PATH")` to view it in your browser.
Comment on lines +160 to +163
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is a look at the new handling for an error that comes as html. In certain contexts, such as RStudio, the "See 'VOLATILE_FILE_PATH' ..." is a clickable link to open the file. I can't make the browseURL() a clickable link because it calls into a base package. But the user can copy it, paste into the console, and execute without too much trouble.

https://cli.r-lib.org/reference/links.html#security-considerations


Binary file modified tests/testthat/fixtures/tokeninfo-bad-path_404.rds
Binary file not shown.
Binary file modified tests/testthat/fixtures/tokeninfo-stale_400.rds
Binary file not shown.
10 changes: 9 additions & 1 deletion tests/testthat/test-response_process.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,15 @@ expect_recorded_error <- function(filename, status_code) {
resp <- readRDS(rds_file)
expect_error(response_process(resp), class = "gargle_error_request_failed")
expect_error(response_process(resp), class = glue("http_error_{status_code}"))
expect_snapshot_error(response_process(resp))
# HTML errors (as opposed to JSON) need this
scrub_filepath <- function(x) {
gsub(
"([\"\'])\\S+gargle-unexpected-html-error-\\S+[.]html([\"\'])",
"\\1VOLATILE_FILE_PATH\\2",
x,
perl = TRUE)
}
expect_snapshot(response_process(resp), error = TRUE, transform = scrub_filepath)
}

test_that("Resource exhausted (Sheets, ReadGroup)", {
Expand Down