From 48c79700d4ec79f83d1a5c43f013421498d865a6 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Fri, 27 Oct 2023 12:08:30 -0400 Subject: [PATCH 1/2] normalize names for all servers, but lowercase for shinyapps.io fixes #1022 --- NEWS.md | 4 + R/deploymentTarget.R | 61 +++++++++++---- tests/testthat/test-deploymentTarget.R | 103 ++++++++++++++++++++++--- 3 files changed, 143 insertions(+), 25 deletions(-) diff --git a/NEWS.md b/NEWS.md index f2f2ea7f..22f619c3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,10 @@ 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. The name is derived from an incoming title, when + provided, and otherwise from the content path. (#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 ----------------------------------------------------------------- From e2236c26aee9052ac9c4bb251dba4d3a0b9a85cb Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Wed, 1 Nov 2023 09:35:05 -0400 Subject: [PATCH 2/2] generate title from path; update title from server --- NEWS.md | 10 ++- R/deploymentTarget.R | 53 +++---------- R/deployments.R | 2 +- R/title.R | 13 +-- tests/testthat/test-deploymentTarget.R | 105 ++++++------------------- 5 files changed, 45 insertions(+), 138 deletions(-) diff --git a/NEWS.md b/NEWS.md index 22f619c3..dedb27e0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,9 +4,13 @@ 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. The name is derived from an incoming title, when - provided, and otherwise from the content path. (#1022) +* When `deployApp()` is not given `appName`, the name is generated from an + incoming title, when provided. When the title is not provided, a title is + generated from the content path, which is then used to generate the + normalized application name. (#1022) + +* The application title recorded in the deployment record is updated with + server data. (#1008) * `showLogs()`, `configureApp()`, `setProperty()`, and `unsetProperty()` search for the application by name when there are no matching deployment diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 0bc8f09f..8f4e4213 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -91,10 +91,12 @@ 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 <- generateDefaultName( - recordPath = recordPath, - title = appTitle, - server = accountDetails$server + appTitle <- generateTitle(recordPath = recordPath, title = appTitle) + appName <- generateAppName( + appTitle = appTitle, + appPath = recordPath, + account = accountDetails$name, + unique = FALSE ) return(findDeploymentTargetByAppName( recordPath = recordPath, @@ -319,25 +321,7 @@ updateDeployment <- function(previous, appTitle = NULL, envVars = 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 -} - +# Generate a title from a content path. titleFromPath <- function(recordPath) { if (isDocumentPath(recordPath)) { title <- file_path_sans_ext(basename(recordPath)) @@ -354,24 +338,13 @@ titleFromPath <- function(recordPath) { title } -# 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) +# Generate a title when a title was not already specified. +generateTitle <- function(recordPath, title = NULL) { + if (is.null(title)) { + titleFromPath(recordPath) + } else { + title } - - name } shouldUpdateApp <- function(application, diff --git a/R/deployments.R b/R/deployments.R index 076455bb..a4abd028 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -98,7 +98,7 @@ saveDeployment <- function(recordDir, addToHistory = TRUE) { deployment <- deploymentRecord( name = deployment$name, - title = deployment$title, + title = application$title %||% deployment$title, username = deployment$username, account = deployment$account, server = deployment$server, diff --git a/R/title.R b/R/title.R index 16d725b7..015a1455 100644 --- a/R/title.R +++ b/R/title.R @@ -57,18 +57,7 @@ generateAppName <- function(appTitle, appPath = NULL, account = NULL, unique = T # if we wound up with too few characters, try generating from the directory # name instead if (nchar(name) < 3 && !is.null(appPath) && file.exists(appPath)) { - # strip extension if present - base <- basename(appPath) - if (nzchar(tools::file_ext(base))) { - base <- file_path_sans_ext(base) - - # if we stripped an extension and the name is now "index", use the parent - # folder's name - if (identical(base, "index")) { - base <- basename(dirname(appPath)) - } - } - name <- munge(base) + name <- munge(titleFromPath(appPath)) } # validate that we wound up with a valid name diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 7591ce29..8a8e8412 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -362,22 +362,19 @@ test_that("succeeds if there are no deployments and a single account", { expect_equal(deployment$server, "example.com") }) -test_that("default title is the empty string", { +test_that("default name and title derived from path", { local_temp_config() addTestServer() addTestAccount("ron") local_mocked_bindings( - getAppByName = function(...) data.frame( - name = "remotename", - url = "app-url", - stringsAsFactors = FALSE - ) + getAppByName = function(...) NULL ) - app_dir <- withr::local_tempdir() + app_dir <- dirCreate(file.path(withr::local_tempdir(), "MyApplication")) target <- findDeploymentTarget(app_dir, forceUpdate = TRUE) deployment <- target$deployment - expect_equal(deployment$title, "") + expect_equal(deployment$title, "MyApplication") + expect_equal(deployment$name, "myapplication") }) confirm_existing_app_used <- function(server) { @@ -385,7 +382,8 @@ confirm_existing_app_used <- function(server) { addTestServer() addTestAccount("ron", server = server) local_mocked_bindings(getAppByName = function(...) data.frame( - name = "my_app", + name = "remoteapp", + title = "Remote Application", id = 123, url = "http://example.com/test", stringsAsFactors = FALSE @@ -397,6 +395,8 @@ confirm_existing_app_used <- function(server) { target <- findDeploymentTarget(app_dir, appName = "my_app", server = server) deployment <- target$deployment expect_equal(deployment$appId, 123) + expect_equal(deployment$name, "remoteapp") + expect_equal(deployment$title, "Remote Application") } test_that("can find existing application on server & use it", { @@ -435,102 +435,43 @@ test_that("can find existing application on shinyapps.io & not use it", { confirm_existing_app_not_used("shinyapps.io") }) -# generateDefaultName --------------------------------------------------------- +# generateTitle --------------------------------------------------------- -test_that("generateDefaultName works with sites, documents, and directories", { +test_that("generateTitle works with sites, documents, and directories", { expect_equal( - generateDefaultName("foo/bar.Rmd", "This/is/a/TITLE"), - "This_is_a_TITLE" + generateTitle("foo/bar.Rmd", "This/is/a/TITLE"), + "This/is/a/TITLE" ) expect_equal( - generateDefaultName("foo/bar.Rmd", "NO"), - "bar" + generateTitle("foo/bar.Rmd", "NO"), + "NO" ) expect_equal( - generateDefaultName("foo/bar.Rmd"), + generateTitle("foo/bar.Rmd"), "bar" ) expect_equal( - generateDefaultName("foo/index.html"), + generateTitle("foo/index.html"), "foo" ) expect_equal( - generateDefaultName("foo/bar"), + generateTitle("foo/bar"), "bar" ) expect_equal( - generateDefaultName("foo/Awesome Document.Rmd"), - "Awesome_Document" + generateTitle("foo/Awesome Document.Rmd"), + "Awesome Document" ) expect_equal( - generateDefaultName("My Report/index.html"), - "My_Report" + generateTitle("My Report/index.html"), + "My Report" ) expect_equal( - generateDefaultName("foo/The-Application"), + generateTitle("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("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" - ) - - 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 -----------------------------------------------------------------