From e925be3c547b5cc58b956ce7894f6c1c65524ba4 Mon Sep 17 00:00:00 2001 From: Aaron Jacobs Date: Wed, 11 Dec 2024 16:13:29 -0500 Subject: [PATCH] Introduce comprehensive mocking support. Signed-off-by: Aaron Jacobs --- NAMESPACE | 3 + R/mocking.R | 82 +++++++++++++++++++ man/with_mocked_connect_responses.Rd | 55 +++++++++++++ .../_snaps/viewer-based-credentials.md | 24 ++++++ .../testthat/test-viewer-based-credentials.R | 34 +++++--- 5 files changed, 187 insertions(+), 11 deletions(-) create mode 100644 R/mocking.R create mode 100644 man/with_mocked_connect_responses.Rd diff --git a/NAMESPACE b/NAMESPACE index 4da2d37..4451af8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,9 @@ # Generated by roxygen2: do not edit by hand export(connect_viewer_token) +export(example_connect_session) export(has_viewer_token) +export(local_mocked_connect_responses) +export(with_mocked_connect_responses) import(httr2) import(rlang) diff --git a/R/mocking.R b/R/mocking.R new file mode 100644 index 0000000..9630c37 --- /dev/null +++ b/R/mocking.R @@ -0,0 +1,82 @@ +#' Mock responses from the Posit Connect server +#' +#' These functions can be used to temporarily mock responses from the Connect +#' server, which is useful for writing tests that verify the behaviour of +#' viewer-based credentials. +#' +#' @param token When not `NULL`, return this token from the Connect server. +#' @param error When `TRUE`, return an error from the Connect server. +#' @inheritParams httr2::with_mocked_responses +#' @examples +#' with_mocked_connect_responses( +#' connect_viewer_token(example_connect_session()), +#' token = "test" +#' ) +#' @export +with_mocked_connect_responses <- function(code, mock = NULL, token = NULL, error = FALSE, env = caller_env()) { + check_string(token, allow_empty = FALSE, allow_null = TRUE) + check_bool(error) + check_exclusive(mock, token, error) + mock <- mock %||% connect_mock_fn(token, error) + withr::with_envvar( + c( + RSTUDIO_PRODUCT = "CONNECT", + CONNECT_SERVER = "localhost:3030", + CONNECT_API_KEY = "key", + .local_envir = env + ), + with_mocked_responses(mock, code) + ) +} + +#' @inheritParams httr2::local_mocked_responses +#' @rdname with_mocked_connect_responses +#' @export +local_mocked_connect_responses <- function(mock = NULL, token = NULL, error = FALSE, env = caller_env()) { + check_string(token, allow_empty = FALSE, allow_null = TRUE) + check_bool(error) + check_exclusive(mock, token, error) + mock <- mock %||% connect_mock_fn(token, error) + withr::local_envvar( + RSTUDIO_PRODUCT = "CONNECT", + CONNECT_SERVER = "localhost:3030", + CONNECT_API_KEY = "key", + .local_envir = env + ) + local_mocked_responses(mock, env = env) +} + +connect_mock_fn <- function(token = NULL, error = FALSE) { + function(req) { + if (!grepl("localhost:3030", req$url, fixed = TRUE)) { + return(NULL) + } + if (!error) { + body <- list( + access_token = token, + issued_token_type = "urn:ietf:params:oauth:token-type:access_token", + token_type = "Bearer" + ) + } else { + body <- list( + error_code = 212, + error_message = "No OAuth integrations have been associated with this content item." + ) + } + response_json( + status_code = if (!error) 200L else 400L, + url = req$url, + method = req$method %||% "GET", + body = body + ) + } +} + +#' @rdname with_mocked_connect_responses +#' @export +example_connect_session <- function() { + structure( + list(request = list(HTTP_POSIT_CONNECT_USER_SESSION_TOKEN = "user-token")), + class = "ShinySession" + ) +} diff --git a/man/with_mocked_connect_responses.Rd b/man/with_mocked_connect_responses.Rd new file mode 100644 index 0000000..e6a879b --- /dev/null +++ b/man/with_mocked_connect_responses.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mocking.R +\name{with_mocked_connect_responses} +\alias{with_mocked_connect_responses} +\alias{local_mocked_connect_responses} +\alias{example_connect_session} +\title{Mock responses from the Posit Connect server} +\usage{ +with_mocked_connect_responses( + code, + mock = NULL, + token = NULL, + error = FALSE, + env = caller_env() +) + +local_mocked_connect_responses( + mock = NULL, + token = NULL, + error = FALSE, + env = caller_env() +) + +example_connect_session() +} +\arguments{ +\item{code}{Code to execute in the temporary environment.} + +\item{mock}{A function, a list, or \code{NULL}. +\itemize{ +\item \code{NULL} disables mocking and returns httr2 to regular operation. +\item A list of responses will be returned in sequence. After all responses +have been used up, will return 503 server errors. +\item For maximum flexibility, you can supply a function that that takes a +single argument, \code{req}, and returns either \code{NULL} (if it doesn't want to +handle the request) or a \link[httr2]{response} (if it does). +}} + +\item{token}{When not \code{NULL}, return this token from the Connect server.} + +\item{error}{When \code{TRUE}, return an error from the Connect server.} + +\item{env}{Environment to use for scoping changes.} +} +\description{ +These functions can be used to temporarily mock responses from the Connect +server, which is useful for writing tests that verify the behaviour of +viewer-based credentials. +} +\examples{ +with_mocked_connect_responses( + connect_viewer_token(example_connect_session()), + token = "test" +) +} diff --git a/tests/testthat/_snaps/viewer-based-credentials.md b/tests/testthat/_snaps/viewer-based-credentials.md index fb04ff4..49bc000 100644 --- a/tests/testthat/_snaps/viewer-based-credentials.md +++ b/tests/testthat/_snaps/viewer-based-credentials.md @@ -71,3 +71,27 @@ +# mock Connect responses work as expected + + Code + connect_viewer_token(session) + Condition + Error in `connect_viewer_token()`: + ! Cannot fetch viewer-based credentials for the current Shiny session. + Caused by error: + ! Failed to parse response from `client$token_url` OAuth url. + * Did not contain `access_token`, `device_code`, or `error` field. + +--- + + Code + connect_viewer_token(session) + Condition + Error in `connect_viewer_token()`: + ! Cannot fetch viewer-based credentials for the current Shiny session. + Caused by error: + ! Failed to parse response from `client$token_url` OAuth url. + Caused by error in `resp_body_json()`: + ! Unexpected content type "text/plain". + * Expecting type "application/json" or suffix "json". + diff --git a/tests/testthat/test-viewer-based-credentials.R b/tests/testthat/test-viewer-based-credentials.R index c5f4490..761bd00 100644 --- a/tests/testthat/test-viewer-based-credentials.R +++ b/tests/testthat/test-viewer-based-credentials.R @@ -16,22 +16,34 @@ test_that("missing viewer credentials generate errors on Connect", { }) test_that("token exchange requests to Connect look correct", { - # Mock a Connect environment that supports viewer-based credentials. - withr::local_envvar( - RSTUDIO_PRODUCT = "CONNECT", - CONNECT_SERVER = "localhost:3030", - CONNECT_API_KEY = "key" - ) - local_mocked_responses(function(req) { + local_mocked_connect_responses(function(req) { # Snapshot relevant fields of the outgoing request. expect_snapshot( list(url = req$url, headers = req$headers, body = req$body$data) ) response_json(body = list(access_token = "token")) }) - session <- structure( - list(request = list(HTTP_POSIT_CONNECT_USER_SESSION_TOKEN = "user-token")), - class = "ShinySession" - ) + session <- example_connect_session() expect_equal(connect_viewer_token(session)$access_token, "token") }) + +test_that("mock Connect responses work as expected", { + session <- example_connect_session() + + with_mocked_connect_responses( + expect_equal(connect_viewer_token(session)$access_token, "test"), + token = "test" + ) + + with_mocked_connect_responses( + expect_snapshot(connect_viewer_token(session), error = TRUE), + error = TRUE + ) + + with_mocked_connect_responses( + expect_snapshot(connect_viewer_token(session), error = TRUE), + mock = function(req) { + response(status_code = 500, headers = list(`content-type` = "text/plain")) + } + ) +})