normalize names for all servers, but lowercase for shinyapps.io

fixes #1022
rstudio · Oct 27, 2023 · f4986a9 · f4986a9
1 parent 98ccc9a
commit f4986a9
Show file tree

Hide file tree

Showing 3 changed files with 142 additions and 25 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,9 @@
   content was incorrectly published to a new location rather than reusing an
   existing deployment. (#981, #1007, #1013, #1019)
 
+* Generated application names are always normalized and lower-cased when
+  deploying to shinyapps.io. (#1022)
+
 * `showLogs()`, `configureApp()`, `setProperty()`, and `unsetProperty()`
   search for the application by name when there are no matching deployment
   records. (#985, #989)

diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R
@@ -91,7 +91,11 @@ findDeploymentTarget <- function(
   # Otherwise, identify a target account (given just one available or prompted
   # by the user), generate a name, and locate the deployment.
   accountDetails <- findAccountInfo(account, server, error_call = error_call)
-  appName <- generateAppName(appTitle, recordPath, accountDetails$name, unique = FALSE)
+  appName <- generateDefaultName(
+    recordPath = recordPath,
+    title = appTitle,
+    server = accountDetails$server
+  )
   return(findDeploymentTargetByAppName(
     recordPath = recordPath,
     appName = appName,
@@ -315,27 +319,56 @@ updateDeployment <- function(previous, appTitle = NULL, envVars = NULL) {
   )
 }
 
-defaultAppName <- function(recordPath, server = NULL) {
+normalizeName <- function(name, server = NULL) {
+  if (is.null(name)) {
+    return("")
+  }
+
+  if (isShinyappsServer(server)) {
+    name <- tolower(name)
+  }
+
+  # Replace non-alphanumerics with underscores, trim to length 64
+  name <- gsub("[^[:alnum:]_-]+", "_", name, perl = TRUE)
+  name <- gsub("_+", "_", name)
+  if (nchar(name) > 64) {
+    name <- substr(name, 1, 64)
+  }
+
+  name
+}
+
+titleFromPath <- function(recordPath) {
   if (isDocumentPath(recordPath)) {
-    name <- file_path_sans_ext(basename(recordPath))
-    if (name == "index") {
-      # parent directory will give more informative name
-      name <- basename(dirname(recordPath))
+    title <- file_path_sans_ext(basename(recordPath))
+    if (title == "index") {
+      # parent directory will give more informative name+title
+      title <- basename(dirname(recordPath))
     } else {
       # deploying a document
     }
   } else {
     # deploying a directory
-    name <- basename(recordPath)
+    title <- basename(recordPath)
   }
+  title
+}
 
-  if (isShinyappsServer(server)) {
-    # Replace non-alphanumerics with underscores, trim to length 64
-    name <- tolower(gsub("[^[:alnum:]_-]+", "_", name, perl = TRUE))
-    name <- gsub("_+", "_", name)
-    if (nchar(name) > 64) {
-      name <- substr(name, 1, 64)
-    }
+# Determine name given a file or directory path and (optional) title.
+#
+# Prefer generating the name from the incoming title when provided and
+# fall-back to one derived from the target filename.
+#
+# Name is guaranteed to conform to [a-zA-Z0-9_-]{0,64}. Minimum length is
+# enforced by the server.
+#
+# Names produced for Shinyapps.io deployments are lower-cased.
+generateDefaultName <- function(recordPath, title = NULL, server = NULL) {
+  name <- normalizeName(title, server = server)
+
+  if (nchar(name) < 3) {
+    title <- titleFromPath(recordPath)
+    name <- normalizeName(title, server = server)
   }
 
   name

diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R
@@ -435,21 +435,102 @@ test_that("can find existing application on shinyapps.io & not use it", {
   confirm_existing_app_not_used("shinyapps.io")
 })
 
-# defaultAppName ----------------------------------------------------------
+# generateDefaultName ---------------------------------------------------------
 
-test_that("defaultAppName works with sites, documents, and directories", {
-  expect_equal(defaultAppName("foo/bar.Rmd"), "bar")
-  expect_equal(defaultAppName("foo/index.html"), "foo")
-  expect_equal(defaultAppName("foo/bar"), "bar")
+test_that("generateDefaultName works with sites, documents, and directories", {
+  expect_equal(
+    generateDefaultName("foo/bar.Rmd", "This/is/a/TITLE"),
+    "This_is_a_TITLE"
+  )
+  expect_equal(
+    generateDefaultName("foo/bar.Rmd", "NO"),
+    "bar"
+  )
+
+  expect_equal(
+    generateDefaultName("foo/bar.Rmd"),
+    "bar"
+  )
+  expect_equal(
+    generateDefaultName("foo/index.html"),
+    "foo"
+  )
+  expect_equal(
+    generateDefaultName("foo/bar"),
+    "bar"
+  )
+
+  expect_equal(
+    generateDefaultName("foo/Awesome Document.Rmd"),
+    "Awesome_Document"
+  )
+  expect_equal(
+    generateDefaultName("My Report/index.html"),
+    "My_Report"
+  )
+  expect_equal(
+    generateDefaultName("foo/The-Application"),
+    "The-Application"
+  )
+
+  long_name <- strrep("AbCd", 64 / 4)
+  even_longer_name <- paste(long_name, "...")
+  expect_equal(
+    generateDefaultName(even_longer_name),
+    long_name
+  )
+  expect_equal(
+    generateDefaultName("short-file-path", even_longer_name),
+    long_name
+  )
 })
 
-test_that("defaultAppName reifies appNames for shinyApps", {
-  expect_equal(defaultAppName("a b c", "shinyapps.io"), "a_b_c")
-  expect_equal(defaultAppName("a!b!c", "shinyapps.io"), "a_b_c")
-  expect_equal(defaultAppName("a  b  c", "shinyapps.io"), "a_b_c")
+test_that("generateDefaultName lower-cases names shinyApps", {
+  expect_equal(
+    generateDefaultName("foo/bar.Rmd", "This/is/a/TITLE", server = "shinyapps.io"),
+    "this_is_a_title"
+  )
+  expect_equal(
+    generateDefaultName("foo/bar.Rmd", "NO", server = "shinyapps.io"),
+    "bar"
+  )
+
+  expect_equal(
+    generateDefaultName("foo/bar.Rmd", server = "shinyapps.io"),
+    "bar"
+  )
+  expect_equal(
+    generateDefaultName("foo/index.html", server = "shinyapps.io"),
+    "foo"
+  )
+  expect_equal(
+    generateDefaultName("foo/bar", server = "shinyapps.io"),
+    "bar"
+  )
 
-  long_name <- strrep("abcd", 64 / 4)
-  expect_equal(defaultAppName(paste(long_name, "..."), "shinyapps.io"), long_name)
+  expect_equal(
+    generateDefaultName("foo/Awesome Document.Rmd", server = "shinyapps.io"),
+    "awesome_document"
+  )
+  expect_equal(
+    generateDefaultName("My Report/index.html", server = "shinyapps.io"),
+    "my_report"
+  )
+  expect_equal(
+    generateDefaultName("foo/The-Application", server = "shinyapps.io"),
+    "the-application"
+  )
+
+  long_name <- strrep("AbCd", 64 / 4)
+  even_longer_name <- paste(long_name, "...")
+  expect_equal(
+    generateDefaultName(even_longer_name, server = "shinyapps.io"),
+    tolower(long_name)
+  )
+  expect_equal(
+    generateDefaultName("short-file-path", even_longer_name, server = "shinyapps.io"),
+    tolower(long_name)
+  )
 })
 
 # helpers -----------------------------------------------------------------