chore: use v1 timezones API (#315)

Co-authored-by: Neal Richardson <[email protected]>

Author: toph-allen

NEWS.md

@@ -21,6 +21,8 @@
 ## Minor improvements and fixes
 
 - Upgrade `pkgdown` to bootstrap 5 to enable search (@fh-mthomson, #275)
+- The `get_timezones()` function now uses the `v1/timezones` endpoint if
+  available. (#300)
 
 # connectapi 0.3.0
 

R/connect.R

@@ -252,7 +252,7 @@ Connect <- R6::R6Class(
     #' @description Return all tags.
     #' @param use_cache Indicates that a cached set of tags is used.
     get_tags = function(use_cache = FALSE) {
-      error_if_less_than(self, "1.8.6")
+      error_if_less_than(self$version, "1.8.6")
       # TODO: check cache "age"?
       if (is.null(self$tags) || !use_cache) {
         self$tags <- self$tag()
@@ -305,7 +305,7 @@ Connect <- R6::R6Class(
     #' @param name The tag name.
     #' @param parent_id The parent identifier.
     tag_create = function(name, parent_id = NULL) {
-      error_if_less_than(self, "1.8.6")
+      error_if_less_than(self$version, "1.8.6")
       dat <- list(
         name = name
       )
@@ -328,7 +328,7 @@ Connect <- R6::R6Class(
     #' @description Get a tag.
     #' @param id The tag identifier.
     tag = function(id = NULL) {
-      error_if_less_than(self, "1.8.6")
+      error_if_less_than(self$version, "1.8.6")
       if (is.null(id)) {
         path <- v1_url("tags")
       } else {
@@ -833,6 +833,18 @@ Connect <- R6::R6Class(
     }
 
     # end --------------------------------------------------------
+  ),
+  private = list(
+    .version = NULL
+  ),
+  active = list(
+    #' @field version The server version.
+    version = function() {
+      if (is.null(private$.version)) {
+        private$.version <- safe_server_version(self)
+      }
+      private$.version
+    }
   )
 )
 
@@ -886,7 +898,7 @@ connect <- function(
   tryCatch(
     {
       check_connect_license(con)
-      check_connect_version(using_version = safe_server_version(con))
+      warn_untested_connect(using_version = safe_server_version(con))
     },
     error = function(err) {
       if (.check_is_fatal) {

R/content.R

@@ -65,7 +65,7 @@ Content <- R6::R6Class(
     #' @param ... Content fields.
     update = function(...) {
       con <- self$get_connect()
-      error_if_less_than(con, "1.8.6")
+      error_if_less_than(con$version, "1.8.6")
       url <- v1_url("content", self$get_content()$guid)
       body <- rlang::list2(...)
       if (length(body)) {

R/deploy.R

@@ -422,7 +422,7 @@ deploy_current <- function(content) {
 set_vanity_url <- function(content, url, force = FALSE) {
   validate_R6_class(content, "Content")
   con <- content$get_connect()
-  error_if_less_than(con, "1.8.6")
+  error_if_less_than(con$version, "1.8.6")
   guid <- content$get_content()$guid
 
   scoped_experimental_silence()
@@ -449,7 +449,7 @@ set_vanity_url <- function(content, url, force = FALSE) {
 #' @export
 delete_vanity_url <- function(content) {
   con <- content$get_connect()
-  error_if_less_than(con, "1.8.6")
+  error_if_less_than(con$version, "1.8.6")
   guid <- content$get_content()$guid
 
   con$DELETE(v1_url("content", guid, "vanity"))
@@ -470,7 +470,7 @@ delete_vanity_url <- function(content) {
 get_vanity_url <- function(content) {
   validate_R6_class(content, "Content")
   con <- content$get_connect()
-  error_if_less_than(con, "1.8.6")
+  error_if_less_than(con$version, "1.8.6")
   guid <- content$get_content()$guid
 
   van <- tryCatch(

R/schedule.R

@@ -337,7 +337,13 @@ schedule_describe <- function(.schedule) {
 #' @family schedule functions
 #' @export
 get_timezones <- function(connect) {
-  raw_tz <- connect$GET(unversioned_url("timezones"))
+  raw_tz <- tryCatch(
+    connect$GET(v1_url("timezones")),
+    error = function(e) {
+      connect$GET(unversioned_url("timezones"))
+    }
+  )
+
   tz_values <- purrr::map_chr(raw_tz, ~ .x[["timezone"]])
   tz_display <- purrr::map_chr(raw_tz, ~ glue::glue("{.x[['timezone']]} ({.x[['offset']]})"))
 

R/utils.R

@@ -134,20 +134,25 @@ safe_server_version <- function(client) {
   version <- safe_server_settings(client)$version
   if (is.null(version) || nchar(version) == 0) {
     message("Version information is not exposed by this Posit Connect instance.")
-    # Return 0 so this will always show up as "too old"
-    version <- "0"
+    version <- NA
   }
   version
 }
 
-error_if_less_than <- function(client, tested_version) {
-  server_version <- safe_server_version(client)
-  comp <- compare_connect_version(server_version, tested_version)
-  if (comp < 0) {
-    msg <- paste0(
-      "ERROR: This API requires Posit Connect version ", tested_version,
-      " but you are using", server_version, ". Please use a previous version",
-      " of the `connectapi` package, upgrade Posit Connect, or review the API ",
+error_if_less_than <- function(using_version, tested_version) {
+  comp <- compare_connect_version(using_version, tested_version)
+  if (is.na(comp)) {
+    msg <- glue::glue(
+      "WARNING: This API requires Posit Connect version {tested_version} ",
+      "but the server version is not exposed by this Posit Connect instance. ",
+      "You may be experience errors when using this functionality."
+    )
+    warn_once(msg)
+  } else if (comp < 0) {
+    msg <- glue::glue(
+      "ERROR: This API requires Posit Connect version {tested_version} ",
+      "but you are using {using_version}. Please use a previous version ",
+      "of the `connectapi` package, upgrade Posit Connect, or review the API ",
       "documentation corresponding to your version."
     )
     stop(msg)
@@ -156,12 +161,13 @@ error_if_less_than <- function(client, tested_version) {
 }
 
 compare_connect_version <- function(using_version, tested_version) {
+  if (is.na(using_version)) return(NA)
   compareVersion(simplify_version(using_version), simplify_version(tested_version))
 }
 
-check_connect_version <- function(using_version, minimum_tested_version = "1.8.8.2") {
+warn_untested_connect <- function(using_version, minimum_tested_version = "1.8.8.2") {
   comp <- compare_connect_version(using_version, minimum_tested_version)
-  if (comp < 0) {
+  if (isTRUE(comp < 0)) {
     warn_once(glue::glue(
       "You are using an older version of Posit Connect ",
       "({using_version}) than is tested ({minimum_tested_version}). ",

man/PositConnect.Rd

@@ -80,26 +80,6 @@ test_that("schedule display works", {
   expect_snapshot_output(schedule_describe(tmp))
 })
 
-# test_that("timezones helper works", {
-#   tzs <- get_timezones(test_conn_1)
-#   expect_snapshot(tzs)
-# })
-
-# test_that("schedule timezone works", {
-#   scoped_experimental_silence()
-#
-#   tzs <- get_timezones(test_conn_1)
-#   set_schedule_remove(d_var_sch)
-#
-#   tmp <- set_schedule_minute(d_var_sch, n = 15, timezone = tzs$`America/New_York (-04:00)`)
-#   expect_equal(tmp$schedule_data$timezone, tzs$`America/New_York (-04:00)`)
-#
-#   tmp2 <- set_schedule_minute(d_var_sch, n = 10, timezone = tzs$`Universal (+00:00)`)
-#   expect_equal(tmp$schedule_data$timezone, tzs$`Universal (+00:00)`)
-#
-#   set_schedule_remove(d_var_sch)
-# })
-
 test_that("get_schedules works", {
   scoped_experimental_silence()
   # TODO: add a helper that makes this prettier

tests/integrated/test-schedule.R

@@ -1,3 +1,2 @@
 {
-    "version": "2024.06.0"
 }

tests/testthat/2024.08.0/__api__/server_settings.json

@@ -1,8 +1,7 @@
 {
-    "hostname": "dogfood01",
-    "version": "2024.09.0-dev+77-g9296f96ffb",
-    "build": "v2024.08.0-77-g9296f96ffb",
-    "about": "Posit Connect v2024.09.0-dev+77-g9296f96ffb",
+    "hostname": "example",
+    "version": "2024.09.0",
+    "about": "Posit Connect v2024.09.0",
     "authentication": {
         "handles_credentials": false,
         "handles_login": true,

tests/testthat/2024.09.0/__api__/server_settings.json

@@ -1,14 +1,14 @@
-# check_connect_version warning snapshot
+# warn_untested_connect warning snapshot
 
     Code
-      capture_warning(check_connect_version("2022.02", "2022.01"))
+      capture_warning(warn_untested_connect("2022.02", "2022.01"))
     Output
       NULL
 
 ---
 
     Code
-      capture_warning(check_connect_version("2022.01", "2022.02"))
+      capture_warning(warn_untested_connect("2022.01", "2022.02"))
     Output
       <warning/rlang_warning>
       Warning:

tests/testthat/Rplots.pdf

@@ -1,4 +1,5 @@
 library(httptest)
+library(R6)
 
 set_requester(
   function(r) {
@@ -35,3 +36,72 @@ set_redactor(
 # Mocks are in directories by Connect version. 2024.08.0 contains all mocks
 # created before 2024.09.0, and is the default mock path.
 .mockPaths("2024.08.0")
+
+MockConnect <- R6Class(
+  "MockConnect",
+  inherit = Connect,
+  public = list(
+    initialize = function(version = NA) {
+      self$server <- "https://connect.example"
+      self$api_key <- "fake"
+      private$.version <- version
+    },
+    request = function(method, url, ..., parser = "parsed") {
+      route <- paste(method, url)
+      print(route)
+      
+      # Record call
+      self$log_call(route)
+
+      # Look for response
+      if (!(route %in% names(self$responses))) {
+        stop("Unexpected route")
+      }
+      res <- self$responses[[route]]
+
+      if (is.null(parser)) {
+        res
+      } else {
+        self$raise_error(res)
+        httr::content(res, as = parser)
+      }
+    },
+    responses = list(),
+    mock_response = function(method, path, content, status_code = 200L, headers = c("Content-Type" = "application/json; charset=utf-8")) {
+      url <- self$api_url(path)
+      route <- paste(method, url)
+      print(route)
+      res <- new_mock_response(url, content, status_code, headers)
+      self$responses[[route]] <- res
+    },
+    call_log = character(),
+    log_call = function(route) {
+      self$call_log <- c(self$call_log, route)
+    }
+  )
+)
+
+new_mock_response <- function(url, content, status_code, headers = character()) {
+  # Headers in responses are case-insensitive lists.
+  names(headers) <- tolower(names(headers))
+  headers <- as.list(headers)
+  headers <- structure(as.list(headers), class = c("insensitive", class(headers)))
+
+  # Treat content similarly to httr::POST, with a subset of behaviors
+  if (is.character(content) && length(content) == 1) {
+    content <- charToRaw(content)
+  } else if (is.list(content)) {
+    content <- charToRaw(jsonlite::toJSON(content, auto_unbox = TRUE))
+  }
+
+  structure(
+    list(
+      url = url,
+      status_code = status_code,
+      request = structure(list(url = url), class = "request"),
+      headers = headers,
+      content = content
+    ),
+    class = "response"
+  )
+}

tests/testthat/_snaps/utils.md

@@ -97,4 +97,18 @@ with_mock_api({
       "MY_MAGIC_HEADER: value"
     )
   })
+
+  
+  test_that("client$version is NA when server settings lacks version info", {
+    con <- Connect$new(server = "https://connect.example", api_key = "fake")
+    expect_message(v <- con$version, "Version information is not exposed by this Posit Connect instance")
+    expect_true(is.na(v))
+  })
+})
+
+test_that("client$version is returns version when server settings exposes it", {
+  with_mock_dir("2024.09.0", {
+    con <- Connect$new(server = "https://connect.example", api_key = "fake")
+    expect_equal(con$version, "2024.09.0")
+  })
 })