tests/testthat/test-ide.R

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

test_that("validateServerUrl() returns expected", {
  skip_on_cran()

  expect_false(validateServerUrl("https://posit.cloud")$valid)
  expect_false(validateServerUrl("https://shinyapps.io")$valid)
  expect_true(validateServerUrl("https://connect.posit.it/")$valid)
  expect_true(validateServerUrl("https://colorado.posit.co/rsc")$valid)
})

test_that("validateServerUrl() normalises urls", {
  skip_on_cran()

  expect_true(validateServerUrl("connect.posit.it/")$valid)
  expect_true(validateServerUrl("colorado.posit.co/rsc")$valid)
})

test_that("validateConnectUrl() returns expected return for some known endpoints", {
  skip_on_cran()

  expect_false(validateConnectUrl("https://posit.cloud")$valid)
  expect_false(validateConnectUrl("https://shinyapps.io")$valid)
  expect_true(validateConnectUrl("https://connect.posit.it/")$valid)
  expect_true(validateConnectUrl("https://colorado.posit.co/rsc")$valid)
})

test_that("validateConnectUrl() normalises urls", {
  skip_on_cran()

  api_url <- "https://connect.posit.it/__api__"
  expect_equal(validateConnectUrl("connect.posit.it")$url, api_url)
  expect_equal(validateConnectUrl("connect.posit.it")$url, api_url)
  expect_equal(validateConnectUrl("https://connect.posit.it/")$url, api_url)
})

test_that("validateConnectUrl() follows redirects", {
  skip_on_cran()

  api_url <- "https://connect.posit.it:443/__api__"
  expect_equal(validateConnectUrl("http://connect.posit.it")$url, api_url)
})

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", {
  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", {
  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")
})