Introduce comprehensive mocking support.

Signed-off-by: Aaron Jacobs <[email protected]>

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)

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"
+  )
+}

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".
+

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"))
+    }
+  )
+})