tests/testthat/test-ide.R

In rstudio/rsconnect: Deploy Docs, Apps, and APIs to 'Posit Connect', 'shinyapps.io', and 'RPubs'

test_that("validateServerUrl() when not Connect", {
  skip_on_cran()
  skip_if_not_installed("webfakes")

  service <- service_settings_404()

  url <- buildHttpUrl(service)
  expect_false(validateServerUrl(url)$valid)
})

test_that("validateServerUrl() when Connect", {
  skip_on_cran()
  skip_if_not_installed("webfakes")

  service <- service_settings_200()
  url <- buildHttpUrl(service)
  expected_url <- paste0(url, "__api__")

  redirect <- service_redirect(paste0(url, "__api__/server_settings"))
  redirect_url <- buildHttpUrl(redirect)

  # Full server URL.
  result <- validateServerUrl(url)
  expect_true(result$valid, info = url)
  expect_equal(result$url, expected_url, info = url)

  # Overspecified (includes /__api__)
  result <- validateServerUrl(expected_url)
  expect_true(result$valid, info = expected_url)
  expect_equal(result$url, expected_url, info = expected_url)

  # Incomplete (lacks path).
  # Lack of protocol is not easily tested because validateConnectUrl()
  # prefers https://.
  partial_url <- paste0(service$protocol, "://", service$host, ":", service$port)
  result <- validateServerUrl(partial_url)
  expect_true(result$valid, info = partial_url)
  expect_equal(result$url, expected_url, info = partial_url)

  # Redirects
  result <- validateServerUrl(redirect_url)
  expect_true(result$valid)
  expect_equal(result$url, expected_url)
})

test_that("validateServerUrl() hosted", {
  skip_on_cran()

  expect_false(validateServerUrl("https://posit.cloud")$valid)
  expect_false(validateServerUrl("https://shinyapps.io")$valid)
})

test_that("getAppById() fails where expected", {
  local_temp_config()
  addTestServer()
  addTestAccount("susan")

  expect_snapshot(error = TRUE, {
    getAppById("123", "susan", "unknown", "unknown.com")
    getAppById("123", "robert", "unknown", "https://example.com")
  })
})

current_user_service <- function() {
  app <- env_cache(
    cache,
    "current_user_app",
    {
      json_app <- webfakes::new_app()
      json_app$use(webfakes::mw_json())
      json_app$get("/users/current", function(req, res) {
        res$set_status(200L)$send_json(list(username = jsonlite::unbox("susan")))
      })
      app <- webfakes::new_app_process(json_app)
    }
  )
  parseHttpUrl(app$url())
}

test_that("getUserFromRawToken having a single matching server", {
  skip_if_not_installed("webfakes")

  local_temp_config()

  service <- current_user_service()
  url <- buildHttpUrl(service)

  addTestServer("test", url = url)

  token <- generateToken()
  claimUrl <- url

  user <- getUserFromRawToken(claimUrl, token$token, token$private_key)
  expect_equal(user$username, "susan")
})

test_that("getUserFromRawToken having multiple matching servers", {
  skip_if_not_installed("webfakes")

  local_temp_config()

  service <- current_user_service()
  url <- buildHttpUrl(service)

  addTestServer("test", url = url)
  addTestServer("test2", url = url)

  token <- generateToken()
  claimUrl <- url

  user <- getUserFromRawToken(claimUrl, token$token, token$private_key)
  expect_equal(user$username, "susan")
})