colorado: so long, farewell (#1129)

* colorado: so long, farewell

* test addServer, addConnectServer, and validateServerUrl without using real Connect

tests/testthat/_snaps/servers-deprec.md

@@ -1,7 +1,7 @@
 # addConnectServer is deprecated
 
     Code
-      addConnectServer("https://colorado.posit.co/rsc", quiet = TRUE)
+      addConnectServer(url, quiet = TRUE)
     Condition
       Warning:
       `addConnectServer()` was deprecated in rsconnect 1.0.0.

tests/testthat/helper-http.R

@@ -31,6 +31,58 @@ skip_on_http_failure <- function(code) {
   )
 }
 
+# Service that 404s for server settings.
+service_settings_404 <- function() {
+  app <- env_cache(
+    cache,
+    "service_settings_404",
+    {
+      json_app <- webfakes::new_app()
+      json_app$use(webfakes::mw_json())
+      json_app$get("/__api__/server_settings", function(req, res) {
+        res$set_status(404L)$send_json(list(error = jsonlite::unbox("not found")))
+      })
+      app <- webfakes::new_app_process(json_app)
+    }
+  )
+  parseHttpUrl(app$url())
+}
+
+# Service that 200s for server settings.
+service_settings_200 <- function() {
+  app <- env_cache(
+    cache,
+    "service_settings_200",
+    {
+      json_app <- webfakes::new_app()
+      json_app$use(webfakes::mw_json())
+      json_app$get("/__api__/server_settings", function(req, res) {
+        res$set_status(200L)$send_json(list(data = jsonlite::unbox("ok")))
+      })
+      app <- webfakes::new_app_process(json_app)
+    }
+  )
+  parseHttpUrl(app$url())
+}
+
+# Service that redirects for server settings.
+service_redirect <- function(target) {
+  app <- env_cache(
+    cache,
+    "service_redirect",
+    {
+      json_app <- webfakes::new_app()
+      json_app$use(webfakes::mw_json())
+      json_app$get("/__api__/server_settings", function(req, res) {
+        res$redirect(target)
+      })
+      app <- webfakes::new_app_process(json_app)
+    }
+  )
+  parseHttpUrl(app$url())
+}
+
+
 # Generic tests of various http methods -----------------------------------
 
 test_http_GET <- function() {

tests/testthat/test-ide.R

@@ -1,42 +1,53 @@
-test_that("validateServerUrl() returns expected", {
+test_that("validateServerUrl() when not Connect", {
   skip_on_cran()
+  skip_if_not_installed("webfakes")
 
-  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()
+  service <- service_settings_404()
 
-  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)
+  url <- buildHttpUrl(service)
+  expect_false(validateServerUrl(url)$valid)
 })
 
-test_that("validateConnectUrl() normalises urls", {
+test_that("validateServerUrl() when Connect", {
   skip_on_cran()
+  skip_if_not_installed("webfakes")
 
-  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)
+  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("validateConnectUrl() follows redirects", {
+test_that("validateServerUrl() hosted", {
   skip_on_cran()
 
-  api_url <- "https://connect.posit.it:443/__api__"
-  expect_equal(validateConnectUrl("http://connect.posit.it")$url, api_url)
+  expect_false(validateServerUrl("https://posit.cloud")$valid)
+  expect_false(validateServerUrl("https://shinyapps.io")$valid)
 })
 
 test_that("getAppById() fails where expected", {

tests/testthat/test-servers-deprec.R

@@ -1,8 +1,13 @@
 test_that("addConnectServer is deprecated", {
   skip_on_cran()
+  skip_if_not_installed("webfakes")
+
   local_temp_config()
 
+  service <- service_settings_200()
+  url <- buildHttpUrl(service)
+
   expect_snapshot(
-    addConnectServer("https://colorado.posit.co/rsc", quiet = TRUE)
+    addConnectServer(url, quiet = TRUE)
   )
 })

tests/testthat/test-servers.R

@@ -51,11 +51,21 @@ test_that("addServer() name defaults to hostname & port of url", {
 
 test_that("addServer() normalises url", {
   skip_on_cran()
+  skip_if_not_installed("webfakes")
+
   local_temp_config()
 
-  addServer("connect.posit.it", name = "connect", quiet = TRUE)
+  service <- service_settings_200()
+  url <- buildHttpUrl(service)
+  expected_url <- paste0(url, "__api__")
+
+  # Incomplete (lacks path).
+  # Lack of protocol is not easily tested because validateConnectUrl()
+  # prefers https://.
+  partial_url <- paste0(service$protocol, "://", service$host, ":", service$port)
+  addServer(partial_url, name = "connect", quiet = TRUE)
   info <- serverInfo("connect")
-  expect_equal(info$url, "https://connect.posit.it/__api__")
+  expect_equal(info$url, expected_url)
 })
 
 test_that("addServer() errors if url not a connect server", {