From f4986a9bf6f2d40161508cb2ef382e5b7c0bd67d Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Fri, 27 Oct 2023 12:08:30 -0400 Subject: [PATCH] normalize names for all servers, but lowercase for shinyapps.io fixes #1022 --- NEWS.md | 3 + R/deploymentTarget.R | 61 +++++++++++---- tests/testthat/test-deploymentTarget.R | 103 ++++++++++++++++++++++--- 3 files changed, 142 insertions(+), 25 deletions(-) diff --git a/NEWS.md b/NEWS.md index f2f2ea7f..f17cfd0e 100644 --- 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 index 7e6dd55b..0bc8f09f 100644 --- 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 index 5757d813..7591ce29 100644 --- 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 -----------------------------------------------------------------